// The MIT License (MIT) // // Copyright (C) 2026 Scott Duensing // // Permission is hereby granted, free of charge, to any person obtaining a copy // of this software and associated documentation files (the "Software"), to // deal in the Software without restriction, including without limitation the // rights to use, copy, modify, merge, publish, distribute, sublicense, and/or // sell copies of the Software, and to permit persons to whom the Software is // furnished to do so, subject to the following conditions: // // The above copyright notice and this permission notice shall be included in // all copies or substantial portions of the Software. // // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR // IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, // FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE // AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER // LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING // FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS // IN THE SOFTWARE. // test_suite.c -- Assertion-based regression tests for the BASIC // language runtime. Each test compiles a snippet, runs the VM with // PRINT output captured, and compares the captured text to an // expected string. Failures are reported with a diff-style preview // and the process exits non-zero, so `make tests` surfaces regressions // before they reach 86Box. // // Add new tests with TEST_EQ(name, source, expected) -- other helpers // cover compile errors and runtime errors. #include "compiler/parser.h" #include "runtime/vm.h" #include "runtime/values.h" #include "stb_ds_wrap.h" #include #include #include // ============================================================ // Capture buffer // ============================================================ #define CAPTURE_MAX 8192 typedef struct { char buf[CAPTURE_MAX]; int32_t len; } CaptureT; static void captureReset(CaptureT *c) { c->buf[0] = '\0'; c->len = 0; } static void captureAppend(CaptureT *c, const char *s) { int32_t n = (int32_t)strlen(s); if (c->len + n >= CAPTURE_MAX - 1) { n = CAPTURE_MAX - 1 - c->len; } if (n > 0) { memcpy(c->buf + c->len, s, n); c->len += n; c->buf[c->len] = '\0'; } } static void capturePrint(void *ctx, const char *text, bool newline) { CaptureT *c = (CaptureT *)ctx; if (text) { captureAppend(c, text); } if (newline) { captureAppend(c, "\n"); } } // ============================================================ // Test driver // ============================================================ static int32_t sPassCount = 0; static int32_t sFailCount = 0; static void reportPass(const char *name) { printf("PASS %s\n", name); sPassCount++; } static void reportFail(const char *name, const char *detail) { printf("FAIL %s\n", name); if (detail && detail[0]) { printf(" %s\n", detail); } sFailCount++; } static void reportFailDiff(const char *name, const char *expected, const char *got) { printf("FAIL %s\n", name); printf(" expected: [%s]\n", expected); printf(" got: [%s]\n", got); sFailCount++; } // Set up callStack[0] as the implicit main frame for module-level code. static void primeMainFrame(BasVmT *vm, const BasModuleT *mod) { vm->callStack[0].localCount = mod->globalCount > BAS_VM_MAX_LOCALS ? BAS_VM_MAX_LOCALS : mod->globalCount; vm->callDepth = 1; } // Compile + run. On success captures PRINT output into *out. Returns // 0 on success, negative on compile error, positive for runtime errors. // Runtime error text goes into outErr if provided. static int32_t runAndCapture(const char *source, char *out, int32_t outSize, char *outErr, int32_t outErrSize) { int32_t len = (int32_t)strlen(source); BasParserT parser; basParserInit(&parser, source, len); if (!basParse(&parser)) { if (outErr) { snprintf(outErr, outErrSize, "%s", parser.error); } basParserFree(&parser); return -1; } BasModuleT *mod = basParserBuildModule(&parser); basParserFree(&parser); if (!mod) { if (outErr) { snprintf(outErr, outErrSize, "module build failed"); } return -2; } BasVmT *vm = basVmCreate(); basVmLoadModule(vm, mod); CaptureT cap; captureReset(&cap); basVmSetPrintCallback(vm, capturePrint, &cap); primeMainFrame(vm, mod); BasVmResultE result = basVmRun(vm); int32_t rc = 0; if (result != BAS_VM_HALTED && result != BAS_VM_OK) { if (outErr) { snprintf(outErr, outErrSize, "%s", basVmGetError(vm)); } rc = (int32_t)result; } if (out && outSize > 0) { snprintf(out, outSize, "%s", cap.buf); } basVmDestroy(vm); basModuleFree(mod); return rc; } // TEST_EQ -- compile, run, expect captured output to match static void testEq(const char *name, const char *source, const char *expected) { char out[CAPTURE_MAX]; char err[256] = ""; int32_t rc = runAndCapture(source, out, sizeof(out), err, sizeof(err)); if (rc != 0) { char detail[512]; snprintf(detail, sizeof(detail), "rc=%d err=%s", (int)rc, err); reportFail(name, detail); return; } if (strcmp(out, expected) != 0) { reportFailDiff(name, expected, out); return; } reportPass(name); } // TEST_COMPILE_ERROR -- expect compilation to fail; substring of the // error message must match. Pass an empty needle to accept any error. static void testCompileError(const char *name, const char *source, const char *needle) { char out[CAPTURE_MAX]; char err[256] = ""; int32_t rc = runAndCapture(source, out, sizeof(out), err, sizeof(err)); if (rc != -1) { char detail[256]; snprintf(detail, sizeof(detail), "expected compile error; got rc=%d output=[%s]", (int)rc, out); reportFail(name, detail); return; } if (needle && needle[0] && strstr(err, needle) == NULL) { char detail[512]; snprintf(detail, sizeof(detail), "error [%s] did not contain [%s]", err, needle); reportFail(name, detail); return; } reportPass(name); } // runSubAndCapture -- compile, then invoke a specific named SUB via // basVmCallSub. Mirrors what fireCtrlEvent does for event handlers. // Returns 0 if the SUB returned normally, 1 if it returned false // (unhandled error), -1 on compile/load error. Captured PRINT output // goes into out; runtime error text (if any) goes into outErr. static int32_t runSubAndCapture(const char *source, const char *subName, char *out, int32_t outSize, char *outErr, int32_t outErrSize) { int32_t len = (int32_t)strlen(source); BasParserT parser; basParserInit(&parser, source, len); if (!basParse(&parser)) { if (outErr) { snprintf(outErr, outErrSize, "%s", parser.error); } basParserFree(&parser); return -1; } BasModuleT *mod = basParserBuildModule(&parser); basParserFree(&parser); if (!mod) { if (outErr) { snprintf(outErr, outErrSize, "module build failed"); } return -1; } BasVmT *vm = basVmCreate(); basVmLoadModule(vm, mod); CaptureT cap; captureReset(&cap); basVmSetPrintCallback(vm, capturePrint, &cap); primeMainFrame(vm, mod); // Execute module-level code first (to initialize globals). A // failure here (e.g. an error during global init) must be reported, // not swallowed -- otherwise the SUB runs against half-built state // and the test passes or fails for the wrong reason. BasVmResultE initResult = basVmRun(vm); if (initResult != BAS_VM_HALTED && initResult != BAS_VM_OK) { if (outErr) { snprintf(outErr, outErrSize, "module init error: %s", basVmGetError(vm)); } basVmDestroy(vm); basModuleFree(mod); return -1; } // Find the target SUB by name int32_t subAddr = -1; for (int32_t i = 0; i < mod->procCount; i++) { if (strcasecmp(mod->procs[i].name, subName) == 0) { subAddr = mod->procs[i].codeAddr; break; } } int32_t rc = 0; if (subAddr < 0) { if (outErr) { snprintf(outErr, outErrSize, "SUB '%s' not found", subName); } rc = -1; } else { // Clear error state before the call so we see only this call's errors vm->errorNumber = 0; vm->errorMsg[0] = '\0'; vm->inErrorHandler = false; vm->errorHandler = 0; bool ok = basVmCallSub(vm, subAddr); rc = ok ? 0 : 1; if (!ok && outErr) { snprintf(outErr, outErrSize, "%s", basVmGetError(vm)); } } if (out && outSize > 0) { snprintf(out, outSize, "%s", cap.buf); } basVmDestroy(vm); basModuleFree(mod); return rc; } // TEST_SUB_EQ -- compile, run module-level code, then invoke a named // SUB through basVmCallSub (the path used by event handlers), and // compare captured output. static void testSubEq(const char *name, const char *source, const char *subName, const char *expected) { char out[CAPTURE_MAX]; char err[256] = ""; int32_t rc = runSubAndCapture(source, subName, out, sizeof(out), err, sizeof(err)); if (rc < 0) { char detail[512]; snprintf(detail, sizeof(detail), "setup error: %s", err); reportFail(name, detail); return; } if (rc != 0) { char detail[512]; snprintf(detail, sizeof(detail), "SUB returned false (unhandled error): %s", err); reportFail(name, detail); return; } if (strcmp(out, expected) != 0) { reportFailDiff(name, expected, out); return; } reportPass(name); } #define TEST_SUB_EQ(n, s, sub, e) testSubEq((n), (s), (sub), (e)) // TEST_RUNTIME_ERROR -- expect runtime error; optional substring match // on the error message. static void testRuntimeError(const char *name, const char *source, const char *needle) { char out[CAPTURE_MAX]; char err[256] = ""; int32_t rc = runAndCapture(source, out, sizeof(out), err, sizeof(err)); if (rc <= 0) { char detail[256]; snprintf(detail, sizeof(detail), "expected runtime error; got rc=%d output=[%s]", (int)rc, out); reportFail(name, detail); return; } if (needle && needle[0] && strstr(err, needle) == NULL) { char detail[512]; snprintf(detail, sizeof(detail), "error [%s] did not contain [%s]", err, needle); reportFail(name, detail); return; } reportPass(name); } #define TEST_EQ(n, s, e) testEq((n), (s), (e)) #define TEST_COMPILE_ERROR(n, s, e) testCompileError((n), (s), (e)) #define TEST_RUNTIME_ERROR(n, s, e) testRuntimeError((n), (s), (e)) // ============================================================ // Widget-level event-dispatch harness // ============================================================ // // formrt.c depends on the full DVX widget/window stack and can't be // linked into the host test binary. This harness mirrors the dispatch // semantics of fireCtrlEvent / basFormRtFireEvent using stand-alone // mini-structs and a bare minimum of VM calls. // // IMPORTANT: if you change the dispatch rules in formrt.c (event // override table, re-entrancy guard, form-scope-vars binding), update // the matching code below. The tests are re-implementation tests, // not link-through tests. #define MINI_MAX_NAME 32 #define MINI_MAX_OVERRIDES 16 typedef struct { char eventName[MINI_MAX_NAME]; char handlerName[MINI_MAX_NAME]; } MiniOverrideT; typedef struct MiniCtrlT { char name[MINI_MAX_NAME]; char typeName[MINI_MAX_NAME]; struct MiniFormT *form; MiniOverrideT overrides[MINI_MAX_OVERRIDES]; int32_t overrideCount; bool eventFiring; char firingEventName[MINI_MAX_NAME]; } MiniCtrlT; typedef struct MiniFormT { char name[MINI_MAX_NAME]; MiniCtrlT **ctrls; // stb_ds array of heap-alloc'd controls BasValueT *formVars; int32_t formVarCount; } MiniFormT; typedef struct { BasVmT *vm; BasModuleT *module; MiniFormT **forms; // stb_ds array of heap-alloc'd forms MiniFormT *currentForm; } MiniRtT; static MiniFormT *miniCreateForm(MiniRtT *rt, const char *name, int32_t formVarCount) { MiniFormT *f = (MiniFormT *)calloc(1, sizeof(MiniFormT)); snprintf(f->name, MINI_MAX_NAME, "%s", name); f->ctrls = NULL; if (formVarCount > 0) { f->formVars = (BasValueT *)calloc(formVarCount, sizeof(BasValueT)); f->formVarCount = formVarCount; } arrput(rt->forms, f); return f; } static MiniCtrlT *miniAddCtrl(MiniFormT *f, const char *name, const char *typeName) { // Store stable heap pointers: arrput may realloc f->ctrls, so returning // an interior address would dangle once a second control is added. MiniCtrlT *c = (MiniCtrlT *)calloc(1, sizeof(MiniCtrlT)); snprintf(c->name, MINI_MAX_NAME, "%s", name); snprintf(c->typeName, MINI_MAX_NAME, "%s", typeName ? typeName : ""); c->form = f; arrput(f->ctrls, c); return c; } static void miniSetEvent(MiniCtrlT *ctrl, const char *eventName, const char *handlerName) { // Match formrt's SetEvent: update existing or append for (int32_t i = 0; i < ctrl->overrideCount; i++) { if (strcasecmp(ctrl->overrides[i].eventName, eventName) == 0) { snprintf(ctrl->overrides[i].handlerName, MINI_MAX_NAME, "%s", handlerName); return; } } if (ctrl->overrideCount < MINI_MAX_OVERRIDES) { MiniOverrideT *o = &ctrl->overrides[ctrl->overrideCount++]; snprintf(o->eventName, MINI_MAX_NAME, "%s", eventName); snprintf(o->handlerName, MINI_MAX_NAME, "%s", handlerName); } } static const BasProcEntryT *miniFindProc(BasModuleT *mod, const char *name) { if (!mod || !mod->procs || !name) { return NULL; } for (int32_t i = 0; i < mod->procCount; i++) { if (strcasecmp(mod->procs[i].name, name) == 0) { return &mod->procs[i]; } } return NULL; } static MiniFormT *miniResolveOwningForm(MiniRtT *rt, const BasProcEntryT *proc) { if (!rt || !proc || !proc->formName[0]) { return NULL; } for (int32_t i = 0; i < (int32_t)arrlen(rt->forms); i++) { if (strcasecmp(rt->forms[i]->name, proc->formName) == 0) { return rt->forms[i]; } } return NULL; } // Mirror of formrt.c's fireCtrlEvent. Re-entrancy guard, override // table, form-scope vars binding -- kept in sync by copy. static void miniFireCtrlEvent(MiniRtT *rt, MiniCtrlT *ctrl, const char *eventName) { if (!rt || !ctrl || !eventName) { return; } if (ctrl->eventFiring) { bool sameEvent = (ctrl->firingEventName[0] && strcasecmp(ctrl->firingEventName, eventName) == 0); if (sameEvent) { return; } } // Event-override path (SetEvent) for (int32_t i = 0; i < ctrl->overrideCount; i++) { if (strcasecmp(ctrl->overrides[i].eventName, eventName) != 0) { continue; } if (!rt->vm || !rt->module) { return; } const BasProcEntryT *proc = miniFindProc(rt->module, ctrl->overrides[i].handlerName); if (!proc || proc->isFunction) { return; } MiniFormT *prevForm = rt->currentForm; BasValueT *prevVars = rt->vm->currentFormVars; int32_t prevVarCount = rt->vm->currentFormVarCount; MiniFormT *owningForm = miniResolveOwningForm(rt, proc); MiniFormT *varsForm = owningForm ? owningForm : ctrl->form; rt->currentForm = ctrl->form; basVmSetCurrentFormVars(rt->vm, varsForm->formVars, varsForm->formVarCount); bool claimedGuard = !ctrl->eventFiring; if (claimedGuard) { ctrl->eventFiring = true; snprintf(ctrl->firingEventName, MINI_MAX_NAME, "%s", eventName); } rt->vm->errorMsg[0] = '\0'; rt->vm->errorNumber = 0; basVmCallSub(rt->vm, proc->codeAddr); if (claimedGuard) { ctrl->eventFiring = false; ctrl->firingEventName[0] = '\0'; } rt->currentForm = prevForm; basVmSetCurrentFormVars(rt->vm, prevVars, prevVarCount); return; } // Naming-convention fallback: CtrlName_EventName char handlerName[MINI_MAX_NAME * 2]; snprintf(handlerName, sizeof(handlerName), "%s_%s", ctrl->name, eventName); const BasProcEntryT *proc = miniFindProc(rt->module, handlerName); if (!proc || proc->isFunction) { return; } MiniFormT *prevForm = rt->currentForm; BasValueT *prevVars = rt->vm->currentFormVars; int32_t prevVarCount = rt->vm->currentFormVarCount; MiniFormT *owningForm = miniResolveOwningForm(rt, proc); MiniFormT *varsForm = owningForm ? owningForm : ctrl->form; rt->currentForm = ctrl->form; basVmSetCurrentFormVars(rt->vm, varsForm->formVars, varsForm->formVarCount); bool claimedGuard = !ctrl->eventFiring; if (claimedGuard) { ctrl->eventFiring = true; snprintf(ctrl->firingEventName, MINI_MAX_NAME, "%s", eventName); } basVmCallSub(rt->vm, proc->codeAddr); if (claimedGuard) { ctrl->eventFiring = false; ctrl->firingEventName[0] = '\0'; } rt->currentForm = prevForm; basVmSetCurrentFormVars(rt->vm, prevVars, prevVarCount); } // Context for an event-dispatch test: what to build and how to fire. typedef struct { const char *source; // BASIC source const char *formName; // "" if ctrl has no owning BEGINFORM int32_t formVarCount; // >0 if the module has form-scope vars const char *ctrlName; // control to fire events on const char *ctrlType; // widget type, e.g. "CommandButton" / "Timer" // Array of (eventName, handlerName) for SetEvent. Terminate with NULL. const char *overrides[2 * 8]; // Array of event names to fire in order. Terminate with NULL. const char *fires[8]; } TestDispatchT; static void testDispatchEq(const char *name, const TestDispatchT *d, const char *expected) { int32_t len = (int32_t)strlen(d->source); BasParserT parser; basParserInit(&parser, d->source, len); if (!basParse(&parser)) { char detail[256]; snprintf(detail, sizeof(detail), "compile error: %s", parser.error); reportFail(name, detail); basParserFree(&parser); return; } BasModuleT *mod = basParserBuildModule(&parser); basParserFree(&parser); if (!mod) { reportFail(name, "module build failed"); return; } BasVmT *vm = basVmCreate(); basVmLoadModule(vm, mod); CaptureT cap; captureReset(&cap); basVmSetPrintCallback(vm, capturePrint, &cap); primeMainFrame(vm, mod); // Run module-level init (populates globals, runs BEGINFORM init block). BasVmResultE initResult = basVmRun(vm); if (initResult != BAS_VM_HALTED && initResult != BAS_VM_OK) { char detail[256]; snprintf(detail, sizeof(detail), "module init error: %s", basVmGetError(vm)); reportFail(name, detail); basVmDestroy(vm); basModuleFree(mod); return; } // Build the mini runtime + form + control. MiniRtT rt; memset(&rt, 0, sizeof(rt)); rt.vm = vm; rt.module = mod; MiniFormT *form = miniCreateForm(&rt, d->formName[0] ? d->formName : "_NoForm", d->formVarCount); MiniCtrlT *ctrl = miniAddCtrl(form, d->ctrlName, d->ctrlType); // Wire overrides. for (int32_t i = 0; d->overrides[i] && d->overrides[i + 1]; i += 2) { miniSetEvent(ctrl, d->overrides[i], d->overrides[i + 1]); } // Fire the sequence of events. for (int32_t i = 0; d->fires[i]; i++) { miniFireCtrlEvent(&rt, ctrl, d->fires[i]); } if (strcmp(cap.buf, expected) == 0) { reportPass(name); } else { reportFailDiff(name, expected, cap.buf); } // Teardown. for (int32_t i = 0; i < (int32_t)arrlen(rt.forms); i++) { MiniFormT *f = rt.forms[i]; if (f->formVars) { for (int32_t j = 0; j < f->formVarCount; j++) { basValRelease(&f->formVars[j]); } free(f->formVars); } for (int32_t k = 0; k < (int32_t)arrlen(f->ctrls); k++) { free(f->ctrls[k]); } arrfree(f->ctrls); free(f); } arrfree(rt.forms); basVmDestroy(vm); basModuleFree(mod); } // Helper macros to keep tests compact. `overrides` and `fires` are // comma lists terminated with NULL/NULL. #define DISPATCH_OVR(...) { __VA_ARGS__, NULL, NULL } #define DISPATCH_FIRE(...) { __VA_ARGS__, NULL } // ============================================================ // Test cases // ============================================================ int main(void) { basStringSystemInit(); printf("DVX BASIC Regression Suite\n"); printf("==========================\n"); // --- Arithmetic / literals --- // DVX BASIC PRINT format: "N \n" for positive/zero integers, "-N \n" // for negatives. No leading space (unlike classic QBASIC). TEST_EQ("int-add", "PRINT 2 + 3\n", "5 \n"); TEST_EQ("int-sub", "PRINT 10 - 4\n", "6 \n"); TEST_EQ("int-mul", "PRINT 6 * 7\n", "42 \n"); TEST_EQ("int-div-float", "PRINT 10 / 4\n", "2.5 \n"); TEST_EQ("int-idiv", "PRINT 10 \\ 3\n", "3 \n"); TEST_EQ("int-mod", "PRINT 17 MOD 5\n", "2 \n"); TEST_EQ("int-pow", "PRINT 2 ^ 10\n", "1024 \n"); TEST_EQ("precedence", "PRINT 2 + 3 * 4\n", "14 \n"); TEST_EQ("parens", "PRINT (2 + 3) * 4\n", "20 \n"); TEST_EQ("unary-neg", "PRINT -5 + 2\n", "-3 \n"); TEST_EQ("double-lit", "PRINT 1.5 + 2.25\n", "3.75 \n"); // --- Strings --- TEST_EQ("string-concat", "PRINT \"foo\" + \"bar\"\n", "foobar\n"); TEST_EQ("string-len", "PRINT LEN(\"hello\")\n", "5 \n"); TEST_EQ("string-left", "PRINT LEFT$(\"abcdef\", 3)\n", "abc\n"); TEST_EQ("string-right", "PRINT RIGHT$(\"abcdef\", 2)\n", "ef\n"); TEST_EQ("string-mid", "PRINT MID$(\"abcdef\", 2, 3)\n", "bcd\n"); TEST_EQ("string-ucase", "PRINT UCASE$(\"Hello\")\n", "HELLO\n"); TEST_EQ("string-lcase", "PRINT LCASE$(\"Hello\")\n", "hello\n"); TEST_EQ("string-str", "PRINT STR$(42)\n", " 42\n"); TEST_EQ("string-val", "PRINT VAL(\"123\")\n", "123 \n"); // --- Control flow --- TEST_EQ("if-then", "DIM x AS INTEGER\nx = 5\nIF x > 3 THEN PRINT \"big\"\n", "big\n"); TEST_EQ("if-else", "DIM x AS INTEGER\nx = 1\nIF x > 3 THEN PRINT \"big\" ELSE PRINT \"small\"\n", "small\n"); TEST_EQ("if-block", "DIM x AS INTEGER\nx = 5\nIF x > 3 THEN\n PRINT \"a\"\n PRINT \"b\"\nEND IF\n", "a\nb\n"); // QuickBASIC single-line IF: ALL colon-separated statements after THEN // belong to the conditional branch (a false condition runs none of them). TEST_EQ("if-then-colon-false", "DIM x AS INTEGER\nx = 0\nIF 0 THEN x = 1 : x = 2\nPRINT x\n", "0 \n"); TEST_EQ("if-then-colon-true", "DIM x AS INTEGER\nx = 0\nIF 1 THEN x = 1 : x = 2\nPRINT x\n", "2 \n"); TEST_EQ("select-case", "DIM n AS INTEGER\nn = 2\n" "SELECT CASE n\n" " CASE 1: PRINT \"one\"\n" " CASE 2: PRINT \"two\"\n" " CASE ELSE: PRINT \"other\"\n" "END SELECT\n", "two\n"); // --- FOR loops (the recent bug: double step was truncating) --- TEST_EQ("for-int-step", "DIM i AS INTEGER\nFOR i = 1 TO 3\n PRINT i\nNEXT i\n", "1 \n2 \n3 \n"); TEST_EQ("for-neg-step", "DIM i AS INTEGER\nFOR i = 3 TO 1 STEP -1\n PRINT i\nNEXT i\n", "3 \n2 \n1 \n"); TEST_EQ("for-double-step", // Regression: DIM AS DOUBLE with fractional STEP must not // truncate the increment to zero. Pre-fix this looped forever. "DIM a AS DOUBLE\n" "DIM c AS INTEGER\n" "c = 0\n" "FOR a = 0 TO 1 STEP 0.25\n" " c = c + 1\n" "NEXT a\n" "PRINT c\n", "5 \n"); TEST_EQ("for-double-six-cycles", // Direct analogue of GfxDrawAll's circle loop. "DIM a AS DOUBLE\n" "DIM c AS INTEGER\n" "c = 0\n" "FOR a = 0 TO 6.3 STEP 0.2\n" " c = c + 1\n" "NEXT a\n" "PRINT c\n", "32 \n"); TEST_EQ("for-exit", "DIM i AS INTEGER\n" "FOR i = 1 TO 10\n" " IF i = 4 THEN EXIT FOR\n" " PRINT i\n" "NEXT i\n", "1 \n2 \n3 \n"); // --- WHILE / DO loops --- TEST_EQ("do-while", "DIM i AS INTEGER\n" "i = 0\n" "DO WHILE i < 3\n" " PRINT i\n" " i = i + 1\n" "LOOP\n", "0 \n1 \n2 \n"); TEST_EQ("do-until", "DIM i AS INTEGER\n" "i = 0\n" "DO\n" " i = i + 1\n" "LOOP UNTIL i = 3\n" "PRINT i\n", "3 \n"); // --- SUB / FUNCTION --- TEST_EQ("sub-call", "SUB greet\n PRINT \"hi\"\nEND SUB\n" "greet\n", "hi\n"); TEST_EQ("sub-params", "SUB twice(n AS INTEGER)\n PRINT n * 2\nEND SUB\n" "twice 7\n", "14 \n"); TEST_EQ("function-return", "FUNCTION sq(n AS INTEGER) AS INTEGER\n sq = n * n\nEND FUNCTION\n" "PRINT sq(9)\n", "81 \n"); TEST_EQ("recursion", "FUNCTION fact(n AS INTEGER) AS LONG\n" " IF n <= 1 THEN\n fact = 1\n ELSE\n fact = n * fact(n - 1)\n END IF\n" "END FUNCTION\n" "PRINT fact(6)\n", "720 \n"); TEST_EQ("byref-vs-byval", "SUB bump(BYVAL a AS INTEGER, b AS INTEGER)\n a = a + 1\n b = b + 1\nEND SUB\n" "DIM x AS INTEGER\nDIM y AS INTEGER\n" "x = 10\ny = 20\n" "bump x, y\n" "PRINT x\nPRINT y\n", "10 \n21 \n"); // --- Globals from within SUB --- TEST_EQ("global-from-sub", // Regression: the basdemo Dynamic Form bug was caused by // SUBs unable to access module-level DIM. "DIM counter AS INTEGER\n" "counter = 0\n" "SUB inc\n counter = counter + 1\nEND SUB\n" "inc\ninc\ninc\n" "PRINT counter\n", "3 \n"); // --- BEGINFORM / ENDFORM --- // Inside BEGINFORM, DIMs become form-scope vars; SUBs still live // globally but inherit the owning form context when called through // basVmCallSub with form vars bound. Running the init code requires // a form to actually be loaded (formrt sets currentFormVars) so we // can only verify the parser accepts/rejects forms here. TEST_COMPILE_ERROR("nested-beginform", "BEGINFORM \"A\"\nBEGINFORM \"B\"\nENDFORM\nENDFORM\n", "Nested BEGINFORM"); TEST_COMPILE_ERROR("beginform-in-sub", "SUB foo\nBEGINFORM \"X\"\nENDFORM\nEND SUB\n", "BEGINFORM inside SUB"); // --- Arrays --- TEST_EQ("array-1d", "DIM a(3) AS INTEGER\n" "a(0) = 10\na(1) = 20\na(2) = 30\na(3) = 40\n" "PRINT a(0) + a(3)\n", "50 \n"); TEST_EQ("array-lbound-ubound", "DIM a(5 TO 9) AS INTEGER\n" "PRINT LBOUND(a)\nPRINT UBOUND(a)\n", "5 \n9 \n"); // --- UDT --- TEST_EQ("udt-fields", "TYPE Pt\n x AS INTEGER\n y AS INTEGER\nEND TYPE\n" "DIM p AS Pt\n" "p.x = 3\np.y = 4\n" "PRINT p.x + p.y\n", "7 \n"); // --- ON ERROR GOTO --- TEST_EQ("on-error-module", "ON ERROR GOTO handler\n" "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 10\nb = 0\n" "PRINT a \\ b\n" "PRINT \"never\"\n" "END\n" "handler:\n" "PRINT \"caught\"\n" "PRINT ERR\n", "caught\n11 \n"); TEST_EQ("on-error-in-sub", // Regression: .frm's btnError_Click demo has ON ERROR inside a // SUB. Make sure the handler label resolves within the SUB. "SUB doit\n" " ON ERROR GOTO handler\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a \\ b\n" " PRINT \"never\"\n" " EXIT SUB\n" " handler:\n" " PRINT \"caught\"\n" " PRINT ERR\n" "END SUB\n" "doit\n", "caught\n11 \n"); // --- Runtime errors surface --- TEST_RUNTIME_ERROR("divzero-no-handler", "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 10\nb = 0\n" "PRINT a \\ b\n", ""); // --- Compile-time checks --- TEST_COMPILE_ERROR("unknown-keyword", "FLOOGLE 1, 2, 3\n", ""); // --- STATIC variables in SUB persist across calls --- TEST_EQ("static-local", "SUB inc\n" " STATIC n AS INTEGER\n" " n = n + 1\n" " PRINT n\n" "END SUB\n" "inc\ninc\ninc\n", "1 \n2 \n3 \n"); // --- GOSUB / RETURN --- TEST_EQ("gosub-return", "GOSUB sub1\n" "PRINT \"back\"\n" "END\n" "sub1:\n" "PRINT \"in sub\"\n" "RETURN\n", "in sub\nback\n"); // --- SWAP --- TEST_EQ("swap", "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 1\nb = 9\n" "SWAP a, b\n" "PRINT a\nPRINT b\n", "9 \n1 \n"); // --- DATA / READ --- TEST_EQ("data-read", "DIM x AS INTEGER\n" "READ x\nPRINT x\n" "READ x\nPRINT x\n" "DATA 11, 22\n", "11 \n22 \n"); // --- FORMAT$ --- TEST_EQ("format-number", "PRINT FORMAT$(1234.5, \"#,##0.00\")\n", "1,234.50\n"); // --- String comparison --- TEST_EQ("string-equal", "IF \"abc\" = \"abc\" THEN PRINT \"y\" ELSE PRINT \"n\"\n", "y\n"); TEST_EQ("string-less", "IF \"abc\" < \"abd\" THEN PRINT \"y\" ELSE PRINT \"n\"\n", "y\n"); // --- OPTION EXPLICIT enforces DIM --- TEST_COMPILE_ERROR("option-explicit", "OPTION EXPLICIT\n" "x = 5\n", ""); // --- Math functions --- TEST_EQ("math-abs", "PRINT ABS(-7)\n", "7 \n"); TEST_EQ("math-int", "PRINT INT(3.7)\n", "3 \n"); TEST_EQ("math-sgn-pos", "PRINT SGN(5)\n", "1 \n"); TEST_EQ("math-sgn-neg", "PRINT SGN(-5)\n", "-1 \n"); TEST_EQ("math-sgn-zero","PRINT SGN(0)\n", "0 \n"); // --- CAST/conversion --- TEST_EQ("cint", "PRINT CINT(3.6)\n", "4 \n"); TEST_EQ("clng", "PRINT CLNG(100000)\n", "100000 \n"); TEST_EQ("cdbl", "PRINT CDBL(1) / 3\n", "0.333333 \n"); // --- Float arithmetic preserves fractional results --- // Regression: the VM was promoting OP_ADD_INT results back to int16 // even when either operand was a float, truncating 1.5+2.25 to 3. TEST_EQ("float-add-literal", "PRINT 1.5 + 2.25\n", "3.75 \n"); TEST_EQ("float-add-var", "DIM a AS DOUBLE\nDIM b AS DOUBLE\n" "a = 1.5\nb = 2.25\n" "PRINT a + b\n", "3.75 \n"); TEST_EQ("float-mul", "PRINT 2.5 * 4\n", "10 \n"); TEST_EQ("float-sub", "PRINT 10 - 0.5\n", "9.5 \n"); TEST_EQ("div-produces-double", "PRINT 7 / 2\n", "3.5 \n"); // --- ON ERROR with float division (the actual .frm demo scenario) --- TEST_EQ("on-error-float-div", "SUB doit\n" " ON ERROR GOTO handler\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a / b\n" " PRINT \"never\"\n" " EXIT SUB\n" " handler:\n" " PRINT \"caught\"\n" " PRINT ERR\n" "END SUB\n" "doit\n", "caught\n11 \n"); // --- ON ERROR, error during arg evaluation of a nested SUB call --- // Mirrors basdemo's btnError_Click: Say "..." + STR$(a / b) causes the // divide-by-zero inside an expression that's about to be an argument // to Say. The error handler for the outer SUB must still catch it. TEST_EQ("on-error-in-expr-arg", "SUB emit(s AS STRING)\n PRINT s\nEND SUB\n" "SUB doit\n" " ON ERROR GOTO handler\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " emit \"10/\" + STR$(b) + \"=\" + STR$(a / b)\n" " PRINT \"never\"\n" " EXIT SUB\n" " handler:\n" " PRINT \"caught\"\n" " PRINT ERR\n" "END SUB\n" "doit\n", "caught\n11 \n"); // --- SUB is called from another SUB; error fires in the callee --- // When one SUB calls another and the *callee* has no handler but the // *caller* does, the caller's handler should still catch the error. TEST_EQ("on-error-bubbles-up", "SUB bomb\n DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n PRINT a / b\n" "END SUB\n" "SUB doit\n" " ON ERROR GOTO handler\n" " bomb\n" " PRINT \"never\"\n" " EXIT SUB\n" " handler:\n" " PRINT \"caught in doit\"\n" " PRINT ERR\n" "END SUB\n" "doit\n", "caught in doit\n11 \n"); // --- Handler calls other SUBs, then completes normally --- // Mirrors basdemo's btnError_Click: the handler itself calls `Say` // and sets properties before END SUB. After the handler ends, the // outer SUB's caller (Run All chain) must continue normally. TEST_EQ("on-error-handler-calls-sub", "SUB emit(s AS STRING)\n PRINT s\nEND SUB\n" "SUB doit\n" " ON ERROR GOTO handler\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " emit \"about to divide\"\n" " emit STR$(a / b)\n" " emit \"never\"\n" " EXIT SUB\n" " handler:\n" " emit \"caught\"\n" " emit STR$(ERR)\n" "END SUB\n" "doit\n" "PRINT \"after-doit\"\n", "about to divide\ncaught\n 11\nafter-doit\n"); // --- Run-All style chain: caller runs several SUBs in sequence, // one of them has a handler that catches its own error, the chain // must continue with the next SUB in the caller. --- TEST_EQ("on-error-chain-continues", "SUB stepOne\n PRINT \"one\"\nEND SUB\n" "SUB stepBoom\n" " ON ERROR GOTO h\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a \\ b\n" " PRINT \"never\"\n" " EXIT SUB\n" " h:\n" " PRINT \"boom-caught\"\n" "END SUB\n" "SUB stepTwo\n PRINT \"two\"\nEND SUB\n" "SUB runAll\n" " stepOne\n" " stepBoom\n" " stepTwo\n" "END SUB\n" "runAll\n", "one\nboom-caught\ntwo\n"); // --- Multiple ON ERROR blocks in sequence in one SUB --- TEST_EQ("on-error-reset", "SUB doit\n" " ON ERROR GOTO h1\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a \\ b\n" " EXIT SUB\n" " h1:\n" " PRINT \"h1\"\n" "END SUB\n" "doit\n" "PRINT \"done\"\n", "h1\ndone\n"); // --- ON ERROR GOTO 0 clears the handler --- TEST_RUNTIME_ERROR("on-error-goto-zero", "ON ERROR GOTO handler\n" "ON ERROR GOTO 0\n" "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 10\nb = 0\n" "PRINT a \\ b\n" "END\n" "handler:\n" "PRINT \"not caught\"\n", ""); // --- inErrorHandler must clear after handler completes via END SUB --- // If we don't clear it, a *second* error in a later SUB wouldn't trap. TEST_EQ("on-error-reusable", "SUB doit\n" " ON ERROR GOTO h\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a \\ b\n" " EXIT SUB\n" " h:\n" " PRINT \"once\"\n" "END SUB\n" "doit\n" "doit\n", "once\nonce\n"); // --- String builtins --- TEST_EQ("string-instr", "PRINT INSTR(\"abcdef\", \"cd\")\n", "3 \n"); TEST_EQ("string-chr", "PRINT CHR$(65)\n", "A\n"); TEST_EQ("string-asc", "PRINT ASC(\"A\")\n", "65 \n"); TEST_EQ("string-space", "PRINT \"[\" + SPACE$(3) + \"]\"\n", "[ ]\n"); TEST_EQ("string-string", "PRINT STRING$(4, \"*\")\n", "****\n"); TEST_EQ("string-ltrim", "PRINT \"[\" + LTRIM$(\" hi\") + \"]\"\n", "[hi]\n"); TEST_EQ("string-rtrim", "PRINT \"[\" + RTRIM$(\"hi \") + \"]\"\n", "[hi]\n"); // --- Logical operators --- TEST_EQ("logical-and", "IF 1 = 1 AND 2 = 2 THEN PRINT \"y\" ELSE PRINT \"n\"\n", "y\n"); TEST_EQ("logical-or", "IF 1 = 0 OR 2 = 2 THEN PRINT \"y\" ELSE PRINT \"n\"\n", "y\n"); TEST_EQ("logical-not", "IF NOT (1 = 2) THEN PRINT \"y\" ELSE PRINT \"n\"\n", "y\n"); // --- Short-circuit only fires when needed (documented behavior) --- TEST_EQ("and-short-circuit-full", "DIM x AS INTEGER\nx = 0\n" "IF 1 = 1 AND 2 = 2 THEN x = 5\n" "PRINT x\n", "5 \n"); // --- Nested FOR --- TEST_EQ("nested-for", "DIM i AS INTEGER\nDIM j AS INTEGER\n" "FOR i = 1 TO 2\n" " FOR j = 1 TO 2\n" " PRINT i * 10 + j\n" " NEXT j\n" "NEXT i\n", "11 \n12 \n21 \n22 \n"); // --- WHILE / WEND (older syntax) --- TEST_EQ("while-wend", "DIM i AS INTEGER\ni = 0\n" "WHILE i < 3\n" " PRINT i\n i = i + 1\n" "WEND\n", "0 \n1 \n2 \n"); // --- 2D array --- TEST_EQ("array-2d", "DIM a(2, 2) AS INTEGER\n" "a(0, 0) = 1\na(1, 1) = 5\na(2, 2) = 9\n" "PRINT a(0, 0) + a(1, 1) + a(2, 2)\n", "15 \n"); // --- REDIM PRESERVE keeps old values --- TEST_EQ("redim-preserve", "DIM a(2) AS INTEGER\n" "a(0) = 10\na(1) = 20\na(2) = 30\n" "REDIM PRESERVE a(4)\n" "a(3) = 40\na(4) = 50\n" "PRINT a(0) + a(2) + a(4)\n", "90 \n"); // --- Nested UDT --- TEST_EQ("udt-nested", "TYPE Inner\n x AS INTEGER\nEND TYPE\n" "TYPE Outer\n lbl AS STRING\n pt AS Inner\nEND TYPE\n" "DIM o AS Outer\n" "o.lbl = \"hi\"\n" "o.pt.x = 42\n" "PRINT o.lbl\nPRINT o.pt.x\n", "hi\n42 \n"); // --- Multi-value PRINT with comma/semicolon --- TEST_EQ("print-semi", "PRINT \"a\"; \"b\"; \"c\"\n", "abc\n"); // --- EXIT SUB --- TEST_EQ("exit-sub-early", "SUB foo(n AS INTEGER)\n" " IF n < 0 THEN EXIT SUB\n" " PRINT n\n" "END SUB\n" "foo 5\nfoo -1\nfoo 9\n", "5 \n9 \n"); // --- EXIT FUNCTION --- TEST_EQ("exit-function-early", "FUNCTION absval(n AS INTEGER) AS INTEGER\n" " IF n < 0 THEN\n absval = -n\n EXIT FUNCTION\n END IF\n" " absval = n\n" "END FUNCTION\n" "PRINT absval(-7)\nPRINT absval(3)\n", "7 \n3 \n"); // --- Module globals initialize --- TEST_EQ("global-init-order", "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 10\nb = a * 2\n" "PRINT b\n", "20 \n"); // --- STEP 0 or near-zero should not infinite-loop (if STEP > 0, needs > 0) --- TEST_EQ("for-empty-range", "DIM i AS INTEGER\n" "FOR i = 10 TO 5\n PRINT i\nNEXT i\n" "PRINT \"done\"\n", "done\n"); // --- CONST values --- TEST_EQ("const", "CONST PI = 3\n" "PRINT PI * 2\n", "6 \n"); // --- Nested SUB calls preserve locals --- TEST_EQ("nested-sub-locals", "SUB inner(x AS INTEGER)\n PRINT x * 10\nEND SUB\n" "SUB outer(y AS INTEGER)\n" " inner y\n" " PRINT y\n" "END SUB\n" "outer 7\n", "70 \n7 \n"); // --- Recursive sum --- TEST_EQ("recursion-sum", "FUNCTION sumto(n AS INTEGER) AS LONG\n" " IF n <= 0 THEN\n sumto = 0\n ELSE\n sumto = n + sumto(n - 1)\n END IF\n" "END FUNCTION\n" "PRINT sumto(10)\n", "55 \n"); // --- Early EXIT DO --- TEST_EQ("exit-do", "DIM i AS INTEGER\ni = 0\n" "DO\n" " IF i = 3 THEN EXIT DO\n" " PRINT i\n i = i + 1\n" "LOOP\n", "0 \n1 \n2 \n"); // --- String concatenation with numbers via STR$ --- TEST_EQ("string-concat-num", "DIM n AS INTEGER\n" "n = 42\n" "PRINT \"n=\" + STR$(n)\n", "n= 42\n"); // --- VAL of empty string returns 0 --- TEST_EQ("val-empty", "PRINT VAL(\"\")\n", "0 \n"); // --- VAL parses up to first non-numeric --- TEST_EQ("val-parse-prefix", "PRINT VAL(\"42abc\")\n", "42 \n"); // --- LEFT$/RIGHT$/MID$ with length past end --- TEST_EQ("string-bounds-safe", "PRINT LEFT$(\"hi\", 10)\n" "PRINT RIGHT$(\"hi\", 10)\n" "PRINT MID$(\"hi\", 1, 10)\n", "hi\nhi\nhi\n"); // --- INSTR with no match returns 0 --- TEST_EQ("instr-nomatch", "PRINT INSTR(\"abc\", \"z\")\n", "0 \n"); // --- IF with ELSEIF chain --- TEST_EQ("elseif-chain", "DIM n AS INTEGER\nn = 2\n" "IF n = 1 THEN\n PRINT \"one\"\n" "ELSEIF n = 2 THEN\n PRINT \"two\"\n" "ELSEIF n = 3 THEN\n PRINT \"three\"\n" "ELSE\n PRINT \"other\"\nEND IF\n", "two\n"); // --- FOR with STEP > range size skips body --- TEST_EQ("for-step-over", "DIM i AS INTEGER\n" "FOR i = 1 TO 5 STEP 10\n PRINT i\nNEXT i\n", "1 \n"); // --- SELECT CASE with range --- TEST_EQ("select-case-range", "DIM n AS INTEGER\nn = 5\n" "SELECT CASE n\n" " CASE 1 TO 3: PRINT \"low\"\n" " CASE 4 TO 6: PRINT \"mid\"\n" " CASE ELSE: PRINT \"high\"\n" "END SELECT\n", "mid\n"); // --- SELECT CASE with IS comparator --- TEST_EQ("select-case-is", "DIM n AS INTEGER\nn = 100\n" "SELECT CASE n\n" " CASE IS < 10: PRINT \"small\"\n" " CASE IS >= 10: PRINT \"big\"\n" "END SELECT\n", "big\n"); // --- SUB forward reference backpatched --- TEST_EQ("forward-sub-ref", "later\n" "SUB later\n PRINT \"ok\"\nEND SUB\n", "ok\n"); // --- FUNCTION without explicit return returns default value --- TEST_EQ("function-default-return", "FUNCTION zero AS INTEGER\nEND FUNCTION\n" "PRINT zero\n", "0 \n"); // --- STATIC counter across SUB invocations with params --- TEST_EQ("static-with-params", "SUB inc(n AS INTEGER)\n" " STATIC total AS INTEGER\n" " total = total + n\n" " PRINT total\n" "END SUB\n" "inc 5\ninc 10\ninc 15\n", "5 \n15 \n30 \n"); // --- IIF equivalent via IF/THEN/ELSE expression on same line --- TEST_EQ("inline-if-expr", "DIM n AS INTEGER\nn = 7\n" "IF n > 5 THEN PRINT \"big\" ELSE PRINT \"small\"\n", "big\n"); // --- CONST string --- TEST_EQ("const-string", "CONST GREETING = \"hello\"\n" "PRINT GREETING\n", "hello\n"); // --- RND and RANDOMIZE don't crash --- TEST_EQ("rnd-fires", "RANDOMIZE 42\n" "DIM n AS DOUBLE\n" "n = RND\n" "IF n >= 0 AND n < 1 THEN PRINT \"ok\"\n", "ok\n"); // --- TIMER returns a number (just verify it runs) --- TEST_EQ("timer-fires", "DIM t AS DOUBLE\nt = TIMER\n" "IF t >= 0 THEN PRINT \"ok\"\n", "ok\n"); // --- Integer overflow promotes to LONG --- TEST_EQ("int-to-long-promotion", "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 20000\nb = 20000\n" "PRINT a + b\n", "40000 \n"); // --- String compare case sensitivity --- TEST_EQ("string-case-compare", "IF \"Abc\" = \"abc\" THEN PRINT \"eq\" ELSE PRINT \"ne\"\n", "ne\n"); // --- OPTION COMPARE TEXT if supported; otherwise skip --- // Omitted: checking support first would just cause a compile failure. // --- Unary NOT on ints (bitwise) --- TEST_EQ("bitwise-not", "PRINT NOT 0\n", "-1 \n"); // --- AND/OR as bitwise on ints --- TEST_EQ("bitwise-and", "PRINT 12 AND 10\n", "8 \n"); TEST_EQ("bitwise-or", "PRINT 12 OR 10\n", "14 \n"); // --- STR$ with negative --- TEST_EQ("str-negative", "PRINT \"[\" + STR$(-5) + \"]\"\n", "[-5]\n"); // --- INT vs FIX on negative --- TEST_EQ("int-negative", "PRINT INT(-1.5)\n", "-2 \n"); TEST_EQ("fix-negative", "PRINT FIX(-1.5)\n", "-1 \n"); // --- MOD on negatives --- TEST_EQ("mod-negative", "PRINT -7 MOD 3\n", "-1 \n"); // --- SQR --- TEST_EQ("sqr", "PRINT SQR(16)\n", "4 \n"); // --- LEN of empty --- TEST_EQ("len-empty", "PRINT LEN(\"\")\n", "0 \n"); // --- Array of UDTs --- TEST_EQ("array-of-udt", "TYPE P\n x AS INTEGER\n y AS INTEGER\nEND TYPE\n" "DIM arr(1) AS P\n" "arr(0).x = 1\narr(0).y = 2\n" "arr(1).x = 10\narr(1).y = 20\n" "PRINT arr(0).x + arr(1).y\n", "21 \n"); // --- Empty FOR range, explicit STEP 1 --- TEST_EQ("for-step1-empty", "DIM i AS INTEGER\n" "FOR i = 5 TO 1 STEP 1\n PRINT i\nNEXT i\n" "PRINT \"done\"\n", "done\n"); // --- Negative-step range where start = end --- TEST_EQ("for-single-iter", "DIM i AS INTEGER\n" "FOR i = 3 TO 3 STEP -1\n PRINT i\nNEXT i\n", "3 \n"); // ============================================================ // Event-handler dispatch path (runSubLoop, not basVmRun) // ============================================================ // fireCtrlEvent calls basVmCallSub for each event handler. That // routes through runSubLoop which has its own error-dispatch loop. // The tests above exercise basVmRun only; these exercise the SUB // call path that real event handlers use. TEST_SUB_EQ("sub-call-basic", "SUB handler\n PRINT \"hi\"\nEND SUB\n", "handler", "hi\n"); TEST_SUB_EQ("sub-call-on-error-div", "SUB handler\n" " ON ERROR GOTO h\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a \\ b\n" " PRINT \"never\"\n" " EXIT SUB\n" " h:\n" " PRINT \"caught\"\n" " PRINT ERR\n" "END SUB\n", "handler", "caught\n11 \n"); TEST_SUB_EQ("sub-call-on-error-float-div", "SUB handler\n" " ON ERROR GOTO h\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a / b\n" " PRINT \"never\"\n" " EXIT SUB\n" " h:\n" " PRINT \"caught\"\n" " PRINT ERR\n" "END SUB\n", "handler", "caught\n11 \n"); // Regression: basdemo's Run All calls btnError_Click via OP_CALL. // The error dispatcher must work when the SUB-under-dispatch runs // nested calls before hitting the error. TEST_SUB_EQ("sub-call-on-error-after-nested-calls", "SUB greet(s AS STRING)\n PRINT s\nEND SUB\n" "SUB handler\n" " greet \"before\"\n" " ON ERROR GOTO h\n" " greet \"armed\"\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " greet STR$(a / b)\n" " greet \"never\"\n" " EXIT SUB\n" " h:\n" " greet \"caught\"\n" "END SUB\n", "handler", "before\narmed\ncaught\n"); // Regression: Run All dispatches many SUBs in sequence via OP_CALL. // One of them has a handler that catches its own error; the chain // must continue with the next SUB AND a later SUB's error must // still be trappable (inErrorHandler must reset). TEST_SUB_EQ("sub-call-run-all-chain", "SUB stepOne\n PRINT \"1\"\nEND SUB\n" "SUB stepBoom\n" " ON ERROR GOTO h\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a \\ b\n" " EXIT SUB\n" " h:\n" " PRINT \"b-caught\"\n" "END SUB\n" "SUB stepTwo\n PRINT \"2\"\nEND SUB\n" "SUB stepBoom2\n" " ON ERROR GOTO h2\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 20\n b = 0\n" " PRINT a \\ b\n" " EXIT SUB\n" " h2:\n" " PRINT \"b2-caught\"\n" "END SUB\n" "SUB runAll\n" " stepOne\n" " stepBoom\n" " stepTwo\n" " stepBoom2\n" " PRINT \"done\"\n" "END SUB\n", "runAll", "1\nb-caught\n2\nb2-caught\ndone\n"); // ============================================================ // Numeric limits and overflow behavior // ============================================================ TEST_EQ("int-max", "PRINT 32767\n", "32767 \n"); TEST_EQ("int-min", "PRINT -32768\n", "-32768 \n"); TEST_EQ("int-overflow-promotes", "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 32000\nb = 32000\n" "PRINT a + b\n", "64000 \n"); TEST_EQ("long-max", "PRINT 2147483647\n", "2147483647 \n"); TEST_EQ("long-min", "PRINT -2147483648\n", "-2147483648 \n"); // ============================================================ // Float formatting and precision // ============================================================ TEST_EQ("float-zero", "PRINT 0.0\n", "0 \n"); TEST_EQ("float-one", "PRINT 1.0\n", "1 \n"); TEST_EQ("float-tiny", "PRINT 0.001\n", "0.001 \n"); TEST_EQ("float-neg", "PRINT -3.14\n", "-3.14 \n"); // DVX uses %g formatting (~6 digits of precision) for doubles. TEST_EQ("float-via-div", "PRINT 22 / 7\n", "3.14286 \n"); TEST_EQ("float-large", "PRINT 1000000.5\n", "1e+06 \n"); // ============================================================ // Integer division and MOD edge cases // ============================================================ TEST_EQ("idiv-negative-positive", "PRINT -7 \\ 2\n", "-3 \n"); TEST_EQ("idiv-positive-negative", "PRINT 7 \\ -2\n", "-3 \n"); TEST_EQ("mod-positive", "PRINT 7 MOD 3\n", "1 \n"); TEST_EQ("mod-zero-dividend", "PRINT 0 MOD 3\n", "0 \n"); TEST_RUNTIME_ERROR("idiv-zero", "PRINT 5 \\ 0\n", ""); TEST_RUNTIME_ERROR("fdiv-zero", "PRINT 5 / 0\n", ""); TEST_RUNTIME_ERROR("mod-zero", "PRINT 5 MOD 0\n", ""); // ============================================================ // Comparison operators // ============================================================ // DVX BASIC prints boolean-typed values as "True"/"False" rather // than -1/0. (Same value, different PRINT formatting.) TEST_EQ("cmp-eq-true", "PRINT (5 = 5)\n", "True \n"); TEST_EQ("cmp-eq-false", "PRINT (5 = 6)\n", "False \n"); TEST_EQ("cmp-ne", "PRINT (5 <> 6)\n", "True \n"); TEST_EQ("cmp-lt", "PRINT (3 < 5)\n", "True \n"); TEST_EQ("cmp-le", "PRINT (5 <= 5)\n", "True \n"); TEST_EQ("cmp-gt", "PRINT (7 > 5)\n", "True \n"); TEST_EQ("cmp-ge", "PRINT (5 >= 5)\n", "True \n"); TEST_EQ("cmp-mixed-types", "PRINT (5 = 5.0)\n", "True \n"); // ============================================================ // Boolean operators // ============================================================ TEST_EQ("bool-true-const", "PRINT TRUE\n", "True \n"); TEST_EQ("bool-false-const", "PRINT FALSE\n", "False \n"); TEST_EQ("xor", "PRINT 12 XOR 10\n", "6 \n"); TEST_EQ("imp", "PRINT -1 IMP 0\n", "0 \n"); TEST_EQ("eqv", "PRINT -1 EQV -1\n", "-1 \n"); // ============================================================ // String concatenation operators // ============================================================ TEST_EQ("string-amp-concat", "PRINT \"a\" & \"b\"\n", "ab\n"); // Unlike STR$, the & operator concatenates the digits directly with // no leading space. TEST_EQ("string-amp-number", "PRINT \"num=\" & 42\n", "num=42\n"); TEST_EQ("string-long-concat", "DIM s AS STRING\ns = \"\"\n" "DIM i AS INTEGER\n" "FOR i = 1 TO 5\n s = s + \"x\"\nNEXT i\n" "PRINT s\n" "PRINT LEN(s)\n", "xxxxx\n5 \n"); // ============================================================ // Fixed-length strings // ============================================================ TEST_EQ("fixed-length-string", "DIM s AS STRING * 5\n" "s = \"hi\"\n" "PRINT \"[\" + s + \"]\"\n" "PRINT LEN(s)\n", "[hi ]\n5 \n"); TEST_EQ("fixed-length-truncate", "DIM s AS STRING * 3\n" "s = \"hello\"\n" "PRINT s\n", "hel\n"); // ============================================================ // String search / manipulation // ============================================================ TEST_EQ("instr-start-pos", "PRINT INSTR(3, \"abcabc\", \"a\")\n", "4 \n"); TEST_EQ("mid-replace-assign", "DIM s AS STRING\ns = \"abcdef\"\n" "MID$(s, 2, 3) = \"XYZ\"\n" "PRINT s\n", "aXYZef\n"); TEST_EQ("str-leading-space-positive", "PRINT \"[\" + STR$(5) + \"]\"\n", "[ 5]\n"); TEST_EQ("str-no-leading-neg", "PRINT \"[\" + STR$(-5) + \"]\"\n", "[-5]\n"); // ============================================================ // Type conversion functions // ============================================================ // DVX rounds half-away-from-zero (not VB banker's rounding). TEST_EQ("cint-round-half-up", "PRINT CINT(2.5)\n", "3 \n"); TEST_EQ("cint-round-half-up2","PRINT CINT(3.5)\n", "4 \n"); TEST_EQ("cint-truncate", "PRINT CINT(2.49)\n", "2 \n"); TEST_EQ("cint-negative", "PRINT CINT(-2.5)\n", "-3 \n"); TEST_EQ("clng-from-double", "PRINT CLNG(3.9)\n", "4 \n"); TEST_EQ("csng", "PRINT CSNG(1.5)\n", "1.5 \n"); TEST_EQ("cstr-int", "PRINT CSTR(42)\n", "42\n"); TEST_EQ("cdbl-of-int", "PRINT CDBL(10) / 4\n", "2.5 \n"); TEST_EQ("cbool-nonzero", "PRINT CBOOL(5)\n", "True \n"); TEST_EQ("cbool-zero", "PRINT CBOOL(0)\n", "False \n"); TEST_EQ("cbool-neg", "PRINT CBOOL(-42)\n", "True \n"); TEST_EQ("cbool-empty-string", "PRINT CBOOL(\"\")\n", "False \n"); TEST_EQ("cbool-nonempty-str", "PRINT CBOOL(\"hi\")\n", "True \n"); TEST_EQ("hex-positive", "PRINT HEX$(255)\n", "FF\n"); TEST_EQ("hex-zero", "PRINT HEX$(0)\n", "0\n"); TEST_EQ("oct-eight", "PRINT OCT$(8)\n", "10\n"); TEST_EQ("oct-zero", "PRINT OCT$(0)\n", "0\n"); TEST_EQ("oct-sixtythree", "PRINT OCT$(63)\n", "77\n"); // ============================================================ // Math functions // ============================================================ TEST_EQ("math-sqr-zero", "PRINT SQR(0)\n", "0 \n"); TEST_EQ("math-sqr-float", "PRINT SQR(2)\n", "1.41421 \n"); TEST_EQ("math-cos-zero", "PRINT COS(0)\n", "1 \n"); TEST_EQ("math-sin-zero", "PRINT SIN(0)\n", "0 \n"); TEST_EQ("math-exp-zero", "PRINT EXP(0)\n", "1 \n"); TEST_EQ("math-log-one", "PRINT LOG(1)\n", "0 \n"); TEST_EQ("math-abs-double", "PRINT ABS(-3.14)\n", "3.14 \n"); // ============================================================ // Variable types and default initialization // ============================================================ TEST_EQ("default-int-zero", "DIM n AS INTEGER\nPRINT n\n", "0 \n"); TEST_EQ("default-long-zero", "DIM n AS LONG\nPRINT n\n", "0 \n"); TEST_EQ("default-double-zero", "DIM n AS DOUBLE\nPRINT n\n", "0 \n"); // Regression: DIM AS STRING now initializes the slot to an empty // string rather than leaving it as integer 0. Previously // "[" + s + "]" on an uninitialized STRING stringified as "0" // because the slot type was INTEGER. TEST_EQ("default-string-is-empty", "DIM s AS STRING\nPRINT \"[\" + s + \"]\"\n", "[]\n"); TEST_EQ("default-string-concat-works", "DIM s AS STRING\ns = s + \"x\"\ns = s + \"y\"\nPRINT s\n", "xy\n"); TEST_EQ("dollar-suffix", "DIM s$\ns$ = \"hi\"\nPRINT s$\n", "hi\n"); TEST_EQ("percent-suffix", "DIM n%\nn% = 42\nPRINT n%\n", "42 \n"); TEST_EQ("amp-suffix", "DIM n&\nn& = 100000\nPRINT n&\n", "100000 \n"); TEST_EQ("bang-suffix", "DIM f!\nf! = 1.5\nPRINT f!\n", "1.5 \n"); TEST_EQ("hash-suffix", "DIM d#\nd# = 3.14159\nPRINT d#\n", "3.14159 \n"); // ============================================================ // FOR loop variants // ============================================================ TEST_EQ("for-next-var-name", "DIM i AS INTEGER\n" "FOR i = 1 TO 3\n PRINT i\nNEXT i\n", "1 \n2 \n3 \n"); TEST_EQ("for-next-no-varname", "DIM i AS INTEGER\n" "FOR i = 1 TO 3\n PRINT i\nNEXT\n", "1 \n2 \n3 \n"); TEST_EQ("for-double-varies", "DIM a AS DOUBLE\n" "FOR a = 1 TO 3 STEP 0.5\n PRINT a\nNEXT a\n", "1 \n1.5 \n2 \n2.5 \n3 \n"); TEST_EQ("for-neg-step-range", "DIM i AS INTEGER\n" "FOR i = 10 TO 4 STEP -2\n PRINT i\nNEXT i\n", "10 \n8 \n6 \n4 \n"); TEST_EQ("for-nested-exit-inner", "DIM i AS INTEGER\nDIM j AS INTEGER\n" "FOR i = 1 TO 3\n" " FOR j = 1 TO 3\n" " IF j = 2 THEN EXIT FOR\n" " PRINT i*10+j\n" " NEXT j\n" "NEXT i\n", "11 \n21 \n31 \n"); // ============================================================ // WHILE / DO variants // ============================================================ TEST_EQ("do-loop-while-post", "DIM i AS INTEGER\ni = 10\n" "DO\n PRINT i\n i = i - 1\nLOOP WHILE i > 8\n", "10 \n9 \n"); TEST_EQ("do-loop-until-post", "DIM i AS INTEGER\ni = 0\n" "DO\n i = i + 1\n PRINT i\nLOOP UNTIL i = 3\n", "1 \n2 \n3 \n"); TEST_EQ("do-while-never-enters", "DIM i AS INTEGER\ni = 5\n" "DO WHILE i = 0\n PRINT \"inside\"\nLOOP\n" "PRINT \"after\"\n", "after\n"); // ============================================================ // String scanning / conversion round-trip // ============================================================ TEST_EQ("val-negative", "PRINT VAL(\"-42\")\n", "-42 \n"); TEST_EQ("val-float", "PRINT VAL(\"3.14\")\n", "3.14 \n"); TEST_EQ("val-whitespace", "PRINT VAL(\" 123 \")\n", "123 \n"); TEST_EQ("val-only-letters", "PRINT VAL(\"abc\")\n", "0 \n"); TEST_EQ("str-then-val", "DIM n AS INTEGER\nn = 42\n" "PRINT VAL(STR$(n))\n", "42 \n"); // ============================================================ // SUB / FUNCTION edge cases // ============================================================ TEST_EQ("sub-zero-params", "SUB greet\n PRINT \"hi\"\nEND SUB\n" "greet\n", "hi\n"); TEST_EQ("function-returning-string", "FUNCTION greeting() AS STRING\n greeting = \"hi\"\nEND FUNCTION\n" "PRINT greeting()\n", "hi\n"); TEST_EQ("function-multi-arg", "FUNCTION sum3(a AS INTEGER, b AS INTEGER, c AS INTEGER) AS INTEGER\n" " sum3 = a + b + c\nEND FUNCTION\n" "PRINT sum3(1, 2, 3)\n", "6 \n"); // OPTIONAL parameters: use `nm` as the param name; `name` is // a reserved keyword for the NAME statement in DVX BASIC. TEST_EQ("optional-param-omitted", "SUB greet(nm AS STRING, OPTIONAL count AS INTEGER)\n" " DIM i AS INTEGER\n" " IF count = 0 THEN count = 1\n" " FOR i = 1 TO count\n PRINT nm\n NEXT i\n" "END SUB\n" "greet \"hi\", 2\n" "greet \"solo\"\n", "hi\nhi\nsolo\n"); // Mutual recursion: needs DECLARE forward for the later function. TEST_EQ("mutual-recursion", "DECLARE FUNCTION isOdd(n AS INTEGER) AS INTEGER\n" "FUNCTION isEven(n AS INTEGER) AS INTEGER\n" " IF n = 0 THEN\n isEven = 1\n ELSE\n isEven = isOdd(n - 1)\n END IF\n" "END FUNCTION\n" "FUNCTION isOdd(n AS INTEGER) AS INTEGER\n" " IF n = 0 THEN\n isOdd = 0\n ELSE\n isOdd = isEven(n - 1)\n END IF\n" "END FUNCTION\n" "PRINT isEven(10)\nPRINT isOdd(10)\n", "1 \n0 \n"); TEST_EQ("byval-array-element", "SUB bump(BYVAL x AS INTEGER)\n x = x + 1\nEND SUB\n" "DIM a(2) AS INTEGER\n" "a(0) = 5\na(1) = 10\n" "bump a(0)\n" "PRINT a(0)\nPRINT a(1)\n", "5 \n10 \n"); TEST_EQ("byref-array-element", "SUB bump(x AS INTEGER)\n x = x + 1\nEND SUB\n" "DIM a(2) AS INTEGER\n" "a(0) = 5\na(1) = 10\n" "bump a(0)\n" "bump a(1)\nbump a(1)\n" "PRINT a(0)\nPRINT a(1)\n", "6 \n12 \n"); TEST_EQ("byref-array-element-2d", "SUB bump(x AS INTEGER)\n x = x + 100\nEND SUB\n" "DIM a(1, 1) AS INTEGER\n" "a(0, 0) = 1\na(1, 1) = 2\n" "bump a(0, 0)\n" "bump a(1, 1)\n" "PRINT a(0, 0)\nPRINT a(1, 1)\n", "101 \n102 \n"); // ============================================================ // Array operations // ============================================================ TEST_EQ("array-negative-lbound", "DIM a(-2 TO 2) AS INTEGER\n" "a(-2) = 10\na(0) = 50\na(2) = 90\n" "PRINT a(-2) + a(0) + a(2)\n" "PRINT LBOUND(a)\nPRINT UBOUND(a)\n", "150 \n-2 \n2 \n"); TEST_EQ("redim-clears", "DIM a(3) AS INTEGER\n" "a(0) = 99\n" "REDIM a(5)\n" "PRINT a(0)\n", "0 \n"); // ERASE behavior in DVX: after ERASE a, accessing a(0) errors // ("Not an array"). Verify that behavior. TEST_RUNTIME_ERROR("erase-makes-not-array", "DIM a(3) AS INTEGER\n" "a(0) = 7\n" "ERASE a\n" "PRINT a(0)\n", ""); TEST_EQ("array-3d", "DIM a(1, 1, 1) AS INTEGER\n" "a(0, 0, 0) = 1\n" "a(1, 1, 1) = 8\n" "PRINT a(0, 0, 0) + a(1, 1, 1)\n", "9 \n"); TEST_EQ("array-string", "DIM names(2) AS STRING\n" "names(0) = \"alpha\"\nnames(1) = \"beta\"\nnames(2) = \"gamma\"\n" "PRINT names(0) + \"-\" + names(2)\n", "alpha-gamma\n"); // ============================================================ // UDTs // ============================================================ TEST_EQ("udt-used-locally", "TYPE P\n x AS INTEGER\n y AS INTEGER\nEND TYPE\n" "DIM a AS P\na.x = 3\na.y = 4\n" "PRINT a.x\nPRINT a.y\n", "3 \n4 \n"); TEST_EQ("udt-byref-param", "TYPE P\n x AS INTEGER\n y AS INTEGER\nEND TYPE\n" "SUB move(pt AS P, dx AS INTEGER, dy AS INTEGER)\n" " pt.x = pt.x + dx\n pt.y = pt.y + dy\n" "END SUB\n" "DIM a AS P\na.x = 1\na.y = 2\n" "move a, 10, 20\n" "PRINT a.x\nPRINT a.y\n", "11 \n22 \n"); TEST_EQ("udt-function-arg-read", "TYPE Box\n w AS INTEGER\n h AS INTEGER\nEND TYPE\n" "FUNCTION area(b AS Box) AS LONG\n" " area = b.w * b.h\n" "END FUNCTION\n" "DIM r AS Box\nr.w = 6\nr.h = 7\n" "PRINT area(r)\n", "42 \n"); // ============================================================ // DATA / READ / RESTORE // ============================================================ TEST_EQ("data-read-strings", "DIM s AS STRING\n" "READ s\nPRINT s\n" "READ s\nPRINT s\n" "DATA hello, world\n", "hello\nworld\n"); TEST_EQ("data-read-mixed", "DIM n AS INTEGER\nDIM s AS STRING\n" "READ n\nREAD s\nREAD n\n" "PRINT s\nPRINT n\n" "DATA 10, hello, 20\n", "hello\n20 \n"); TEST_EQ("restore-rewinds", "DIM n AS INTEGER\n" "READ n\nPRINT n\n" "RESTORE\nREAD n\nPRINT n\n" "DATA 5, 6, 7\n", "5 \n5 \n"); // ============================================================ // ON ERROR additional scenarios // ============================================================ TEST_EQ("err-clears-after-handler", "SUB foo\n" " ON ERROR GOTO h\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 5\n b = 0\n" " PRINT a \\ b\n" " EXIT SUB\n" " h:\n" " PRINT \"caught\"\n" "END SUB\n" "foo\n" "PRINT \"err=\"; ERR\n", "caught\nerr=0 \n"); // ============================================================ // Labels and GOTO // ============================================================ TEST_EQ("goto-forward", "GOTO done\n" "PRINT \"skipped\"\n" "done:\n" "PRINT \"here\"\n", "here\n"); TEST_EQ("goto-backward-countdown", "DIM i AS INTEGER\ni = 3\n" "top:\n" "PRINT i\ni = i - 1\n" "IF i > 0 THEN GOTO top\n", "3 \n2 \n1 \n"); // ============================================================ // SELECT CASE edge cases // ============================================================ TEST_EQ("select-case-multi-val", "DIM n AS INTEGER\nn = 3\n" "SELECT CASE n\n" " CASE 1, 2, 3: PRINT \"small\"\n" " CASE 4, 5, 6: PRINT \"mid\"\n" " CASE ELSE: PRINT \"big\"\n" "END SELECT\n", "small\n"); TEST_EQ("select-case-string", "DIM s AS STRING\ns = \"b\"\n" "SELECT CASE s\n" " CASE \"a\": PRINT \"A\"\n" " CASE \"b\": PRINT \"B\"\n" " CASE ELSE: PRINT \"?\"\n" "END SELECT\n", "B\n"); TEST_EQ("select-case-fallthrough-none", // SELECT CASE does NOT fall through -- it matches first, exits. "DIM n AS INTEGER\nn = 5\n" "SELECT CASE n\n" " CASE 1 TO 10: PRINT \"range\"\n" " CASE IS > 0: PRINT \"pos\"\n" "END SELECT\n", "range\n"); // ============================================================ // STATIC: value persists across calls // ============================================================ TEST_EQ("static-double", "SUB tick\n" " STATIC n AS DOUBLE\n" " n = n + 0.5\n" " PRINT n\n" "END SUB\n" "tick\ntick\ntick\n", "0.5 \n1 \n1.5 \n"); TEST_EQ("static-string", "SUB appendHistory\n" " STATIC hist AS STRING\n" " hist = hist + \"x\"\n" " PRINT hist\n" "END SUB\n" "appendHistory\nappendHistory\nappendHistory\n", "x\nxx\nxxx\n"); // ============================================================ // String array element manipulation // ============================================================ TEST_EQ("string-array-accumulate", "DIM parts(2) AS STRING\n" "parts(0) = \"A\"\nparts(1) = \"B\"\nparts(2) = \"C\"\n" "DIM result AS STRING\nresult = \"\"\n" "DIM i AS INTEGER\n" "FOR i = 0 TO 2\n result = result + parts(i)\nNEXT i\n" "PRINT result\n", "ABC\n"); // ============================================================ // PRINT formatting // ============================================================ TEST_EQ("print-comma-tab", "PRINT \"a\", \"b\"\n", "a\tb\n"); TEST_EQ("print-trailing-semi", "PRINT \"no-newline\";\nPRINT \"follow\"\n", "no-newlinefollow\n"); TEST_EQ("print-multi-numbers", "PRINT 1; 2; 3\n", "1 2 3 \n"); // ============================================================ // Edge cases in ON ERROR // ============================================================ TEST_EQ("error-in-handler-still-fires", // A second error inside the handler with no new ON ERROR should // NOT loop back to the same handler. QBASIC: second error is // fatal while inErrorHandler=true. "ON ERROR GOTO h\n" "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 5\nb = 0\n" "PRINT a \\ b\n" "END\n" "h:\n" "PRINT \"handler\"\n" "PRINT ERR\n", "handler\n11 \n"); // ============================================================ // GOSUB / RETURN // ============================================================ TEST_EQ("gosub-multiple", "GOSUB one\nGOSUB two\nEND\n" "one:\nPRINT \"1\"\nRETURN\n" "two:\nPRINT \"2\"\nRETURN\n", "1\n2\n"); TEST_EQ("gosub-nested", "GOSUB outer\nEND\n" "outer:\nPRINT \"outer-in\"\nGOSUB inner\nPRINT \"outer-out\"\nRETURN\n" "inner:\nPRINT \"inner\"\nRETURN\n", "outer-in\ninner\nouter-out\n"); // ============================================================ // Complex expressions // ============================================================ TEST_EQ("expr-chained-string-concat", "DIM a AS STRING\nDIM b AS STRING\nDIM c AS STRING\n" "a = \"foo\"\nb = \"bar\"\nc = \"baz\"\n" "PRINT a + b + c + \"-end\"\n", "foobarbaz-end\n"); TEST_EQ("expr-paren-nested", "PRINT ((1 + 2) * 3) - (4 \\ 2)\n", "7 \n"); TEST_EQ("expr-short-circuit-and", // OR should evaluate both operands in classic BASIC (no // short-circuit). Just verify the result is correct. "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 0\nb = 5\n" "IF a = 0 OR b = 5 THEN PRINT \"ok\"\n", "ok\n"); // ============================================================ // IF/END IF variants // ============================================================ TEST_EQ("if-else-block", "DIM n AS INTEGER\nn = 1\n" "IF n > 0 THEN\n PRINT \"pos\"\nELSE\n PRINT \"neg\"\nEND IF\n", "pos\n"); TEST_EQ("if-elseif-block", "DIM n AS INTEGER\nn = 15\n" "IF n < 10 THEN\n PRINT \"<10\"\n" "ELSEIF n < 20 THEN\n PRINT \"<20\"\n" "ELSEIF n < 30 THEN\n PRINT \"<30\"\n" "ELSE\n PRINT \">=30\"\nEND IF\n", "<20\n"); TEST_EQ("if-nested", "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 5\nb = 10\n" "IF a > 0 THEN\n" " IF b > 0 THEN\n PRINT \"both\"\n END IF\n" "END IF\n", "both\n"); // ============================================================ // Number parsing in source // ============================================================ TEST_EQ("num-hex-literal", "PRINT &H10\n", "16 \n"); TEST_EQ("num-hex-ff", "PRINT &HFF\n", "255 \n"); TEST_EQ("num-octal-literal", "PRINT &O10\n", "8 \n"); TEST_EQ("num-octal-77", "PRINT &O77\n", "63 \n"); TEST_EQ("num-binary-literal","PRINT &B1010\n", "10 \n"); TEST_EQ("num-binary-all", "PRINT &B11111111\n", "255 \n"); TEST_EQ("num-scientific", "PRINT 1E3\n", "1000 \n"); TEST_EQ("num-scientific-neg","PRINT 1E-2\n", "0.01 \n"); // ============================================================ // Comments // ============================================================ TEST_EQ("apostrophe-comment", "PRINT 1 ' this is a comment\n" "PRINT 2\n", "1 \n2 \n"); TEST_EQ("rem-comment", "REM this is a comment\n" "PRINT 1\n", "1 \n"); // ============================================================ // Empty PRINT and blank lines // ============================================================ TEST_EQ("print-empty", "PRINT\n" "PRINT \"after\"\n", "\nafter\n"); // ============================================================ // String literal with embedded quotes (via CHR$) // ============================================================ TEST_EQ("chr-quote", "PRINT \"say \" + CHR$(34) + \"hi\" + CHR$(34)\n", "say \"hi\"\n"); TEST_EQ("chr-newline-embeds", "PRINT \"a\" + CHR$(10) + \"b\"\n", "a\nb\n"); // ============================================================ // END statement halts execution // ============================================================ TEST_EQ("end-halts", "PRINT \"before\"\nEND\nPRINT \"after\"\n", "before\n"); // ============================================================ // Declaration ordering: globals must be DIM'd before SUBs that // reference them (the DVX compiler is single-pass). // ============================================================ TEST_EQ("global-dim-then-sub", "DIM counter AS INTEGER\n" "SUB showIt\n PRINT counter\nEND SUB\n" "counter = 7\n" "showIt\n", "7 \n"); // ============================================================ // Type conversion through assignment // ============================================================ // DVX uses dynamic typing: assigning a float to a DIM AS INTEGER // slot stores the float value (the DIM only sets the INITIAL type). // This differs from QBASIC but is consistent across the language. TEST_EQ("dim-int-assign-float-preserves-type", "DIM n AS INTEGER\n" "n = 3.7\n" "PRINT n\n", "3.7 \n"); TEST_EQ("assign-string-from-num", "DIM s AS STRING\n" "s = STR$(42)\n" "PRINT s\n", " 42\n"); // ============================================================ // Arrays of doubles // ============================================================ TEST_EQ("double-array", "DIM d(3) AS DOUBLE\n" "d(0) = 0.25\nd(1) = 0.5\nd(2) = 0.75\nd(3) = 1.0\n" "PRINT d(0) + d(1) + d(2) + d(3)\n", "2.5 \n"); // ============================================================ // Very deep recursion smoke test // ============================================================ TEST_EQ("deep-recursion-50", "FUNCTION countdown(n AS INTEGER) AS INTEGER\n" " IF n <= 0 THEN\n countdown = 0\n ELSE\n countdown = 1 + countdown(n - 1)\n END IF\n" "END FUNCTION\n" "PRINT countdown(50)\n", "50 \n"); // ============================================================ // String in SELECT CASE with mixed case (default: case sensitive) // ============================================================ TEST_EQ("select-case-str-case-sensitive", "DIM s AS STRING\ns = \"Apple\"\n" "SELECT CASE s\n" " CASE \"apple\": PRINT \"lower\"\n" " CASE \"Apple\": PRINT \"title\"\n" " CASE ELSE: PRINT \"?\"\n" "END SELECT\n", "title\n"); // ============================================================ // SUB-call tests through basVmCallSub (event handler path) // ============================================================ TEST_SUB_EQ("subcall-globals-shared", "DIM g AS INTEGER\ng = 5\n" "SUB showG\n PRINT g\n g = g + 1\nEND SUB\n", "showG", "5 \n"); TEST_SUB_EQ("subcall-calls-other-sub", "SUB a\n PRINT \"a\"\n b\nEND SUB\n" "SUB b\n PRINT \"b\"\nEND SUB\n", "a", "a\nb\n"); TEST_SUB_EQ("subcall-for-loop-fractional", // Event handler running GfxDrawAll-style code "SUB drawCircle\n" " DIM a AS DOUBLE\n" " DIM c AS INTEGER\n" " c = 0\n" " FOR a = 0 TO 6.3 STEP 0.2\n" " c = c + 1\n" " NEXT a\n" " PRINT c\n" "END SUB\n", "drawCircle", "32 \n"); TEST_SUB_EQ("subcall-on-error-then-normal", // After handler runs, a subsequent call should work normally. "SUB maybeFail(shouldFail AS INTEGER)\n" " ON ERROR GOTO h\n" " IF shouldFail THEN\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 1\n b = 0\n" " PRINT a \\ b\n" " ELSE\n" " PRINT \"ok\"\n" " END IF\n" " EXIT SUB\n" " h:\n" " PRINT \"caught\"\n" "END SUB\n" "SUB driver\n" " maybeFail 0\n" " maybeFail 1\n" " maybeFail 0\n" "END SUB\n", "driver", "ok\ncaught\nok\n"); // ============================================================ // Widget-level event dispatch (mirrors formrt.c fireCtrlEvent) // ============================================================ // SetEvent override: handler name differs from Ctrl_Event convention { TestDispatchT d = { .source = "SUB handleIt\n PRINT \"clicked\"\nEND SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .overrides = DISPATCH_OVR("Click", "handleIt"), .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-override", &d, "clicked\n"); } // Naming-convention fallback: no override, CtrlName_EventName SUB { TestDispatchT d = { .source = "SUB btn1_Click\n PRINT \"fallback\"\nEND SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-naming-convention", &d, "fallback\n"); } // Override wins over naming convention { TestDispatchT d = { .source = "SUB btn1_Click\n PRINT \"convention\"\nEND SUB\n" "SUB doOverride\n PRINT \"override\"\nEND SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .overrides = DISPATCH_OVR("Click", "doOverride"), .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-override-beats-naming", &d, "override\n"); } // Handler missing: silently skipped, no crash { TestDispatchT d = { .source = "SUB unrelated\n PRINT \"never\"\nEND SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-no-handler", &d, ""); } // Multiple events on same control { TestDispatchT d = { .source = "SUB btn1_Click\n PRINT \"click\"\nEND SUB\n" "SUB btn1_GotFocus\n PRINT \"focus\"\nEND SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("GotFocus", "Click", "GotFocus"), }; testDispatchEq("dispatch-multiple-events", &d, "focus\nclick\nfocus\n"); } // Globals accumulate across events (real apps' common pattern) { TestDispatchT d = { .source = "DIM counter AS INTEGER\n" "counter = 0\n" "SUB btn1_Click\n" " counter = counter + 1\n" " PRINT counter\n" "END SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("Click", "Click", "Click"), }; testDispatchEq("dispatch-global-counter", &d, "1 \n2 \n3 \n"); } // Form-scope vars accessed via SUB declared in BEGINFORM { TestDispatchT d = { .source = "BEGINFORM \"MyForm\"\n" "DIM hits AS INTEGER\n" "SUB btn1_Click\n" " hits = hits + 1\n" " PRINT hits\n" "END SUB\n" "ENDFORM\n", .formName = "MyForm", .formVarCount = 1, .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("Click", "Click"), }; testDispatchEq("dispatch-form-scope-vars", &d, "1 \n2 \n"); } // ON ERROR inside the handler traps the error and the handler is // reusable on the next fire (inErrorHandler must reset cleanly). { TestDispatchT d = { .source = "SUB btn1_Click\n" " ON ERROR GOTO h\n" " DIM a AS INTEGER\n DIM b AS INTEGER\n" " a = 10\n b = 0\n" " PRINT a \\ b\n" " EXIT SUB\n" " h:\n" " PRINT \"caught\"\n" "END SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("Click", "Click"), }; testDispatchEq("dispatch-on-error-reusable", &d, "caught\ncaught\n"); } // Single fire of a handler that increments and prints a global. // NOTE: this does NOT exercise the same-event re-entrancy guard in // miniFireCtrlEvent -- the mini-runtime gives BASIC no way to re-fire // the same control's event from within its own handler, so genuine // re-entrant coverage would require a synthetic harness trigger. { TestDispatchT d = { .source = "DIM depth AS INTEGER\n" "depth = 0\n" "SUB btn1_Click\n" " depth = depth + 1\n" " PRINT depth\n" "END SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-single-fire-counter", &d, "1 \n"); } // SetEvent override twice on the same event name: second wins. { TestDispatchT d = { .source = "SUB first\n PRINT \"first\"\nEND SUB\n" "SUB second\n PRINT \"second\"\nEND SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .overrides = DISPATCH_OVR("Click", "first", "Click", "second"), .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-override-replace", &d, "second\n"); } // Timer-like pattern: onChange fires "Timer" (mapped in formrt by // ctrl->typeName == "Timer"); here we exercise the SetEvent path // with a Timer-typed control. { TestDispatchT d = { .source = "DIM ticks AS INTEGER\n" "ticks = 0\n" "SUB onTick\n" " ticks = ticks + 1\n" " PRINT ticks\n" "END SUB\n", .formName = "", .ctrlName = "t1", .ctrlType = "Timer", .overrides = DISPATCH_OVR("Timer", "onTick"), .fires = DISPATCH_FIRE("Timer", "Timer", "Timer"), }; testDispatchEq("dispatch-timer-override", &d, "1 \n2 \n3 \n"); } // Menu-like dispatch via naming convention (proxies have typeName "") { TestDispatchT d = { .source = "SUB mnuFoo_Click\n PRINT \"menu\"\nEND SUB\n", .formName = "", .ctrlName = "mnuFoo", .ctrlType = "Menu", .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-menu-click", &d, "menu\n"); } // Handler calls into another SUB. Verifies nested SUB calls don't // interact badly with the event guard. { TestDispatchT d = { .source = "SUB say(s AS STRING)\n PRINT s\nEND SUB\n" "SUB btn1_Click\n" " say \"a\"\n say \"b\"\n say \"c\"\n" "END SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .fires = DISPATCH_FIRE("Click"), }; testDispatchEq("dispatch-handler-nested-calls", &d, "a\nb\nc\n"); } // Different events on the same control during a single sequence: // GotFocus, Click, LostFocus. Guard lets each event through. { TestDispatchT d = { .source = "SUB onFocus\n PRINT \"focus\"\nEND SUB\n" "SUB onClick\n PRINT \"click\"\nEND SUB\n" "SUB onBlur\n PRINT \"blur\"\nEND SUB\n", .formName = "", .ctrlName = "btn1", .ctrlType = "CommandButton", .overrides = DISPATCH_OVR( "GotFocus", "onFocus", "Click", "onClick", "LostFocus", "onBlur"), .fires = DISPATCH_FIRE("GotFocus", "Click", "LostFocus"), }; testDispatchEq("dispatch-focus-click-blur", &d, "focus\nclick\nblur\n"); } // ============================================================ // Operator precedence edge cases // ============================================================ TEST_EQ("prec-neg-then-pow", "PRINT -2 ^ 2\n", "-4 \n"); // -(2^2) = -4 // DVX ^ is left-associative: 2^3^2 == (2^3)^2 = 64. QBASIC doc // says right-assoc but DVX chose left. Matches actual behavior. TEST_EQ("prec-pow-left-assoc", "PRINT 2 ^ 3 ^ 2\n", "64 \n"); TEST_EQ("prec-mul-add", "PRINT 2 + 3 * 4\n", "14 \n"); TEST_EQ("prec-eq-chain", "PRINT 1 + 2 = 3\n", "True \n"); TEST_EQ("prec-string-and-num", "PRINT \"n=\" + STR$(1 + 2)\n", "n= 3\n"); // True QuickBASIC precedence: * / bind tighter than \ which binds tighter // than MOD, so the multiplicative operators sit on three distinct levels. TEST_EQ("prec-mod-below-mul", "PRINT 8 MOD 3 * 2\n", "2 \n"); // 8 MOD (3*2) TEST_EQ("prec-idiv-below-mul", "PRINT 10 \\ 2 * 3\n", "1 \n"); // 10 \ (2*3) // Unary sign on the exponent operand (QB: 2 ^ -2 == 0.25). TEST_EQ("pow-neg-exponent", "PRINT 2 ^ -2 = 0.25\n", "True \n"); // ============================================================ // More string operations // ============================================================ TEST_EQ("trim-both-sides", "DIM s AS STRING\ns = \" hello \"\n" "PRINT \"[\" + LTRIM$(RTRIM$(s)) + \"]\"\n", "[hello]\n"); TEST_EQ("chr-special-chars", "PRINT CHR$(9) + \"tab\"\n", "\ttab\n"); // ============================================================ // LEN edge cases // ============================================================ TEST_EQ("len-unicode-is-bytes", "PRINT LEN(\"abc\")\n", "3 \n"); // ============================================================ // Integer overflow detection // ============================================================ TEST_EQ("int-max-plus-one", "PRINT 32767 + 1\n", "32768 \n"); // ============================================================ // String length tests // ============================================================ TEST_EQ("string-len-after-build", "DIM s AS STRING\ns = \"abc\"\ns = s + s\n" "PRINT LEN(s)\n", "6 \n"); // ============================================================ // Array bounds: writing past UBOUND is an error // ============================================================ TEST_RUNTIME_ERROR("array-out-of-bounds-write", "DIM a(2) AS INTEGER\na(5) = 99\n", ""); TEST_RUNTIME_ERROR("array-out-of-bounds-read", "DIM a(2) AS INTEGER\nPRINT a(5)\n", ""); TEST_RUNTIME_ERROR("array-negative-index-no-lbound", "DIM a(2) AS INTEGER\nPRINT a(-1)\n", ""); // ============================================================ // More UDT tests // ============================================================ TEST_EQ("udt-multiple-instances", "TYPE P\n x AS INTEGER\n y AS INTEGER\nEND TYPE\n" "DIM a AS P\nDIM b AS P\n" "a.x = 1\na.y = 2\n" "b.x = 10\nb.y = 20\n" "PRINT a.x + b.x\nPRINT a.y + b.y\n", "11 \n22 \n"); TEST_EQ("udt-return-from-function-via-byref", "TYPE P\n x AS INTEGER\n y AS INTEGER\nEND TYPE\n" "SUB setPt(pt AS P, xv AS INTEGER, yv AS INTEGER)\n" " pt.x = xv\n pt.y = yv\n" "END SUB\n" "DIM a AS P\n" "setPt a, 7, 8\n" "PRINT a.x\nPRINT a.y\n", "7 \n8 \n"); // ============================================================ // More FOR/loop edge cases // ============================================================ TEST_EQ("for-zero-to-zero", "DIM i AS INTEGER\nFOR i = 0 TO 0\n PRINT i\nNEXT i\n", "0 \n"); TEST_EQ("for-neg-to-neg", "DIM i AS INTEGER\nFOR i = -3 TO -1\n PRINT i\nNEXT i\n", "-3 \n-2 \n-1 \n"); // ============================================================ // More SELECT CASE // ============================================================ TEST_EQ("select-case-no-match-no-else", "DIM n AS INTEGER\nn = 99\n" "SELECT CASE n\n" " CASE 1: PRINT \"one\"\n" " CASE 2: PRINT \"two\"\n" "END SELECT\n" "PRINT \"done\"\n", "done\n"); // ============================================================ // Global String and STATIC STRING from event-dispatch path // ============================================================ TEST_SUB_EQ("subcall-global-string", "DIM g AS STRING\ng = \"init\"\n" "SUB appendX\n" " g = g + \"x\"\n" " PRINT g\n" "END SUB\n", "appendX", "initx\n"); TEST_SUB_EQ("subcall-static-accumulates", "SUB count\n" " STATIC n AS INTEGER\n" " n = n + 1\n" " PRINT n\n" "END SUB\n" "SUB run3\n" " count\n count\n count\n" "END SUB\n", "run3", "1 \n2 \n3 \n"); // ============================================================ // FUNCTION returning string works in expressions // ============================================================ TEST_EQ("function-string-in-expr", "FUNCTION tag(s AS STRING) AS STRING\n" " tag = \"<\" + s + \">\"\nEND FUNCTION\n" "PRINT tag(\"foo\") + tag(\"bar\")\n", "\n"); // ============================================================ // Dictionary-like pattern using parallel arrays // ============================================================ TEST_EQ("parallel-arrays", "DIM keys(2) AS STRING\nDIM vals(2) AS INTEGER\n" "keys(0) = \"a\"\nkeys(1) = \"b\"\nkeys(2) = \"c\"\n" "vals(0) = 10\nvals(1) = 20\nvals(2) = 30\n" "DIM i AS INTEGER\n" "FOR i = 0 TO 2\n" " PRINT keys(i) + \"=\" + STR$(vals(i))\n" "NEXT i\n", "a= 10\nb= 20\nc= 30\n"); // ============================================================ // Recursive algorithms // ============================================================ TEST_EQ("fib-recursive", "FUNCTION fib(n AS INTEGER) AS LONG\n" " IF n <= 1 THEN\n fib = n\n ELSE\n fib = fib(n - 1) + fib(n - 2)\n END IF\n" "END FUNCTION\n" "PRINT fib(10)\n", "55 \n"); // ============================================================ // String-valued DIM inside a SUB // ============================================================ TEST_EQ("local-string-dim-in-sub", "SUB build\n" " DIM s AS STRING\n" " s = s + \"x\"\n" " s = s + \"y\"\n" " PRINT s\n" "END SUB\n" "build\n" "build\n", "xy\nxy\n"); // ============================================================ // Boolean short-circuit edge case (no crash on null side) // ============================================================ TEST_EQ("bool-and-normal", "DIM a AS INTEGER\nDIM b AS INTEGER\n" "a = 5\nb = 10\n" "IF a > 0 AND b > 0 THEN PRINT \"both-pos\"\n", "both-pos\n"); // ============================================================ // IF with compound conditions using NOT / AND / OR // ============================================================ TEST_EQ("if-not-or", "DIM x AS INTEGER\nx = 5\n" "IF NOT (x < 0 OR x > 100) THEN PRINT \"in-range\"\n", "in-range\n"); printf("\n--------------------------\n"); printf("PASS: %d FAIL: %d\n", (int)sPassCount, (int)sFailCount); return sFailCount == 0 ? 0 : 1; }