QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-03 08:51:22 +00:00
Code Releases Wiki Activity

Merge pull request #192 from QB64Team/compiler-fixes

Browse source 
Compiler fixes
This commit is contained in:
Fellippe Heitor 2021-09-19 20:08:04 -03:00 committed by GitHub
parent 4d94cc56d8 42208832f5
commit 6b2299919b
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 13 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
source/qb64.bas
View file

@ -1804,17 +1804,7 @@ DO
IF temp = 0 THEN a$ = "Invalid Syntax. $LET <flag> = <value>": GOTO errmes IF temp = 0 THEN a$ = "Invalid Syntax. $LET <flag> = <value>": GOTO errmes
l$ = RTRIM$(LEFT$(temp$, temp - 1)): r$ = LTRIM$(MID$(temp$, temp + 1)) l$ = RTRIM$(LEFT$(temp$, temp - 1)): r$ = LTRIM$(MID$(temp$, temp + 1))
'then validate to make certain the left side looks proper 'then validate to make certain the left side looks proper
l1$ = "" IF validname(l$) = 0 THEN a$ = "Invalid flag name": GOTO errmes
FOR i = 1 TO LEN(l$)
a = ASC(l$, i)
SELECT CASE a
CASE 32 'strip out spaces
CASE 46: l1$ = l1$ + CHR$(a)
CASE IS < 48, IS > 90: a$ = "Invalid symbol left of equal sign (" + CHR$(a) + ")": GOTO errmes
CASE ELSE: l1$ = l1$ + CHR$(a)
END SELECT
NEXT
l$ = l1$
IF LEFT$(r$, 1) = CHR$(34) THEN r$ = LTRIM$(MID$(r$, 2)) IF LEFT$(r$, 1) = CHR$(34) THEN r$ = LTRIM$(MID$(r$, 2))
IF RIGHT$(r$, 1) = CHR$(34) THEN r$ = RTRIM$(LEFT$(r$, LEN(r$) - 1)) IF RIGHT$(r$, 1) = CHR$(34) THEN r$ = RTRIM$(LEFT$(r$, LEN(r$) - 1))
IF LEFT$(r$, 1) = "-" THEN IF LEFT$(r$, 1) = "-" THEN
@ -1831,7 +1821,7 @@ DO
CASE 46 'periods are fine. CASE 46 'periods are fine.
r1$ = r1$ + "." r1$ = r1$ + "."
CASE IS < 48, IS > 90 CASE IS < 48, IS > 90
a$ = "Invalid symbol right of equal sign (" + CHR$(a) + ")": GOTO errmes a$ = "Invalid value": GOTO errmes
CASE ELSE CASE ELSE
r1$ = r1$ + CHR$(a) r1$ = r1$ + CHR$(a)
END SELECT END SELECT
@ -2054,6 +2044,7 @@ DO
IF typ = 0 THEN a$ = "Undefined type": GOTO errmes IF typ = 0 THEN a$ = "Undefined type": GOTO errmes
typsize = typname2typsize typsize = typname2typsize
previousElement$ = lastElement$
nexttypeelement: nexttypeelement:
lasttypeelement = lasttypeelement + 1 lasttypeelement = lasttypeelement + 1
i2 = lasttypeelement i2 = lasttypeelement
@ -2074,8 +2065,14 @@ DO
lastElement$ = getelement$(a$, ii) lastElement$ = getelement$(a$, ii)
IF lastElement$ = "" THEN GOTO finishedlinepp IF lastElement$ = "" THEN GOTO finishedlinepp
IF ii = n AND lastElement$ = "," THEN a$ = "Expected element-name": GOTO errmes IF ii = n AND lastElement$ = "," THEN a$ = "Expected element-name": GOTO errmes
IF lastElement$ = "," THEN GOTO getNextElement IF lastElement$ = "," THEN
IF previousElement$ = "," THEN a$ = "Expected element-name": GOTO errmes
previousElement$ = lastElement$
GOTO getNextElement
END IF
n$ = lastElement$ n$ = lastElement$
IF previousElement$ <> "," THEN a$ = "Expected ,": GOTO errmes
previousElement$ = lastElement$
cn$ = getelement$(ca$, ii) cn$ = getelement$(ca$, ii)
GOTO nexttypeelement GOTO nexttypeelement
END IF END IF
@ -8120,7 +8117,7 @@ DO
GOTO dimgottyp GOTO dimgottyp
dimgottyp: dimgottyp:
IF d$ <> "" AND d$ <> "," THEN a$ = "DIM: Expected comma!": GOTO errmes IF d$ <> "" AND d$ <> "," THEN a$ = "DIM: Expected ,": GOTO errmes
'In QBASIC, if no type info is given it can refer to an expeicit/formally defined array 'In QBASIC, if no type info is given it can refer to an expeicit/formally defined array
IF notype <> 0 AND dimoption <> 3 AND dimoption <> 1 THEN 'not DIM or STATIC which only create new content IF notype <> 0 AND dimoption <> 3 AND dimoption <> 1 THEN 'not DIM or STATIC which only create new content
@ -8674,7 +8671,7 @@ DO
GOTO errmes GOTO errmes
END IF END IF
IF d$ <> "" AND d$ <> "," THEN a$ = "DIM: Expected comma!": GOTO errmes IF d$ <> "" AND d$ <> "," THEN a$ = "DIM: Expected ,": GOTO errmes
newDimSyntax = -1 newDimSyntax = -1
GOSUB NormalDimBlock GOSUB NormalDimBlock
@ -25723,6 +25720,7 @@ FUNCTION EvalPreIF (text$, err$)
NEXT NEXT
leftside$ = RTRIM$(LEFT$(temp$, i)) leftside$ = RTRIM$(LEFT$(temp$, i))
l$ = LTRIM$(RTRIM$(MID$(temp$, i + 1, LEN(l$) - i))) l$ = LTRIM$(RTRIM$(MID$(temp$, i + 1, LEN(l$) - i)))
IF validname(l$) = 0 THEN err$ = "Invalid flag name": EXIT FUNCTION
rightstop = LEN(r$) rightstop = LEN(r$)
FOR i = 1 TO LEN(r$) FOR i = 1 TO LEN(r$)
IF ASC(r$, i) = 32 THEN EXIT FOR IF ASC(r$, i) = 32 THEN EXIT FOR