mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-20 03:14:45 +00:00
Merge pull request #497 from flukiluke/redim_preserve_reinit
Properly initialise memory when REDIMming with UDT
This commit is contained in:
commit
91eab72643
8 changed files with 215 additions and 84 deletions
|
@ -8875,10 +8875,7 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
|
|||
END IF
|
||||
|
||||
usedVariableList(tempIndex&).arrayElementSize = udtxsize(typ)
|
||||
IF udtxbytealign(typ) THEN
|
||||
IF usedVariableList(tempIndex&).arrayElementSize MOD 8 THEN usedVariableList(tempIndex&).arrayElementSize = usedVariableList(tempIndex&).arrayElementSize + (8 - (usedVariableList(tempIndex&).arrayElementSize MOD 8)) 'round up to nearest byte
|
||||
usedVariableList(tempIndex&).arrayElementSize = usedVariableList(tempIndex&).arrayElementSize \ 8
|
||||
END IF
|
||||
ELSE
|
||||
usedVariableList(tempIndex&).arrayElementSize = 0
|
||||
END IF
|
||||
|
@ -9400,10 +9397,7 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
|
|||
END IF
|
||||
|
||||
usedVariableList(varDlgList(y).index).arrayElementSize = udtxsize(typ)
|
||||
IF udtxbytealign(typ) THEN
|
||||
IF usedVariableList(varDlgList(y).index).arrayElementSize MOD 8 THEN usedVariableList(varDlgList(y).index).arrayElementSize = usedVariableList(varDlgList(y).index).arrayElementSize + (8 - (usedVariableList(varDlgList(y).index).arrayElementSize MOD 8)) 'round up to nearest byte
|
||||
usedVariableList(varDlgList(y).index).arrayElementSize = usedVariableList(varDlgList(y).index).arrayElementSize \ 8
|
||||
END IF
|
||||
ELSE
|
||||
usedVariableList(varDlgList(y).index).arrayElementSize = 0
|
||||
END IF
|
||||
|
|
|
@ -1326,13 +1326,11 @@ lasttypeelement = 0
|
|||
REDIM SHARED udtxname(1000) AS STRING * 256
|
||||
REDIM SHARED udtxcname(1000) AS STRING * 256
|
||||
REDIM SHARED udtxsize(1000) AS LONG
|
||||
REDIM SHARED udtxbytealign(1000) AS INTEGER 'first element MUST be on a byte alignment & size is a multiple of 8
|
||||
REDIM SHARED udtxnext(1000) AS LONG
|
||||
REDIM SHARED udtxvariable(1000) AS INTEGER 'true if the udt contains variable length elements
|
||||
'elements
|
||||
REDIM SHARED udtename(1000) AS STRING * 256
|
||||
REDIM SHARED udtecname(1000) AS STRING * 256
|
||||
REDIM SHARED udtebytealign(1000) AS INTEGER
|
||||
REDIM SHARED udtesize(1000) AS LONG
|
||||
REDIM SHARED udtetype(1000) AS LONG
|
||||
REDIM SHARED udtetypesize(1000) AS LONG
|
||||
|
@ -1392,27 +1390,6 @@ REDIM SHARED warningIncFiles(1000) AS STRING
|
|||
maxLineNumber = 0
|
||||
uniquenumbern = 0
|
||||
|
||||
|
||||
''create a type for storing memory blocks
|
||||
''UDT
|
||||
''names
|
||||
'DIM SHARED lasttype AS LONG
|
||||
'DIM SHARED udtxname(1000) AS STRING * 256
|
||||
'DIM SHARED udtxcname(1000) AS STRING * 256
|
||||
'DIM SHARED udtxsize(1000) AS LONG
|
||||
'DIM SHARED udtxbytealign(1000) AS INTEGER 'first element MUST be on a byte alignment & size is a multiple of 8
|
||||
'DIM SHARED udtxnext(1000) AS LONG
|
||||
''elements
|
||||
'DIM SHARED lasttypeelement AS LONG
|
||||
'DIM SHARED udtename(1000) AS STRING * 256
|
||||
'DIM SHARED udtecname(1000) AS STRING * 256
|
||||
'DIM SHARED udtebytealign(1000) AS INTEGER
|
||||
'DIM SHARED udtesize(1000) AS LONG
|
||||
'DIM SHARED udtetype(1000) AS LONG
|
||||
'DIM SHARED udtetypesize(1000) AS LONG
|
||||
'DIM SHARED udtearrayelements(1000) AS LONG
|
||||
'DIM SHARED udtenext(1000) AS LONG
|
||||
|
||||
'import _MEM type
|
||||
ptrsz = OS_BITS \ 8
|
||||
|
||||
|
@ -1420,11 +1397,9 @@ lasttype = lasttype + 1: i = lasttype
|
|||
udtxname(i) = "_MEM"
|
||||
udtxcname(i) = "_MEM"
|
||||
udtxsize(i) = ((ptrsz) * 5 + (4) * 2 + (8) * 1) * 8
|
||||
udtxbytealign(i) = 1
|
||||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "OFFSET"
|
||||
udtecname(i2) = "OFFSET"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtxnext(i) = i2
|
||||
|
@ -1432,7 +1407,6 @@ i3 = i2
|
|||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "SIZE"
|
||||
udtecname(i2) = "SIZE"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtenext(i3) = i2
|
||||
|
@ -1440,7 +1414,6 @@ i3 = i2
|
|||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "$_LOCK_ID"
|
||||
udtecname(i2) = "$_LOCK_ID"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = INTEGER64TYPE: udtesize(i2) = 64
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtenext(i3) = i2
|
||||
|
@ -1448,7 +1421,6 @@ i3 = i2
|
|||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "$_LOCK_OFFSET"
|
||||
udtecname(i2) = "$_LOCK_OFFSET"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtenext(i3) = i2
|
||||
|
@ -1456,7 +1428,6 @@ i3 = i2
|
|||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "TYPE"
|
||||
udtecname(i2) = "TYPE"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtenext(i3) = i2
|
||||
|
@ -1464,7 +1435,6 @@ i3 = i2
|
|||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "ELEMENTSIZE"
|
||||
udtecname(i2) = "ELEMENTSIZE"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = OFFSETTYPE: udtesize(i2) = ptrsz * 8
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtenext(i3) = i2
|
||||
|
@ -1473,7 +1443,6 @@ i3 = i2
|
|||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "IMAGE"
|
||||
udtecname(i2) = "IMAGE"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = LONGTYPE: udtesize(i2) = 32
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtenext(i3) = i2
|
||||
|
@ -1482,7 +1451,6 @@ i3 = i2
|
|||
lasttypeelement = lasttypeelement + 1: i2 = lasttypeelement
|
||||
udtename(i2) = "SOUND"
|
||||
udtecname(i2) = "SOUND"
|
||||
udtebytealign(i2) = 1
|
||||
udtetype(i2) = LONGTYPE: udtesize(i2) = 32
|
||||
udtetypesize(i2) = 0 'tsize
|
||||
udtenext(i3) = i2
|
||||
|
@ -1882,8 +1850,6 @@ DO
|
|||
'create global buffer for SWAP space
|
||||
siz$ = str2$(udtxsize(i) \ 8)
|
||||
WriteBufLine GlobTxtBuf, "char *g_tmp_udt_" + RTRIM$(udtxname(i)) + "=(char*)malloc(" + siz$ + ");"
|
||||
|
||||
'print "END TYPE";udtxsize(i);udtxbytealign(i)
|
||||
GOTO finishedlinepp
|
||||
END IF
|
||||
END IF
|
||||
|
@ -1940,29 +1906,21 @@ DO
|
|||
IF typ AND ISUDT THEN
|
||||
u = typ AND 511
|
||||
udtesize(i2) = udtxsize(u)
|
||||
IF udtxbytealign(u) THEN udtxbytealign(i) = 1: udtebytealign(i2) = 1
|
||||
IF udtxvariable(u) THEN udtxvariable(i) = -1
|
||||
ELSE
|
||||
IF (typ AND ISSTRING) THEN
|
||||
ELSEIF typ AND ISSTRING THEN
|
||||
IF (typ AND ISFIXEDLENGTH) = 0 THEN
|
||||
udtesize(i2) = OFFSETTYPE AND 511
|
||||
udtxvariable(i) = -1
|
||||
ELSE
|
||||
udtesize(i2) = typsize * 8
|
||||
END IF
|
||||
udtxbytealign(i) = 1: udtebytealign(i2) = 1
|
||||
ELSEIF typ AND ISOFFSETINBITS THEN
|
||||
a$ = "Cannot use " + qb64prefix$ + "BIT inside user defined types": GOTO errmes
|
||||
ELSE
|
||||
udtesize(i2) = typ AND 511
|
||||
IF (typ AND ISOFFSETINBITS) = 0 THEN udtxbytealign(i) = 1: udtebytealign(i2) = 1
|
||||
END IF
|
||||
END IF
|
||||
|
||||
'Increase block size
|
||||
IF udtebytealign(i2) THEN
|
||||
IF udtxsize(i) MOD 8 THEN
|
||||
udtxsize(i) = udtxsize(i) + (8 - (udtxsize(i) MOD 8))
|
||||
END IF
|
||||
END IF
|
||||
udtxsize(i) = udtxsize(i) + udtesize(i2)
|
||||
|
||||
'Link element to previous element
|
||||
|
@ -1972,7 +1930,7 @@ DO
|
|||
udtenext(i2 - 1) = i2
|
||||
END IF
|
||||
|
||||
'print "+"+rtrim$(udtename(i2));udtetype(i2);udtesize(i2);udtebytealign(i2);udtxsize(i)
|
||||
'print "+"+rtrim$(udtename(i2));udtetype(i2);udtesize(i2);udtxsize(i)
|
||||
IF newAsTypeBlockSyntax THEN RETURN
|
||||
GOTO finishedlinepp
|
||||
ELSE
|
||||
|
@ -13826,6 +13784,10 @@ FUNCTION allocarray (n2$, elements$, elementsize, udt)
|
|||
f12$ = f12$ + CRLF + n$ + "[0]=(ptrszint)realloc((void*)(" + n$ + "[0]),tmp_long2*" + bytesperelement$ + ");"
|
||||
f12$ = f12$ + CRLF + "if (!" + n$ + "[0]) error(257);" 'not enough memory
|
||||
f12$ = f12$ + CRLF + "if (preserved_elements<tmp_long2){"
|
||||
IF stringarray = 0 THEN
|
||||
'ensure any numeric udt elements are zeroed
|
||||
f12$ = f12$ + CRLF + "ZeroMemory(((uint8*)(" + n$ + "[0]))+preserved_elements*" + bytesperelement$ + ",(tmp_long2*" + bytesperelement$ + ")-(preserved_elements*" + bytesperelement$ + "));"
|
||||
END IF
|
||||
f12$ = f12$ + CRLF + "for(tmp_long=preserved_elements;tmp_long<tmp_long2;tmp_long++){"
|
||||
IF stringarray THEN
|
||||
f12$ = f12$ + CRLF + "if (" + n$ + "[2]&4){" 'array is in cmem
|
||||
|
@ -13859,6 +13821,7 @@ FUNCTION allocarray (n2$, elements$, elementsize, udt)
|
|||
f12$ = f12$ + CRLF + "while(tmp_long--) ((uint64*)(" + n$ + "[0]))[tmp_long]=(uint64)qbs_new(0,0);"
|
||||
f12$ = f12$ + CRLF + "}" 'not in cmem
|
||||
ELSE 'initialise udt's
|
||||
f12$ = f12$ + CRLF + "ZeroMemory((uint8*)(" + n$ + "[0]),tmp_long*" + bytesperelement$ + ");"
|
||||
f12$ = f12$ + CRLF + "while(tmp_long--){"
|
||||
acc$ = ""
|
||||
initialise_array_udt_varstrings n$, udt, 0, bytesperelement$, acc$
|
||||
|
@ -14372,16 +14335,13 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
|
|||
END IF
|
||||
n$ = scope2$ + "ARRAY_" + n$
|
||||
bits = udtxsize(i)
|
||||
IF udtxbytealign(i) THEN
|
||||
IF bits MOD 8 THEN bits = bits + 8 - (bits MOD 8)
|
||||
END IF
|
||||
|
||||
IF f = 1 THEN
|
||||
|
||||
IF LEN(elements$) = 1 AND ASC(elements$) = 63 THEN '"?"
|
||||
E = arrayelementslist(idn + 1): IF E THEN elements$ = elements$ + str2$(E) 'eg. "?3" for a 3 dimensional array
|
||||
END IF
|
||||
nume = allocarray(n$, elements$, -bits, i)
|
||||
nume = allocarray(n$, elements$, bits \ 8, i)
|
||||
IF Error_Happened THEN EXIT FUNCTION
|
||||
l$ = l$ + sp + tlayout$
|
||||
IF arraydesc THEN GOTO dim2exitfunc
|
||||
|
@ -15569,9 +15529,6 @@ FUNCTION udtreference$ (o$, a$, typ AS LONG)
|
|||
IF E = 0 THEN E = udtxnext(u) ELSE E = udtenext(E)
|
||||
IF E = 0 THEN Give_Error "Element not defined": EXIT FUNCTION
|
||||
n2$ = RTRIM$(udtename(E))
|
||||
IF udtebytealign(E) THEN
|
||||
IF o MOD 8 THEN o = o + (8 - (o MOD 8))
|
||||
END IF
|
||||
|
||||
IF n$ <> n2$ THEN
|
||||
'increment fixed offset
|
||||
|
@ -15609,7 +15566,7 @@ FUNCTION udtreference$ (o$, a$, typ AS LONG)
|
|||
|
||||
r$ = r$ + str2$(u) + sp3 + str2$(E) + sp3
|
||||
|
||||
IF o MOD 8 THEN Give_Error "QB64 cannot handle bit offsets within user defined types": EXIT FUNCTION
|
||||
IF o MOD 8 THEN Give_Error "Non-byte aligned user defined type": EXIT FUNCTION
|
||||
o = o \ 8
|
||||
|
||||
IF o$ <> "" THEN
|
||||
|
@ -15727,13 +15684,9 @@ FUNCTION evaluate$ (a2$, typ AS LONG)
|
|||
getid arrayid
|
||||
IF Error_Happened THEN EXIT FUNCTION
|
||||
o$ = RIGHT$(c$, LEN(c$) - INSTR(c$, sp3))
|
||||
'change o$ to a byte offset if necessary
|
||||
'change o$ to a byte offset
|
||||
u = typ2 AND 511
|
||||
s = udtxsize(u)
|
||||
IF udtxbytealign(u) THEN
|
||||
IF s MOD 8 THEN s = s + (8 - (s MOD 8)) 'round up to nearest byte
|
||||
s = s \ 8
|
||||
END IF
|
||||
s = udtxsize(u) \ 8
|
||||
o$ = "(" + o$ + ")*" + str2$(s)
|
||||
'print "calling evaludt with o$:"+o$
|
||||
GOTO evaludt
|
||||
|
|
|
@ -615,13 +615,11 @@ SUB increaseUDTArrays
|
|||
REDIM _PRESERVE udtxname(x + 1000) AS STRING * 256
|
||||
REDIM _PRESERVE udtxcname(x + 1000) AS STRING * 256
|
||||
REDIM _PRESERVE udtxsize(x + 1000) AS LONG
|
||||
REDIM _PRESERVE udtxbytealign(x + 1000) AS INTEGER 'first element MUST be on a byte alignment & size is a multiple of 8
|
||||
REDIM _PRESERVE udtxnext(x + 1000) AS LONG
|
||||
REDIM _PRESERVE udtxvariable(x + 1000) AS INTEGER 'true if the udt contains variable length elements
|
||||
'elements
|
||||
REDIM _PRESERVE udtename(x + 1000) AS STRING * 256
|
||||
REDIM _PRESERVE udtecname(x + 1000) AS STRING * 256
|
||||
REDIM _PRESERVE udtebytealign(x + 1000) AS INTEGER
|
||||
REDIM _PRESERVE udtesize(x + 1000) AS LONG
|
||||
REDIM _PRESERVE udtetype(x + 1000) AS LONG
|
||||
REDIM _PRESERVE udtetypesize(x + 1000) AS LONG
|
||||
|
@ -693,7 +691,7 @@ SUB initialise_array_udt_varstrings (n$, udt, base_offset, bytesperelement$, acc
|
|||
DO WHILE element
|
||||
IF udtetype(element) AND ISSTRING THEN
|
||||
IF (udtetype(element) AND ISFIXEDLENGTH) = 0 THEN
|
||||
acc$ = acc$ + CHR$(13) + CHR$(10) + "*(qbs**)(" + n$ + "[0]+(" + bytesperelement$ + "-1)*tmp_long+" + STR$(offset) + ")=qbs_new(0,0);"
|
||||
acc$ = acc$ + CHR$(13) + CHR$(10) + "*(qbs**)(" + n$ + "[0]+" + bytesperelement$ + "*tmp_long+" + STR$(offset) + ")=qbs_new(0,0);"
|
||||
END IF
|
||||
ELSEIF udtetype(element) AND ISUDT THEN
|
||||
initialise_array_udt_varstrings n$, udtetype(element) AND 511, offset, bytesperelement$, acc$
|
||||
|
@ -710,7 +708,7 @@ SUB free_array_udt_varstrings (n$, udt, base_offset, bytesperelement$, acc$)
|
|||
DO WHILE element
|
||||
IF udtetype(element) AND ISSTRING THEN
|
||||
IF (udtetype(element) AND ISFIXEDLENGTH) = 0 THEN
|
||||
acc$ = acc$ + CHR$(13) + CHR$(10) + "qbs_free(*(qbs**)(" + n$ + "[0]+(" + bytesperelement$ + "-1)*tmp_long+" + STR$(offset) + "));"
|
||||
acc$ = acc$ + CHR$(13) + CHR$(10) + "qbs_free(*(qbs**)(" + n$ + "[0]+" + bytesperelement$ + "*tmp_long+" + STR$(offset) + "));"
|
||||
END IF
|
||||
ELSEIF udtetype(element) AND ISUDT THEN
|
||||
free_array_udt_varstrings n$, udtetype(element) AND 511, offset, bytesperelement$, acc$
|
||||
|
@ -743,13 +741,13 @@ END SUB
|
|||
SUB dump_udts
|
||||
fh = FREEFILE
|
||||
OPEN "types.txt" FOR OUTPUT AS #fh
|
||||
PRINT #fh, "Name Size Align? Next Var?"
|
||||
PRINT #fh, "Name Size Next Var?"
|
||||
FOR i = 1 TO lasttype
|
||||
PRINT #fh, RTRIM$(udtxname(i)), udtxsize(i), udtxbytealign(i), udtxnext(i), udtxvariable(i)
|
||||
PRINT #fh, RTRIM$(udtxname(i)), udtxsize(i), udtxnext(i), udtxvariable(i)
|
||||
NEXT i
|
||||
PRINT #fh, "Name Size Align? Next Type Tsize Arr"
|
||||
PRINT #fh, "Name Size Next Type Tsize Arr"
|
||||
FOR i = 1 TO lasttypeelement
|
||||
PRINT #fh, RTRIM$(udtename(i)), udtesize(i), udtebytealign(i), udtenext(i), udtetype(i), udtetypesize(i), udtearrayelements(i)
|
||||
PRINT #fh, RTRIM$(udtename(i)), udtesize(i), udtenext(i), udtetype(i), udtetypesize(i), udtearrayelements(i)
|
||||
NEXT i
|
||||
CLOSE #fh
|
||||
END SUB
|
||||
|
|
|
@ -62,13 +62,11 @@ UDTTYPE = ISUDT + ISPOINTER
|
|||
REDIM SHARED udtxname(1000) AS STRING * 256
|
||||
REDIM SHARED udtxcname(1000) AS STRING * 256
|
||||
REDIM SHARED udtxsize(1000) AS LONG
|
||||
REDIM SHARED udtxbytealign(1000) AS INTEGER 'first element MUST be on a byte alignment & size is a multiple of 8
|
||||
REDIM SHARED udtxnext(1000) AS LONG
|
||||
REDIM SHARED udtxvariable(1000) AS INTEGER 'true if the udt contains variable length elements
|
||||
'elements
|
||||
REDIM SHARED udtename(1000) AS STRING * 256
|
||||
REDIM SHARED udtecname(1000) AS STRING * 256
|
||||
REDIM SHARED udtebytealign(1000) AS INTEGER
|
||||
REDIM SHARED udtesize(1000) AS LONG
|
||||
REDIM SHARED udtetype(1000) AS LONG
|
||||
REDIM SHARED udtetypesize(1000) AS LONG
|
||||
|
|
81
tests/compile_tests/types/udt.bas
Normal file
81
tests/compile_tests/types/udt.bas
Normal file
|
@ -0,0 +1,81 @@
|
|||
$Console:Only
|
||||
|
||||
'Test assignment to and size of UDT with numeric values
|
||||
Type num_t
|
||||
b As _Byte
|
||||
ub As _Unsigned _Byte
|
||||
i As Integer
|
||||
ui As _Unsigned Integer
|
||||
l As Long
|
||||
ul As _Unsigned Long
|
||||
i64 As _Integer64
|
||||
ui64 As _Unsigned _Integer64
|
||||
o As _Offset
|
||||
uo As _Unsigned _Offset
|
||||
s As Single
|
||||
d As Double
|
||||
f As _Float
|
||||
End Type
|
||||
Dim num As num_t
|
||||
num.b = -100
|
||||
num.ub = 200
|
||||
num.i = -12345
|
||||
num.ui = 54321
|
||||
num.l = -1234567
|
||||
num.ul = 7654321
|
||||
num.i64 = -123412341234
|
||||
num.ui64 = 432143214321
|
||||
num.o = -1
|
||||
num.uo = 1
|
||||
num.s = 3.5
|
||||
num.d = -1.25
|
||||
num.f = 10.125
|
||||
expected_size = Len(x%%) + Len(x~%%) + Len(x%) + Len(x~%) + Len(x&) + Len(x~&) + Len(x&&) + Len(x~&&) + Len(x%&) + Len(x~%&) + Len(x!) + Len(x#) + Len(x##)
|
||||
Print "NUM VALUES: "; num.b; num.ub; num.i; num.ui; num.l; num.ul; num.i64; num.ui64; num.o; num.uo; num.s; num.d; num.f
|
||||
Print "NUM SIZE: "; expected_size - Len(num)
|
||||
|
||||
|
||||
'Test copying between UDT instances
|
||||
Dim num2 As num_t
|
||||
num2 = num
|
||||
Print "NUM2 VALUES: "; num2.b; num2.ub; num2.i; num2.ui; num2.l; num2.ul; num2.i64; num2.ui64; num2.o; num2.uo; num2.s; num2.d; num2.f
|
||||
|
||||
|
||||
'Test fixed length string in UDT is initialised to NUL
|
||||
Type fstr_t
|
||||
a As Long
|
||||
s As String * 10
|
||||
b As Long
|
||||
End Type
|
||||
Dim fstr As fstr_t
|
||||
fstr.a = 1000
|
||||
fstr.b = -6666
|
||||
Print "FSTR UNINIT: ";
|
||||
For i = 1 To 10
|
||||
Print Asc(fstr.s, i);
|
||||
Next i
|
||||
Print
|
||||
|
||||
|
||||
'Test assignment to fixed length string in UDT
|
||||
fstr.s = "hello"
|
||||
Print "FSTR: "; fstr.a; "["; fstr.s; "] "; fstr.b
|
||||
|
||||
|
||||
'Test variable length string in UDT is initialised to 0 length
|
||||
Type vstr_t
|
||||
a As Long
|
||||
s As String
|
||||
b As Long
|
||||
End Type
|
||||
Dim vstr As vstr_t
|
||||
vstr.a = 1000
|
||||
vstr.b = -6666
|
||||
Print "VSTR LEN: "; Len(vstr.s)
|
||||
|
||||
|
||||
'Test assignment to variable length string in UDT
|
||||
vstr.s = "hello"
|
||||
Print "VSTR: "; vstr.a; "["; vstr.s; "] "; vstr.b
|
||||
|
||||
System
|
7
tests/compile_tests/types/udt.output
Normal file
7
tests/compile_tests/types/udt.output
Normal file
|
@ -0,0 +1,7 @@
|
|||
NUM VALUES: -100 200 -12345 54321 -1234567 7654321 -123412341234 432143214321 -1 1 3.5 -1.25 10.125
|
||||
NUM SIZE: 0
|
||||
NUM2 VALUES: -100 200 -12345 54321 -1234567 7654321 -123412341234 432143214321 -1 1 3.5 -1.25 10.125
|
||||
FSTR UNINIT: 0 0 0 0 0 0 0 0 0 0
|
||||
FSTR: 1000 [hello ] -6666
|
||||
VSTR LEN: 0
|
||||
VSTR: 1000 [hello] -6666
|
89
tests/compile_tests/types/udt_array.bas
Normal file
89
tests/compile_tests/types/udt_array.bas
Normal file
|
@ -0,0 +1,89 @@
|
|||
$Console:Only
|
||||
|
||||
'Test assignment to and size of numeric UDT array
|
||||
Type num_t
|
||||
a As Long
|
||||
b As Long
|
||||
End Type
|
||||
Dim na(-3 To 2) As num_t
|
||||
na(-3).a = -12345
|
||||
na(-3).b = -54321
|
||||
na(2).a = 12345
|
||||
na(2).b = 54321
|
||||
Print "NA VALUES: "; na(-3).a; na(-3).b; na(2).a; na(2).b
|
||||
Print "NA SIZE: "; Len(na())
|
||||
|
||||
|
||||
'Test resizing dynamic array of numeric UDT initialises to 0
|
||||
ReDim nda(0 To 2) As num_t
|
||||
nda(0).a = -12345
|
||||
nda(0).b = -54321
|
||||
nda(2).a = 12345
|
||||
nda(2).b = 54321
|
||||
ReDim nda(0 To 1) As num_t
|
||||
Print "NDA VALUES1: "; nda(0).a; nda(0).b; nda(1).a; nda(1).b
|
||||
ReDim nda(0 To 2) As num_t
|
||||
Print "NDA VALUES2: "; nda(0).a; nda(0).b; nda(1).a; nda(1).b; nda(2).a; nda(2).b
|
||||
|
||||
|
||||
'Test resizing _preserve dynamic array of numeric UDT initialises to 0
|
||||
ReDim _Preserve ndpa(0 To 2) As num_t
|
||||
ndpa(0).a = -12345
|
||||
ndpa(0).b = -54321
|
||||
ndpa(2).a = 12345
|
||||
ndpa(2).b = 54321
|
||||
ReDim _Preserve ndpa(0 To 1) As num_t
|
||||
Print "NDPA VALUES1: "; ndpa(0).a; ndpa(0).b; ndpa(1).a; ndpa(1).b
|
||||
ndpa(1).a = 56789
|
||||
ndpa(1).b = 98765
|
||||
ReDim _Preserve ndpa(0 To 2) As num_t
|
||||
Print "NDPA VALUES2: "; ndpa(0).a; ndpa(0).b; ndpa(1).a; ndpa(1).b; ndpa(2).a; ndpa(2).b
|
||||
|
||||
|
||||
'Test assignment to variable string UDT array
|
||||
Type str_t
|
||||
a As Long
|
||||
s As String
|
||||
b As Long
|
||||
End Type
|
||||
Dim sa(-3 To 2) As str_t
|
||||
sa(-3).a = -12345
|
||||
sa(-3).s = "hello"
|
||||
sa(-3).b = -54321
|
||||
sa(2).a = 12345
|
||||
sa(2).s = "strings"
|
||||
sa(2).b = 54321
|
||||
Print "SA VALUES: "; sa(-3).a; sa(-3).s; sa(-3).b; sa(2).a; sa(2).s; sa(2).b
|
||||
|
||||
|
||||
'Test resizing dynamic array of variable string UDT initialises to 0 / empty string
|
||||
ReDim sda(0 To 2) As str_t
|
||||
sda(0).a = -12345
|
||||
sda(0).s = "hello"
|
||||
sda(0).b = -54321
|
||||
sda(2).a = 12345
|
||||
sda(2).s = "strings"
|
||||
sda(2).b = 54321
|
||||
ReDim sda(0 To 1) As str_t
|
||||
Print "SDA VALUES1: "; sda(0).a; sda(0).s; sda(0).b; sda(1).a; sda(1).s; sda(1).b
|
||||
ReDim sda(0 To 2) As str_t
|
||||
Print "SDA VALUES2: "; sda(0).a; sda(0).s; sda(0).b; sda(1).a; sda(1).s; sda(1).b; sda(2).a; sda(2).s; sda(2).b
|
||||
|
||||
|
||||
'Test resizing _preserve dynamic array of variable string UDT initialises new elements to 0 / empty string
|
||||
ReDim _Preserve sdpa(0 To 2) As str_t
|
||||
sdpa(0).a = -12345
|
||||
sdpa(0).s = "hello"
|
||||
sdpa(0).b = -54321
|
||||
sdpa(2).a = 12345
|
||||
sdpa(2).s = "strings"
|
||||
sdpa(2).b = 54321
|
||||
ReDim _Preserve sdpa(0 To 1) As str_t
|
||||
Print "SDPA VALUES1: "; sdpa(0).a; sdpa(0).s; sdpa(0).b; sdpa(1).a; sdpa(1).s; sdpa(1).b
|
||||
sdpa(1).a = 56789
|
||||
sdpa(1).s = "more"
|
||||
sdpa(1).b = 98765
|
||||
ReDim _Preserve sdpa(0 To 2) As str_t
|
||||
Print "SDPA VALUES2: "; sdpa(0).a; sdpa(0).s; sdpa(0).b; sdpa(1).a; sdpa(1).s; sdpa(1).b; sdpa(2).a; sdpa(2).s; sdpa(2).b
|
||||
|
||||
System
|
11
tests/compile_tests/types/udt_array.output
Normal file
11
tests/compile_tests/types/udt_array.output
Normal file
|
@ -0,0 +1,11 @@
|
|||
NA VALUES: -12345 -54321 12345 54321
|
||||
NA SIZE: 48
|
||||
NDA VALUES1: 0 0 0 0
|
||||
NDA VALUES2: 0 0 0 0 0 0
|
||||
NDPA VALUES1: -12345 -54321 0 0
|
||||
NDPA VALUES2: -12345 -54321 56789 98765 0 0
|
||||
SA VALUES: -12345 hello-54321 12345 strings 54321
|
||||
SDA VALUES1: 0 0 0 0
|
||||
SDA VALUES2: 0 0 0 0 0 0
|
||||
SDPA VALUES1: -12345 hello-54321 0 0
|
||||
SDPA VALUES2: -12345 hello-54321 56789 more 98765 0 0
|
Loading…
Reference in a new issue