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

On error, report back to the IDE. ($DEBUG)

Browse source
This commit is contained in:
Fellippe Heitor 2021-07-16 23:18:46 -03:00
parent 78fb2ff1b9
commit ae887507c2
5 changed files with 47 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
internal/c/libqb.cpp
View file

@ -1364,6 +1364,7 @@ extern uint32 qbevent;
extern int32 console; extern int32 console;
extern int32 screen_hide_startup; extern int32 screen_hide_startup;
extern int32 asserts; extern int32 asserts;
extern int32 vwatch;
//... //...
int64 exit_code=0; int64 exit_code=0;

1
internal/c/qbx.cpp
View file

@ -706,6 +706,7 @@ double error_erl=0;
uint32 qbs_tmp_list_nexti=1; uint32 qbs_tmp_list_nexti=1;
uint32 error_occurred=0; uint32 error_occurred=0;
uint32 new_error=0; uint32 new_error=0;
uint32 bkp_new_error=0;
qbs* nothingstring; qbs* nothingstring;
uint32 qbevent=0; uint32 qbevent=0;
uint8 suspend_program=0; uint8 suspend_program=0;

24
source/ide/ide_methods.bas
View file

@ -700,6 +700,7 @@ FUNCTION ide2 (ignore)
SELECT CASE IdeDebugMode SELECT CASE IdeDebugMode
CASE 1 CASE 1
IdeDebugMode = 0 IdeDebugMode = 0
idefocusline = 0
END SELECT END SELECT
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$ COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
IF idesubwindow <> 0 THEN _RESIZE OFF ELSE _RESIZE ON IF idesubwindow <> 0 THEN _RESIZE OFF ELSE _RESIZE ON
@ -6285,6 +6286,7 @@ SUB DebugMode
CASE "breakpoint", "line number" CASE "breakpoint", "line number"
l = CVL(value$) l = CVL(value$)
idecy = l idecy = l
idefocusline = 0
ideshowtext ideshowtext
clearStatusWindow 1 clearStatusWindow 1
IF cmd$ = "breakpoint" THEN IF cmd$ = "breakpoint" THEN
@ -6297,18 +6299,22 @@ SUB DebugMode
CLOSE #client& CLOSE #client&
dummy = DarkenFGBG(0) dummy = DarkenFGBG(0)
clearStatusWindow 0 clearStatusWindow 0
setStatusMessage 1, "Debug session aborted.", 7 setStatusMessage 1, "Debug session aborted.", 15
IF LEN(value$) THEN
setStatusMessage 2, value$, 7
END IF
WHILE _MOUSEINPUT: WEND WHILE _MOUSEINPUT: WEND
_KEYCLEAR _KEYCLEAR
EXIT SUB EXIT SUB
CASE "error" CASE "error"
clearStatusWindow 0 l = CVL(value$)
setStatusMessage 1, "Debug session aborted.", 7 idecy = l
IF value$ = "" THEN idefocusline = l
setStatusMessage 2, "Communication error.", 2 ideshowtext
ELSE clearStatusWindow 1
setStatusMessage 2, LEFT$(value$, idewx - 2), 2 COLOR , 4
END IF setStatusMessage 1, "Error occurred on line" + STR$(l), 13
PauseMode = -1
END SELECT END SELECT
_LIMIT 100 _LIMIT 100
@ -8567,7 +8573,7 @@ SUB ideshowtext
GOSUB ShowLineNumber GOSUB ShowLineNumber
IF l = idefocusline AND idecy <> l THEN IF (l = idefocusline AND idecy <> l AND IdeDebugMode = 0) OR (l = idefocusline AND idecy = l AND IdeDebugMode <> 0) THEN
COLOR 7, 4 'Line with error gets a red background COLOR 7, 4 'Line with error gets a red background
ELSEIF idecy = l OR (l >= idecy_multilinestart AND l <= idecy_multilineend) THEN ELSEIF idecy = l OR (l >= idecy_multilinestart AND l <= idecy_multilineend) THEN
IF HideCurrentLineHighlight = 0 AND IdeSystem = 1 THEN COLOR 7, 6 'Highlight the current line IF HideCurrentLineHighlight = 0 AND IdeSystem = 1 THEN COLOR 7, 6 'Highlight the current line

27
source/qb64.bas
View file

@ -26,7 +26,9 @@ REDIM SHARED PL(1000) AS INTEGER 'Priority Level
REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name Conversion variables. REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name Conversion variables.
Set_OrderOfOperations Set_OrderOfOperations
DIM SHARED vWatchOn, vWatchRecompileAttempts, vWatchDesiredState DIM SHARED vWatchOn, vWatchRecompileAttempts, vWatchDesiredState, vWatchErrorCall$
vWatchErrorCall$ = "if(new_error){bkp_new_error=new_error;new_error=0;*__LONG_VWATCH_LINENUMBER=-1; SUB_VWATCH((ptrszint*)vwatch_local_vars);new_error=bkp_new_error;};"
DIM SHARED qb64prefix_set_recompileAttempts, qb64prefix_set_desiredState DIM SHARED qb64prefix_set_recompileAttempts, qb64prefix_set_desiredState
DIM SHARED opex_recompileAttempts, opex_desiredState DIM SHARED opex_recompileAttempts, opex_desiredState
DIM SHARED opexarray_recompileAttempts, opexarray_desiredState DIM SHARED opexarray_recompileAttempts, opexarray_desiredState
@ -3423,7 +3425,8 @@ DO
inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34) inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34)
END IF END IF
IF NoChecks = 0 THEN IF NoChecks = 0 THEN
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + inclinenump$ + ");r=0;}" IF vWatchOn THEN temp$ = vWatchErrorCall$ ELSE temp$ = ""
PRINT #12, "if(qbevent){" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");r=0;}"
END IF END IF
IF n = 1 THEN GOTO finishednonexec IF n = 1 THEN GOTO finishednonexec
entireline$ = getelements(entireline$, 2, n): u$ = UCASE$(entireline$): n = n - 1 entireline$ = getelements(entireline$, 2, n): u$ = UCASE$(entireline$): n = n - 1
@ -3483,7 +3486,8 @@ DO
inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34) inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34)
END IF END IF
IF NoChecks = 0 THEN IF NoChecks = 0 THEN
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + inclinenump$ + ");r=0;}" IF vWatchOn THEN temp$ = vWatchErrorCall$ ELSE temp$ = ""
PRINT #12, "if(qbevent){" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");r=0;}"
END IF END IF
entireline$ = RIGHT$(entireline$, LEN(entireline$) - x3): u$ = UCASE$(entireline$) entireline$ = RIGHT$(entireline$, LEN(entireline$) - x3): u$ = UCASE$(entireline$)
n = numelements(entireline$): IF n = 0 THEN GOTO finishednonexec n = numelements(entireline$): IF n = 0 THEN GOTO finishednonexec
@ -8782,7 +8786,8 @@ DO
thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1)
inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34) inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34)
END IF END IF
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + inclinenump$ + ");}" 'non-resumable error check (cannot exit without handling errors) IF vWatchOn THEN temp$ = vWatchErrorCall$ ELSE temp$ = ""
PRINT #12, "if(qbevent){" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");}" 'non-resumable error check (cannot exit without handling errors)
PRINT #12, "exit_code=" + e$ + ";" PRINT #12, "exit_code=" + e$ + ";"
l$ = l$ + sp + l2$ l$ = l$ + sp + l2$
END IF END IF
@ -8805,7 +8810,8 @@ DO
thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1)
inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34) inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34)
END IF END IF
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + inclinenump$ + ");}" 'non-resumable error check (cannot exit without handling errors) IF vWatchOn = 1 AND NoChecks = 0 THEN temp$ = vWatchErrorCall$ ELSE temp$ = ""
PRINT #12, "if(qbevent){" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");}" 'non-resumable error check (cannot exit without handling errors)
PRINT #12, "exit_code=" + e$ + ";" PRINT #12, "exit_code=" + e$ + ";"
l$ = l$ + sp + l2$ l$ = l$ + sp + l2$
END IF END IF
@ -11086,11 +11092,12 @@ DO
inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34) inclinenump$ = inclinenump$ + "," + CHR$(34) + thisincname$ + CHR$(34)
END IF END IF
IF NoChecks = 0 THEN IF NoChecks = 0 THEN
IF vWatchOn THEN temp$ = vWatchErrorCall$ ELSE temp$ = ""
IF dynscope THEN IF dynscope THEN
dynscope = 0 dynscope = 0
PRINT #12, "if(qbevent){evnt(" + str2$(linenumber) + inclinenump$ + ");if(r)goto S_" + str2$(statementn) + ";}" PRINT #12, "if(qbevent){" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");if(r)goto S_" + str2$(statementn) + ";}"
ELSE ELSE
PRINT #12, "if(!qbevent)break;evnt(" + str2$(linenumber) + inclinenump$ + ");}while(r);" PRINT #12, "if(!qbevent)break;" + temp$ + "evnt(" + str2$(linenumber) + inclinenump$ + ");}while(r);"
END IF END IF
END IF END IF
@ -11609,6 +11616,12 @@ ELSE
PRINT #18, "int32 asserts=0;" PRINT #18, "int32 asserts=0;"
END IF END IF
IF vWatchOn THEN
PRINT #18, "int32 vwatch=1;"
ELSE
PRINT #18, "int32 vwatch=0;"
END IF
fh = FREEFILE fh = FREEFILE
OPEN tmpdir$ + "dyninfo.txt" FOR APPEND AS #fh OPEN tmpdir$ + "dyninfo.txt" FOR APPEND AS #fh
IF Resize THEN IF Resize THEN

15
source/utilities/vwatch.bm
View file

@ -42,7 +42,7 @@ SUB vwatch (localVariables AS _OFFSET)
breakpointCount = CVL(value$) breakpointCount = CVL(value$)
CASE "breakpoint list" CASE "breakpoint list"
IF LEN(value$) \ 4 <> breakpointCount THEN IF LEN(value$) \ 4 <> breakpointCount THEN
cmd$ = "error" cmd$ = "quit:Communication error."
GOSUB SendCommand GOSUB SendCommand
CLOSE #ide CLOSE #ide
bypass = -1 bypass = -1
@ -63,18 +63,23 @@ SUB vwatch (localVariables AS _OFFSET)
LOOP LOOP
END IF END IF
IF vwatch_linenumber = lastLine THEN EXIT SUB
lastLine = vwatch_linenumber
IF vwatch_linenumber = 0 THEN IF vwatch_linenumber = 0 THEN
cmd$ = "quit" cmd$ = "quit:Program ended."
GOSUB SendCommand GOSUB SendCommand
CLOSE #ide CLOSE #ide
bypass = -1 bypass = -1
ide = 0 ide = 0
EXIT SUB EXIT SUB
ELSEIF vwatch_linenumber = -1 THEN
'report an error in the most recent line
cmd$ = "error:" + MKL$(lastLine)
GOSUB SendCommand
EXIT SUB
END IF END IF
IF vwatch_linenumber = lastLine THEN EXIT SUB
lastLine = vwatch_linenumber
GOSUB GetCommand GOSUB GetCommand
SELECT CASE cmd$ SELECT CASE cmd$
CASE "break" CASE "break"