From cdf665c91867e09c94549cb9a29f29b33b05a38f Mon Sep 17 00:00:00 2001 From: Luke Ceddia Date: Sat, 1 Jun 2024 16:55:44 +1000 Subject: [PATCH 1/3] Add tests for UDTs and UDT arrays --- tests/compile_tests/types/udt.bas | 81 ++++++++++++++++++++ tests/compile_tests/types/udt.output | 7 ++ tests/compile_tests/types/udt_array.bas | 89 ++++++++++++++++++++++ tests/compile_tests/types/udt_array.output | 11 +++ 4 files changed, 188 insertions(+) create mode 100644 tests/compile_tests/types/udt.bas create mode 100644 tests/compile_tests/types/udt.output create mode 100644 tests/compile_tests/types/udt_array.bas create mode 100644 tests/compile_tests/types/udt_array.output diff --git a/tests/compile_tests/types/udt.bas b/tests/compile_tests/types/udt.bas new file mode 100644 index 000000000..ad9b964bc --- /dev/null +++ b/tests/compile_tests/types/udt.bas @@ -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 diff --git a/tests/compile_tests/types/udt.output b/tests/compile_tests/types/udt.output new file mode 100644 index 000000000..063f092f1 --- /dev/null +++ b/tests/compile_tests/types/udt.output @@ -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 \ No newline at end of file diff --git a/tests/compile_tests/types/udt_array.bas b/tests/compile_tests/types/udt_array.bas new file mode 100644 index 000000000..2746c5e1b --- /dev/null +++ b/tests/compile_tests/types/udt_array.bas @@ -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 diff --git a/tests/compile_tests/types/udt_array.output b/tests/compile_tests/types/udt_array.output new file mode 100644 index 000000000..b2539a98c --- /dev/null +++ b/tests/compile_tests/types/udt_array.output @@ -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 \ No newline at end of file From 49f0471e03d28ef94293063e5a6ae0010c01b699 Mon Sep 17 00:00:00 2001 From: Luke Ceddia Date: Sat, 1 Jun 2024 17:23:22 +1000 Subject: [PATCH 2/3] Assume UDT sizes are whole number of bytes This allows simplifying how the size of UDT arrays are calculated, and thus not leave memory uninitialised when doing a redim that expands the array size. --- source/ide/ide_methods.bas | 10 +---- source/qb64pe.bas | 80 +++++++------------------------------- source/utilities/type.bas | 14 +++---- source/utilities/type.bi | 2 - 4 files changed, 22 insertions(+), 84 deletions(-) diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index 887ac59d1..5fa952ebc 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -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 + usedVariableList(tempIndex&).arrayElementSize = usedVariableList(tempIndex&).arrayElementSize \ 8 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 + usedVariableList(varDlgList(y).index).arrayElementSize = usedVariableList(varDlgList(y).index).arrayElementSize \ 8 ELSE usedVariableList(varDlgList(y).index).arrayElementSize = 0 END IF diff --git a/source/qb64pe.bas b/source/qb64pe.bas index e89fccd07..94b36d01b 100644 --- a/source/qb64pe.bas +++ b/source/qb64pe.bas @@ -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 - 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 ISSTRING THEN + IF (typ AND ISFIXEDLENGTH) = 0 THEN + udtesize(i2) = OFFSETTYPE AND 511 + udtxvariable(i) = -1 ELSE - udtesize(i2) = typ AND 511 - IF (typ AND ISOFFSETINBITS) = 0 THEN udtxbytealign(i) = 1: udtebytealign(i2) = 1 + udtesize(i2) = typsize * 8 END IF + ELSEIF typ AND ISOFFSETINBITS THEN + a$ = "Cannot use " + qb64prefix$ + "BIT inside user defined types": GOTO errmes + ELSE + udtesize(i2) = typ AND 511 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 @@ -14372,16 +14330,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 +15524,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 +15561,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 +15679,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 diff --git a/source/utilities/type.bas b/source/utilities/type.bas index 50b59897d..3b67a4aea 100644 --- a/source/utilities/type.bas +++ b/source/utilities/type.bas @@ -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 diff --git a/source/utilities/type.bi b/source/utilities/type.bi index a3a25bd03..e68e1d84f 100644 --- a/source/utilities/type.bi +++ b/source/utilities/type.bi @@ -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 From e1028d67de69ac8bfa10cb9cc95b3821e7c4321e Mon Sep 17 00:00:00 2001 From: Luke Ceddia Date: Sat, 1 Jun 2024 17:45:34 +1000 Subject: [PATCH 3/3] Zero memory on redim array of UDT allocarray() previously assumed a variable size UDT had only variable-length strings. This caused any numeric elements to remain uninitialised. --- source/qb64pe.bas | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/source/qb64pe.bas b/source/qb64pe.bas index 94b36d01b..125eebb64 100644 --- a/source/qb64pe.bas +++ b/source/qb64pe.bas @@ -13784,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