QB64/QB64-PE
QB64/QB64-PE
1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-06-01 10:10:15 +00:00
Code Issues Releases Wiki Activity

Replace CONSTs while we have the individual elements

Browse source 
This moves the CONST replacement up before we turn the elements into a
single string. The advantage is that we don't have to worry about
splitting the string properly to find the CONST names as the elements
are already split for us.t
This commit is contained in:
Matthew Kilgore 2024-01-05 23:01:51 -05:00
parent 0122c6c11e
commit 90941fffa7
58 changed files with 4119 additions and 2559 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
source/global/constants.bas
View file

@ -60,3 +60,6 @@ CONST KEY_TAB = 9
DIM SHARED CHR_QUOTE AS STRING: CHR_QUOTE = CHR$(34)
DIM SHARED CHR_TAB AS STRING: CHR_TAB = CHR$(9)
DIM SHARED CRLF AS STRING: CRLF = CHR$(13) + CHR$(10) 'carriage return+line feed
DIM SHARED OS_BITS AS LONG
OS_BITS = 64: IF INSTR(_OS$, "[32BIT]") THEN OS_BITS = 32

3
source/ide/ide_methods.bas
View file

@ -5461,8 +5461,9 @@ FUNCTION ide2 (ignore)
retval$ = ideinputbox$("Math Evaluator", "#Enter expression", mathEvalExpr$, "", 60, 0, 0)
result = 0
IF LEN(retval$) THEN
Dim num As ParseNum
mathEvalExpr$ = retval$
ev0$ = Evaluate_Expression$(retval$)
ev0$ = Evaluate_Expression$(retval$, num)
ev$ = ev0$
mathEvalError%% = INSTR(ev$, "ERROR") > 0
IF mathEvalError%% = 0 AND mathEvalHEX%% THEN ev$ = "&H" + HEX$(VAL(ev$))

2574
source/qb64pe.bas
View file

File diff suppressed because it is too large Load diff

1117
source/utilities/const_eval.bas Normal file
View file

File diff suppressed because it is too large Load diff

20
source/utilities/const_eval.bi Normal file
View file

@ -0,0 +1,20 @@
TYPE ConstFunction
nam AS STRING
ArgCount AS INTEGER ' If positive, this is the number of argument this function accepts
END TYPE
REDIM SHARED ConstFuncs(1000) AS ConstFunction
TYPE ParseNum
f AS _FLOAT
i AS _INTEGER64
ui AS _UNSIGNED _INTEGER64
s AS STRING
typ AS LONG
END TYPE
CONST CONST_EVAL_DEBUG = 0
Set_ConstFunctions

300
source/utilities/elements.bas
View file

@ -24,6 +24,71 @@ FUNCTION getelement$ (a$, elenum)
GOTO getelementnext
END FUNCTION
' Used to iterate over all the elements in a$
'
' index returns the current element number. index = -1 after last element
' strIndex is string index of the start of the next element
'
' index and strIndex should start initialized to zero
FUNCTION getnextelement$ (a$, index AS LONG, strIndex AS LONG)
DIM i AS LONG
IF strIndex = 0 THEN strIndex = 1
i = INSTR(strIndex, a$, sp)
IF i THEN
getnextelement$ = MID$(a$, strIndex, i - strIndex)
strIndex = i + 1
index = index + 1
ELSEIF strIndex <> LEN(a$) + 1 THEN
getnextelement$ = MID$(a$, strIndex)
strIndex = LEN(a$) + 1
index = index + 1
ELSE
index = -1
END IF
END FUNCTION
FUNCTION peeknextelement$ (a$, index AS LONG, strIndex AS LONG)
peeknextelement$ = getnextelement$(a$, (index), (strIndex))
END FUNCTION
SUB pushelement (a$, b$)
IF a$ <> "" THEN a$ = a$ + sp + b$ ELSE a$ = b$
END SUB
' Used to iterate over all the elements in a$ start with the last
'
' index returns the current element number. index = -1 after last element
' strIndex is string index of the start of the next element in the iteration
'
' index and strIndex should start initialized to zero, iteration will start at last element
FUNCTION getprevelement$ (a$, index AS LONG, strIndex AS LONG)
DIM i AS LONG
IF strIndex = 0 THEN strIndex = LEN(a$): Index = numelements(a$) + 1
IF strIndex = -1 THEN Index = -1: EXIT FUNCTION
IF strIndex > 0 THEN i = _INSTRREV(strIndex, a$, sp)
IF i THEN
getprevelement$ = MID$(a$, i + 1, strIndex - i)
strIndex = i - 1
index = index - 1
' Handle the case of an empty first element, strIndex would be zero
' which would trigger the starting logic again
IF strIndex = 0 THEN strIndex = -2
ELSEIF strIndex <> -1 THEN
getprevelement$ = MID$(a$, 1, strIndex)
strIndex = -1
index = index - 1
ELSE
index = -1
END IF
END FUNCTION
FUNCTION getelements$ (a$, i1, i2)
DIM p AS LONG, n AS LONG, i AS LONG, i1pos AS LONG
@ -48,6 +113,29 @@ FUNCTION getelements$ (a$, i1, i2)
GOTO getelementsnext
END FUNCTION
FUNCTION getelementsbefore$ (a$, i1)
getelementsbefore$ = getelements$(a$, 1, i1)
END FUNCTION
FUNCTION getelementsafter$ (a$, i1)
DIM p AS LONG, n AS LONG, i AS LONG, i1pos AS LONG
n = 1
p = 1
getelementsnext:
i = INSTR(p, a$, sp)
IF n = i1 THEN
getelementsafter$ = RIGHT$(a$, LEN(a$) - p + 1)
EXIT FUNCTION
END IF
n = n + 1
p = i + 1
GOTO getelementsnext
END FUNCTION
SUB insertelements (a$, i, elements$)
DIM a2 AS STRING, n AS LONG, i2 AS LONG
@ -109,6 +197,10 @@ SUB removeelements (a$, first, last, keepindexing)
END SUB
SUB removeelement (a$, i)
removeelements a$, i, i, 0
END SUB
' a$ should be a function argument list
' Returns number of function arguments (including empty ones) in the provided list
FUNCTION countFunctionElements (a$)
@ -310,3 +402,211 @@ FUNCTION isValidArgSet (format AS STRING, providedArgs() AS LONG, firstOptionalA
isValidArgSet = -1
END FUNCTION
FUNCTION eleucase$ (a$)
DIM i AS LONG, i2 AS LONG, a2$, sp34$, i3 AS LONG
'this function upper-cases all elements except for quoted strings
'check first element
IF LEN(a$) = 0 THEN EXIT FUNCTION
i = 1
IF ASC(a$) = 34 THEN
i2 = INSTR(a$, sp)
IF i2 = 0 THEN eleucase$ = a$: EXIT FUNCTION
a2$ = LEFT$(a$, i2 - 1)
i = i2
END IF
'check other elements
sp34$ = sp + CHR$(34)
IF i < LEN(a$) THEN
DO WHILE INSTR(i, a$, sp34$)
i2 = INSTR(i, a$, sp34$)
a2$ = a2$ + UCASE$(MID$(a$, i, i2 - i + 1)) 'everything prior including spacer
i3 = INSTR(i2 + 1, a$, sp): IF i3 = 0 THEN i3 = LEN(a$) ELSE i3 = i3 - 1
a2$ = a2$ + MID$(a$, i2 + 1, i3 - (i2 + 1) + 1) 'everything from " to before next spacer or end
i = i3 + 1
IF i > LEN(a$) THEN EXIT DO
LOOP
END IF
a2$ = a2$ + UCASE$(MID$(a$, i, LEN(a$) - i + 1))
eleucase$ = a2$
END FUNCTION
'
' The natural type of the value is returned.
'
' The actual value is given back as floating point, integer, and unsigned integer.
'
FUNCTION elementGetNumericValue&(ele$, floating AS _FLOAT, integral AS _INTEGER64, uintegral AS _UNSIGNED _INTEGER64)
Dim num$, typ&, e$, x As Long
num$ = ele$
typ& = 0
' Cut off the hex/oct/bin representation if present
IF INSTR(num$, ",") THEN num$ = MID$(num$, 1, INSTR(num$, ",") - 1)
' integer suffixes
e$ = RIGHT$(num$, 3)
IF e$ = "~&&" THEN elementGetNumericValue& = UINTEGER64TYPE - ISPOINTER: GOTO handleInteger
IF e$ = "~%%" THEN elementGetNumericValue& = UBYTETYPE - ISPOINTER: GOTO handleInteger
e$ = RIGHT$(num$, 2)
IF e$ = "&&" THEN elementGetNumericValue& = INTEGER64TYPE - ISPOINTER: GOTO handleInteger
IF e$ = "%%" THEN elementGetNumericValue& = BYTETYPE - ISPOINTER: GOTO handleInteger
IF e$ = "~%" THEN elementGetNumericValue& = UINTEGERTYPE - ISPOINTER: GOTO handleInteger
IF e$ = "~&" THEN elementGetNumericValue& = ULONGTYPE - ISPOINTER: GOTO handleInteger
e$ = RIGHT$(num$, 1)
IF e$ = "%" THEN elementGetNumericValue& = INTEGERTYPE - ISPOINTER: GOTO handleInteger
IF e$ = "&" THEN elementGetNumericValue& = LONGTYPE - ISPOINTER: GOTO handleInteger
'ubit-type?
IF INSTR(num$, "~`") THEN
x = INSTR(num$, "~`")
elementGetNumericValue& = UBITTYPE - ISPOINTER - 1 + VAL(RIGHT$(num$, LEN(num$) - x - 1))
integral = VAL(LEFT$(num$, x - 1))
uintegral = integral
floating = integral
EXIT FUNCTION
END IF
'bit-type?
IF INSTR(num$, "`") THEN
x = INSTR(num$, "`")
elementGetNumericValue& = BITTYPE - ISPOINTER - 1 + VAL(RIGHT$(num$, LEN(num$) - x))
integral = VAL(LEFT$(num$, x - 1))
uintegral = integral
floating = integral
EXIT FUNCTION
END IF
'floats
IF INSTR(num$, "F") OR RIGHT$(num$, 2) = "##" THEN
floating = VAL(num$)
integral = floating
uintegral = floating
elementGetNumericValue& = FLOATTYPE - ISPOINTER
EXIT FUNCTION
END IF
IF INSTR(num$, "E") OR RIGHT$(num$, 1) = "!" THEN
floating = VAL(num$)
integral = floating
uintegral = floating
elementGetNumericValue& = SINGLETYPE - ISPOINTER
EXIT FUNCTION
END IF
IF INSTR(num$, "D") OR RIGHT$(num$, 1) = "#" OR INSTR(num$, ".") THEN
floating = VAL(num$)
integral = floating
uintegral = floating
elementGetNumericValue& = DOUBLETYPE - ISPOINTER
EXIT FUNCTION
END IF
' No mentioned type, assume int64
elementGetNumericValue& = INTEGER64TYPE - ISPOINTER
e$ = ""
handleInteger:
num$ = LEFT$(num$, LEN(num$) - LEN(e$))
integral = VAL(num$)
uintegral = integral
floating = integral
END FUNCTION
' Returns whether the given element is a number
'
' Note that it allows numbers to have a negative sign.
FUNCTION elementIsNumber&(oele$)
DIM ele$, res&
IF oele$ = "" THEN EXIT FUNCTION
ele$ = oele$
' Skip the negative if present
IF ASC(ele$) = ASC("-") THEN ele$ = MID$(ele$, 2)
' Can start with a decimal point
res& = (ASC(ele$) >= ASC("0") AND ASC(ele$) <= ASC("9"))
IF NOT res& AND LEN(ele$) > 1 THEN res& = (ASC(ele$) = ASC(".") AND (ASC(ele$, 2) >= ASC("0") AND ASC(ele$, 2) <= ASC("9")))
elementIsNumber& = res&
END FUNCTION
FUNCTION elementIsString&(ele$)
' String elements are always surounded by quotes
elementIsString& = INSTR(ele$, CHR$(34))
END FUNCTION
FUNCTION elementGetStringValue&(ele$, value AS STRING)
Dim rawString$, res$, i AS LONG
' We have to invert the escaping done by createElementString
'
' Note this does not handle all possible C escaping, just the specific
' escaping done by createElementString
'
rawString$ = MID$(ele$, 2, INSTR(2, ele$, CHR$(34)) - 2)
res$ = ""
i = 1
WHILE INSTR(i, rawString$, "\")
res$ = res$ + MID$(rawString$, i, INSTR(i, rawString$, "\") - i)
i = INSTR(i, rawString$, "\") + 1
IF ASC(rawString$, i) = ASC("\") THEN
res$ = res$ + "\"
i = i + 1
ELSE
res$ = res$ + CHR$(VAL("&O" + MID$(rawString$, i, 3)))
i = i + 3
END IF
WEND
value = res$ + MID$(rawString$, i)
elementGetStringValue& = STRINGTYPE
END FUNCTION
' s$ should be all the data making up the string, with no quotes around it
'
' The string data will have C escape sequences in it if necessary
FUNCTION createElementString$(s$)
Dim ele$, o$, p1 As Long, c2 As Long, i As Long
ele$ = CHR$(34)
p1 = 1
FOR i = 1 TO LEN(s$)
c2 = ASC(s$, i)
IF c2 = 92 THEN '\
ele$ = ele$ + MID$(s$, p1, i - p1) + "\\"
p1 = i + 1
END IF
IF c2 < 32 OR c2 = 34 OR c2 > 126 THEN
o$ = OCT$(c2)
IF LEN(o$) < 3 THEN
o$ = "0" + o$
IF LEN(o$) < 3 THEN o$ = "0" + o$
END IF
ele$ = ele$ + MID$(s$, p1, i - p1) + "\" + o$
p1 = i + 1
END IF
NEXT
ele$ = ele$ + MID$(s$, p1) + CHR$(34) + "," + _TRIM$(STR$(LEN(s$)))
createElementString$ = ele$
END FUNCTION
FUNCTION elementStringConcat$(os1$, os2$)
DIM s1$, s2$, s1size AS LONG, s2size AS LONG
'concat strings
s1$ = MID$(os1$, 2, _INSTRREV(os1$, CHR$(34)) - 2)
s1size = VAL(RIGHT$(os1$, LEN(os1$) - LEN(s1$) - 3))
s2$ = MID$(os2$, 2, _INSTRREV(os2$, CHR$(34)) - 2)
s2size = VAL(RIGHT$(os2$, LEN(os2$) - LEN(s2$) - 3))
elementStringConcat$ = CHR$(34) + s1$ + s2$ + CHR$(34) + "," + _TRIM$(STR$(s1size + s2size))
END FUNCTION

5
source/utilities/give_error.bas Normal file
View file

@ -0,0 +1,5 @@
SUB Give_Error (a$)
Error_Happened = 1
Error_Message = a$
END SUB

4
source/utilities/give_error.bi Normal file
View file

@ -0,0 +1,4 @@
DIM SHARED Error_Happened AS LONG
DIM SHARED Error_Message AS STRING

333
source/utilities/hash.bas Normal file
View file

@ -0,0 +1,333 @@
FUNCTION HashValue& (a$) 'returns the hash table value of a string
'[5(first)][5(second)][5(last)][5(2nd-last)][3(length AND 7)][1(first char is underscore)]
l = LEN(a$)
IF l = 0 THEN EXIT FUNCTION 'an (invalid) NULL string equates to 0
a = ASC(a$)
IF a <> 95 THEN 'does not begin with underscore
SELECT CASE l
CASE 1
HashValue& = hash1char(a) + 1048576
EXIT FUNCTION
CASE 2
HashValue& = hash2char(CVI(a$)) + 2097152
EXIT FUNCTION
CASE 3
HashValue& = hash2char(CVI(a$)) + hash1char(ASC(a$, 3)) * 1024 + 3145728
EXIT FUNCTION
CASE ELSE
HashValue& = hash2char(CVI(a$)) + hash2char(ASC(a$, l) + ASC(a$, l - 1) * 256) * 1024 + (l AND 7) * 1048576
EXIT FUNCTION
END SELECT
ELSE 'does begin with underscore
SELECT CASE l
CASE 1
HashValue& = (1048576 + 8388608): EXIT FUNCTION 'note: underscore only is illegal in QB64 but supported by hash
CASE 2
HashValue& = hash1char(ASC(a$, 2)) + (2097152 + 8388608)
EXIT FUNCTION
CASE 3
HashValue& = hash2char(ASC(a$, 2) + ASC(a$, 3) * 256) + (3145728 + 8388608)
EXIT FUNCTION
CASE 4
HashValue& = hash2char((CVL(a$) AND &HFFFF00) \ 256) + hash1char(ASC(a$, 4)) * 1024 + (4194304 + 8388608)
EXIT FUNCTION
CASE ELSE
HashValue& = hash2char((CVL(a$) AND &HFFFF00) \ 256) + hash2char(ASC(a$, l) + ASC(a$, l - 1) * 256) * 1024 + (l AND 7) * 1048576 + 8388608
EXIT FUNCTION
END SELECT
END IF
END FUNCTION
SUB HashAdd (a$, flags, reference)
'find the index to use
IF HashListFreeLast > 0 THEN
'take from free list
i = HashListFree(HashListFreeLast)
HashListFreeLast = HashListFreeLast - 1
ELSE
IF HashListNext > HashListSize THEN
'double hash list size
HashListSize = HashListSize * 2
REDIM _PRESERVE HashList(1 TO HashListSize) AS HashListItem
REDIM _PRESERVE HashListName(1 TO HashListSize) AS STRING * 256
END IF
i = HashListNext
HashListNext = HashListNext + 1
END IF
'setup links to index
x = HashValue(a$)
i2 = HashTable(x)
IF i2 THEN
i3 = HashList(i2).LastItem
HashList(i2).LastItem = i
HashList(i3).NextItem = i
HashList(i).PrevItem = i3
ELSE
HashTable(x) = i
HashList(i).PrevItem = 0
HashList(i).LastItem = i
END IF
HashList(i).NextItem = 0
'set common hashlist values
HashList(i).Flags = flags
HashList(i).Reference = reference
HashListName(i) = UCASE$(a$)
END SUB
FUNCTION HashFind (a$, searchflags, resultflags, resultreference)
'(0,1,2)z=hashfind[rev]("RUMI",Hashflag_label,resflag,resref)
'0=doesn't exist
'1=found, no more items to scan
'2=found, more items still to scan
i = HashTable(HashValue(a$))
IF i THEN
ua$ = UCASE$(a$) + SPACE$(256 - LEN(a$))
hashfind_next:
f = HashList(i).Flags
IF searchflags AND f THEN 'flags in common
IF HashListName(i) = ua$ THEN
resultflags = f
resultreference = HashList(i).Reference
i2 = HashList(i).NextItem
IF i2 THEN
HashFind = 2
HashFind_NextListItem = i2
HashFind_Reverse = 0
HashFind_SearchFlags = searchflags
HashFind_Name = ua$
HashRemove_LastFound = i
EXIT FUNCTION
ELSE
HashFind = 1
HashRemove_LastFound = i
EXIT FUNCTION
END IF
END IF
END IF
i = HashList(i).NextItem
IF i THEN GOTO hashfind_next
END IF
END FUNCTION
FUNCTION HashFindRev (a$, searchflags, resultflags, resultreference)
'(0,1,2)z=hashfind[rev]("RUMI",Hashflag_label,resflag,resref)
'0=doesn't exist
'1=found, no more items to scan
'2=found, more items still to scan
i = HashTable(HashValue(a$))
IF i THEN
i = HashList(i).LastItem
ua$ = UCASE$(a$) + SPACE$(256 - LEN(a$))
hashfindrev_next:
f = HashList(i).Flags
IF searchflags AND f THEN 'flags in common
IF HashListName(i) = ua$ THEN
resultflags = f
resultreference = HashList(i).Reference
i2 = HashList(i).PrevItem
IF i2 THEN
HashFindRev = 2
HashFind_NextListItem = i2
HashFind_Reverse = 1
HashFind_SearchFlags = searchflags
HashFind_Name = ua$
HashRemove_LastFound = i
EXIT FUNCTION
ELSE
HashFindRev = 1
HashRemove_LastFound = i
EXIT FUNCTION
END IF
END IF
END IF
i = HashList(i).PrevItem
IF i THEN GOTO hashfindrev_next
END IF
END FUNCTION
FUNCTION HashFindCont (resultflags, resultreference)
'(0,1,2)z=hashfind[rev](resflag,resref)
'0=no more items exist
'1=found, no more items to scan
'2=found, more items still to scan
IF HashFind_Reverse THEN
i = HashFind_NextListItem
hashfindrevc_next:
f = HashList(i).Flags
IF HashFind_SearchFlags AND f THEN 'flags in common
IF HashListName(i) = HashFind_Name THEN
resultflags = f
resultreference = HashList(i).Reference
i2 = HashList(i).PrevItem
IF i2 THEN
HashFindCont = 2
HashFind_NextListItem = i2
HashRemove_LastFound = i
EXIT FUNCTION
ELSE
HashFindCont = 1
HashRemove_LastFound = i
EXIT FUNCTION
END IF
END IF
END IF
i = HashList(i).PrevItem
IF i THEN GOTO hashfindrevc_next
EXIT FUNCTION
ELSE
i = HashFind_NextListItem
hashfindc_next:
f = HashList(i).Flags
IF HashFind_SearchFlags AND f THEN 'flags in common
IF HashListName(i) = HashFind_Name THEN
resultflags = f
resultreference = HashList(i).Reference
i2 = HashList(i).NextItem
IF i2 THEN
HashFindCont = 2
HashFind_NextListItem = i2
HashRemove_LastFound = i
EXIT FUNCTION
ELSE
HashFindCont = 1
HashRemove_LastFound = i
EXIT FUNCTION
END IF
END IF
END IF
i = HashList(i).NextItem
IF i THEN GOTO hashfindc_next
EXIT FUNCTION
END IF
END FUNCTION
SUB HashRemove
i = HashRemove_LastFound
'add to free list
HashListFreeLast = HashListFreeLast + 1
IF HashListFreeLast > HashListFreeSize THEN
HashListFreeSize = HashListFreeSize * 2
REDIM _PRESERVE HashListFree(1 TO HashListFreeSize) AS LONG
END IF
HashListFree(HashListFreeLast) = i
'unlink
i1 = HashList(i).PrevItem
IF i1 THEN
'not first item in list
i2 = HashList(i).NextItem
IF i2 THEN
'(not first and) not last item
HashList(i1).NextItem = i2
HashList(i2).LastItem = i1
ELSE
'last item
x = HashTable(HashValue(HashListName$(i)))
HashList(x).LastItem = i1
HashList(i1).NextItem = 0
END IF
ELSE
'first item in list
x = HashTable(HashValue(HashListName$(i)))
i2 = HashList(i).NextItem
IF i2 THEN
'(first item but) not last item
HashTable(x) = i2
HashList(i2).PrevItem = 0
HashList(i2).LastItem = HashList(i).LastItem
ELSE
'(first and) last item
HashTable(x) = 0
END IF
END IF
END SUB
SUB HashDump 'used for debugging purposes
fh = FREEFILE
OPEN "hashdump.txt" FOR OUTPUT AS #fh
b$ = "12345678901234567890123456789012}"
FOR x = 0 TO 16777215
IF HashTable(x) THEN
PRINT #fh, "START HashTable("; x; "):"
i = HashTable(x)
'validate
lasti = HashList(i).LastItem
IF HashList(i).LastItem = 0 OR HashList(i).PrevItem <> 0 OR HashValue(HashListName(i)) <> x THEN GOTO corrupt
PRINT #fh, " HashList("; i; ").LastItem="; HashList(i).LastItem
hashdumpnextitem:
x$ = " [" + STR$(i) + "]" + HashListName(i)
f = HashList(i).Flags
x$ = x$ + ",.Flags=" + STR$(f) + "{"
FOR z = 1 TO 32
ASC(b$, z) = (f AND 1) + 48
f = f \ 2
NEXT
x$ = x$ + b$
x$ = x$ + ",.Reference=" + STR$(HashList(i).Reference)
PRINT #fh, x$
'validate
i1 = HashList(i).PrevItem
i2 = HashList(i).NextItem
IF i1 THEN
IF HashList(i1).NextItem <> i THEN GOTO corrupt
END IF
IF i2 THEN
IF HashList(i2).PrevItem <> i THEN GOTO corrupt
END IF
IF i2 = 0 THEN
IF lasti <> i THEN GOTO corrupt
END IF
i = HashList(i).NextItem
IF i THEN GOTO hashdumpnextitem
PRINT #fh, "END HashTable("; x; ")"
END IF
NEXT
CLOSE #fh
EXIT SUB
corrupt:
PRINT #fh, "HASH TABLE CORRUPT!" 'should never happen
CLOSE #fh
END SUB
SUB HashClear 'clear entire hash table
HashListSize = 65536
HashListNext = 1
HashListFreeSize = 1024
HashListFreeLast = 0
REDIM HashList(1 TO HashListSize) AS HashListItem
REDIM HashListName(1 TO HashListSize) AS STRING * 256
REDIM HashListFree(1 TO HashListFreeSize) AS LONG
REDIM HashTable(16777215) AS LONG '64MB lookup table with indexes to the hashlist
HashFind_NextListItem = 0
HashFind_Reverse = 0
HashFind_SearchFlags = 0
HashFind_Name = ""
HashRemove_LastFound = 0
END SUB

86
source/utilities/hash.bi Normal file
View file

@ -0,0 +1,86 @@
'hash table data
TYPE HashListItem
Flags AS LONG
Reference AS LONG
NextItem AS LONG
PrevItem AS LONG
LastItem AS LONG 'note: this value is only valid on the first item in the list
'note: name is stored in a separate array of strings
END TYPE
DIM SHARED HashFind_NextListItem AS LONG
DIM SHARED HashFind_Reverse AS LONG
DIM SHARED HashFind_SearchFlags AS LONG
DIM SHARED HashFind_Name AS STRING
DIM SHARED HashRemove_LastFound AS LONG
DIM SHARED HashListSize AS LONG
DIM SHARED HashListNext AS LONG
DIM SHARED HashListFreeSize AS LONG
DIM SHARED HashListFreeLast AS LONG
'hash lookup tables
DIM SHARED hash1char(255) AS INTEGER
DIM SHARED hash2char(65535) AS INTEGER
FOR x = 1 TO 26
hash1char(64 + x) = x
hash1char(96 + x) = x
NEXT
hash1char(95) = 27 '_
hash1char(48) = 28 '0
hash1char(49) = 29 '1
hash1char(50) = 30 '2
hash1char(51) = 31 '3
hash1char(52) = 23 '4 'note: x, y, z and beginning alphabet letters avoided because of common usage (eg. a2, y3)
hash1char(53) = 22 '5
hash1char(54) = 20 '6
hash1char(55) = 19 '7
hash1char(56) = 18 '8
hash1char(57) = 17 '9
FOR c1 = 0 TO 255
FOR c2 = 0 TO 255
hash2char(c1 + c2 * 256) = hash1char(c1) + hash1char(c2) * 32
NEXT
NEXT
'init
HashListSize = 65536
HashListNext = 1
HashListFreeSize = 1024
HashListFreeLast = 0
REDIM SHARED HashList(1 TO HashListSize) AS HashListItem
REDIM SHARED HashListName(1 TO HashListSize) AS STRING * 256
REDIM SHARED HashListFree(1 TO HashListFreeSize) AS LONG
REDIM SHARED HashTable(16777215) AS LONG '64MB lookup table with indexes to the hashlist
CONST HASHFLAG_LABEL = 2
CONST HASHFLAG_TYPE = 4
CONST HASHFLAG_RESERVED = 8
CONST HASHFLAG_OPERATOR = 16
CONST HASHFLAG_CUSTOMSYNTAX = 32
CONST HASHFLAG_SUB = 64
CONST HASHFLAG_FUNCTION = 128
CONST HASHFLAG_UDT = 256
CONST HASHFLAG_UDTELEMENT = 512
CONST HASHFLAG_CONSTANT = 1024
CONST HASHFLAG_VARIABLE = 2048
CONST HASHFLAG_ARRAY = 4096
CONST HASHFLAG_XELEMENTNAME = 8192
CONST HASHFLAG_XTYPENAME = 16384
'CONST support
DIM SHARED constmax AS LONG
constmax = 100
DIM SHARED constlast AS LONG
constlast = -1
REDIM SHARED constname(constmax) AS STRING
REDIM SHARED constcname(constmax) AS STRING
REDIM SHARED constnamesymbol(constmax) AS STRING 'optional name symbol
' `1 and `no-number must be handled correctly
'DIM SHARED constlastshared AS LONG 'so any defined inside a sub/function after this index can be "forgotten" when sub/function exits
'constlastshared = -1
REDIM SHARED consttype(constmax) AS LONG 'variable type number
'consttype determines storage
REDIM SHARED constinteger(constmax) AS _INTEGER64
REDIM SHARED constuinteger(constmax) AS _UNSIGNED _INTEGER64
REDIM SHARED constfloat(constmax) AS _FLOAT
REDIM SHARED conststring(constmax) AS STRING
REDIM SHARED constsubfunc(constmax) AS LONG
REDIM SHARED constdefined(constmax) AS LONG

22
source/utilities/strings.bas
View file

@ -81,6 +81,15 @@ FUNCTION TFStringToBool% (s AS STRING)
END IF
END FUNCTION
SUB WriteConfigSetting (section$, item$, value$)
WriteSetting ConfigFile$, section$, item$, value$
END SUB
FUNCTION ReadConfigSetting (section$, item$, value$)
value$ = ReadSetting$(ConfigFile$, section$, item$)
ReadConfigSetting = (LEN(value$) > 0)
END FUNCTION
'
' Reads the bool setting at section:setting. If it is not there or invalid, writes the default value to it
'
@ -139,3 +148,16 @@ FUNCTION ReadWriteLongSettingValue& (section AS STRING, setting AS STRING, defau
ReadWriteLongSettingValue& = checkResult
END IF
END FUNCTION
FUNCTION str2$ (v AS LONG)
str2$ = _TRIM$(STR$(v))
END FUNCTION
FUNCTION str2u64$ (v~&&)
str2u64$ = LTRIM$(RTRIM$(STR$(v~&&)))
END FUNCTION
FUNCTION str2i64$ (v&&)
str2i64$ = LTRIM$(RTRIM$(STR$(v&&)))
END FUNCTION

765
source/utilities/type.bas Normal file
View file

@ -0,0 +1,765 @@
FUNCTION typevalue2symbol$ (t)
IF t AND ISSTRING THEN
IF t AND ISFIXEDLENGTH THEN Give_Error "Cannot convert expression type to symbol": EXIT FUNCTION
typevalue2symbol$ = "$"
EXIT FUNCTION
END IF
s$ = ""
IF t AND ISUNSIGNED THEN s$ = "~"
b = t AND 511
IF t AND ISOFFSETINBITS THEN
IF b > 1 THEN s$ = s$ + "`" + str2$(b) ELSE s$ = s$ + "`"
typevalue2symbol$ = s$
EXIT FUNCTION
END IF
IF t AND ISFLOAT THEN
IF b = 32 THEN s$ = "!"
IF b = 64 THEN s$ = "#"
IF b = 256 THEN s$ = "##"
typevalue2symbol$ = s$
EXIT FUNCTION
END IF
IF b = 8 THEN s$ = s$ + "%%"
IF b = 16 THEN s$ = s$ + "%"
IF b = 32 THEN s$ = s$ + "&"
IF b = 64 THEN s$ = s$ + "&&"
typevalue2symbol$ = s$
END FUNCTION
FUNCTION id2fulltypename$
t = id.t
IF t = 0 THEN t = id.arraytype
size = id.tsize
bits = t AND 511
IF t AND ISUDT THEN
a$ = RTRIM$(udtxcname(t AND 511))
id2fulltypename$ = a$: EXIT FUNCTION
END IF
IF t AND ISSTRING THEN
IF t AND ISFIXEDLENGTH THEN a$ = "STRING * " + str2(size) ELSE a$ = "STRING"
id2fulltypename$ = a$: EXIT FUNCTION
END IF
IF t AND ISOFFSETINBITS THEN
IF bits > 1 THEN a$ = qb64prefix$ + "BIT * " + str2(bits) ELSE a$ = qb64prefix$ + "BIT"
IF t AND ISUNSIGNED THEN a$ = qb64prefix$ + "UNSIGNED " + a$
id2fulltypename$ = a$: EXIT FUNCTION
END IF
IF t AND ISFLOAT THEN
IF bits = 32 THEN a$ = "SINGLE"
IF bits = 64 THEN a$ = "DOUBLE"
IF bits = 256 THEN a$ = qb64prefix$ + "FLOAT"
ELSE 'integer-based
IF bits = 8 THEN a$ = qb64prefix$ + "BYTE"
IF bits = 16 THEN a$ = "INTEGER"
IF bits = 32 THEN a$ = "LONG"
IF bits = 64 THEN a$ = qb64prefix$ + "INTEGER64"
IF t AND ISUNSIGNED THEN a$ = qb64prefix$ + "UNSIGNED " + a$
END IF
IF t AND ISOFFSET THEN
a$ = qb64prefix$ + "OFFSET"
IF t AND ISUNSIGNED THEN a$ = qb64prefix$ + "UNSIGNED " + a$
END IF
id2fulltypename$ = a$
END FUNCTION
FUNCTION id2shorttypename$
t = id.t
IF t = 0 THEN t = id.arraytype
size = id.tsize
bits = t AND 511
IF t AND ISUDT THEN
a$ = RTRIM$(udtxcname(t AND 511))
id2shorttypename$ = a$: EXIT FUNCTION
END IF
IF t AND ISSTRING THEN
IF t AND ISFIXEDLENGTH THEN a$ = "STRING" + str2(size) ELSE a$ = "STRING"
id2shorttypename$ = a$: EXIT FUNCTION
END IF
IF t AND ISOFFSETINBITS THEN
IF t AND ISUNSIGNED THEN a$ = "_U" ELSE a$ = "_"
IF bits > 1 THEN a$ = a$ + "BIT" + str2(bits) ELSE a$ = a$ + "BIT1"
id2shorttypename$ = a$: EXIT FUNCTION
END IF
IF t AND ISFLOAT THEN
IF bits = 32 THEN a$ = "SINGLE"
IF bits = 64 THEN a$ = "DOUBLE"
IF bits = 256 THEN a$ = "_FLOAT"
ELSE 'integer-based
IF bits = 8 THEN
IF (t AND ISUNSIGNED) THEN a$ = "_UBYTE" ELSE a$ = "_BYTE"
END IF
IF bits = 16 THEN
IF (t AND ISUNSIGNED) THEN a$ = "UINTEGER" ELSE a$ = "INTEGER"
END IF
IF bits = 32 THEN
IF (t AND ISUNSIGNED) THEN a$ = "ULONG" ELSE a$ = "LONG"
END IF
IF bits = 64 THEN
IF (t AND ISUNSIGNED) THEN a$ = "_UINTEGER64" ELSE a$ = "_INTEGER64"
END IF
END IF
id2shorttypename$ = a$
END FUNCTION
FUNCTION symbol2fulltypename$ (s2$)
'note: accepts both symbols and type names
s$ = s2$
IF LEFT$(s$, 1) = "~" THEN
u = 1
IF LEN(typ$) = 1 THEN Give_Error "Expected ~...": EXIT FUNCTION
s$ = RIGHT$(s$, LEN(s$) - 1)
u$ = qb64prefix$ + "UNSIGNED "
END IF
IF s$ = "%%" THEN t$ = u$ + qb64prefix$ + "BYTE": GOTO gotsym2typ
IF s$ = "%" THEN t$ = u$ + "INTEGER": GOTO gotsym2typ
IF s$ = "&" THEN t$ = u$ + "LONG": GOTO gotsym2typ
IF s$ = "&&" THEN t$ = u$ + qb64prefix$ + "INTEGER64": GOTO gotsym2typ
IF s$ = "%&" THEN t$ = u$ + qb64prefix$ + "OFFSET": GOTO gotsym2typ
IF LEFT$(s$, 1) = "`" THEN
IF LEN(s$) = 1 THEN
t$ = u$ + qb64prefix$ + "BIT * 1"
GOTO gotsym2typ
END IF
n$ = RIGHT$(s$, LEN(s$) - 1)
IF isuinteger(n$) = 0 THEN Give_Error "Expected number after symbol `": EXIT FUNCTION
t$ = u$ + qb64prefix$ + "BIT * " + n$
GOTO gotsym2typ
END IF
IF u = 1 THEN Give_Error "Expected type symbol after ~": EXIT FUNCTION
IF s$ = "!" THEN t$ = "SINGLE": GOTO gotsym2typ
IF s$ = "#" THEN t$ = "DOUBLE": GOTO gotsym2typ
IF s$ = "##" THEN t$ = qb64prefix$ + "FLOAT": GOTO gotsym2typ
IF s$ = "$" THEN t$ = "STRING": GOTO gotsym2typ
IF LEFT$(s$, 1) = "$" THEN
n$ = RIGHT$(s$, LEN(s$) - 1)
IF isuinteger(n$) = 0 THEN Give_Error "Expected number after symbol $": EXIT FUNCTION
t$ = "STRING * " + n$
GOTO gotsym2typ
END IF
t$ = s$
gotsym2typ:
IF RIGHT$(" " + t$, 5) = " _BIT" THEN t$ = t$ + " * 1" 'clarify (_UNSIGNED) _BIT as (_UNSIGNED) _BIT * 1
FOR i = 1 TO LEN(t$)
IF ASC(t$, i) = ASC(sp) THEN ASC(t$, i) = 32
NEXT
symbol2fulltypename$ = t$
END FUNCTION
FUNCTION symboltype (s$) 'returns type or 0(not a valid symbol)
'note: sets symboltype_size for fixed length strings
'created: 2011 (fast & comprehensive)
IF LEN(s$) = 0 THEN EXIT FUNCTION
'treat common cases first
a = ASC(s$)
l = LEN(s$)
IF a = 37 THEN '%
IF l = 1 THEN symboltype = 16: EXIT FUNCTION
IF l > 2 THEN EXIT FUNCTION
IF ASC(s$, 2) = 37 THEN symboltype = 8: EXIT FUNCTION
IF ASC(s$, 2) = 38 THEN symboltype = OFFSETTYPE - ISPOINTER: EXIT FUNCTION '%&
EXIT FUNCTION
END IF
IF a = 38 THEN '&
IF l = 1 THEN symboltype = 32: EXIT FUNCTION
IF l > 2 THEN EXIT FUNCTION
IF ASC(s$, 2) = 38 THEN symboltype = 64: EXIT FUNCTION
EXIT FUNCTION
END IF
IF a = 33 THEN '!
IF l = 1 THEN symboltype = 32 + ISFLOAT: EXIT FUNCTION
EXIT FUNCTION
END IF
IF a = 35 THEN '#
IF l = 1 THEN symboltype = 64 + ISFLOAT: EXIT FUNCTION
IF l > 2 THEN EXIT FUNCTION
IF ASC(s$, 2) = 35 THEN symboltype = 64 + ISFLOAT: EXIT FUNCTION
EXIT FUNCTION
END IF
IF a = 36 THEN '$
IF l = 1 THEN symboltype = ISSTRING: EXIT FUNCTION
IF isuinteger(RIGHT$(s$, l - 1)) THEN
IF l >= (1 + 10) THEN
IF l > (1 + 10) THEN EXIT FUNCTION
IF s$ > "$2147483647" THEN EXIT FUNCTION
END IF
symboltype_size = VAL(RIGHT$(s$, l - 1))
symboltype = ISSTRING + ISFIXEDLENGTH
EXIT FUNCTION
END IF
EXIT FUNCTION
END IF
IF a = 96 THEN '`
IF l = 1 THEN symboltype = 1 + ISOFFSETINBITS: EXIT FUNCTION
IF isuinteger(RIGHT$(s$, l - 1)) THEN
IF l > 3 THEN EXIT FUNCTION
n = VAL(RIGHT$(s$, l - 1))
IF n > 64 THEN EXIT FUNCTION
symboltype = n + ISOFFSETINBITS: EXIT FUNCTION
END IF
EXIT FUNCTION
END IF
IF a = 126 THEN '~
IF l = 1 THEN EXIT FUNCTION
a = ASC(s$, 2)
IF a = 37 THEN '%
IF l = 2 THEN symboltype = 16 + ISUNSIGNED: EXIT FUNCTION
IF l > 3 THEN EXIT FUNCTION
IF ASC(s$, 3) = 37 THEN symboltype = 8 + ISUNSIGNED: EXIT FUNCTION
IF ASC(s$, 3) = 38 THEN symboltype = UOFFSETTYPE - ISPOINTER: EXIT FUNCTION '~%&
EXIT FUNCTION
END IF
IF a = 38 THEN '&
IF l = 2 THEN symboltype = 32 + ISUNSIGNED: EXIT FUNCTION
IF l > 3 THEN EXIT FUNCTION
IF ASC(s$, 3) = 38 THEN symboltype = 64 + ISUNSIGNED: EXIT FUNCTION
EXIT FUNCTION
END IF
IF a = 96 THEN '`
IF l = 2 THEN symboltype = 1 + ISOFFSETINBITS + ISUNSIGNED: EXIT FUNCTION
IF isuinteger(RIGHT$(s$, l - 2)) THEN
IF l > 4 THEN EXIT FUNCTION
n = VAL(RIGHT$(s$, l - 2))
IF n > 64 THEN EXIT FUNCTION
symboltype = n + ISOFFSETINBITS + ISUNSIGNED: EXIT FUNCTION
END IF
EXIT FUNCTION
END IF
END IF '~
END FUNCTION
FUNCTION typ2ctyp$ (t AS LONG, tstr AS STRING)
ctyp$ = ""
'typ can be passed as either: (the unused value is ignored)
'i. as a typ value in t
'ii. as a typ symbol (eg. "~%") in tstr
'iii. as a typ name (eg. _UNSIGNED INTEGER) in tstr
IF tstr$ = "" THEN
IF (t AND ISARRAY) THEN EXIT FUNCTION 'cannot return array types
IF (t AND ISSTRING) THEN typ2ctyp$ = "qbs": EXIT FUNCTION
b = t AND 511
IF (t AND ISUDT) THEN typ2ctyp$ = "void": EXIT FUNCTION
IF (t AND ISOFFSETINBITS) THEN
IF b <= 32 THEN ctyp$ = "int32" ELSE ctyp$ = "int64"
IF (t AND ISUNSIGNED) THEN ctyp$ = "u" + ctyp$
typ2ctyp$ = ctyp$: EXIT FUNCTION
END IF
IF (t AND ISFLOAT) THEN
IF b = 32 THEN ctyp$ = "float"
IF b = 64 THEN ctyp$ = "double"
IF b = 256 THEN ctyp$ = "long double"
ELSE
IF b = 8 THEN ctyp$ = "int8"
IF b = 16 THEN ctyp$ = "int16"
IF b = 32 THEN ctyp$ = "int32"
IF b = 64 THEN ctyp$ = "int64"
IF t AND ISOFFSET THEN ctyp$ = "ptrszint"
IF (t AND ISUNSIGNED) THEN ctyp$ = "u" + ctyp$
END IF
IF t AND ISOFFSET THEN
ctyp$ = "ptrszint": IF (t AND ISUNSIGNED) THEN ctyp$ = "uptrszint"
END IF
typ2ctyp$ = ctyp$: EXIT FUNCTION
END IF
ts$ = tstr$
'is ts$ a symbol?
IF ts$ = "$" THEN ctyp$ = "qbs"
IF ts$ = "!" THEN ctyp$ = "float"
IF ts$ = "#" THEN ctyp$ = "double"
IF ts$ = "##" THEN ctyp$ = "long double"
IF LEFT$(ts$, 1) = "~" THEN unsgn = 1: ts$ = RIGHT$(ts$, LEN(ts$) - 1)
IF LEFT$(ts$, 1) = "`" THEN
n$ = RIGHT$(ts$, LEN(ts$) - 1)
b = 1
IF n$ <> "" THEN
IF isuinteger(n$) = 0 THEN Give_Error "Invalid index after _BIT type": EXIT FUNCTION
b = VAL(n$)
IF b > 64 THEN Give_Error "Invalid index after _BIT type": EXIT FUNCTION
END IF
IF b <= 32 THEN ctyp$ = "int32" ELSE ctyp$ = "int64"
IF unsgn THEN ctyp$ = "u" + ctyp$
typ2ctyp$ = ctyp$: EXIT FUNCTION
END IF
IF ts$ = "%&" THEN
typ2ctyp$ = "ptrszint": IF (t AND ISUNSIGNED) THEN typ2ctyp$ = "uptrszint"
EXIT FUNCTION
END IF
IF ts$ = "%%" THEN ctyp$ = "int8"
IF ts$ = "%" THEN ctyp$ = "int16"
IF ts$ = "&" THEN ctyp$ = "int32"
IF ts$ = "&&" THEN ctyp$ = "int64"
IF ctyp$ <> "" THEN
IF unsgn THEN ctyp$ = "u" + ctyp$
typ2ctyp$ = ctyp$: EXIT FUNCTION
END IF
'is tstr$ a named type? (eg. 'LONG')
s$ = type2symbol$(tstr$)
IF Error_Happened THEN EXIT FUNCTION
IF LEN(s$) THEN
typ2ctyp$ = typ2ctyp$(0, s$)
IF Error_Happened THEN EXIT FUNCTION
EXIT FUNCTION
END IF
Give_Error "Invalid type": EXIT FUNCTION
END FUNCTION
FUNCTION type2symbol$ (typ$)
t$ = typ$
FOR i = 1 TO LEN(t$)
IF MID$(t$, i, 1) = sp THEN MID$(t$, i, 1) = " "
NEXT
e$ = "Cannot convert type (" + typ$ + ") to symbol"
t2$ = "INTEGER": s$ = "%": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "LONG": s$ = "&": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "SINGLE": s$ = "!": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "DOUBLE": s$ = "#": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "_BYTE": s$ = "%%": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "BYTE": s$ = "%%": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED LONG": s$ = "~&": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED LONG": s$ = "~&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED INTEGER": s$ = "~%": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED INTEGER": s$ = "~%": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED _BYTE": s$ = "~%%": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED BYTE": s$ = "~%%": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED _BYTE": s$ = "~%%": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED BYTE": s$ = "~%%": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED _OFFSET": s$ = "~%&": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED OFFSET": s$ = "~%&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED _OFFSET": s$ = "~%&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED OFFSET": s$ = "~%&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED _INTEGER64": s$ = "~&&": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED INTEGER64": s$ = "~&&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED _INTEGER64": s$ = "~&&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED INTEGER64": s$ = "~&&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_INTEGER64": s$ = "&&": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "INTEGER64": s$ = "&&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_OFFSET": s$ = "%&": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "OFFSET": s$ = "%&": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
t2$ = "_FLOAT": s$ = "##": IF t$ = t2$ THEN GOTO t2sfound
t2$ = "FLOAT": s$ = "##": IF qb64prefix_set = 1 AND t$ = t2$ THEN GOTO t2sfound
' These can have a length after them, so LEFT$() is used
t2$ = "STRING": s$ = "$": IF LEFT$(t$, LEN(t2$)) = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED _BIT": s$ = "~`1": IF LEFT$(t$, LEN(t2$)) = t2$ THEN GOTO t2sfound
t2$ = "_UNSIGNED BIT": s$ = "~`1": IF qb64prefix_set = 1 AND LEFT$(t$, LEN(t2$)) = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED _BIT": s$ = "~`1": IF qb64prefix_set = 1 AND LEFT$(t$, LEN(t2$)) = t2$ THEN GOTO t2sfound
t2$ = "UNSIGNED BIT": s$ = "~`1": IF qb64prefix_set = 1 AND LEFT$(t$, LEN(t2$)) = t2$ THEN GOTO t2sfound
t2$ = "_BIT": s$ = "`1": IF LEFT$(t$, LEN(t2$)) = t2$ THEN GOTO t2sfound
t2$ = "BIT": s$ = "`1": IF qb64prefix_set = 1 AND LEFT$(t$, LEN(t2$)) = t2$ THEN GOTO t2sfound
Give_Error e$: EXIT FUNCTION
t2sfound:
type2symbol$ = s$
IF LEN(t2$) <> LEN(t$) THEN
IF s$ <> "$" AND s$ <> "~`1" AND s$ <> "`1" THEN Give_Error e$: EXIT FUNCTION
t$ = RIGHT$(t$, LEN(t$) - LEN(t2$))
IF LEFT$(t$, 3) <> " * " THEN Give_Error e$: EXIT FUNCTION
t$ = RIGHT$(t$, LEN(t$) - 3)
IF isuinteger(t$) = 0 THEN Give_Error e$: EXIT FUNCTION
v = VAL(t$)
IF v = 0 THEN Give_Error e$: EXIT FUNCTION
IF s$ <> "$" AND v > 64 THEN Give_Error e$: EXIT FUNCTION
IF s$ = "$" THEN
s$ = s$ + str2$(v)
ELSE
s$ = LEFT$(s$, LEN(s$) - 1) + str2$(v)
END IF
type2symbol$ = s$
END IF
END FUNCTION
'Strips away bits/indentifiers which make locating a variables source difficult
FUNCTION typecomp (typ)
typ2 = typ
IF (typ2 AND ISINCONVENTIONALMEMORY) THEN typ2 = typ2 - ISINCONVENTIONALMEMORY
typecomp = typ2
END FUNCTION
FUNCTION typname2typ& (t2$)
typname2typsize = 0 'the default
t$ = t2$
'symbol?
ts$ = t$
IF ts$ = "$" THEN typname2typ& = STRINGTYPE: EXIT FUNCTION
IF ts$ = "!" THEN typname2typ& = SINGLETYPE: EXIT FUNCTION
IF ts$ = "#" THEN typname2typ& = DOUBLETYPE: EXIT FUNCTION
IF ts$ = "##" THEN typname2typ& = FLOATTYPE: EXIT FUNCTION
'fixed length string?
IF LEFT$(ts$, 1) = "$" THEN
n$ = RIGHT$(ts$, LEN(ts$) - 1)
IF isuinteger(n$) = 0 THEN Give_Error "Invalid index after STRING * type": EXIT FUNCTION
b = VAL(n$)
IF b = 0 THEN Give_Error "Invalid index after STRING * type": EXIT FUNCTION
typname2typsize = b
typname2typ& = STRINGTYPE + ISFIXEDLENGTH
EXIT FUNCTION
END IF
'unsigned?
IF LEFT$(ts$, 1) = "~" THEN unsgn = 1: ts$ = RIGHT$(ts$, LEN(ts$) - 1)
'bit-type?
IF LEFT$(ts$, 1) = "`" THEN
n$ = RIGHT$(ts$, LEN(ts$) - 1)
b = 1
IF n$ <> "" THEN
IF isuinteger(n$) = 0 THEN Give_Error "Invalid index after _BIT type": EXIT FUNCTION
b = VAL(n$)
IF b > 64 THEN Give_Error "Invalid index after _BIT type": EXIT FUNCTION
END IF
IF unsgn THEN typname2typ& = UBITTYPE + (b - 1) ELSE typname2typ& = BITTYPE + (b - 1)
EXIT FUNCTION
END IF
t = 0
IF ts$ = "%%" THEN t = BYTETYPE
IF ts$ = "%" THEN t = INTEGERTYPE
IF ts$ = "&" THEN t = LONGTYPE
IF ts$ = "&&" THEN t = INTEGER64TYPE
IF ts$ = "%&" THEN t = OFFSETTYPE
IF t THEN
IF unsgn THEN t = t + ISUNSIGNED
typname2typ& = t: EXIT FUNCTION
END IF
'not a valid symbol
'type name?
FOR i = 1 TO LEN(t$)
IF MID$(t$, i, 1) = sp THEN MID$(t$, i, 1) = " "
NEXT
IF t$ = "STRING" THEN typname2typ& = STRINGTYPE: EXIT FUNCTION
IF LEFT$(t$, 9) = "STRING * " THEN
n$ = RIGHT$(t$, LEN(t$) - 9)
'constant check 2011
hashfound = 0
hashname$ = n$
hashchkflags = HASHFLAG_CONSTANT
hashres = HashFindRev(hashname$, hashchkflags, hashresflags, hashresref)
DO WHILE hashres
IF constsubfunc(hashresref) = subfuncn OR constsubfunc(hashresref) = 0 THEN
IF constdefined(hashresref) THEN
hashfound = 1
EXIT DO
END IF
END IF
IF hashres <> 1 THEN hashres = HashFindCont(hashresflags, hashresref) ELSE hashres = 0
LOOP
IF hashfound THEN
i2 = hashresref
t = consttype(i2)
IF t AND ISSTRING THEN Give_Error "Expected STRING * numeric-constant": EXIT FUNCTION
'convert value to general formats
IF t AND ISFLOAT THEN
v## = constfloat(i2)
v&& = v##
v~&& = v&&
ELSE
IF t AND ISUNSIGNED THEN
v~&& = constuinteger(i2)
v&& = v~&&
v## = v&&
ELSE
v&& = constinteger(i2)
v## = v&&
v~&& = v&&
END IF
END IF
IF v&& < 1 OR v&& > 9999999999 THEN Give_Error "STRING * out-of-range constant": EXIT FUNCTION
b = v&&
GOTO constantlenstr
END IF
IF isuinteger(n$) = 0 OR LEN(n$) > 10 THEN Give_Error "Invalid number/constant after STRING * type": EXIT FUNCTION
b = VAL(n$)
IF b = 0 OR LEN(n$) > 10 THEN Give_Error "Invalid number after STRING * type": EXIT FUNCTION
constantlenstr:
typname2typsize = b
typname2typ& = STRINGTYPE + ISFIXEDLENGTH
EXIT FUNCTION
END IF
IF t$ = "SINGLE" THEN typname2typ& = SINGLETYPE: EXIT FUNCTION
IF t$ = "DOUBLE" THEN typname2typ& = DOUBLETYPE: EXIT FUNCTION
IF t$ = "_FLOAT" OR (t$ = "FLOAT" AND qb64prefix_set = 1) THEN typname2typ& = FLOATTYPE: EXIT FUNCTION
IF LEFT$(t$, 10) = "_UNSIGNED " OR (LEFT$(t$, 9) = "UNSIGNED " AND qb64prefix_set = 1) THEN
u = 1
t$ = MID$(t$, INSTR(t$, CHR$(32)) + 1)
END IF
IF LEFT$(t$, 4) = "_BIT" OR (LEFT$(t$, 3) = "BIT" AND qb64prefix_set = 1) THEN
IF t$ = "_BIT" OR (t$ = "BIT" AND qb64prefix_set = 1) THEN
IF u THEN typname2typ& = UBITTYPE ELSE typname2typ& = BITTYPE
EXIT FUNCTION
END IF
IF LEFT$(t$, 7) <> "_BIT * " AND LEFT$(t$, 6) <> "BIT * " THEN Give_Error "Expected " + qb64prefix$ + "BIT * number": EXIT FUNCTION
IF LEFT$(t$, 4) = "_BIT" THEN
n$ = RIGHT$(t$, LEN(t$) - 7)
ELSE
n$ = RIGHT$(t$, LEN(t$) - 6)
END IF
IF isuinteger(n$) = 0 THEN Give_Error "Invalid size after " + qb64prefix$ + "BIT *": EXIT FUNCTION
b = VAL(n$)
IF b = 0 OR b > 64 THEN Give_Error "Invalid size after " + qb64prefix$ + "BIT *": EXIT FUNCTION
t = BITTYPE - 1 + b: IF u THEN t = t + ISUNSIGNED
typname2typ& = t
EXIT FUNCTION
END IF
t = 0
IF t$ = "_BYTE" OR (t$ = "BYTE" AND qb64prefix_set = 1) THEN t = BYTETYPE
IF t$ = "INTEGER" THEN t = INTEGERTYPE
IF t$ = "LONG" THEN t = LONGTYPE
IF t$ = "_INTEGER64" OR (t$ = "INTEGER64" AND qb64prefix_set = 1) THEN t = INTEGER64TYPE
IF t$ = "_OFFSET" OR (t$ = "OFFSET" AND qb64prefix_set = 1) THEN t = OFFSETTYPE
IF t THEN
IF u THEN t = t + ISUNSIGNED
typname2typ& = t
EXIT FUNCTION
END IF
IF u THEN EXIT FUNCTION '_UNSIGNED (nothing)
'UDT?
FOR i = 1 TO lasttype
IF t$ = RTRIM$(udtxname(i)) THEN
typname2typ& = ISUDT + ISPOINTER + i
EXIT FUNCTION
ELSEIF RTRIM$(udtxname(i)) = "_MEM" AND t$ = "MEM" AND qb64prefix_set = 1 THEN
typname2typ& = ISUDT + ISPOINTER + i
EXIT FUNCTION
END IF
NEXT
'return 0 (failed)
END FUNCTION
FUNCTION removesymbol$ (varname$)
i = INSTR(varname$, "~"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "`"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "%"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "&"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "!"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "#"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "$"): IF i THEN GOTO foundsymbol
EXIT FUNCTION
foundsymbol:
IF i = 1 THEN Give_Error "Expected variable name before symbol": EXIT FUNCTION
symbol$ = RIGHT$(varname$, LEN(varname$) - i + 1)
IF symboltype(symbol$) = 0 THEN Give_Error "Invalid symbol": EXIT FUNCTION
removesymbol$ = symbol$
varname$ = LEFT$(varname$, i - 1)
END FUNCTION
'
' Does not report an error if the symbol is invalid or varname is blank
'
FUNCTION tryRemoveSymbol$ (varname$)
i = INSTR(varname$, "~"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "`"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "%"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "&"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "!"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "#"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "$"): IF i THEN GOTO foundsymbol
EXIT FUNCTION
foundsymbol:
symbol$ = RIGHT$(varname$, LEN(varname$) - i + 1)
IF symboltype(symbol$) = 0 THEN EXIT FUNCTION
tryRemoveSymbol$ = symbol$
varname$ = LEFT$(varname$, i - 1)
END FUNCTION
SUB increaseUDTArrays
x = UBOUND(udtxname)
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
REDIM _PRESERVE udtearrayelements(x + 1000) AS LONG
REDIM _PRESERVE udtenext(x + 1000) AS LONG
END SUB
SUB initialise_udt_varstrings (n$, udt, buf, base_offset)
IF NOT udtxvariable(udt) THEN EXIT SUB
element = udtxnext(udt)
offset = 0
DO WHILE element
IF udtetype(element) AND ISSTRING THEN
IF (udtetype(element) AND ISFIXEDLENGTH) = 0 THEN
WriteBufLine buf, "*(qbs**)(((char*)" + n$ + ")+" + STR$(base_offset + offset) + ") = qbs_new(0,0);"
END IF
ELSEIF udtetype(element) AND ISUDT THEN
initialise_udt_varstrings n$, udtetype(element) AND 511, buf, offset
END IF
offset = offset + udtesize(element) \ 8
element = udtenext(element)
LOOP
END SUB
SUB free_udt_varstrings (n$, udt, buf, base_offset)
IF NOT udtxvariable(udt) THEN EXIT SUB
element = udtxnext(udt)
offset = 0
DO WHILE element
IF udtetype(element) AND ISSTRING THEN
IF (udtetype(element) AND ISFIXEDLENGTH) = 0 THEN
WriteBufLine buf, "qbs_free(*((qbs**)(((char*)" + n$ + ")+" + STR$(base_offset + offset) + ")));"
END IF
ELSEIF udtetype(element) AND ISUDT THEN
initialise_udt_varstrings n$, udtetype(element) AND 511, buf, offset
END IF
offset = offset + udtesize(element) \ 8
element = udtenext(element)
LOOP
END SUB
SUB clear_udt_with_varstrings (n$, udt, buf, base_offset)
IF NOT udtxvariable(udt) THEN EXIT SUB
element = udtxnext(udt)
offset = 0
DO WHILE element
IF udtetype(element) AND ISSTRING THEN
IF (udtetype(element) AND ISFIXEDLENGTH) = 0 THEN
WriteBufLine buf, "(*(qbs**)(((char*)" + n$ + ")+" + STR$(base_offset + offset) + "))->len=0;"
ELSE
WriteBufLine buf, "memset((char*)" + n$ + "+" + STR$(base_offset + offset) + ",0," + STR$(udtesize(element) \ 8) + ");"
END IF
ELSE
IF udtetype(element) AND ISUDT THEN
clear_udt_with_varstrings n$, udtetype(element) AND 511, buf, base_offset + offset
ELSE
WriteBufLine buf, "memset((char*)" + n$ + "+" + STR$(base_offset + offset) + ",0," + STR$(udtesize(element) \ 8) + ");"
END IF
END IF
offset = offset + udtesize(element) \ 8
element = udtenext(element)
LOOP
END SUB
SUB initialise_array_udt_varstrings (n$, udt, base_offset, bytesperelement$, acc$)
IF NOT udtxvariable(udt) THEN EXIT SUB
offset = base_offset
element = udtxnext(udt)
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);"
END IF
ELSEIF udtetype(element) AND ISUDT THEN
initialise_array_udt_varstrings n$, udtetype(element) AND 511, offset, bytesperelement$, acc$
END IF
offset = offset + udtesize(element) \ 8
element = udtenext(element)
LOOP
END SUB
SUB free_array_udt_varstrings (n$, udt, base_offset, bytesperelement$, acc$)
IF NOT udtxvariable(udt) THEN EXIT SUB
offset = base_offset
element = udtxnext(udt)
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) + "));"
END IF
ELSEIF udtetype(element) AND ISUDT THEN
free_array_udt_varstrings n$, udtetype(element) AND 511, offset, bytesperelement$, acc$
END IF
offset = offset + udtesize(element) \ 8
element = udtenext(element)
LOOP
END SUB
SUB copy_full_udt (dst$, src$, buf, base_offset, udt)
IF NOT udtxvariable(udt) THEN
WriteBufLine buf, "memcpy(" + dst$ + "+" + STR$(base_offset) + "," + src$ + "+" + STR$(base_offset) + "," + STR$(udtxsize(udt) \ 8) + ");"
EXIT SUB
END IF
offset = base_offset
element = udtxnext(udt)
DO WHILE element
IF ((udtetype(element) AND ISSTRING) > 0) AND (udtetype(element) AND ISFIXEDLENGTH) = 0 THEN
WriteBufLine buf, "qbs_set(*(qbs**)(" + dst$ + "+" + STR$(offset) + "), *(qbs**)(" + src$ + "+" + STR$(offset) + "));"
ELSEIF ((udtetype(element) AND ISUDT) > 0) THEN
copy_full_udt dst$, src$, MainTxtBuf, offset, udtetype(element) AND 511
ELSE
WriteBufLine buf, "memcpy((" + dst$ + "+" + STR$(offset) + "),(" + src$ + "+" + STR$(offset) + ")," + STR$(udtesize(element) \ 8) + ");"
END IF
offset = offset + udtesize(element) \ 8
element = udtenext(element)
LOOP
END SUB
SUB dump_udts
fh = FREEFILE
OPEN "types.txt" FOR OUTPUT AS #fh
PRINT #fh, "Name Size Align? Next Var?"
FOR i = 1 TO lasttype
PRINT #fh, RTRIM$(udtxname(i)), udtxsize(i), udtxbytealign(i), udtxnext(i), udtxvariable(i)
NEXT i
PRINT #fh, "Name Size Align? 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)
NEXT i
CLOSE #fh
END SUB
FUNCTION isuinteger (i$)
IF LEN(i$) = 0 THEN EXIT FUNCTION
IF ASC(i$, 1) = 48 AND LEN(i$) > 1 THEN EXIT FUNCTION
FOR c = 1 TO LEN(i$)
v = ASC(i$, c)
IF v < 48 OR v > 57 THEN EXIT FUNCTION
NEXT
isuinteger = -1
END FUNCTION

76
source/utilities/type.bi Normal file
View file

@ -0,0 +1,76 @@
DIM SHARED ISSTRING AS LONG
DIM SHARED ISFLOAT AS LONG
DIM SHARED ISUNSIGNED AS LONG
DIM SHARED ISPOINTER AS LONG
DIM SHARED ISFIXEDLENGTH AS LONG
DIM SHARED ISINCONVENTIONALMEMORY AS LONG
DIM SHARED ISOFFSETINBITS AS LONG
DIM SHARED ISARRAY AS LONG
DIM SHARED ISREFERENCE AS LONG
DIM SHARED ISUDT AS LONG
DIM SHARED ISOFFSET AS LONG
DIM SHARED STRINGTYPE AS LONG
DIM SHARED BITTYPE AS LONG
DIM SHARED UBITTYPE AS LONG
DIM SHARED BYTETYPE AS LONG
DIM SHARED UBYTETYPE AS LONG
DIM SHARED INTEGERTYPE AS LONG
DIM SHARED UINTEGERTYPE AS LONG
DIM SHARED LONGTYPE AS LONG
DIM SHARED ULONGTYPE AS LONG
DIM SHARED INTEGER64TYPE AS LONG
DIM SHARED UINTEGER64TYPE AS LONG
DIM SHARED SINGLETYPE AS LONG
DIM SHARED DOUBLETYPE AS LONG
DIM SHARED FLOATTYPE AS LONG
DIM SHARED OFFSETTYPE AS LONG
DIM SHARED UOFFSETTYPE AS LONG
DIM SHARED UDTTYPE AS LONG
ISSTRING = 1073741824
ISFLOAT = 536870912
ISUNSIGNED = 268435456
ISPOINTER = 134217728
ISFIXEDLENGTH = 67108864 'only set for strings with pointer flag
ISINCONVENTIONALMEMORY = 33554432
ISOFFSETINBITS = 16777216
ISARRAY = 8388608
ISREFERENCE = 4194304
ISUDT = 2097152
ISOFFSET = 1048576
STRINGTYPE = ISSTRING + ISPOINTER
BITTYPE = 1& + ISPOINTER + ISOFFSETINBITS
UBITTYPE = 1& + ISPOINTER + ISUNSIGNED + ISOFFSETINBITS 'QB64 will also support BIT*n, eg. DIM bitarray[10] AS _UNSIGNED _BIT*10
BYTETYPE = 8& + ISPOINTER
UBYTETYPE = 8& + ISPOINTER + ISUNSIGNED
INTEGERTYPE = 16& + ISPOINTER
UINTEGERTYPE = 16& + ISPOINTER + ISUNSIGNED
LONGTYPE = 32& + ISPOINTER
ULONGTYPE = 32& + ISPOINTER + ISUNSIGNED
INTEGER64TYPE = 64& + ISPOINTER
UINTEGER64TYPE = 64& + ISPOINTER + ISUNSIGNED
SINGLETYPE = 32& + ISFLOAT + ISPOINTER
DOUBLETYPE = 64& + ISFLOAT + ISPOINTER
FLOATTYPE = 256& + ISFLOAT + ISPOINTER '8-32 bytes
OFFSETTYPE = 64& + ISOFFSET + ISPOINTER: IF OS_BITS = 32 THEN OFFSETTYPE = 32& + ISOFFSET + ISPOINTER
UOFFSETTYPE = 64& + ISOFFSET + ISUNSIGNED + ISPOINTER: IF OS_BITS = 32 THEN UOFFSETTYPE = 32& + ISOFFSET + ISUNSIGNED + ISPOINTER
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
REDIM SHARED udtearrayelements(1000) AS LONG
REDIM SHARED udtenext(1000) AS LONG

10
tests/compile_tests.sh
View file

@ -10,10 +10,16 @@ mkdir -p $RESULTS_DIR
QB64=$1
if [ "$#" -eq 2 ]; then
if [ "$#" -ge 2 ]; then
CATEGORY="/$2"
fi
if [ "$#" -eq 3 ]; then
TESTS_TO_RUN="$3"
else
TESTS_TO_RUN='*.bas'
fi
show_failure()
{
cat "$RESULTS_DIR/$1-$2-compile_result.txt"
@ -156,4 +162,4 @@ do
diffResult=$(diff -y "./tests/compile_tests/$category/$testName.err" "$compileResultOutput")
assert_success_named "Error result" "Error reporting is wrong:" echo "$diffResult"
fi
done < <(find "./tests/compile_tests$CATEGORY" -name "*.bas" -print)
done < <(find "./tests/compile_tests$CATEGORY" -name "$TESTS_TO_RUN" -print)

2
tests/compile_tests/const/bad_boolean_arg.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.9
Unexpected element 'ASDF'
Caused by (or after):
LINE 3:CONST FOOBAR = 1 ASDF 2

2
tests/compile_tests/const/bad_not_no_arg.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.2
Expected variable/value after 'NOT'
Caused by (or after):
LINE 3:CONST FOOBAR = 1 OR NOT

2
tests/compile_tests/const/bad_not_to_many_args.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.4
Unexpected element '2'
Caused by (or after):
LINE 3:CONST FOOBAR = NOT 2E+0,2! 2

2
tests/compile_tests/const/bad_single_arg.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.2
Unexpected element 'OR'
Caused by (or after):
LINE 3:CONST FOOBAR = OR

9
tests/compile_tests/const/comma.bas Normal file
View file

@ -0,0 +1,9 @@
$CONSOLE:ONLY
' Multiple CONST values can be declared in a single line
CONST a = 20, b = 40, c = 60
CONST foo = a, bar = b + c
PRINT a; b; c; foo; bar
SYSTEM

1
tests/compile_tests/const/comma.output Normal file
View file

@ -0,0 +1 @@
20 40 60 20 100

27
tests/compile_tests/const/const_float.bas Normal file
View file

@ -0,0 +1,27 @@
$CONSOLE:ONLY
CONST const__single! = 32E+0
CONST const__single_exp! = 32E+2
CONST const__single_neg_exp! = 32E-10
CONST const__double# = 32D+0
CONST const__double_exp# = 32D+2
CONST const__double_neg_exp# = 32D-20
CONST const__float## = 32F+0
CONST const__float_exp## = 32F+2
CONST const__float_neg_exp## = 32F-10
PRINT const__single!
PRINT const__single_exp!
PRINT const__single_neg_exp!
PRINT
PRINT const__double#
PRINT const__double_exp#
PRINT const__double_neg_exp#
PRINT
PRINT const__float##
PRINT const__float_exp##
PRINT const__float_neg_exp##
SYSTEM

11
tests/compile_tests/const/const_float.output Normal file
View file

@ -0,0 +1,11 @@
32
3200
3.2E-11
32
3200
3.2D-21
32
32
32

44
tests/compile_tests/const/const_replace.bas Normal file
View file

@ -0,0 +1,44 @@
$CONSOLE:ONLY
CONST const__OR__test = 1 OR 2 ' 3
CONST const__AND__test = 3 AND 1 ' 1
CONST const__XOR__test = 2 XOR 3 ' 1
CONST const__mod__test = 20 MOD 3 ' 2
CONST const__byte%% = 1%%
CONST const__ubyte~%% = 2~%%
CONST const__int% = 4%
CONST const__uint~% = 8~%
CONST const__long& = 16&
CONST const__ulong~& = 32~&
CONST const__int64&& = 64&&
CONST const__uint64~&& = 128~&&
CONST const__single! = 256!
CONST const__double# = 512#
CONST const__float## = 1024##
CONST const__negative = -20000
' Test original casing, and UCASE
CONST const_replace_test = const__OR__test + const__AND__test + const__XOR__test + const__mod__test
CONST const_replace_test_ucase = CONST__OR__test + CONST__AND__test + CONST__XOR__test + CONST__MOD__test
' Defined with suffix, used with suffix
CONST const_replace_test_suffix = const__byte%% + const__ubyte~%% + const__int% + const__uint~% + const__long& + const__ulong~& + const__int64&& + const__uint64~&& + const__single! + const__double# + const__float##
' Defined with suffix, but missing when used
CONST const_replace_test_no_suffix = const__byte + const__ubyte + const__int + const__uint + const__long + const__ulong + const__int64 + const__uint64 + const__single + const__double + const__float
CONST const_replace_test_added_suffix = const__OR__test&& + const__AND__test&& + const__XOR__test&& + const__mod__test&&
CONST const_replace_test_negative = 20 - const__negative
PRINT const_replace_test
PRINT const_replace_test_ucase
PRINT const_replace_test_suffix
PRINT const_replace_test_no_suffix
PRINT const_replace_test_added_suffix
PRINT const_replace_test_negative
SYSTEM

6
tests/compile_tests/const/const_replace.output Normal file
View file

@ -0,0 +1,6 @@
7
7
2047
2047
7
20020

24
tests/compile_tests/const/const_sub.bas Normal file
View file

@ -0,0 +1,24 @@
$CONSOLE:ONLY
CONST glob = 60
foo
baz
SYSTEM
' SUB/FUNCTIONs should be able to define their on CONST that are local to that SUB/FUNCTION
' They should also be able to access the global CONSTs
SUB foo()
CONST a = 20
CONST bar = a + 20 + glob
PRINT bar
END SUB
' Separate SUB/FUNCTIONs should be able to define CONST values with the same names
SUB baz()
CONST a = 40
CONST bar = a + 20 + glob
PRINT bar
END SUB

2
tests/compile_tests/const/const_sub.output Normal file
View file

@ -0,0 +1,2 @@
100
120

12
tests/compile_tests/const/expression.bas
View file

@ -32,7 +32,7 @@ CONST const__lt = 2 < 3
CONST const__oporder1 = (2 ^ 2 * 2) = ((2 ^ 2) * 2)
CONST const__oporder2 = (2 ^ 2 + 2) = ((2 ^ 2) + 2)
CONST const__oporder3 = (NOT 2 + 3) = (NOT (2 + 3))
CONST const__oporder4 = (-2 ^ 2) <> (-(2 ^ 2)) ' WRONG, should be equal, negation is applied incorrectly
CONST const__oporder4 = (-2 ^ 2) = (-(2 ^ 2))
CONST const__oporder5 = (NOT 2 ^ 3) = (NOT (2 ^ 3))
CONST const__oporder6 = (3 * 6 / 2) = ((3 * 6) / 2)
CONST const__oporder7 = (3 * 10 \ 3) = ((3 * 10) \ 3)
@ -40,6 +40,11 @@ CONST const__oporder7 = (3 * 10 \ 3) = ((3 * 10) \ 3)
' Many levels of parens
CONST const__parens = (2 ^ (3 * (4 - (2 - (10 / (20 / 2))))))
CONST const__str = "foobar"
CONST const__str2 = "foobar" + "foobar2"
CONST const__str3 = const__str + const__str2
CONST const__str4 = (const__str + (const__str2))
PRINT const__OR
PRINT const__AND
PRINT const__NOT
@ -77,4 +82,9 @@ PRINT const__oporder7
PRINT const__parens
PRINT const__str
PRINT const__str2
PRINT const__str3
PRINT const__str4
SYSTEM

4
tests/compile_tests/const/expression.output
View file

@ -29,3 +29,7 @@
-1
-1
512
foobar
foobarfoobar2
foobarfoobarfoobar2
foobarfoobarfoobar2

57
tests/compile_tests/const/hex_literals.bas Normal file
View file

@ -0,0 +1,57 @@
$CONSOLE:ONLY
CONST test__byte%% = &H4F
CONST test__byte_neg%% = &HFF
CONST test__integer% = &H00FF
CONST test__integer_neg% = &HFFF3
CONST test__long& = &H00FF00FF
CONST test__long_neg& = &HFFFFFF00 ' -256
CONST test__long_neg16& = &HFF00 ' -256
CONST test__ulong~& = &H4FFFFF00
CONST test__ulong_neg~& = &HFFFFFF00
CONST test__ulong_neg16~& = &HFF00 ' sign extension to &HFFFFFF00~&
CONST test__int64&& = &H4FFFFFFFFFFFFF00
CONST test__int64_neg&& = &HFFFFFFFFFFFFFF00
CONST test__int64_neg32&& = &HFFFFFF00 ' sign extension to &HFFFFFFFFFFFFFF00
CONST test__int64_neg16&& = &HFF00 ' sign extension to &HFFFFFFFFFFFFFF00
CONST test__uint64_neg~&& = &HFFFFFFFFFFFFFF00
CONST test__uint64_neg32~&& = &HFFFFFF00 ' sign extension to &HFFFFFFFFFFFFFF00
CONST test__uint64_neg64~&& = &HFFFFFFFFFFFFFF00
CONST test__uint64&& = &H4000000000000001
CONST test__ulong_uinteger~& = &HFFFF~% ' should avoid sign extension due to unsigned type
PRINT "byte: "; test__byte%%; HEX$(test__byte%%) ' 4F
PRINT "byte negative: "; test__byte_neg%%; HEX$(test__byte_neg%%) ' FF
PRINT "integer: "; test__integer%; HEX$(test__integer%) ' FF
PRINT "integer negative: "; test__integer_neg%; HEX$(test__integer_neg%) ' FFF3
PRINT "long: "; test__long&; HEX$(test__long&) ' FF00FF
PRINT "long negative: "; test__long_neg&; HEX$(test__long_neg&) ' FFFFFF00
PRINT "long negative sign extension: "; test__long_neg16&; HEX$(test__long_neg16&) ' FFFFFF00
PRINT "ulong: "; test__ulong~&; HEX$(test__ulong~&) ' 4FFFFF00
PRINT "ulong negative: "; test__ulong_neg~&; HEX$(test__ulong_neg~&) ' FFFFFF00
PRINT "ulong negative sign extension: "; test__ulong_neg16~&; HEX$(test__ulong_neg16~&) ' FFFFFF00
PRINT "int64: "; test__int64&&; HEX$(test__int64&&) ' 4FFFFFFFFFFFFF00
PRINT "int64 negative: "; test__int64_neg&&; HEX$(test__int64_neg&&) ' FF00?
PRINT "int64 negative sign extension: "; test__int64_neg32&&; HEX$(test__int64_neg32&&) ' FF00?
PRINT "int64 negative sign extension: "; test__int64_neg16&&; HEX$(test__int64_neg16&&) ' FFFFFF00?
PRINT "uint64 negative: "; test__uint64_neg~&&; HEX$(test__uint64_neg~&&) ' FF00 - possible bug
PRINT "uint64 negative sign extension: "; test__uint64_neg32~&&; HEX$(test__uint64_neg32~&&) ' FF00 - possible bug
PRINT "uint64 negative sign extension: "; test__uint64_neg64~&&; HEX$(test__uint64_neg64~&&) ' FF00 - possible bug
PRINT "uint64: "; test__uint64&&; HEX$(test__uint64&&) ' 4000000000000001
PRINT "ulong uinteger: "; test__ulong_uinteger~&; HEX$(test__ulong_uinteger~&) ' 4000000000000001
SYSTEM

19
tests/compile_tests/const/hex_literals.output Normal file
View file

@ -0,0 +1,19 @@
byte: 79 4F
byte negative: -1 FF
integer: 255 FF
integer negative: -13 FFF3
long: 16711935 FF00FF
long negative: -256 FFFFFF00
long negative sign extension: -256 FFFFFF00
ulong: 1342177024 4FFFFF00
ulong negative: 4294967040 FFFFFF00
ulong negative sign extension: 4294967040 FFFFFF00
int64: 5764607523034234624 4FFFFFFFFFFFFF00
int64 negative: -256 FF00
int64 negative sign extension: -256 FF00
int64 negative sign extension: -256 FF00
uint64 negative: 18446744073709551360 FF00
uint64 negative sign extension: 18446744073709551360 FF00
uint64 negative sign extension: 18446744073709551360 FF00
uint64: 4611686018427387905 4000000000000001
ulong uinteger: 65535 FFFF

2
tests/compile_tests/const/math_funcs.bas
View file

@ -3,6 +3,7 @@ _DEST _CONSOLE
' This list comprises all of the math functions usable in CONST
CONST const_PI = _PI
CONST const_PIfunc = _PI(2)
CONST const_ACOS = _ACOS(.2)
CONST const_ASIN = _ASIN(.2)
CONST const_ARCSEC = _ARCSEC(1.2)
@ -54,6 +55,7 @@ CONST const_ROOT = 20 ROOT 3
' The answers have to be within the allowed range, to account for floating point
' differences.
PRINT "PI: "; 3.141592653589793 * .999999 < const_PI; 3.141592653589793 * 1.000001 > const_PI
PRINT "PI: "; 6.283185307179586 * .999999 < const_PIfunc; 6.283185307179586 * 1.000001 > const_PIfunc
PRINT "ACOS: "; 1.369438406004566 * .999999 < const_ACOS; 1.369438406004566 * 1.000001 > const_ACOS
PRINT "ASIN: "; .2013579207903308 * .999999 < const_ASIN; .2013579207903308 * 1.000001 > const_ASIN
PRINT "ARCSEC: "; .5856855434571508 * .999999 < const_ARCSEC; .5856855434571508 * 1.000001 > const_ARCSEC

1
tests/compile_tests/const/math_funcs.output
View file

@ -1,4 +1,5 @@
PI: -1 -1
PI: -1 -1
ACOS: -1 -1
ASIN: -1 -1
ARCSEC: -1 -1

85
tests/compile_tests/const/noprefix.bas Normal file
View file

@ -0,0 +1,85 @@
$NOPREFIX
$CONSOLE:ONLY
_DEST _CONSOLE
' This list comprises all of the math functions usable in CONST
CONST const_PI = PI
CONST const_PIfunc = PI(2)
CONST const_ACOS = ACOS(.2)
CONST const_ASIN = ASIN(.2)
CONST const_ARCSEC = ARCSEC(1.2)
CONST const_ARCCOT = ARCCOT(.2)
CONST const_ARCCSC = ARCCSC(1.2)
CONST const_SECH = SECH(.2)
CONST const_CSCH = CSCH(.2)
CONST const_COTH = COTH(.2)
CONST const_D2R = _D2R(.2)
CONST const_D2G = D2G(.2)
CONST const_R2D = R2D(.2)
CONST const_R2G = R2G(.2)
CONST const_G2D = G2D(.2)
CONST const_G2R = G2R(.2)
CONST const_ROUND = ROUND(20.2)
CONST const_CEIL = CEIL(20.2)
CONST const_SEC = SEC(2)
CONST const_CSC = CSC(2)
CONST const_COT = COT(2)
' CONST const_ASC = ASC("a") ' Bugged, not implemented
CONST const__RGB32 = RGB32(2, 3, 4)
CONST const__RGBA32 = RGBA32(2, 3, 4, 5)
CONST const__RGB32_1 = RGB32(2)
CONST const__RGB32_2 = RGB32(2, 3)
CONST const__RGB32_4 = RGB32(2, 3, 4, 5)
CONST const__RGB = RGB(2, 3, 4, 2)
CONST const__RGBA = RGBA(2, 3, 4, 2, 2)
CONST const__RED32 = RED32(22)
CONST const__GREEN32 = GREEN32(22)
CONST const__BLUE32 = BLUE32(22)
CONST const__ALPHA32 = ALPHA32(22)
CONST const__RED = RED(22, 0)
CONST const__GREEN = GREEN(22, 0)
CONST const__BLUE = BLUE(22, 0)
CONST const__ALPHA = ALPHA(2222, 0)
' The answers have to be within the allowed range, to account for floating point
' differences.
PRINT "PI: "; 3.141592653589793 * .999999 < const_PI; 3.141592653589793 * 1.000001 > const_PI
PRINT "PI: "; 6.283185307179586 * .999999 < const_PIfunc; 6.283185307179586 * 1.000001 > const_PIfunc
PRINT "ACOS: "; 1.369438406004566 * .999999 < const_ACOS; 1.369438406004566 * 1.000001 > const_ACOS
PRINT "ASIN: "; .2013579207903308 * .999999 < const_ASIN; .2013579207903308 * 1.000001 > const_ASIN
PRINT "ARCSEC: "; .5856855434571508 * .999999 < const_ARCSEC; .5856855434571508 * 1.000001 > const_ARCSEC
PRINT "ARCCOT: "; 1.373400766945016 * .999999 < const_ARCCOT; 1.373400766945016 * 1.000001 > const_ARCCOT
PRINT "ARCCSC: "; .9851107833377457 * .999999 < const_ARCCSC; .9851107833377457 * 1.000001 > const_ARCCSC
PRINT "SECH: "; .9803279976447253 * .999999 < const_SECH; .9803279976447253 * 1.000001 > const_SECH
PRINT "CSCH: "; 4.966821568814516 * .999999 < const_CSCH; 4.966821568814516 * 1.000001 > const_CSCH
PRINT "COTH: "; 1.44280551632034 * .999999 < const_COTH; 1.44280551632034 * 1.000001 > const_COTH
PRINT "D2R: "; .0034906585 * .999999 < const_D2R; .0034906585 * 1.000001 > const_D2R
PRINT "D2G: "; .22222222222 * .999999 < const_D2G; .22222222222 * 1.000001 > const_D2G
PRINT "R2D: "; 11.4591559 * .999999 < const_R2D; 11.4591559 * 1.000001 > const_R2D
PRINT "R2G: "; .0031415926 * .999999 < const_R2G; .0031415926 * 1.000001 > const_R2G
PRINT "G2D: "; .18 * .999999 < const_G2D; .18 * 1.000001 > const_G2D
PRINT "G2R: "; 12.7323954474 * .999999 < const_G2R; 12.7323954474 * 1.000001 > const_G2R
PRINT "CSC: "; 1.099750170294616 * .999999 < const_CSC; 1.099750170294616 * 1.000001 > const_CSC
PRINT "SEC: "; -2.402997961722381 * .999999 > const_SEC; -2.402997961722381 * 1.000001 < const_SEC
PRINT "COT: "; -.4576575543602858 * .999999 > const_COT; -.4576575543602858 * 1.000001 < const_COT
PRINT "ROUND: "; const_ROUND
PRINT "CEIL: "; const_CEIL
PRINT "RGB32: "; HEX$(const__RGB32)
PRINT "RGBA32: "; HEX$(const__RGBA32)
PRINT "1: "; HEX$(const__RGB32_1)
PRINT "2: "; HEX$(const__RGB32_2)
PRINT "4: "; HEX$(const__RGB32_4)
PRINT "RGB: "; HEX$(const__RGB)
PRINT "RGBA: "; HEX$(const__RGBA)
PRINT "RED32: "; HEX$(const__RED32)
PRINT "GREEN32: "; const__GREEN32
PRINT "BLUE32: "; const__BLUE32
PRINT "ALPHA32: "; const__ALPHA32
PRINT "RED: "; const__RED
PRINT "GREEN: "; const__GREEN
PRINT "BLUE: "; const__BLUE
PRINT "ALPHA: "; const__ALPHA
SYSTEM

36
tests/compile_tests/const/noprefix.output Normal file
View file

@ -0,0 +1,36 @@
PI: -1 -1
PI: -1 -1
ACOS: -1 -1
ASIN: -1 -1
ARCSEC: -1 -1
ARCCOT: -1 -1
ARCCSC: -1 -1
SECH: -1 -1
CSCH: -1 -1
COTH: -1 -1
D2R: -1 -1
D2G: -1 -1
R2D: -1 -1
R2G: -1 -1
G2D: -1 -1
G2R: -1 -1
CSC: -1 -1
SEC: -1 -1
COT: -1 -1
ROUND: 20
CEIL: 21
RGB32: FF020304
RGBA32: 5020304
1: FF020202
2: 3020202
4: 5020304
RGB: 0
RGBA: 0
RED32: 0
GREEN32: 0
BLUE32: 22
ALPHA32: 0
RED: 0
GREEN: 0
BLUE: 0
ALPHA: 255

2
tests/compile_tests/const/not_bad_identifier.err
View file

@ -1,4 +1,4 @@
Expected variable/value after 'OR'
Expected variable/value after 'NOT'
Caused by (or after):
LINE 3:CONST FOOBAR = NOT OR

2
tests/compile_tests/const/not_string.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.6
Unexpected element '"string",6'
Caused by (or after):
LINE 3:CONST FOOBAR = NOT "string",6

20
tests/compile_tests/const/rho_test.bas Normal file
View file

@ -0,0 +1,20 @@
CONST chunkSIZEOF% = 4 + 4
CONST CHformLEN% = 4
CONST formSIZEOF% = chunkSIZEOF% + CHformLEN% 'remove trailing % and it works
CONST CHthdrLEN% = 30 + 2 + 4
CONST thdrSIZEOF% = chunkSIZEOF% + CHthdrLEN% 'no error
CONST CHcsetLEN% = 16 + 264 + 2 + 2 + 2 + 2
CONST csetSIZEOF% = chunkSIZEOF% + CHcsetLEN% 'no error
CONST CHwposLEN% = 30 + 2 + 2
CONST wposSIZEOF% = chunkSIZEOF% + CHwposLEN% 'no error
CONST CHvarsLEN% = 4 + 2 + 2
CONST varsSIZEOF% = chunkSIZEOF% + CHvarsLEN% 'no error
CONST CHtlogLEN% = 30 + 12 + 80
CONST tlogSIZEOF% = chunkSIZEOF% + CHtlogLEN% 'no error

2
tests/compile_tests/const/too_few_arguments_to_boolean.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.8
Expected variable/value after 'OR'
Caused by (or after):
LINE 3:CONST FOOBAR = 1 OR 2 OR

2
tests/compile_tests/const/type_mismatch_string_integer.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.11
Unexpected element '20'
Caused by (or after):
LINE 3:CONST FOOBAR = "asdf",4 + 20

2
tests/compile_tests/const/type_mismatch_string_subtract.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.12
Unexpected element '-'
Caused by (or after):
LINE 3:CONST FOOBAR = "asdf",4 - "asdf2",5

2
tests/compile_tests/const/undefined_argument.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.15
Unexpected element 'UNDEFINED'
Caused by (or after):
LINE 3:CONST FOOBAR = 20 OR UNDEFINED

2
tests/compile_tests/const/undefined_argument_first.err
View file

@ -1,4 +1,4 @@
Invalid CONST expression.4
Unexpected element 'UNDEFINED'
Caused by (or after):
LINE 3:CONST FOOBAR = UNDEFINED OR 2

52
tests/compile_tests/qb64pe/dwd.bas Normal file
View file

@ -0,0 +1,52 @@
DEFLNG A-Z
$Console:Only
Dim Debug As Long
'$include:'../../../source/global/constants.bas'
sp = "@" ' Makes sequences easier to write
'$include:'../../../source/utilities/const_eval.bi'
'$include:'../../../source/utilities/ini-manager/ini.bi'
'$include:'../../../source/utilities/s-buffer/simplebuffer.bi'
'$include:'../../../source/utilities/hash.bi'
'$include:'../../../source/utilities/type.bi'
'$include:'../../../source/utilities/give_error.bi'
Dim tests(10) As String
tests(1) = "2@+@+@+@3"
tests(2) = "2@-@-@3"
tests(3) = "2@-@+@3@-@-@4"
tests(4) = "(@-@-@3@+@+@3@)@-@-@3"
tests(5) = "-@-@3"
tests(6) = "-@+@3"
tests(7) = "+@-@3"
tests(8) = "+@+@3"
tests(9) = "+@+@+@3"
tests(10) = "-@-@-@3"
For i = 1 TO UBOUND(tests)
Print "Test: "; Readable$(tests(i))
Print "DWD: "; Readable$(DWD$(tests(i)))
Next i
SYSTEM
'$include:'../../../source/utilities/ini-manager/ini.bm'
'$include:'../../../source/utilities/s-buffer/simplebuffer.bm'
'$include:'../../../source/utilities/elements.bas'
'$include:'../../../source/utilities/const_eval.bas'
'$include:'../../../source/utilities/hash.bas'
'$include:'../../../source/utilities/give_error.bas'
'$include:'../../../source/utilities/strings.bas'
'$include:'../../../source/utilities/type.bas'
FUNCTION Readable$(a$)
r$ = ""
FOR i = 1 TO numelements(a$)
r$ = r$ + getelement$(a$, i) + " "
NEXT
Readable$ = r$
END FUNCTION

20
tests/compile_tests/qb64pe/dwd.output Normal file
View file

@ -0,0 +1,20 @@
Test: 2 + + + 3
DWD: 2 + 3
Test: 2 - - 3
DWD: 2 + 3
Test: 2 - + 3 - - 4
DWD: 2 - 3 + 4
Test: ( - - 3 + + 3 ) - - 3
DWD: ( + 3 + 3 ) + 3
Test: - - 3
DWD: + 3
Test: - + 3
DWD: - 3
Test: + - 3
DWD: - 3
Test: + + 3
DWD: + 3
Test: + + + 3
DWD: + 3
Test: - - - 3
DWD: - 3

1
tests/compile_tests/qb64pe/element.bas
View file

@ -5,6 +5,7 @@ $Console:Only
Dim Debug As Long
'$include:'../../../source/global/constants.bas'
'$include:'../../../source/utilities/type.bi'
sp = "@" ' Makes the output readable
Type TestCase

32
tests/compile_tests/qb64pe/element_createElementString.bas Normal file
View file

@ -0,0 +1,32 @@
Option _Explicit
DEFLNG A-Z
$Console:Only
Dim Debug As Long
Debug = -1
'$include:'../../../source/global/constants.bas'
'$include:'../../../source/utilities/type.bi'
sp = "@" ' Makes the output readable
Dim i As Long
PRINT "foobar element: " + createElementString$("foobar")
FOR i = 0 to 30
PRINT "foobar element"; i; ": " + createElementString$("foobar" + CHR$(i) + "baz")
NEXT
FOR i = 126 to 255
PRINT "foobar element"; i; ": " + createElementString$("foobar" + CHR$(i) + "baz")
NEXT
DIM s$
FOR i = 0 TO 255
s$ = s$ + CHR$(i)
NEXT
PRINT "all chars: " + createElementString$(s$)
System
'$include:'../../../source/utilities/elements.bas'

163
tests/compile_tests/qb64pe/element_createElementString.output Normal file
View file

@ -0,0 +1,163 @@
foobar element: "foobar",6
foobar element 0 : "foobar\000baz",10
foobar element 1 : "foobar\001baz",10
foobar element 2 : "foobar\002baz",10
foobar element 3 : "foobar\003baz",10
foobar element 4 : "foobar\004baz",10
foobar element 5 : "foobar\005baz",10
foobar element 6 : "foobar\006baz",10
foobar element 7 : "foobar\007baz",10
foobar element 8 : "foobar\010baz",10
foobar element 9 : "foobar\011baz",10
foobar element 10 : "foobar\012baz",10
foobar element 11 : "foobar\013baz",10
foobar element 12 : "foobar\014baz",10
foobar element 13 : "foobar\015baz",10
foobar element 14 : "foobar\016baz",10
foobar element 15 : "foobar\017baz",10
foobar element 16 : "foobar\020baz",10
foobar element 17 : "foobar\021baz",10
foobar element 18 : "foobar\022baz",10
foobar element 19 : "foobar\023baz",10
foobar element 20 : "foobar\024baz",10
foobar element 21 : "foobar\025baz",10
foobar element 22 : "foobar\026baz",10
foobar element 23 : "foobar\027baz",10
foobar element 24 : "foobar\030baz",10
foobar element 25 : "foobar\031baz",10
foobar element 26 : "foobar\032baz",10
foobar element 27 : "foobar\033baz",10
foobar element 28 : "foobar\034baz",10
foobar element 29 : "foobar\035baz",10
foobar element 30 : "foobar\036baz",10
foobar element 126 : "foobar~baz",10
foobar element 127 : "foobar\177baz",10
foobar element 128 : "foobar\200baz",10
foobar element 129 : "foobar\201baz",10
foobar element 130 : "foobar\202baz",10
foobar element 131 : "foobar\203baz",10
foobar element 132 : "foobar\204baz",10
foobar element 133 : "foobar\205baz",10
foobar element 134 : "foobar\206baz",10
foobar element 135 : "foobar\207baz",10
foobar element 136 : "foobar\210baz",10
foobar element 137 : "foobar\211baz",10
foobar element 138 : "foobar\212baz",10
foobar element 139 : "foobar\213baz",10
foobar element 140 : "foobar\214baz",10
foobar element 141 : "foobar\215baz",10
foobar element 142 : "foobar\216baz",10
foobar element 143 : "foobar\217baz",10
foobar element 144 : "foobar\220baz",10
foobar element 145 : "foobar\221baz",10
foobar element 146 : "foobar\222baz",10
foobar element 147 : "foobar\223baz",10
foobar element 148 : "foobar\224baz",10
foobar element 149 : "foobar\225baz",10
foobar element 150 : "foobar\226baz",10
foobar element 151 : "foobar\227baz",10
foobar element 152 : "foobar\230baz",10
foobar element 153 : "foobar\231baz",10
foobar element 154 : "foobar\232baz",10
foobar element 155 : "foobar\233baz",10
foobar element 156 : "foobar\234baz",10
foobar element 157 : "foobar\235baz",10
foobar element 158 : "foobar\236baz",10
foobar element 159 : "foobar\237baz",10
foobar element 160 : "foobar\240baz",10
foobar element 161 : "foobar\241baz",10
foobar element 162 : "foobar\242baz",10
foobar element 163 : "foobar\243baz",10
foobar element 164 : "foobar\244baz",10
foobar element 165 : "foobar\245baz",10
foobar element 166 : "foobar\246baz",10
foobar element 167 : "foobar\247baz",10
foobar element 168 : "foobar\250baz",10
foobar element 169 : "foobar\251baz",10
foobar element 170 : "foobar\252baz",10
foobar element 171 : "foobar\253baz",10
foobar element 172 : "foobar\254baz",10
foobar element 173 : "foobar\255baz",10
foobar element 174 : "foobar\256baz",10
foobar element 175 : "foobar\257baz",10
foobar element 176 : "foobar\260baz",10
foobar element 177 : "foobar\261baz",10
foobar element 178 : "foobar\262baz",10
foobar element 179 : "foobar\263baz",10
foobar element 180 : "foobar\264baz",10
foobar element 181 : "foobar\265baz",10
foobar element 182 : "foobar\266baz",10
foobar element 183 : "foobar\267baz",10
foobar element 184 : "foobar\270baz",10
foobar element 185 : "foobar\271baz",10
foobar element 186 : "foobar\272baz",10
foobar element 187 : "foobar\273baz",10
foobar element 188 : "foobar\274baz",10
foobar element 189 : "foobar\275baz",10
foobar element 190 : "foobar\276baz",10
foobar element 191 : "foobar\277baz",10
foobar element 192 : "foobar\300baz",10
foobar element 193 : "foobar\301baz",10
foobar element 194 : "foobar\302baz",10
foobar element 195 : "foobar\303baz",10
foobar element 196 : "foobar\304baz",10
foobar element 197 : "foobar\305baz",10
foobar element 198 : "foobar\306baz",10
foobar element 199 : "foobar\307baz",10
foobar element 200 : "foobar\310baz",10
foobar element 201 : "foobar\311baz",10
foobar element 202 : "foobar\312baz",10
foobar element 203 : "foobar\313baz",10
foobar element 204 : "foobar\314baz",10
foobar element 205 : "foobar\315baz",10
foobar element 206 : "foobar\316baz",10
foobar element 207 : "foobar\317baz",10
foobar element 208 : "foobar\320baz",10
foobar element 209 : "foobar\321baz",10
foobar element 210 : "foobar\322baz",10
foobar element 211 : "foobar\323baz",10
foobar element 212 : "foobar\324baz",10
foobar element 213 : "foobar\325baz",10
foobar element 214 : "foobar\326baz",10
foobar element 215 : "foobar\327baz",10
foobar element 216 : "foobar\330baz",10
foobar element 217 : "foobar\331baz",10
foobar element 218 : "foobar\332baz",10
foobar element 219 : "foobar\333baz",10
foobar element 220 : "foobar\334baz",10
foobar element 221 : "foobar\335baz",10
foobar element 222 : "foobar\336baz",10
foobar element 223 : "foobar\337baz",10
foobar element 224 : "foobar\340baz",10
foobar element 225 : "foobar\341baz",10
foobar element 226 : "foobar\342baz",10
foobar element 227 : "foobar\343baz",10
foobar element 228 : "foobar\344baz",10
foobar element 229 : "foobar\345baz",10
foobar element 230 : "foobar\346baz",10
foobar element 231 : "foobar\347baz",10
foobar element 232 : "foobar\350baz",10
foobar element 233 : "foobar\351baz",10
foobar element 234 : "foobar\352baz",10
foobar element 235 : "foobar\353baz",10
foobar element 236 : "foobar\354baz",10
foobar element 237 : "foobar\355baz",10
foobar element 238 : "foobar\356baz",10
foobar element 239 : "foobar\357baz",10
foobar element 240 : "foobar\360baz",10
foobar element 241 : "foobar\361baz",10
foobar element 242 : "foobar\362baz",10
foobar element 243 : "foobar\363baz",10
foobar element 244 : "foobar\364baz",10
foobar element 245 : "foobar\365baz",10
foobar element 246 : "foobar\366baz",10
foobar element 247 : "foobar\367baz",10
foobar element 248 : "foobar\370baz",10
foobar element 249 : "foobar\371baz",10
foobar element 250 : "foobar\372baz",10
foobar element 251 : "foobar\373baz",10
foobar element 252 : "foobar\374baz",10
foobar element 253 : "foobar\375baz",10
foobar element 254 : "foobar\376baz",10
foobar element 255 : "foobar\377baz",10
all chars: "\000\001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037 !\042#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377",256

44
tests/compile_tests/qb64pe/element_getStringValue.bas Normal file
View file

@ -0,0 +1,44 @@
Option _Explicit
DEFLNG A-Z
$Console:Only
Dim Debug As Long
Debug = -1
'$include:'../../../source/global/constants.bas'
'$include:'../../../source/utilities/type.bi'
sp = "@" ' Makes the output readable
Dim i As Long, value As String, typ As Long
typ = elementGetStringValue&(createElementString$("foobar"), value)
PRINT "foobar element: " + value
FOR i = 1 to 30
typ = elementGetStringValue&(createElementString$("foobar" + CHR$(i) + "baz"), value)
PRINT "foobar element"; i
PRINT value
NEXT
FOR i = 126 to 255
typ = elementGetStringValue&(createElementString$("foobar" + CHR$(i) + "baz"), value)
PRINT "foobar element"; i
PRINT value
NEXT
DIM s$
FOR i = 0 TO 255
s$ = s$ + CHR$(i)
NEXT
typ = elementGetStringValue&(createElementString$(s$), value)
PRINT "all chars: ";
FOR i = 1 TO LEN(value)
PRINT HEX$(ASC(value, i)); " ";
NEXT
System
'$include:'../../../source/utilities/elements.bas'

323
tests/compile_tests/qb64pe/element_getStringValue.output Normal file
View file

@ -0,0 +1,323 @@
foobar element: foobar
foobar element 1
foobarbaz
foobar element 2
foobarbaz
foobar element 3
foobarbaz
foobar element 4
foobarbaz
foobar element 5
foobarbaz
foobar element 6
foobarbaz
foobar element 7
foobarbaz
foobar element 8
foobarbaz
foobar element 9
foobar baz
foobar element 10
foobar
baz
foobar element 11
foobar baz
foobar element 12
foobar baz
foobar element 13
foobar baz
foobar element 14
foobarbaz
foobar element 15
foobarbaz
foobar element 16
foobarbaz
foobar element 17
foobarbaz
foobar element 18
foobarbaz
foobar element 19
foobarbaz
foobar element 20
foobarbaz
foobar element 21
foobarbaz
foobar element 22
foobarbaz
foobar element 23
foobarbaz
foobar element 24
foobarbaz
foobar element 25
foobarbaz
foobar element 26
foobarbaz
foobar element 27
foobarbaz
foobar element 28
foobarbaz
foobar element 29
foobarbaz
foobar element 30
foobarbaz
foobar element 126
foobar~baz
foobar element 127
foobarbaz
foobar element 128
foobar€baz
foobar element 129
foobar<EFBFBD>baz
foobar element 130
foobar‚baz
foobar element 131
foobarƒbaz
foobar element 132
foobar„baz
foobar element 133
foobar…baz
foobar element 134
foobar†baz
foobar element 135
foobar‡baz
foobar element 136
foobarˆbaz
foobar element 137
foobar‰baz
foobar element 138
foobarŠbaz
foobar element 139
foobar‹baz
foobar element 140
foobarŒbaz
foobar element 141
foobar<EFBFBD>baz
foobar element 142
foobarŽbaz
foobar element 143
foobar<EFBFBD>baz
foobar element 144
foobar<EFBFBD>baz
foobar element 145
foobar‘baz
foobar element 146
foobar’baz
foobar element 147
foobar“baz
foobar element 148
foobar”baz
foobar element 149
foobar•baz
foobar element 150
foobar–baz
foobar element 151
foobar—baz
foobar element 152
foobar˜baz
foobar element 153
foobar™baz
foobar element 154
foobaršbaz
foobar element 155
foobar›baz
foobar element 156
foobarœbaz
foobar element 157
foobar<EFBFBD>baz
foobar element 158
foobaržbaz
foobar element 159
foobarŸbaz
foobar element 160
foobar baz
foobar element 161
foobar¡baz
foobar element 162
foobar¢baz
foobar element 163
foobar£baz
foobar element 164
foobar¤baz
foobar element 165
foobar¥baz
foobar element 166
foobar¦baz
foobar element 167
foobar§baz
foobar element 168
foobar¨baz
foobar element 169
foobar©baz
foobar element 170
foobarªbaz
foobar element 171
foobar«baz
foobar element 172
foobar¬baz
foobar element 173
foobar­baz
foobar element 174
foobar®baz
foobar element 175
foobar¯baz
foobar element 176
foobar°baz
foobar element 177
foobar±baz
foobar element 178
foobar²baz
foobar element 179
foobar³baz
foobar element 180
foobar´baz
foobar element 181
foobarµbaz
foobar element 182
foobar¶baz
foobar element 183
foobar·baz
foobar element 184
foobar¸baz
foobar element 185
foobar¹baz
foobar element 186
foobarºbaz
foobar element 187
foobar»baz
foobar element 188
foobar¼baz
foobar element 189
foobar½baz
foobar element 190
foobar¾baz
foobar element 191
foobar¿baz
foobar element 192
foobarÀbaz
foobar element 193
foobarÁbaz
foobar element 194
foobarÂbaz
foobar element 195
foobarÃbaz
foobar element 196
foobarÄbaz
foobar element 197
foobarÅbaz
foobar element 198
foobarÆbaz
foobar element 199
foobarÇbaz
foobar element 200
foobarÈbaz
foobar element 201
foobarÉbaz
foobar element 202
foobarÊbaz
foobar element 203
foobarËbaz
foobar element 204
foobarÌbaz
foobar element 205
foobarÍbaz
foobar element 206
foobarÎbaz
foobar element 207
foobarÏbaz
foobar element 208
foobarÐbaz
foobar element 209
foobarÑbaz
foobar element 210
foobarÒbaz
foobar element 211
foobarÓbaz
foobar element 212
foobarÔbaz
foobar element 213
foobarÕbaz
foobar element 214
foobarÖbaz
foobar element 215
foobar×baz
foobar element 216
foobarØbaz
foobar element 217
foobarÙbaz
foobar element 218
foobarÚbaz
foobar element 219
foobarÛbaz
foobar element 220
foobarÜbaz
foobar element 221
foobarÝbaz
foobar element 222
foobarÞbaz
foobar element 223
foobarßbaz
foobar element 224
foobaràbaz
foobar element 225
foobarábaz
foobar element 226
foobarâbaz
foobar element 227
foobarãbaz
foobar element 228
foobaräbaz
foobar element 229
foobaråbaz
foobar element 230
foobaræbaz
foobar element 231
foobarçbaz
foobar element 232
foobarèbaz
foobar element 233
foobarébaz
foobar element 234
foobarêbaz
foobar element 235
foobarëbaz
foobar element 236
foobarìbaz
foobar element 237
foobaríbaz
foobar element 238
foobarîbaz
foobar element 239
foobarïbaz
foobar element 240
foobarðbaz
foobar element 241
foobarñbaz
foobar element 242
foobaròbaz
foobar element 243
foobaróbaz
foobar element 244
foobarôbaz
foobar element 245
foobarõbaz
foobar element 246
foobaröbaz
foobar element 247
foobar÷baz
foobar element 248
foobarøbaz
foobar element 249
foobarùbaz
foobar element 250
foobarúbaz
foobar element 251
foobarûbaz
foobar element 252
foobarübaz
foobar element 253
foobarýbaz
foobar element 254
foobarþbaz
foobar element 255
foobarÿbaz
all chars: 0 1 2 3 4 5 6 7 8 9 A B C D E F 10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F 20 21 22 23 24 25 26 27 28 29 2A 2B 2C 2D 2E 2F 30 31 32 33 34 35 36 37 38 39 3A 3B 3C 3D 3E 3F 40 41 42 43 44 45 46 47 48 49 4A 4B 4C 4D 4E 4F 50 51 52 53 54 55 56 57 58 59 5A 5B 5C 5D 5E 5F 60 61 62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F 70 71 72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E 7F 80 81 82 83 84 85 86 87 88 89 8A 8B 8C 8D 8E 8F 90 91 92 93 94 95 96 97 98 99 9A 9B 9C 9D 9E 9F A0 A1 A2 A3 A4 A5 A6 A7 A8 A9 AA AB AC AD AE AF B0 B1 B2 B3 B4 B5 B6 B7 B8 B9 BA BB BC BD BE BF C0 C1 C2 C3 C4 C5 C6 C7 C8 C9 CA CB CC CD CE CF D0 D1 D2 D3 D4 D5 D6 D7 D8 D9 DA DB DC DD DE DF E0 E1 E2 E3 E4 E5 E6 E7 E8 E9 EA EB EC ED EE EF F0 F1 F2 F3 F4 F5 F6 F7 F8 F9 FA FB FC FD FE FF

50
tests/compile_tests/qb64pe/element_getnextelement.bas Normal file
View file

@ -0,0 +1,50 @@
Option _Explicit
DEFLNG A-Z
$Console:Only
Dim Debug As Long
Debug = -1
'$include:'../../../source/global/constants.bas'
'$include:'../../../source/utilities/type.bi'
sp = "@" ' Makes the output readable
DIM test$, strIndex AS LONG, Index AS LONG, ele$, i AS LONG
test$ = ""
strIndex = 0
Index = 0
ele$ = getnextelement$(test$, Index, strIndex)
Print "Empty element: "; ele$
Print "strIndex = 1: "; strIndex
Print "Index = -1: "; Index
Print
test$ = "foo"
strIndex = 0
Index = 0
' Should return one element for 'foo' and then Index = -1
For i = 1 To 2
ele$ = getnextelement$(test$, Index, strIndex)
Print "element: "; ele$
Print "strIndex: "; strIndex
Print "Index: "; Index
Next
Print
test$ = "foo@bar@baz@20202020@&HADDD"
strIndex = 0
Index = 0
' Should return the 5 individual elements, and then Index = -1
For i = 1 To 6
ele$ = getnextelement$(test$, Index, strIndex)
Print "element: "; ele$
Print "strIndex: "; strIndex
Print "Index: "; Index
Next
System
'$include:'../../../source/utilities/elements.bas'

29
tests/compile_tests/qb64pe/element_getnextelement.output Normal file
View file

@ -0,0 +1,29 @@
Empty element:
strIndex = 1: 1
Index = -1: -1
element: foo
strIndex: 4
Index: 1
element:
strIndex: 4
Index: -1
element: foo
strIndex: 5
Index: 1
element: bar
strIndex: 9
Index: 2
element: baz
strIndex: 13
Index: 3
element: 20202020
strIndex: 22
Index: 4
element: &HADDD
strIndex: 28
Index: 5
element:
strIndex: 28
Index: -1

63
tests/compile_tests/qb64pe/element_getprevelement.bas Normal file
View file

@ -0,0 +1,63 @@
Option _Explicit
DEFLNG A-Z
$Console:Only
Dim Debug As Long
Debug = -1
'$include:'../../../source/global/constants.bas'
'$include:'../../../source/utilities/type.bi'
sp = "@" ' Makes the output readable
DIM test$, strIndex AS LONG, Index AS LONG, ele$, i AS LONG
test$ = ""
strIndex = 0
Index = 0
ele$ = getprevelement$(test$, Index, strIndex)
Print "Empty element: "; ele$
Print "strIndex = 1: "; strIndex
Print "Index = -1: "; Index
Print
test$ = "foo"
strIndex = 0
Index = 0
' Should return one element for 'foo' and then Index = -1
For i = 1 To 2
ele$ = getprevelement$(test$, Index, strIndex)
Print "element: "; ele$
Print "strIndex: "; strIndex
Print "Index: "; Index
Next
Print
test$ = "foo@bar@baz@20202020@&HADDD"
strIndex = 0
Index = 0
' Should return the 5 individual elements, and then Index = -1
For i = 1 To 6
ele$ = getprevelement$(test$, Index, strIndex)
Print "element: "; ele$
Print "strIndex: "; strIndex
Print "Index: "; Index
Next
Print
test$ = "@@baz@@@&HADDD@"
strIndex = 0
Index = 0
' Make sure the blank elements are considered
For i = 1 To 8
ele$ = getprevelement$(test$, Index, strIndex)
Print "element: "; ele$
Print "strIndex: "; strIndex
Print "Index: "; Index
Next
System
'$include:'../../../source/utilities/elements.bas'

54
tests/compile_tests/qb64pe/element_getprevelement.output Normal file
View file

@ -0,0 +1,54 @@
Empty element:
strIndex = 1: -1
Index = -1: 0
element: foo
strIndex: -1
Index: 1
element:
strIndex: -1
Index: -1
element: &HADDD
strIndex: 20
Index: 5
element: 20202020
strIndex: 11
Index: 4
element: baz
strIndex: 7
Index: 3
element: bar
strIndex: 3
Index: 2
element: foo
strIndex: -1
Index: 1
element:
strIndex: -1
Index: -1
element:
strIndex: 14
Index: 7
element: &HADDD
strIndex: 7
Index: 6
element:
strIndex: 6
Index: 5
element:
strIndex: 5
Index: 4
element: baz
strIndex: 1
Index: 3
element:
strIndex: -2
Index: 2
element:
strIndex: -1
Index: 1
element:
strIndex: -1
Index: -1

1
tests/compile_tests/qb64pe/hasFunctionElement.bas
View file

@ -5,6 +5,7 @@ Dim Debug As Long
Debug = -1
'$include:'../../../source/global/constants.bas'
'$include:'../../../source/utilities/type.bi'
sp = "@" ' Makes the output readable
Type TestCase

69
tests/compile_tests/qb64pe/prepass.bas Normal file
View file

@ -0,0 +1,69 @@
DEFLNG A-Z
$Console:Only
Dim Debug As Long
'$include:'../../../source/global/constants.bas'
sp = "@" ' Makes the output readable
'$include:'../../../source/utilities/const_eval.bi'
'$include:'../../../source/utilities/ini-manager/ini.bi'
'$INCLUDE:'../../../source/utilities/s-buffer/simplebuffer.bi'
'$include:'../../../source/utilities/hash.bi'
'$include:'../../../source/utilities/type.bi'
'$include:'../../../source/utilities/give_error.bi'
Dim tests(4) As String
' These tests cover the paren insert around NOT, and some simple cases
tests(1) = "(@20@+@40@+@(@60@*@4@AND@50@+@NOT@5@+@4@)@-@2@)"
tests(2) = "(@20@+@40%@+@60000000&&@+@_RGB32@(@20@,@50@,@60@)@+@(@60@*@4@AND@50@+@NOT@5@+@4@)@-@2@)"
tests(3) = "2@+@NOT@5@+@2@*@6@^@3"
tests(4) = "2@+@-@2@"
For i = 1 TO UBOUND(tests)
Print "Test: "; Readable$(tests(i))
PreParse tests(i)
Print "PrePass: "; Readable$(tests(i))
Next i
' Test empty string
test2$ = ""
Print "Test: "; Readable$(test2$)
PreParse test2$
Print "PrePass: "; Readable$(test2$)
Dim errs(5) As String
' Various invalid paren cases
errs(1) = ")@("
errs(2) = "(@(@)@)@)"
errs(3) = "(@(@(@)@)"
errs(4) = "("
errs(5) = ")"
For i = 1 to UBOUND(errs)
Print "Test: "; Readable$(errs(i))
PreParse errs(i)
Print "PrePass: "; Readable$(errs(i))
Next
SYSTEM
'$include:'../../../source/utilities/ini-manager/ini.bm'
'$include:'../../../source/utilities/s-buffer/simplebuffer.bm'
'$include:'../../../source/utilities/elements.bas'
'$include:'../../../source/utilities/const_eval.bas'
'$include:'../../../source/utilities/hash.bas'
'$include:'../../../source/utilities/give_error.bas'
'$include:'../../../source/utilities/strings.bas'
'$include:'../../../source/utilities/type.bas'
FUNCTION Readable$(a$)
r$ = ""
FOR i = 1 TO numelements(a$)
r$ = r$ + getelement$(a$, i) + " "
NEXT
Readable$ = r$
END FUNCTION

20
tests/compile_tests/qb64pe/prepass.output Normal file
View file

@ -0,0 +1,20 @@
Test: ( 20 + 40 + ( 60 * 4 AND 50 + NOT 5 + 4 ) - 2 )
PrePass: ( 20 + 40 + ( 60 * 4 AND 50 + ( NOT 5 + 4 ) ) - 2 )
Test: ( 20 + 40% + 60000000&& + _RGB32 ( 20 , 50 , 60 ) + ( 60 * 4 AND 50 + NOT 5 + 4 ) - 2 )
PrePass: ( 20 + 40% + 60000000&& + _RGB32 ( 20 , 50 , 60 ) + ( 60 * 4 AND 50 + ( NOT 5 + 4 ) ) - 2 )
Test: 2 + NOT 5 + 2 * 6 ^ 3
PrePass: 2 + ( NOT 5 + 2 * 6 ^ 3 )
Test: 2 + - 2
PrePass: 2 + - 2
Test:
PrePass: ERROR - NULL string; nothing to evaluate
Test: ) (
PrePass: ERROR - Bad Parenthesis, too many )
Test: ( ( ) ) )
PrePass: ERROR - Bad Parenthesis, too many )
Test: ( ( ( ) )
PrePass: ERROR - Bad Parenthesis
Test: (
PrePass: ERROR - Bad Parenthesis
Test: )
PrePass: ERROR - Bad Parenthesis, too many )

51
tests/compile_tests/qb64pe/string.bas Normal file
View file

@ -0,0 +1,51 @@
DEFLNG A-Z
$Console:Only
Dim Debug As Long
'$include:'../../../source/global/constants.bas'
sp = "@" ' Makes sequences easier to write
'$include:'../../../source/utilities/const_eval.bi'
'$include:'../../../source/utilities/ini-manager/ini.bi'
'$include:'../../../source/utilities/s-buffer/simplebuffer.bi'
'$include:'../../../source/utilities/hash.bi'
'$include:'../../../source/utilities/type.bi'
'$include:'../../../source/utilities/give_error.bi'
Dim test As String
test = CHR$(34) + "foobar" + CHR$(34) + ",6"
Dim num As ParseNum, eval AS String
eval = Evaluate_Expression$(test, num)
Print "eval result: " + eval
Print "num.s: " + num.s
test = test + "@+@" + test
eval = Evaluate_Expression$(test, num)
Print "eval result: " + eval
Print "num.s: " + num.s
test = test + "@+@" + CHR$(34) + "test\034" + CHR$(34) + ",5"
eval = Evaluate_Expression$(test, num)
Print "eval result: " + eval
Print "num.s: " + num.s
SYSTEM
'$include:'../../../source/utilities/ini-manager/ini.bm'
'$include:'../../../source/utilities/s-buffer/simplebuffer.bm'
'$include:'../../../source/utilities/elements.bas'
'$include:'../../../source/utilities/const_eval.bas'
'$include:'../../../source/utilities/hash.bas'
'$include:'../../../source/utilities/give_error.bas'
'$include:'../../../source/utilities/strings.bas'
'$include:'../../../source/utilities/type.bas'

6
tests/compile_tests/qb64pe/string.output Normal file
View file

@ -0,0 +1,6 @@
eval result: "foobar",6
num.s: "foobar",6
eval result: "foobarfoobar",12
num.s: "foobarfoobar",12
eval result: "foobarfoobartest\034",17
num.s: "foobarfoobartest\034",17