1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-07-04 06:00:23 +00:00

Format source, apply Option _Explicit in tests

This commit is contained in:
Matthew Kilgore 2023-02-12 22:38:29 -05:00
parent 83533dc319
commit 0836cf31eb
4 changed files with 147 additions and 123 deletions

View file

@ -12317,7 +12317,7 @@ IF idemode = 0 AND No_C_Compile_Mode = 0 THEN
END IF
' Fixup the output path if either we got an `-o` argument, or we're relative to `_StartDir$`
IF LEN(outputfile_cmd$) Or OutputIsRelativeToStartDir THEN
IF LEN(outputfile_cmd$) OR OutputIsRelativeToStartDir THEN
IF LEN(outputfile_cmd$) THEN
'resolve relative path for output file
path.out$ = getfilepath$(outputfile_cmd$)
@ -16424,7 +16424,7 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
SetDependency id2.Dependency
argCount = countFunctionElements(a$)
ReDim providedArgs(argCount)
REDIM providedArgs(argCount)
passomit = 0
hasOptionalFirstArg = 0
@ -16433,26 +16433,26 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
f$ = RTRIM$(id2.specialformat)
IF LEN(f$) THEN 'special format given
For fi = 1 to argCount
FOR fi = 1 TO argCount
providedArgs(fi) = hasFunctionElement(a$, fi)
Next
NEXT
' Special case for the INSTR and _INSTRREV format, which have an optional argument at the beginning
If f$ = "[?],?,?" Then
IF f$ = "[?],?,?" THEN
hasOptionalFirstArg = -1
if UBOUND(providedArgs) = 2 Then
ReDim _Preserve providedArgs(3)
IF UBOUND(providedArgs) = 2 THEN
REDIM _PRESERVE providedArgs(3)
providedArgs(3) = providedArgs(2)
providedArgs(2) = providedArgs(1)
providedArgs(1) = 0 ' The first argument was not provided
skipFirstArg = -1
End If
End If
END IF
END IF
IF Not isValidArgSet(id2.specialformat, providedArgs(), firstOptionalArgument) Then
IF NOT isValidArgSet(id2.specialformat, providedArgs(), firstOptionalArgument) THEN
IF LEN(id2.hr_syntax) > 0 THEN
Give_Error "Incorrect number of arguments - Reference: " + id2.hr_syntax
ELSE
@ -16465,9 +16465,9 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
ELSE 'no special format given
For fi = 1 to argCount
FOR fi = 1 TO argCount
providedArgs(fi) = -1
Next
NEXT
IF n$ = "ASC" AND args = 2 THEN GOTO skipargnumchk
IF id2.overloaded = -1 AND (args >= id2.minargs AND args <= id2.args) THEN GOTO skipargnumchk
@ -16495,10 +16495,10 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
' The first optional argument is missing and not included in the
' argument list
if skipFirstArg Then
IF skipFirstArg THEN
r$ = r$ + "NULL,"
curarg = 2
End If
END IF
n = numelements(a$)
@ -16508,12 +16508,12 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
IF l$ = ")" THEN b = b - 1
IF (l$ = "," AND b = 0) OR (i = n) THEN
IF NOT providedArgs(curarg) THEN
If i = n Then Give_Error "Last function argument cannot be empty": Exit Function
IF i = n THEN Give_Error "Last function argument cannot be empty": EXIT FUNCTION
r$ = r$ + "NULL,"
firsti = i + 1
curarg = curarg + 1
_Continue
_CONTINUE
END IF
targettyp = CVL(MID$(id2.arg, curarg * 4 - 4 + 1, 4))
@ -17650,7 +17650,7 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
IF targettyp AND ISSTRING THEN
IF (sourcetyp AND ISSTRING) = 0 THEN
nth = curarg
if skipFirstArg Then nth = nth - 1
IF skipFirstArg THEN nth = nth - 1
IF ids(targetid).args = 1 THEN Give_Error "String required for function": EXIT FUNCTION
Give_Error str_nth$(nth) + " function argument requires a string": EXIT FUNCTION
END IF
@ -17658,7 +17658,7 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
IF (targettyp AND ISSTRING) = 0 THEN
IF sourcetyp AND ISSTRING THEN
nth = curarg
if skipFirstArg Then nth = nth - 1
IF skipFirstArg THEN nth = nth - 1
IF ids(targetid).args = 1 THEN Give_Error "Number required for function": EXIT FUNCTION
Give_Error str_nth$(nth) + " function argument requires a number": EXIT FUNCTION
END IF
@ -17673,7 +17673,7 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
IF explicitreference = 0 THEN
IF targettyp AND ISUDT THEN
nth = curarg
if skipFirstArg Then nth = nth - 1
IF skipFirstArg THEN nth = nth - 1
IF qb64prefix_set AND udtxcname(targettyp AND 511) = "_MEM" THEN
x$ = "'" + MID$(RTRIM$(udtxcname(targettyp AND 511)), 2) + "'"
ELSE
@ -17783,11 +17783,11 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
NEXT
' Add on any extra optional arguments that were not provided
If curarg <= id2.args Then
For i = curarg To id2.args
If i = 1 Then r$ = r$ + "NULL" Else r$ = r$ + ",NULL"
Next
End If
IF curarg <= id2.args THEN
FOR i = curarg TO id2.args
IF i = 1 THEN r$ = r$ + "NULL" ELSE r$ = r$ + ",NULL"
NEXT
END IF
END IF
IF n$ = "UBOUND" OR n$ = "LBOUND" THEN
@ -17808,13 +17808,13 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
IF passomit THEN
r$ = r$ + ",0"
If hasOptionalFirstArg Then
If providedArgs(1) Then r$ = r$ + "|1"
Else
For i = firstOptionalArgument to UBOUND(providedArgs)
if providedArgs(i) Then r$ = r$ + "|" + str2$(_SHL(1, i - firstOptionalArgument))
Next
End If
IF hasOptionalFirstArg THEN
IF providedArgs(1) THEN r$ = r$ + "|1"
ELSE
FOR i = firstOptionalArgument TO UBOUND(providedArgs)
IF providedArgs(i) THEN r$ = r$ + "|" + str2$(_SHL(1, i - firstOptionalArgument))
NEXT
END IF
END IF
r$ = r$ + ")"

View file

@ -1,5 +1,7 @@
FUNCTION getelement$ (a$, elenum)
DIM p AS LONG, n AS LONG, i AS LONG
IF a$ = "" THEN EXIT FUNCTION 'no elements!
n = 1
@ -23,6 +25,8 @@ FUNCTION getelement$ (a$, elenum)
END FUNCTION
FUNCTION getelements$ (a$, i1, i2)
DIM p AS LONG, n AS LONG, i AS LONG, i1pos AS LONG
IF i2 < i1 THEN getelements$ = "": EXIT FUNCTION
n = 1
p = 1
@ -45,6 +49,8 @@ FUNCTION getelements$ (a$, i1, i2)
END FUNCTION
SUB insertelements (a$, i, elements$)
DIM a2 AS STRING, n AS LONG, i2 AS LONG
IF i = 0 THEN
IF a$ = "" THEN
a$ = elements$
@ -57,9 +63,6 @@ SUB insertelements (a$, i, elements$)
a2$ = ""
n = numelements(a$)
FOR i2 = 1 TO n
IF i2 > 1 THEN a2$ = a2$ + sp
a2$ = a2$ + getelement$(a$, i2)
@ -71,6 +74,8 @@ SUB insertelements (a$, i, elements$)
END SUB
FUNCTION numelements (a$)
DIM p AS LONG, n AS LONG, i AS LONG
IF a$ = "" THEN EXIT FUNCTION
n = 1
p = 1
@ -83,6 +88,8 @@ FUNCTION numelements (a$)
END FUNCTION
SUB removeelements (a$, first, last, keepindexing)
DIM n AS LONG, i AS LONG, a2 AS STRING
a2$ = ""
'note: first and last MUST be valid
' keepindexing means the number of elements will stay the same
@ -105,38 +112,38 @@ END SUB
' a$ should be a function argument list
' Returns number of function arguments (including empty ones) in the provided list
FUNCTION countFunctionElements (a$)
Dim count As Long, p As Long, lvl As Long
DIM count AS LONG, p AS LONG, lvl AS LONG, i AS LONG
p = 1
lvl = 1
i = 0
if Len(a$) = 0 Then
IF LEN(a$) = 0 THEN
countFunctionElements = 0
Exit Function
End If
EXIT FUNCTION
END IF
Do
Select Case Asc(a$, i + 1)
Case Asc("("):
DO
SELECT CASE ASC(a$, i + 1)
CASE ASC("("):
lvl = lvl + 1
Case Asc(")"):
CASE ASC(")"):
lvl = lvl - 1
Case Asc(","):
If lvl = 1 Then
CASE ASC(","):
IF lvl = 1 THEN
count = count + 1
End If
END IF
End Select
END SELECT
i = INSTR(p, a$, sp)
if i = 0 Then
Exit Do
End If
IF i = 0 THEN
EXIT DO
END IF
p = i + 1
Loop
LOOP
' Make sure to count the argument after the last comma
countFunctionElements = count + 1
@ -144,87 +151,87 @@ END FUNCTION
' a$ should be a function argument list
' Returns true if the argument was provided in the list
FUNCTION hasFunctionElement(a$, element)
Dim count As Long, p As Long, lvl As Long
FUNCTION hasFunctionElement (a$, element)
DIM count AS LONG, p AS LONG, lvl AS LONG, i AS LONG, start AS LONG
start = 0
p = 1
lvl = 1
i = 1
if Len(a$) = 0 Then
IF LEN(a$) = 0 THEN
hasFunctionElement = 0
Exit Function
End If
EXIT FUNCTION
END IF
' Special case for a single provided argument
If INSTR(a$, sp) = 0 And Len(a$) <> 0 Then
IF INSTR(a$, sp) = 0 AND LEN(a$) <> 0 THEN
hasFunctionElement = element = 1
Exit Function
End If
EXIT FUNCTION
END IF
Do
If i > Len(a$) Then
Exit Do
End If
DO
IF i > LEN(a$) THEN
EXIT DO
END IF
Select Case Asc(a$, i)
Case Asc("("):
SELECT CASE ASC(a$, i)
CASE ASC("("):
lvl = lvl + 1
Case Asc(")"):
CASE ASC(")"):
lvl = lvl - 1
Case Asc(","):
If lvl = 1 Then
CASE ASC(","):
IF lvl = 1 THEN
count = count + 1
If element = count Then
IF element = count THEN
' We have a element here if there's any elements
' inbetween the previous comma and this one
hasFunctionElement = (i <> 1) And (i - 2 <> start)
Exit Function
End If
hasFunctionElement = (i <> 1) AND (i - 2 <> start)
EXIT FUNCTION
END IF
start = i
End If
End Select
END IF
END SELECT
p = i
i = INSTR(i, a$, sp)
if i = 0 Then
Exit Do
End If
IF i = 0 THEN
EXIT DO
END IF
i = i + 1
Loop
LOOP
If element > count + 1 Then
IF element > count + 1 THEN
hasFunctionElement = 0
Exit Function
End If
EXIT FUNCTION
END IF
' Check if last argument was provided.
'
' Syntax '2,3' has two arguments, the '3' argument is what gets compared here
' Syntax '2,' has one argument, the comma is the last element so it fails this check.
If p > 0 Then
If Asc(a$, p) <> Asc(",") Then
IF p > 0 THEN
IF ASC(a$, p) <> ASC(",") THEN
hasFunctionElement = -1
Exit Function
End If
End If
EXIT FUNCTION
END IF
END IF
hasFunctionElement = 0
END FUNCTION
' Returns true if the provided arguments are a valid set for the given function format
' firstOptionalArgument returns the index of the first argument that is optional
FUNCTION isValidArgSet(format As String, providedArgs() As Long, firstOptionalArgument As Long)
Dim maxArgument As Long, i As Long
Dim currentArg As Long, optionLvl As Long
Dim wasProvided(0 To 10) As Long
Dim As Long ArgProvided , ArgNotProvided, ArgIgnored
FUNCTION isValidArgSet (format AS STRING, providedArgs() AS LONG, firstOptionalArgument AS LONG)
DIM maxArgument AS LONG, i AS LONG
DIM currentArg AS LONG, optionLvl AS LONG
DIM wasProvided(0 TO 10) AS LONG
DIM AS LONG ArgProvided, ArgNotProvided, ArgIgnored
ArgProvided = -1
ArgNotProvided = 0
@ -245,61 +252,61 @@ FUNCTION isValidArgSet(format As String, providedArgs() As Long, firstOptionalAr
maxArgument = UBOUND(providedArgs)
For i = 1 to Len(format)
Select Case Asc(format, i)
Case Asc("["):
FOR i = 1 TO LEN(format)
SELECT CASE ASC(format, i)
CASE ASC("["):
optionLvl = optionLvl + 1
wasProvided(optionLvl) = ArgIgnored
Case Asc("]"):
CASE ASC("]"):
optionLvl = optionLvl - 1
If wasProvided(optionLvl) = ArgIgnored Then
IF wasProvided(optionLvl) = ArgIgnored THEN
' If not provided, then we stay in the ignored state
' because whether this arg set was provided does not matter
' for the rest of the parsing
If wasProvided(optionLvl + 1) = ArgProvided Then
IF wasProvided(optionLvl + 1) = ArgProvided THEN
wasProvided(optionLvl) = ArgProvided
End If
Else
END IF
ELSE
' If an arg at this level was already not provided, then
' this optional set can't be provided either
if wasProvided(optionLvl) = ArgNotProvided And wasProvided(optionLvl + 1) = ArgProvided Then
IF wasProvided(optionLvl) = ArgNotProvided AND wasProvided(optionLvl + 1) = ArgProvided THEN
isValidArgSet = 0
EXIT FUNCTION
End If
End If
END IF
END IF
Case Asc("?"):
CASE ASC("?"):
currentArg = currentArg + 1
if optionLvl >= 1 And firstOptionalArgument = 0 Then firstOptionalArgument = currentArg
IF optionLvl >= 1 AND firstOptionalArgument = 0 THEN firstOptionalArgument = currentArg
if wasProvided(optionLvl) = ArgIgnored Then
If maxArgument >= currentArg Then
IF wasProvided(optionLvl) = ArgIgnored THEN
IF maxArgument >= currentArg THEN
wasProvided(optionLvl) = providedArgs(currentArg)
else
ELSE
wasProvided(optionLvl) = 0
End If
else
if maxArgument < currentArg Then
If wasProvided(optionLvl) <> ArgNotProvided Then
END IF
ELSE
IF maxArgument < currentArg THEN
IF wasProvided(optionLvl) <> ArgNotProvided THEN
isValidArgSet = 0
Exit Function
End If
Elseif wasProvided(optionLvl) <> providedArgs(currentArg) Then
EXIT FUNCTION
END IF
ELSEIF wasProvided(optionLvl) <> providedArgs(currentArg) THEN
isValidArgSet = 0
EXIT FUNCTION
End If
End If
End Select
Next
END IF
END IF
END SELECT
NEXT
' The base level of arguments are required. They can be in the
' 'ignored' state though if all arguments are within brackets
if currentArg < maxArgument Or wasProvided(0) = ArgNotProvided then
IF currentArg < maxArgument OR wasProvided(0) = ArgNotProvided THEN
isValidArgSet = 0
Exit Function
End If
EXIT FUNCTION
END IF
isValidArgSet = -1
END FUNCTION

View file

@ -1,6 +1,9 @@
Option _Explicit
DEFLNG A-Z
$Console:Only
Dim Debug As Long
'$include:'../../../source/global/constants.bas'
sp = "@" ' Makes the output readable
@ -104,7 +107,11 @@ tests(18).result = -1
tests(18).firstOptional = 4
ReDim provided(10) As Long
Dim i As Long
For i = 1 To UBOUND(tests)
Dim firstOpt As Long, result As Long
firstOpt& = 0
argStringToArray tests(i).providedArgs, provided()
@ -126,7 +133,7 @@ System
'$include:'../../../source/utilities/elements.bas'
SUB argStringToArray(argString As String, provided() As Long)
ReDim provided(LEN(argString) / 4) As Long
ReDim provided(LEN(argString) / 4) As Long, i As Long
for i = 1 to UBOUND(provided)
provided(i) = CVL(MID$(argString, (i - 1) * 4 + 1, 4))
@ -134,6 +141,8 @@ SUB argStringToArray(argString As String, provided() As Long)
END SUB
FUNCTION argStringPrint$(argString As String)
Dim res As String, i As Long
res$ = ""
If argString = "" Then argStringPrint$ = "": Exit Function

View file

@ -1,5 +1,7 @@
Option _Explicit
DEFLNG A-Z
$Console:Only
Dim Debug As Long
Debug = -1
'$include:'../../../source/global/constants.bas'
@ -33,12 +35,16 @@ tests(5).results = MKL$(-1) + MKL$(0) + MKL$(-1) + MKL$(0)
tests(6).args = "2" + sp + "," + sp + ","
tests(6).results = MKL$(-1) + MKL$(0) + MKL$(0) + MKL$(0)
ReDim provided(10) As Long
ReDim provided(10) As Long, i As Long
For i = 1 To UBOUND(tests)
argStringToArray tests(i).results, provided()
Print "Test"; i; ", Args: "; tests(i).args
Dim k As Long
For k = 1 To UBOUND(provided)
Dim result As Long
result& = hasFunctionElement(tests(i).args, k)
Print " Expected:"; provided(k); ", Actual"; result&;
@ -57,7 +63,7 @@ System
'$include:'../../../source/utilities/elements.bas'
SUB argStringToArray(argString As String, provided() As Long)
ReDim provided(LEN(argString) / 4) As Long
ReDim provided(LEN(argString) / 4) As Long, i As Long
for i = 1 to UBOUND(provided)
provided(i) = CVL(MID$(argString, (i - 1) * 4 + 1, 4))
@ -65,6 +71,8 @@ SUB argStringToArray(argString As String, provided() As Long)
END SUB
FUNCTION argStringPrint$(argString As String)
Dim res As String, i As Long
res$ = ""
res$ = STR$(CVL(MID$(argString, 1, 4)))