Dim-Like-Bug

[ReneMiner]

I thought it had been solved previously already but it re-occurs now. If i call a function that does Dim ... Like ... the function keeps the initial variable-type in memory and does not dim to the correct type thereafter.
it's in the Function tMyMaintype.PrintOutXXX(), line 232
strange because in tAnyType.Alloc(), line 142 it works correct.
(look for multiple "<")



#MINVERSION 1.9.15.0

Uses "console"


'---------------------------------------------------------------------------------
' This is a global function that will enumerate all requested type-names
' each type-name will result in a pointer where the name can be read out
' use Heap_Get on this pointer to retrieve the name
' the pointer is equal and constant to all of the same enumerated type
' - no type gets stored twice

Function Type_Enumerate(ByVal sType As String, _
Optional ByVal TestExist As Boolean _
) As DWord
'---------------------------------------------------------------------------------

Static hAllTypes As DWord
' this points a heap with a list of pointers (Dword-array)
' to all by this function enumerated type-names

Local i As Long ' will hold the index of requested pointer


If Not Type_Exists(sType) Then Return 0 ' if it's not a type then return nothing


sType = Ucase$(sType) ' from here all works in UCase


If HEAP_Size(hAllTypes) Then ' are there any pointers already?


' place Dword-array upon the pointer-list
Local vPtr(HEAP_Size(hAllTypes)/4) As DWord At hAllTypes

' and scan if any of the list points the requested type-name
i = Array Scan vPtr Ptr, = sType

If i Then
' result where to read out the type/global unique Type-ID
Return vPtr(i)
Else
' if just check existance return 0 since not exists
If TestExist Then Return 0
EndIf

Else ' there's none enumerated yet
If TestExist Then Return 0

EndIf

' store sType and append its Pointer to function-static hAllTypes
hAllTypes = HEAP_ReAllocByStr(hAllTypes, HEAP_Get(hAllTypes) & MKDWD$(HEAP_AllocByStr(sType)) )

' return last appended pointer
Function = Peek(DWord, HEAP_End(hAllTypes) - 3 )

End Function

'---------------------------------------------------------------------------------

' tAnyType is the opportunity to node any subtype or array to an udt-element
' so the subtype is not necessariliy the same to all elements of the main-type



'##################################################################################
Type tAnyType
'##################################################################################
Static pTypes As DWord ' list of Dwords at heap
Static pVarPtrs As DWord ' list of Dwords in same order as above
' statics are - as you surely know - the same to all members of the type, no matter what the variable is named...

pData As DWord

Alloc As Function
GetKeyIndex As Function
GetType As Function
End Type

'---------------------------------------------------------------------------------
Function tAnyType.GetKeyIndex(Optional ByVal testExist As Boolean) As Long
'---------------------------------------------------------------------------------
' returns Index of this if available
' or creates new slot if not testExist


' the local key is the varptr:
Local lKey As DWord = VarPtr(Me)
Local lResult As Long

If HEAP_Size(Me.pVarptrs) >= 4 Then

Local lPtr(HEAP_Size(Me.pVarptrs)/4) As DWord At Me.pVarPtrs

lResult = Array Scan lPtr, = lKey

If lResult Then Return lResult
EndIf

If testExist Then Return 0

' make a new one:

Me.pVarptrs = HEAP_ReAllocByStr(Me.pVarptrs, HEAP_Get(Me.pVarptrs) & MKDWD$(lKey))
Me.pTypes = HEAP_ReAllocByStr(Me.pTypes, HEAP_Get(Me.pTypes) & MKDWD$(0))

Function = HEAP_Size(Me.pVarptrs)/4


End Function


'---------------------------------------------------------------------------------
Function tAnyType.Alloc(ByVal sType As String, _
Optional ByVal lUbound As Long = 1 _
) As String
'---------------------------------------------------------------------------------

' this will allocate desired space and store the types name


Local Index As Long = Me.GetKeyIndex()
Local pType(Index) As DWord At Me.pTypes

If HEAP_Size(Me.pData) Then HEAP_Free(Me.pData)
Me.pData = 0 ' usually you may check .pData <> 0 for success, but i omit this below...

pType(Index) = Type_Enumerate(sType)

If Not pType(Index) Then Return "Byte"

lUbound = MinMax(lUbound, 1, &H7FFFFFFF )

If HEAP_Get(pType(Index)) = "STRING" Then
' = dword-array of heap-pointers
Me.pData = HEAP_Alloc(lUbound * 4)
Function = "DWORD"
Else
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< strangely in this case it works correct ! <<<<<<<<<<<<<<
Local data Like sType At 0
Me.pData = HEAP_Alloc(lUbound * SizeOf(data))
Function = sType
EndIf


End Function

'---------------------------------------------------------------------------------
Function tAnyType.GetType() As String
'---------------------------------------------------------------------------------
' this will return the stored Type-name if one


Local Index As Long = Me.GetKeyIndex(TRUE) ' true means check for existance

If Index = 0 Then Return "byte" ' get out of here

Local pType(Index) As DWord At Me.pTypes

Function = HEAP_Get(pType(Index))

End Function




' ################################################################################
' example

' this allows for example an array of completely different
' objects within the same variable-scope

' make 2 totally different subtypes, only have a matching function-name:
'##############################
Type tMySubType1
'##############################
lVal As Long
sVal As Single
PrintOut As Function
End Type

'------------------------------
Function tMySubtype1.PrintOut()
'------------------------------

PrintL "lVal " & Str$(Me.lVal) ' identify "Me" by printing the udt-element-names...
PrintL "sVal " & Str$(Me.sVal)
PrintL

End Function

'##############################
Type tMySubType2
'##############################
qVal As Quad
dVal As Double
PrintOut As Function
End Type

'------------------------------
Function tMySubtype2.PrintOut()
'------------------------------

PrintL "qVal " & Str$(Me.qVal)
PrintL "dVal " & Str$(Me.dVal)
PrintL

End Function


' and a main-type:

'##############################
Type tMyMaintype
'##############################
xxx As tAnyType
PrintOutXXX As Function
End Type


'------------------------------
Function tMyMaintype.PrintOutXXX()
'------------------------------

PrintL "Me.xxx.GetType = " & Me.xxx.GetType()

' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< BUGGY LINE <<<<<<<<<<<
'[!] BUG

Local data Like Me.xxx.GetType() At Me.xxx.pData
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

' data stays the initially called type:

data.PrintOut()

End Function

' &&&&&&&&&&&&&&&&&&&&&&&&&& now the code:

' have an array of maintype:
Dim foo(4) As tMyMainType

' fill in some data now to the xxx-subelements
Dim i As Long

' subtype1 for foo(1).xxx
Dim st1 Like foo(1).xxx.Alloc("tMySubtype1") At foo(1).xxx.pData
st1.lVal = 12 : st1.sVal = 1.2

' subtype2 for foo(2).xxx
Dim st2 Like foo(2).xxx.Alloc("tMySubtype2") At foo(2).xxx.pData
st2.qVal = 22222222222222 : st2.dVal = 2.345

' and some more:
foo(3).xxx.Alloc("tMySubtype1")
SetAt( st1, foo(3).xxx.pData )
st1.lVal = 34 : st1.sVal = 3.4

foo(4).xxx.Alloc("tMySubtype2")
SetAt( st2, foo(4).xxx.pData )
st2.qVal = 44444444444444 : st2.dVal = 4.567

' now lets check:

For i = 1 To UBound(foo)

' expect the same output for both:

PrintL "foo(" & TStr$(i) & ").PrintOutXXX:"

foo(i).PrintOutXXX()
' recheck for the correctness:
' but foo(2) and (4) don't call the correct types function :(
' and (3) is just a coincidence :(((
PrintL "Re-check:"

Select Case foo(i).xxx.GetType()
Case "TMYSUBTYPE1"
SetAt(st1, foo(i).xxx.pData )
st1.PrintOut()
Case"TMYSUBTYPE2"
SetAt(st2, foo(i).xxx.pData )
st2.PrintOut()

End Select

Next

PrintL $CRLF & "any key to end"
WaitKey


PS. if something returns "Byte" not in Ucase$ - its just to omit the error and make it "trap-able". (.pData would be 0- i was layzy here and did'nt want to torture you with more code than necessary...)

[ErosOlmi]

I will have a look asap.
Strange

[Petr Schreiber]

Hi guys,

I tried to make the example for replicating as simple as possible, and here is what I created:


Type greeterCzech
sayHello As Function
End Type

Function greeterCzech.SayHello()
MsgBox 0, "Ahoj"
End Function

' --

Type greeterItalian
sayHello As Function
End Type

Function greeterItalian.SayHello()
MsgBox 0, "Ciao"
End Function

' --

Function CreateAndUseGreeter_Incorrect( whichOne As String )
Dim g Like whichOne

g.sayHello() ' -- This will always use the first type in declaration, for some reason
End Function

Function CreateAndUseGreeter_Correct( whichOne As String )
Dim g Like whichOne

String s = g.sayHello() ' -- Working with return value fixes the issue? :D
End Function

' --
MsgBox 0, "You should see ""Ahoj"" and ""Ciao"""
CreateAndUseGreeter_Incorrect("greeterCzech")
CreateAndUseGreeter_Incorrect("greeterItalian")
MsgBox 0, "...you saw twice ""Ahoj"" because of issue"

MsgBox 0, "You should see ""Ahoj"" and ""Ciao"""
CreateAndUseGreeter_Correct("greeterCzech")
CreateAndUseGreeter_Correct("greeterItalian")
MsgBox 0, "worked okay!"


It seems there is some difference if you watch the return value (even if it does not have meaning) and if you don't.

Rene, could this help you workaround the issue?


Petr

[ReneMiner]

Nice to have a solution for this :)


Anyway I'd like to have a built-in Type_Enumerate()-Function for dynamic Dim-Like-Cases (see top of page) which returns a pointer where the once stored type-name can be read out.

Advanced were not in the way above but deeper inside core - so any type/primitive variable that gets dimensioned could return its current Type_Name()




Function tSomeType.SomeFunction()

'... is Me the basetype or is it some extension? SizeOf can't tell for sure...

If Type_Name( Me ) = "TSOMETYPE" Then
' yes it is
EndIf

End Function

[ErosOlmi]

I think I've found the problem.

In version 1.9.15 I started to optimize a bit methods lookup.
When parser found a UDT and then a method, it search for the method ID and stores it in an inline structure used to optimize code execution.
The second time the same peace of code is encountered/executed, parser first search into the inline optimization structure and only if not found it lookup the methods inside UDT hash table.
That's why, in some cases (the one I started to optimize), the wrong method is executed when UDT is declared using LIKE.

I will try to add optimization only when UDT is declared in a fixed way and not using a dynamic method like LIKE.

[ErosOlmi]

Nice to have a solution for this :)


Anyway I'd like to have a built-in Type_Enumerate()-Function for dynamic Dim-Like-Cases (see top of page) which returns a pointer where the once stored type-name can be read out.

Advanced were not in the way above but deeper inside core - so any type/primitive variable that gets dimensioned could return its current Type_Name()




Function tSomeType.SomeFunction()

'... is Me the basetype or is it some extension? SizeOf can't tell for sure...

If Type_Name( Me ) = "TSOMETYPE" Then
' yes it is
EndIf

End Function



As usual, always interesting requests!
Will check what I can do because actually I do not store any string info but only the referred UDT internal numeric ID.