12260 lines
369 KiB
C
12260 lines
369 KiB
C
// 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_compiler.c -- End-to-end test: source -> compiler -> VM -> output
|
|
//
|
|
// Build: make -C dvxbasic tests
|
|
|
|
#include "compiler/front.h"
|
|
#include "runtime/vm.h"
|
|
#include "runtime/values.h"
|
|
#include "runtime/screen.h"
|
|
#include "runtime/serialize.h"
|
|
#include "testCapture.h"
|
|
|
|
// The DVX 8x16 font, so screen text draws real glyphs
|
|
#define DVX_FONT_IMPL
|
|
#include "dvxFont.h"
|
|
|
|
#include <inttypes.h>
|
|
#include <stdbool.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#include <time.h>
|
|
|
|
// Count of failed checks. main() returns non-zero when this is > 0 so
|
|
// `make tests` actually gates on these assertions instead of the harness
|
|
// always exiting 0 while printing FAIL.
|
|
static int32_t gFailCount = 0;
|
|
|
|
// Generated-source limit tests (testCompilerLimits / testLexerLimits).
|
|
#define TEST_LIMIT_CONSTS 65600 // one past the 16-bit constant pool
|
|
#define TEST_LIMIT_JUMPBODY 3500 // IF body wider than an int16 jump (and, with the FOR body, code past 64 KB)
|
|
#define TEST_LIMIT_FORBODY 3000 // FOR body wider than an int16 jump
|
|
#define TEST_LIMIT_GOSUB_ADD 1000 // what the far GOSUB adds
|
|
#define TEST_LIMIT_GLOBALS 520 // one past BAS_VM_MAX_GLOBALS
|
|
#define TEST_LIMIT_LOCALS 65 // one past BAS_VM_MAX_LOCALS
|
|
#define TEST_LIMIT_READ_ELEMS 40 // READ targets whose temps must not pile up
|
|
#define TEST_LIMIT_SRC_CAP (2 * 1024 * 1024)
|
|
#define TEST_LIMIT_EXPECT_LEN 64
|
|
|
|
// Compile time against program size (testFrontEnd): procedures in the
|
|
// small program, how many times as many the large one has, the most its
|
|
// compile may take relative to the small one's (linear growth gives about
|
|
// TEST_SCALE_FACTOR, quadratic its square), the runs each is timed over
|
|
// (the best counts) and the generated source per procedure.
|
|
#define TEST_SCALE_PROCS 1000
|
|
#define TEST_SCALE_FACTOR 4
|
|
#define TEST_SCALE_LIMIT 8.0
|
|
#define TEST_SCALE_RUNS 5
|
|
#define TEST_SCALE_LINE_MAX 96
|
|
#define TEST_LONG_STRING_LEN 300 // past BAS_MAX_STRING_LEN
|
|
#define TEST_LONG_STRING_SRC 512
|
|
#define TEST_NAMED_EXTRA 4 // named arguments past BAS_VM_MAX_CALL_ARGS
|
|
#define TEST_NAMED_PAD (BAS_MAX_IDENT - 1 - 3) // zeros after "Nnn": the longest identifier
|
|
#define TEST_NAMED_SRC_LEN 2048 // a call with BAS_VM_MAX_CALL_ARGS + TEST_NAMED_EXTRA of them
|
|
#define TEST_TOKEN_NAME_SWEEP 512 // covers the whole token enum
|
|
#define TEST_SWAP_LINES 600 // element SWAPs sharing the temporaries
|
|
#define TEST_EXTERN_REC_LEN 128 // one recorded extern call
|
|
#define TEST_ROW_TEXT_LEN 96 // one screen text row read back
|
|
#define TEST_KEYS_MAX 16 // keys a screen test types
|
|
#define TEST_MOUSE_STEPS 4 // mouse moves a screen test makes, one per DoEvents
|
|
#define TEST_PEN_X1 100 // the PEN test's press (SCREEN 12 pixels) ...
|
|
#define TEST_PEN_Y1 50
|
|
#define TEST_PEN_X2 300 // ... and where the mouse goes after it
|
|
#define TEST_PEN_Y2 200
|
|
#define TEST_PROGRAM_MAX 8192 // a program built from a template (runBothBindings)
|
|
#define TEST_TITLE_MAX 256 // its test title
|
|
|
|
// Keys a screen test's DoEvents stub types into the program screen (once,
|
|
// on its first call), and the mouse it moves there (one step a call).
|
|
typedef struct {
|
|
BasVmT *vm;
|
|
int32_t keys[TEST_KEYS_MAX];
|
|
int32_t count;
|
|
int32_t calls;
|
|
int32_t mouseX[TEST_MOUSE_STEPS]; // the mouse over the screen at DoEvents call i
|
|
int32_t mouseY[TEST_MOUSE_STEPS];
|
|
bool mouseDown[TEST_MOUSE_STEPS];
|
|
int32_t mouseCount;
|
|
} TestKeysT;
|
|
|
|
// Function prototypes
|
|
static double bestCompileSeconds(int32_t procs);
|
|
static bool capturePlayMacro(void *ctx, const char *macro);
|
|
static int32_t cellPixels(const BasScreenT *scr, int32_t row, int32_t col, uint8_t color);
|
|
static void checkTrue(const char *what, bool ok);
|
|
static void compileOnly(const char *name, const char *source);
|
|
static void expectCompileError(const char *name, const char *source, const char *needle);
|
|
static void expectValidatorParse(const char *name, const char *source, const char *needle);
|
|
static uint8_t fbAt(const BasScreenT *scr, int32_t x, int32_t y);
|
|
static double globalNum(const BasVmT *vm, const char *name);
|
|
static void rowText(const BasScreenT *scr, int32_t row, char *out);
|
|
static void runBothBindings(const char *name, const char *source, const char *expected);
|
|
static void runExternProgram(const char *name, const char *source, const char *expected);
|
|
static void runFastAndStepped(const char *name, const char *source, const char *expected);
|
|
static void runProgram(const char *name, const char *source, const char *expected);
|
|
static void runProgramPlay(const char *name, const char *source, const char *expected, bool capturePlay);
|
|
static BasVmT *screenRun(const char *name, const char *source, CaptureT *cap, TestKeysT *keys);
|
|
static void screenRunFree(BasVmT *vm);
|
|
static uint8_t shownAt(const BasScreenT *scr, int32_t x, int32_t y);
|
|
static BasValueT stubCallExtern(void *ctx, void *funcPtr, const char *libName, const char *funcName, BasValueT *args, int32_t argc, uint8_t retType, uint32_t binaryMask);
|
|
static bool stubIsMethodValid(void *ctx, const char *wgtType, const char *methodName);
|
|
static bool stubIsPropValid(void *ctx, const char *wgtType, const char *propName);
|
|
static const char *stubLookupCtrlType(void *ctx, const char *ctrlName);
|
|
static int32_t stubMsgBox(void *ctx, const char *msg, int32_t flags, const char *title);
|
|
static void *stubResolveExtern(void *ctx, const char *libName, const char *funcName);
|
|
static void testClassWithEvents(void);
|
|
static void testCompilerFixes(void);
|
|
static void testCompilerLimits(void);
|
|
static void testConsoleGraphics(void);
|
|
static void testConstEnumParamArray(void);
|
|
static void testEarlyBinding(void);
|
|
static void testEventsAndInterfaces(void);
|
|
static void testFastLoop(void);
|
|
static void testFollowUp(void);
|
|
static void testFrontEnd(void);
|
|
static void testGapClosure(void);
|
|
static bool testKeysDoEvents(void *ctx);
|
|
static void testKeywordApi(void);
|
|
static void testLexerLimits(void);
|
|
static void testMissingAndValues(void);
|
|
static void testObjectsAndVariants(void);
|
|
static void testParamArrayByRef(void);
|
|
static void testParamDefaults(void);
|
|
static void testReferences(void);
|
|
static void testScreenModesPages(void);
|
|
static void testStringsAndDates(void);
|
|
static void testTokenNames(void);
|
|
static void testUserControl(void);
|
|
static void ucEventHost(void *ctx, const BasObjectT *obj, int32_t eventIdx, BasValueT *args, int32_t argc);
|
|
|
|
// Headless stand-in for the form runtime: MsgBox answers OK so programs
|
|
// that show one still run to completion (every other form/control
|
|
// operation raises error 1000 without a callback).
|
|
static const BasUiCallbacksT sStubUi = { .msgBox = stubMsgBox };
|
|
|
|
|
|
|
|
// The best of TEST_SCALE_RUNS compile times (CPU seconds) of a program
|
|
// of procs one-line FUNCTIONs, each calling the one before; -1 when it
|
|
// fails to compile.
|
|
static double bestCompileSeconds(int32_t procs) {
|
|
char *src = (char *)malloc((size_t)(procs + 1) * TEST_SCALE_LINE_MAX);
|
|
|
|
if (src == NULL) {
|
|
return -1.0;
|
|
}
|
|
|
|
int32_t len = snprintf(src, TEST_SCALE_LINE_MAX, "PRINT F%d(1)\n", (int32_t)(procs - 1));
|
|
|
|
for (int32_t i = 0; i < procs; i++) {
|
|
len += snprintf(src + len, TEST_SCALE_LINE_MAX, "FUNCTION F%d(BYVAL a AS LONG) AS LONG\nF%d = a%s\nEND FUNCTION\n", (int)i, (int)i, (i > 0) ? " + 1" : "");
|
|
}
|
|
|
|
double best = -1.0;
|
|
|
|
for (int32_t r = 0; r < TEST_SCALE_RUNS; r++) {
|
|
clock_t start = clock();
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
bool ok = compiler != NULL && basCompile(compiler);
|
|
double secs = (double)(clock() - start) / CLOCKS_PER_SEC;
|
|
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (!ok) {
|
|
free(src);
|
|
return -1.0;
|
|
}
|
|
|
|
if (best < 0.0 || secs < best) {
|
|
best = secs;
|
|
}
|
|
}
|
|
|
|
free(src);
|
|
return best;
|
|
}
|
|
|
|
|
|
// A PLAY device callback for runProgramPlay: ctx is the CaptureT.
|
|
static bool capturePlayMacro(void *ctx, const char *macro) {
|
|
captureAppend((CaptureT *)ctx, "[PLAY ");
|
|
captureAppend((CaptureT *)ctx, macro);
|
|
captureAppend((CaptureT *)ctx, "]\n");
|
|
return true;
|
|
}
|
|
|
|
|
|
// One named check of a screen test.
|
|
// Pixels of one colour in a text cell of the shown page.
|
|
static int32_t cellPixels(const BasScreenT *scr, int32_t row, int32_t col, uint8_t color) {
|
|
int32_t count = 0;
|
|
|
|
for (int32_t y = row * scr->cellH; y < (row + 1) * scr->cellH; y++) {
|
|
for (int32_t x = col * BAS_GFX_GLYPH_W; x < (col + 1) * BAS_GFX_GLYPH_W; x++) {
|
|
count += shownAt(scr, x, y) == color;
|
|
}
|
|
}
|
|
|
|
return count;
|
|
}
|
|
|
|
|
|
static void checkTrue(const char *what, bool ok) {
|
|
if (!ok) {
|
|
printf("FAIL: %s\n", what);
|
|
gFailCount++;
|
|
}
|
|
}
|
|
|
|
|
|
// Compile source expecting success without running it (constructs whose
|
|
// execution needs a form runtime or host I/O).
|
|
static void compileOnly(const char *name, const char *source) {
|
|
printf("=== %s ===\n", name);
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, (int32_t)strlen(source));
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("FAIL: compile error: %s\n\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
return;
|
|
}
|
|
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (!mod) {
|
|
printf("FAIL: module build failed\n\n");
|
|
gFailCount++;
|
|
return;
|
|
}
|
|
|
|
basModuleFree(mod);
|
|
printf("OK\n\n");
|
|
}
|
|
|
|
|
|
// Compile source expecting it to be rejected; the error text must
|
|
// contain needle.
|
|
|
|
|
|
static void expectCompileError(const char *name, const char *source, const char *needle) {
|
|
printf("=== %s ===\n", name);
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, (int32_t)strlen(source));
|
|
|
|
bool ok = basCompile(compiler);
|
|
|
|
if (ok) {
|
|
printf("FAIL: compiled but expected error containing [%s]\n\n", needle);
|
|
gFailCount++;
|
|
} else if (strstr(basCompilerError(compiler), needle) == NULL) {
|
|
printf("FAIL: error [%s] does not contain [%s]\n\n", basCompilerError(compiler), needle);
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK (expected error: %s)\n\n", basCompilerError(compiler));
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
}
|
|
|
|
|
|
|
|
// Compile with the stub control validator attached. A NULL needle means
|
|
// the source must compile; otherwise it must fail with the needle in the
|
|
// error text.
|
|
static void expectValidatorParse(const char *name, const char *source, const char *needle) {
|
|
printf("=== %s ===\n", name);
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, (int32_t)strlen(source));
|
|
BasCtrlValidatorT validator = { stubLookupCtrlType, stubIsMethodValid, stubIsPropValid, compiler };
|
|
|
|
basCompilerSetValidator(compiler, &validator);
|
|
|
|
bool ok = basCompile(compiler);
|
|
|
|
if (needle == NULL) {
|
|
if (ok) {
|
|
printf("OK\n\n");
|
|
} else {
|
|
printf("FAIL: compile error: %s\n\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
}
|
|
} else if (ok) {
|
|
printf("FAIL: compiled but expected error containing [%s]\n\n", needle);
|
|
gFailCount++;
|
|
} else if (strstr(basCompilerError(compiler), needle) == NULL) {
|
|
printf("FAIL: error [%s] does not contain [%s]\n\n", basCompilerError(compiler), needle);
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK (expected error: %s)\n\n", basCompilerError(compiler));
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
}
|
|
|
|
|
|
// Compile and run source. PRINT output is captured and, when expected
|
|
// is not NULL, must match it exactly; a compile error or a VM error is
|
|
// always a failure.
|
|
|
|
|
|
// Compile and run source with DECLARE LIBRARY resolution stubbed out;
|
|
// every extern call records "Name(types)" (see stubCallExtern) and the
|
|
// record must equal expected.
|
|
static uint8_t fbAt(const BasScreenT *scr, int32_t x, int32_t y) {
|
|
return scr->fb[y * scr->width + x];
|
|
}
|
|
|
|
|
|
// A module-level variable's value by name (the module's debug names).
|
|
static double globalNum(const BasVmT *vm, const char *name) {
|
|
for (int32_t i = 0; i < vm->module->debugVarCount; i++) {
|
|
const BasDebugVarT *v = &vm->module->debugVars[i];
|
|
|
|
if (v->procIndex < 0 && strcasecmp(v->name, name) == 0) {
|
|
return basValToNumber(vm->globals[v->index]);
|
|
}
|
|
}
|
|
|
|
printf("FAIL: no variable %s\n", name);
|
|
gFailCount++;
|
|
return 0.0;
|
|
}
|
|
|
|
|
|
// A screen text row, trailing blanks removed.
|
|
static void rowText(const BasScreenT *scr, int32_t row, char *out) {
|
|
int32_t len = scr->cols;
|
|
|
|
memcpy(out, &scr->chars[row * scr->cols], (size_t)len);
|
|
|
|
while (len > 0 && out[len - 1] == ' ') {
|
|
len--;
|
|
}
|
|
|
|
out[len] = '\0';
|
|
}
|
|
|
|
|
|
// Runs program template twice, its @T@ standing for the class Acct (members
|
|
// bound at compile time) and for Object (late bound): both must print
|
|
// expected.
|
|
static void runBothBindings(const char *name, const char *source, const char *expected) {
|
|
static const char *const types[] = { "Acct", "Object" };
|
|
static const char token[] = "@T@";
|
|
|
|
for (int32_t t = 0; t < DVX_ARRAY_LEN(types); t++) {
|
|
char program[TEST_PROGRAM_MAX];
|
|
char title[TEST_TITLE_MAX];
|
|
int32_t len = 0;
|
|
const char *p = source;
|
|
|
|
while (*p != '\0' && len < (int32_t)sizeof(program) - 1) {
|
|
if (strncmp(p, token, sizeof(token) - 1) == 0) {
|
|
len += snprintf(program + len, sizeof(program) - (size_t)len, "%s", types[t]);
|
|
p += sizeof(token) - 1;
|
|
} else {
|
|
program[len++] = *p++;
|
|
}
|
|
}
|
|
|
|
program[DVX_MIN(len, (int32_t)sizeof(program) - 1)] = '\0';
|
|
snprintf(title, sizeof(title), "%s (As %s)", name, types[t]);
|
|
runProgram(title, program, expected);
|
|
}
|
|
}
|
|
|
|
|
|
static void runExternProgram(const char *name, const char *source, const char *expected) {
|
|
printf("=== %s ===\n", name);
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, (int32_t)strlen(source));
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
return;
|
|
}
|
|
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (!mod) {
|
|
printf("MODULE BUILD FAILED\n\n");
|
|
gFailCount++;
|
|
return;
|
|
}
|
|
|
|
CaptureT cap;
|
|
BasExternCallbacksT ext;
|
|
BasVmT *vm = basVmCreate();
|
|
|
|
cap.buf[0] = '\0';
|
|
cap.len = 0;
|
|
ext.resolveExtern = stubResolveExtern;
|
|
ext.callExtern = stubCallExtern;
|
|
ext.ctx = ∩
|
|
|
|
basVmLoadModule(vm, mod);
|
|
basVmSetExternCallbacks(vm, &ext);
|
|
|
|
BasVmResultE result = basVmRun(vm);
|
|
|
|
printf("%s\n", cap.buf);
|
|
|
|
if (result != BAS_VM_HALTED && result != BAS_VM_OK) {
|
|
printf("[VM error %d: %s]\n", result, basVmGetError(vm));
|
|
gFailCount++;
|
|
} else if (strcmp(cap.buf, expected) != 0) {
|
|
printf("FAIL: expected [%s]\n", expected);
|
|
gFailCount++;
|
|
}
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
printf("\n");
|
|
}
|
|
|
|
|
|
// Runs a program (without ON ERROR: basVmStep alone dispatches no error
|
|
// handler) twice: with basVmRun, whose fast loop runs the frequent
|
|
// instructions inline, and one basVmStep at a time, the reference
|
|
// implementation. Both must print expected.
|
|
static void runFastAndStepped(const char *name, const char *source, const char *expected) {
|
|
printf("=== %s ===\n", name);
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, (int32_t)strlen(source));
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
return;
|
|
}
|
|
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (!mod) {
|
|
printf("MODULE BUILD FAILED\n\n");
|
|
gFailCount++;
|
|
return;
|
|
}
|
|
|
|
for (int32_t stepped = 0; stepped <= 1; stepped++) {
|
|
CaptureT cap;
|
|
BasVmT *vm = basVmCreate();
|
|
BasVmResultE result = BAS_VM_OK;
|
|
|
|
captureReset(&cap);
|
|
basVmLoadModule(vm, mod);
|
|
basVmSetPrintCallback(vm, capturePrint, &cap);
|
|
basVmSetUiCallbacks(vm, &sStubUi);
|
|
|
|
if (stepped) {
|
|
vm->running = true;
|
|
|
|
while (vm->running && result == BAS_VM_OK) {
|
|
result = basVmStep(vm);
|
|
}
|
|
} else {
|
|
result = basVmRun(vm);
|
|
}
|
|
|
|
fputs(cap.buf, stdout);
|
|
|
|
if (result != BAS_VM_HALTED && result != BAS_VM_OK) {
|
|
printf("[%s: VM error %d: %s]\n", stepped ? "stepped" : "run", result, basVmGetError(vm));
|
|
gFailCount++;
|
|
} else if (expected != NULL && strcmp(cap.buf, expected) != 0) {
|
|
printf("FAIL (%s): expected output [%s]\n", stepped ? "stepped" : "run", expected);
|
|
gFailCount++;
|
|
}
|
|
|
|
basVmDestroy(vm);
|
|
}
|
|
|
|
basModuleFree(mod);
|
|
printf("\n");
|
|
}
|
|
|
|
|
|
static void runProgram(const char *name, const char *source, const char *expected) {
|
|
runProgramPlay(name, source, expected, false);
|
|
}
|
|
|
|
|
|
// runProgram; with capturePlay each PLAY's macro (as the music library
|
|
// gets it) is captured as "[PLAY macro]" lines among the output.
|
|
static void runProgramPlay(const char *name, const char *source, const char *expected, bool capturePlay) {
|
|
printf("=== %s ===\n", name);
|
|
|
|
int32_t len = (int32_t)strlen(source);
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
return;
|
|
}
|
|
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (!mod) {
|
|
printf("MODULE BUILD FAILED\n\n");
|
|
gFailCount++;
|
|
return;
|
|
}
|
|
|
|
CaptureT cap;
|
|
cap.buf[0] = '\0';
|
|
cap.len = 0;
|
|
|
|
BasVmT *vm = basVmCreate();
|
|
basVmLoadModule(vm, mod);
|
|
basVmSetPrintCallback(vm, capturePrint, &cap);
|
|
basVmSetUiCallbacks(vm, &sStubUi);
|
|
|
|
if (capturePlay) {
|
|
BasDeviceCallbacksT device;
|
|
|
|
memset(&device, 0, sizeof(device));
|
|
device.play = capturePlayMacro;
|
|
device.ctx = ∩
|
|
basVmSetDeviceCallbacks(vm, &device);
|
|
}
|
|
|
|
BasVmResultE result = basVmRun(vm);
|
|
|
|
// A normal end releases the module variables (Class_Terminate), as
|
|
// the hosts do
|
|
if (result == BAS_VM_HALTED && basVmFinish(vm)) {
|
|
result = basVmRun(vm);
|
|
}
|
|
|
|
fputs(cap.buf, stdout);
|
|
|
|
if (result != BAS_VM_HALTED && result != BAS_VM_OK) {
|
|
printf("[VM error %d: %s]\n", result, basVmGetError(vm));
|
|
gFailCount++;
|
|
} else if (expected != NULL && strcmp(cap.buf, expected) != 0) {
|
|
printf("FAIL: expected output [%s]\n", expected);
|
|
gFailCount++;
|
|
}
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
printf("\n");
|
|
}
|
|
|
|
|
|
// Compile and run a program that uses the program screen; the VM is
|
|
// returned for the checks (screenRunFree ends it), NULL when the program
|
|
// did not compile or made no screen. keys (optional) are typed at the
|
|
// first DoEvents.
|
|
static BasVmT *screenRun(const char *name, const char *source, CaptureT *cap, TestKeysT *keys) {
|
|
printf("=== %s ===\n", name);
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, (int32_t)strlen(source));
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("FAIL: compile error: %s\n\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
return NULL;
|
|
}
|
|
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (!mod) {
|
|
printf("FAIL: module build failed\n\n");
|
|
gFailCount++;
|
|
return NULL;
|
|
}
|
|
|
|
BasVmT *vm = basVmCreate();
|
|
basVmLoadModule(vm, mod);
|
|
captureReset(cap);
|
|
basVmSetPrintCallback(vm, capturePrint, cap);
|
|
basVmSetUiCallbacks(vm, &sStubUi);
|
|
|
|
if (keys) {
|
|
keys->vm = vm;
|
|
keys->calls = 0;
|
|
basVmSetDoEventsCallback(vm, testKeysDoEvents, keys);
|
|
}
|
|
|
|
BasVmResultE result = basVmRun(vm);
|
|
|
|
if (result != BAS_VM_HALTED && result != BAS_VM_OK) {
|
|
printf("FAIL: [VM error %d: %s]\n", result, basVmGetError(vm));
|
|
gFailCount++;
|
|
}
|
|
|
|
if (vm->screen == NULL) {
|
|
printf("FAIL: the program made no screen\n\n");
|
|
gFailCount++;
|
|
screenRunFree(vm);
|
|
return NULL;
|
|
}
|
|
|
|
return vm;
|
|
}
|
|
|
|
|
|
static void screenRunFree(BasVmT *vm) {
|
|
BasModuleT *mod = vm->module;
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
printf("\n");
|
|
}
|
|
|
|
|
|
// A pixel of the visual page.
|
|
static uint8_t shownAt(const BasScreenT *scr, int32_t x, int32_t y) {
|
|
return scr->shown[y * scr->width + x];
|
|
}
|
|
|
|
|
|
// Extern call stub: appends "Func(t,t,...)" to the capture (ctx), one
|
|
// type letter per argument, and returns 0.
|
|
static BasValueT stubCallExtern(void *ctx, void *funcPtr, const char *libName, const char *funcName, BasValueT *args, int32_t argc, uint8_t retType, uint32_t binaryMask) {
|
|
CaptureT *c = (CaptureT *)ctx;
|
|
char rec[TEST_EXTERN_REC_LEN];
|
|
int32_t n = 0;
|
|
|
|
(void)funcPtr;
|
|
(void)libName;
|
|
(void)retType;
|
|
|
|
n += snprintf(rec + n, sizeof(rec) - n, "%s%s(", c->len > 0 ? " " : "", funcName);
|
|
|
|
for (int32_t i = 0; i < argc; i++) {
|
|
char t = '?';
|
|
|
|
switch (args[i].type) {
|
|
case BAS_TYPE_INTEGER:
|
|
t = 'I';
|
|
break;
|
|
|
|
case BAS_TYPE_LONG:
|
|
t = 'L';
|
|
break;
|
|
|
|
case BAS_TYPE_SINGLE:
|
|
t = 'S';
|
|
break;
|
|
|
|
case BAS_TYPE_DOUBLE:
|
|
t = 'D';
|
|
break;
|
|
|
|
case BAS_TYPE_STRING:
|
|
t = (binaryMask & (1u << i)) ? 'b' : '$';
|
|
break;
|
|
|
|
case BAS_TYPE_BOOLEAN:
|
|
t = 'B';
|
|
break;
|
|
|
|
default:
|
|
break;
|
|
}
|
|
|
|
n += snprintf(rec + n, sizeof(rec) - n, "%s%c", i > 0 ? "," : "", t);
|
|
}
|
|
|
|
snprintf(rec + n, sizeof(rec) - n, ")%s", (binaryMask & BAS_EXTERN_BINARY_RET) ? "b" : "");
|
|
captureAppend(c, rec);
|
|
return basValInteger(0);
|
|
}
|
|
|
|
|
|
static bool stubIsMethodValid(void *ctx, const char *wgtType, const char *methodName) {
|
|
(void)ctx;
|
|
(void)wgtType;
|
|
return strcasecmp(methodName, "BadMethod") != 0;
|
|
}
|
|
|
|
|
|
static bool stubIsPropValid(void *ctx, const char *wgtType, const char *propName) {
|
|
(void)ctx;
|
|
(void)wgtType;
|
|
return strcasecmp(propName, "BadProp") != 0;
|
|
}
|
|
|
|
|
|
// Text1 is a TextBox on every form; Lbl2 is a Label only on form F1 (the
|
|
// validator ctx is the compiler, asked for the form being compiled).
|
|
static const char *stubLookupCtrlType(void *ctx, const char *ctrlName) {
|
|
if (strcasecmp(ctrlName, "Text1") == 0) {
|
|
return "TextBox";
|
|
}
|
|
|
|
if (strcasecmp(ctrlName, "Lbl2") == 0 && strcasecmp(basCompilerFormScope((const BasCompilerT *)ctx), "F1") == 0) {
|
|
return "Label";
|
|
}
|
|
|
|
return NULL;
|
|
}
|
|
|
|
|
|
static int32_t stubMsgBox(void *ctx, const char *msg, int32_t flags, const char *title) {
|
|
(void)ctx;
|
|
(void)msg;
|
|
(void)flags;
|
|
(void)title;
|
|
return 1;
|
|
}
|
|
|
|
|
|
// Resolve every extern to a dummy non-NULL pointer.
|
|
static void *stubResolveExtern(void *ctx, const char *libName, const char *funcName) {
|
|
(void)libName;
|
|
(void)funcName;
|
|
return ctx;
|
|
}
|
|
|
|
|
|
// Regression tests for the compiler fixes: label ownership, local CONST,
|
|
// DEF FN scope, literal forms, store targets, argument passing and the
|
|
// missing-terminator checks.
|
|
static void testClassWithEvents(void) {
|
|
runProgram("WithEvents in a class: each instance handles its own source with itself as Me",
|
|
"DIM a AS NEW Listener\n"
|
|
"DIM b AS NEW Listener\n"
|
|
"a.Nm = \"A\"\n"
|
|
"b.Nm = \"B\"\n"
|
|
"a.Go 1\n"
|
|
"b.Go 2\n"
|
|
"a.Share b\n"
|
|
"b.Go 3\n"
|
|
"BEGINCLASS \"Source\"\n"
|
|
"Public Event Ping(ByVal n AS INTEGER, reply AS STRING)\n"
|
|
"Public Sub Fire(n AS INTEGER)\n"
|
|
" DIM r AS STRING\n"
|
|
" RaiseEvent Ping(n, r)\n"
|
|
" PRINT \"reply=\"; r\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Listener\"\n"
|
|
"Public Nm AS STRING\n"
|
|
"Private WithEvents src AS Source\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" SET src = NEW Source\n"
|
|
"End Sub\n"
|
|
"Public Sub Go(n AS INTEGER)\n"
|
|
" src.Fire n\n"
|
|
"End Sub\n"
|
|
"Public Sub Share(other AS Listener)\n"
|
|
" other.Take src\n"
|
|
"End Sub\n"
|
|
"Public Sub Take(s AS Source)\n"
|
|
" SET src = s\n"
|
|
"End Sub\n"
|
|
"Private Sub src_Ping(ByVal n AS INTEGER, reply AS STRING)\n"
|
|
" PRINT Nm; n;\n"
|
|
" reply = reply + Me.Nm\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"A1 reply=A\n"
|
|
"B2 reply=B\n"
|
|
"B3 A3 reply=BA\n"
|
|
);
|
|
|
|
runProgram("WithEvents in a class: a freed listener hears nothing; its Terminate order",
|
|
"DIM keep AS Source\n"
|
|
"DIM l AS Listener\n"
|
|
"SET l = NEW Listener\n"
|
|
"SET keep = l.Src\n"
|
|
"keep.Fire 1\n"
|
|
"SET l = Nothing\n"
|
|
"keep.Fire 2\n"
|
|
"PRINT \"end\"\n"
|
|
"BEGINCLASS \"Source\"\n"
|
|
"Public Event Ping(ByVal n AS INTEGER)\n"
|
|
"Public Sub Fire(n AS INTEGER)\n"
|
|
" PRINT \"fire\"; n\n"
|
|
" RaiseEvent Ping(n)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Listener\"\n"
|
|
"Public WithEvents Src AS Source\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" SET Src = NEW Source\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"listener gone\"\n"
|
|
" Src.Fire 9\n"
|
|
"End Sub\n"
|
|
"Private Sub Src_Ping(ByVal n AS INTEGER)\n"
|
|
" PRINT \"heard\"; n\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"fire1 \n"
|
|
"heard1 \n"
|
|
"listener gone\n"
|
|
"fire9 \n"
|
|
"heard9 \n"
|
|
"fire2 \n"
|
|
"end\n"
|
|
);
|
|
|
|
runProgram("WithEvents in a class: a source holding its listener (cycle) is collected, Terminates run",
|
|
"MakePair\n"
|
|
"PRINT \"after\"\n"
|
|
"SUB MakePair()\n"
|
|
" DIM l AS NEW Listener\n"
|
|
" l.Poke\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Source\"\n"
|
|
"Public Event Ping()\n"
|
|
"Public Owner AS Listener\n"
|
|
"Public Sub Fire()\n"
|
|
" RaiseEvent Ping()\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"source term\"\n"
|
|
" RaiseEvent Ping()\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Listener\"\n"
|
|
"Private WithEvents s AS Source\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" SET s = NEW Source\n"
|
|
" SET s.Owner = Me\n"
|
|
"End Sub\n"
|
|
"Public Sub Poke()\n"
|
|
" s.Fire\n"
|
|
"End Sub\n"
|
|
"Private Sub s_Ping()\n"
|
|
" PRINT \"ping\"\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"listener term\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"ping\n"
|
|
"after\n"
|
|
"listener term\n"
|
|
"source term\n"
|
|
"ping\n"
|
|
);
|
|
|
|
runProgram("WithEvents in a class: handler drops the last outside reference and rebinds",
|
|
"DIM SHARED g AS Listener\n"
|
|
"SET g = NEW Listener\n"
|
|
"g.Go\n"
|
|
"PRINT \"done\"\n"
|
|
"BEGINCLASS \"Source\"\n"
|
|
"Public Event Ping(ByVal n AS INTEGER)\n"
|
|
"Public Sub Fire(n AS INTEGER)\n"
|
|
" RaiseEvent Ping(n)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Listener\"\n"
|
|
"Private WithEvents s AS Source\n"
|
|
"Private keepS AS Source\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" SET s = NEW Source\n"
|
|
" SET keepS = s\n"
|
|
"End Sub\n"
|
|
"Public Sub Go()\n"
|
|
" keepS.Fire 1\n"
|
|
" keepS.Fire 2\n"
|
|
"End Sub\n"
|
|
"Private Sub s_Ping(ByVal n AS INTEGER)\n"
|
|
" PRINT \"ping\"; n\n"
|
|
" SET s = Nothing\n"
|
|
" SET g = Nothing\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"term\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"ping1 \n"
|
|
"term\n"
|
|
"done\n"
|
|
);
|
|
|
|
runProgram("WithEvents in a class: many listeners and sources made and dropped in a loop",
|
|
"DIM i AS INTEGER\n"
|
|
"DIM total AS LONG\n"
|
|
"FOR i = 1 TO 3000\n"
|
|
" DIM l AS Listener\n"
|
|
" SET l = NEW Listener\n"
|
|
" total = total + l.Run(i)\n"
|
|
"NEXT\n"
|
|
"PRINT total\n"
|
|
"BEGINCLASS \"Source\"\n"
|
|
"Public Event Ping(v AS LONG)\n"
|
|
"Public Back AS Object\n"
|
|
"Public Sub Fire(v AS LONG)\n"
|
|
" RaiseEvent Ping(v)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Listener\"\n"
|
|
"Private WithEvents s AS Source\n"
|
|
"Public Function Run(n AS INTEGER) AS LONG\n"
|
|
" DIM v AS LONG\n"
|
|
" SET s = NEW Source\n"
|
|
" SET s.Back = Me\n"
|
|
" v = n\n"
|
|
" s.Fire v\n"
|
|
" Run = v\n"
|
|
"End Function\n"
|
|
"Private Sub s_Ping(v AS LONG)\n"
|
|
" v = v * 2\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"9003000 \n"
|
|
);
|
|
|
|
expectCompileError("WithEvents in a class: handler must match the event",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Event E(a AS INTEGER)\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"L\"\n"
|
|
"Private WithEvents kk AS K\n"
|
|
"Private Sub kk_E(a AS STRING)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"does not match the declaration of event E");
|
|
|
|
expectCompileError("WithEvents in a class: not inside a procedure",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Event E()\n"
|
|
"Public Sub F()\n"
|
|
" DIM WithEvents k AS K\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"WithEvents variables belong at module level");
|
|
}
|
|
|
|
|
|
static void testCompilerFixes(void) {
|
|
// Labels are their own namespace and must be defined (S4-004, S3-028, S3-035, S3-036)
|
|
expectCompileError("GOSUB to a SUB name is not a label",
|
|
"PRINT \"start\"\n"
|
|
"GOSUB Foo\n"
|
|
"END\n"
|
|
"SUB Foo\n"
|
|
"END SUB\n",
|
|
"Label not defined: Foo"
|
|
);
|
|
|
|
expectCompileError("GOTO a variable name is not a label",
|
|
"x = 1\n"
|
|
"GOTO x\n"
|
|
"PRINT \"fell through\"\n",
|
|
"Label not defined: x"
|
|
);
|
|
|
|
expectCompileError("Undefined GOTO label rejected",
|
|
"GOTO nowhere\n"
|
|
"PRINT \"fell through\"\n",
|
|
"Label not defined: nowhere"
|
|
);
|
|
|
|
expectCompileError("ON ERROR GOTO a variable rejected",
|
|
"x = 1\n"
|
|
"ON ERROR GOTO x\n"
|
|
"y = 1 / 0\n",
|
|
"Label not defined: x"
|
|
);
|
|
|
|
expectCompileError("Undefined ON ERROR label rejected",
|
|
"ON ERROR GOTO handlr\n"
|
|
"PRINT 1\n",
|
|
"Label not defined: handlr"
|
|
);
|
|
|
|
// Labels belong to their procedure (S3-029, S3-041)
|
|
expectCompileError("GOTO into another SUB rejected",
|
|
"SUB A\n"
|
|
"GOTO fin\n"
|
|
"END SUB\n"
|
|
"SUB B\n"
|
|
"fin:\n"
|
|
"PRINT \"B fin\"\n"
|
|
"END SUB\n"
|
|
"A\n",
|
|
"Label not defined: fin"
|
|
);
|
|
|
|
expectCompileError("GOTO from module into a SUB rejected",
|
|
"GOTO inner\n"
|
|
"SUB S\n"
|
|
"inner:\n"
|
|
"PRINT \"inside S\"\n"
|
|
"END SUB\n",
|
|
"Label not defined: inner"
|
|
);
|
|
|
|
expectCompileError("GOTO from a SUB to a module label rejected",
|
|
"top:\n"
|
|
"SUB S\n"
|
|
"GOTO top\n"
|
|
"END SUB\n",
|
|
"Label not defined: top"
|
|
);
|
|
|
|
runProgram("Same label name in several procedures",
|
|
"SUB A\n"
|
|
"GOTO fin\n"
|
|
"fin:\n"
|
|
"PRINT \"A fin\"\n"
|
|
"END SUB\n"
|
|
"SUB B\n"
|
|
"GOTO fin\n"
|
|
"fin:\n"
|
|
"PRINT \"B fin\"\n"
|
|
"END SUB\n"
|
|
"A\n"
|
|
"B\n"
|
|
"GOTO fin\n"
|
|
"PRINT \"skipped\"\n"
|
|
"fin:\n"
|
|
"PRINT \"module fin\"\n",
|
|
"A fin\nB fin\nmodule fin\n"
|
|
);
|
|
|
|
runProgram("ON ERROR GOTO a label in the same SUB",
|
|
"SUB S\n"
|
|
"ON ERROR GOTO h\n"
|
|
"x = 1 / 0\n"
|
|
"PRINT \"after\"\n"
|
|
"EXIT SUB\n"
|
|
"h:\n"
|
|
"PRINT \"handled\"\n"
|
|
"RESUME NEXT\n"
|
|
"END SUB\n"
|
|
"S\n",
|
|
"handled\nafter\n"
|
|
);
|
|
|
|
// Suffixed literals keep their fraction/exponent (S3-026)
|
|
runProgram("Integer suffix on a fraction or exponent rounds",
|
|
"PRINT 1E3%; 1.5&; 2E3&; 2.5%; 3.5%\n",
|
|
"1000 2 2000 2 4 \n"
|
|
);
|
|
|
|
// S3-027: arr(i) + 1 goes by value, a bare arr(i) still by reference
|
|
runProgram("BYREF argument that is an element expression",
|
|
"SUB Inc(x)\n"
|
|
"x = x + 1\n"
|
|
"END SUB\n"
|
|
"SUB Show1(x)\n"
|
|
"PRINT x\n"
|
|
"END SUB\n"
|
|
"DIM a(3)\n"
|
|
"a(1) = 5\n"
|
|
"Show1 a(1) + 1\n"
|
|
"Inc a(1)\n"
|
|
"PRINT a(1)\n",
|
|
"6 \n6 \n"
|
|
);
|
|
|
|
// S3-030
|
|
runProgram("CONST in a SUB is local",
|
|
"CONST MAXV = 5\n"
|
|
"SUB A\n"
|
|
"CONST MAXV = 10\n"
|
|
"PRINT MAXV\n"
|
|
"END SUB\n"
|
|
"A\n"
|
|
"PRINT MAXV\n"
|
|
"SUB B\n"
|
|
"CONST MAXV = 7\n"
|
|
"PRINT MAXV\n"
|
|
"END SUB\n"
|
|
"B\n",
|
|
"10 \n5 \n7 \n"
|
|
);
|
|
|
|
// S3-031
|
|
runProgram("DEF FN free variables are module variables",
|
|
"DEF FNx(a) = a * rate\n"
|
|
"rate = 2\n"
|
|
"PRINT FNx(5)\n"
|
|
"PRINT rate\n",
|
|
"10 \n2 \n"
|
|
);
|
|
|
|
// S3-032
|
|
runProgram("DIM with several declarators",
|
|
"DIM name$, count%, total&\n"
|
|
"DIM a AS INTEGER, b AS STRING, c(2) AS LONG\n"
|
|
"name$ = \"n\": count% = 2: total& = 70000: a = 3: b = \"s\": c(2) = 9\n"
|
|
"PRINT name$; count%; total&; a; b; c(2)\n",
|
|
"n2 70000 3 s9 \n"
|
|
);
|
|
|
|
// S3-033
|
|
expectCompileError("ENDFORM inside a SUB rejected",
|
|
"BEGINFORM \"F1\"\n"
|
|
"SUB S\n"
|
|
"ENDFORM\n"
|
|
"END SUB\n"
|
|
"PRINT \"x\"\n",
|
|
"ENDFORM inside SUB/FUNCTION is not allowed"
|
|
);
|
|
|
|
// S2-074
|
|
expectCompileError("BEGINFORM without ENDFORM rejected",
|
|
"BEGINFORM \"F1\"\n"
|
|
"DIM x AS INTEGER\n",
|
|
"BEGINFORM without ENDFORM"
|
|
);
|
|
|
|
// S3-037
|
|
runProgram("DEFINT applies to parameters, STATIC and FUNCTION results",
|
|
"DEFINT A-Z\n"
|
|
"SUB S(x)\n"
|
|
"x = 7 / 2\n"
|
|
"PRINT x\n"
|
|
"END SUB\n"
|
|
"SUB T\n"
|
|
"STATIC n\n"
|
|
"n = 7 / 2\n"
|
|
"PRINT n\n"
|
|
"END SUB\n"
|
|
"FUNCTION F()\n"
|
|
"F = 7 / 2\n"
|
|
"END FUNCTION\n"
|
|
"S 1\n"
|
|
"T\n"
|
|
"PRINT F\n",
|
|
"4 \n4 \n4 \n"
|
|
);
|
|
|
|
runProgram("FUNCTION AS INTEGER converts its result",
|
|
"FUNCTION G() AS INTEGER\n"
|
|
"G = 2.5\n"
|
|
"END FUNCTION\n"
|
|
"FUNCTION H$()\n"
|
|
"H$ = \"ok\"\n"
|
|
"END FUNCTION\n"
|
|
"PRINT G; H$\n",
|
|
"2 ok\n"
|
|
);
|
|
|
|
// S3-038
|
|
expectCompileError("SUB called in an expression rejected",
|
|
"SUB MySub(a)\n"
|
|
"END SUB\n"
|
|
"x = MySub(1)\n",
|
|
"Sub 'MySub' cannot be used in an expression"
|
|
);
|
|
|
|
expectCompileError("Scalar variable called like a function rejected",
|
|
"x = 5\n"
|
|
"y = x()\n",
|
|
"'x' is not an array or function"
|
|
);
|
|
|
|
expectCompileError("CONST indexed like an array rejected",
|
|
"CONST C = 5\n"
|
|
"y = C(1)\n",
|
|
"'C' is not an array or function"
|
|
);
|
|
|
|
expectCompileError("Assignment to an element of a scalar rejected",
|
|
"x = 5\n"
|
|
"x(1) = 2\n",
|
|
"'x' is not an array"
|
|
);
|
|
|
|
// S3-039
|
|
runProgram("PRINT USING separators and trailing ;",
|
|
"PRINT USING \"##\"; 5;\n"
|
|
"PRINT \"X\"\n"
|
|
"PRINT USING \"##\"; 1, 2\n"
|
|
"PRINT USING \"##\"; 3,\n"
|
|
"PRINT \"Y\"\n",
|
|
" 5X\n 1 2\n 3Y\n"
|
|
);
|
|
|
|
// S3-042
|
|
runProgram("SWAP evaluates each subscript once",
|
|
"DIM SHARED c\n"
|
|
"DIM a(2)\n"
|
|
"FUNCTION N()\n"
|
|
"c = c + 1\n"
|
|
"N = c\n"
|
|
"END FUNCTION\n"
|
|
"a(1) = 10: a(2) = 20: a(0) = 99\n"
|
|
"SWAP a(N), a(0)\n"
|
|
"PRINT a(0); a(1); a(2); c\n"
|
|
"DIM x, y\n"
|
|
"x = 1: y = 2\n"
|
|
"SWAP x, y\n"
|
|
"PRINT x; y\n",
|
|
"10 99 20 1 \n2 1 \n"
|
|
);
|
|
|
|
// S2-073
|
|
runProgram("FUNCTION called as a statement",
|
|
"FUNCTION F(n)\n"
|
|
"PRINT \"F\"; n\n"
|
|
"F = n\n"
|
|
"END FUNCTION\n"
|
|
"F 3\n",
|
|
"F3 \n"
|
|
);
|
|
|
|
// S2-075
|
|
runProgram("CONST AS type converts the literal",
|
|
"CONST N AS INTEGER = 2.5\n"
|
|
"CONST M AS LONG = 3.5\n"
|
|
"CONST S AS SINGLE = 0.1\n"
|
|
"CONST B AS BOOLEAN = 5\n"
|
|
"PRINT N; M; B\n"
|
|
"PRINT S\n",
|
|
"2 4 True \n0.1 \n"
|
|
);
|
|
|
|
expectCompileError("CONST AS STRING with a number rejected",
|
|
"CONST S AS STRING = 5\n",
|
|
"Type mismatch in CONST"
|
|
);
|
|
|
|
expectCompileError("CONST AS INTEGER overflow rejected",
|
|
"CONST N AS INTEGER = 40000\n",
|
|
"Overflow in CONST"
|
|
);
|
|
|
|
// S2-076, S2-077
|
|
runProgram("Most negative INTEGER and LONG literals",
|
|
"CONST M = -2147483648\n"
|
|
"CONST H = &H80000000\n"
|
|
"PRINT M; H; -32768%; -2147483648&\n"
|
|
"DATA -2147483648, -32768%\n"
|
|
"READ a&, b%\n"
|
|
"PRINT a&; b%\n",
|
|
"-2147483648 -2147483648 -32768 -2147483648 \n-2147483648 -32768 \n"
|
|
);
|
|
|
|
// A CONST value is an expression: -&H80000000 negates the LONG
|
|
// -2147483648 as it would anywhere else, an Overflow (VB)
|
|
expectCompileError("Negated LONG minimum constant overflows",
|
|
"CONST H = -&H80000000\n",
|
|
"Error in constant expression: Overflow"
|
|
);
|
|
|
|
// S2-078
|
|
runProgram("Unquoted DATA text is read raw",
|
|
"DATA Apple, Name, Red Green, 12abc, -, Print\n"
|
|
"FOR i = 1 TO 6\n"
|
|
"READ s$\n"
|
|
"PRINT \"[\"; s$; \"]\"\n"
|
|
"NEXT\n",
|
|
"[Apple]\n[Name]\n[Red Green]\n[12abc]\n[-]\n[Print]\n"
|
|
);
|
|
|
|
// S2-081
|
|
expectCompileError("Nine array dimensions rejected",
|
|
"DIM a(1, 1, 1, 1, 1, 1, 1, 1, 1)\n",
|
|
"Too many array dimensions"
|
|
);
|
|
|
|
expectCompileError("Nine subscripts rejected",
|
|
"DIM a(1)\n"
|
|
"x = a(1, 1, 1, 1, 1, 1, 1, 1, 1)\n",
|
|
"Too many array dimensions"
|
|
);
|
|
|
|
// S2-090
|
|
expectCompileError("UBOUND dimension out of range rejected",
|
|
"DIM a(10)\n"
|
|
"PRINT UBOUND(a, 257)\n",
|
|
"UBOUND dimension must be a constant integer from 1 to 8"
|
|
);
|
|
|
|
// S2-092
|
|
compileOnly("Control array members may be keywords or methods",
|
|
"x$ = Foo(0).Name\n"
|
|
"y = Foo(0).Move(1)\n"
|
|
"Foo(1).Name = \"n\"\n"
|
|
"Me.Foo(0).Text = \"t\"\n"
|
|
"Me.Refresh\n"
|
|
);
|
|
|
|
// S2-093
|
|
runProgram("READ, INPUT # and LINE INPUT # into elements and fields",
|
|
"TYPE P\n"
|
|
"x AS INTEGER\n"
|
|
"n AS STRING\n"
|
|
"END TYPE\n"
|
|
"DIM q AS P\n"
|
|
"DIM arr(2) AS P\n"
|
|
"DIM a(3), t(2)\n"
|
|
"DATA 4, \"nm\", 6, 7, 8\n"
|
|
"READ q.x, q.n, arr(1).x, a(1), a(2)\n"
|
|
"PRINT q.x; q.n; arr(1).x; a(1); a(2)\n"
|
|
"OPEN \"dvxbasic_readelem.txt\" FOR OUTPUT AS #1\n"
|
|
"PRINT #1, 5\n"
|
|
"PRINT #1,\n"
|
|
"PRINT #1, \"z\"\n"
|
|
"CLOSE #1\n"
|
|
"OPEN \"dvxbasic_readelem.txt\" FOR INPUT AS #1\n"
|
|
"INPUT #1, t(1)\n"
|
|
"LINE INPUT #1, e$\n"
|
|
"LINE INPUT #1, arr(2).n\n"
|
|
"CLOSE #1\n"
|
|
"KILL \"dvxbasic_readelem.txt\"\n"
|
|
"PRINT t(1); \"[\"; e$; \"]\"; arr(2).n\n",
|
|
"4 nm6 7 8 \n5 []z\n"
|
|
);
|
|
|
|
// S2-096
|
|
expectCompileError("Missing END SUB rejected",
|
|
"PRINT \"x\"\n"
|
|
"SUB S\n"
|
|
"PRINT 1\n",
|
|
"Expected END SUB"
|
|
);
|
|
|
|
expectCompileError("Missing END FUNCTION rejected",
|
|
"FUNCTION F\n"
|
|
"F = 1\n",
|
|
"Expected END FUNCTION"
|
|
);
|
|
|
|
expectCompileError("Missing END TYPE rejected",
|
|
"TYPE T\n"
|
|
"x AS INTEGER\n",
|
|
"Expected END TYPE"
|
|
);
|
|
|
|
expectCompileError("Missing END DECLARE rejected",
|
|
"DECLARE LIBRARY \"x\"\n"
|
|
"DECLARE SUB F()\n",
|
|
"END DECLARE"
|
|
);
|
|
|
|
// S2-068
|
|
expectCompileError("Lexer error reported at the token start once",
|
|
"PRINT 99999999999\n",
|
|
"Line 1, Col 7: Integer literal out of range"
|
|
);
|
|
|
|
// S1-073
|
|
expectCompileError("Over-long numeric literal rejected",
|
|
"PRINT 0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000007\n",
|
|
"Numeric literal too long"
|
|
);
|
|
|
|
// S1-078
|
|
runProgram("Trailing-dot float literal",
|
|
"PRINT 1.; 2. + 1\n",
|
|
"1 3 \n"
|
|
);
|
|
|
|
// S1-088
|
|
expectCompileError("DEF FN used before its definition rejected",
|
|
"PRINT FNsq(2)\n"
|
|
"DEF FNsq(x) = x * x\n",
|
|
"must be defined before it is used"
|
|
);
|
|
|
|
// S1-087
|
|
expectCompileError("DECLARE with a different BYVAL rejected",
|
|
"DECLARE SUB S(BYVAL x AS INTEGER)\n"
|
|
"SUB S(x AS INTEGER)\n"
|
|
"END SUB\n",
|
|
"does not match its definition"
|
|
);
|
|
|
|
// S1-104
|
|
runProgram("Negated LONG minimum raised to a power",
|
|
"x& = -2147483648 ^ 1\n"
|
|
"PRINT x&\n",
|
|
"-2147483648 \n"
|
|
);
|
|
|
|
// VM coordination: bare RND is RND(1) (a negative argument reseeds)
|
|
runProgram("Bare RND gives the next number",
|
|
"a = RND\n"
|
|
"b = RND\n"
|
|
"c = RND()\n"
|
|
"PRINT a <> b; b <> c; a < 1\n",
|
|
"True True True \n"
|
|
);
|
|
|
|
// MID$ statement without a length replaces as much as fits
|
|
runProgram("MID$ statement with the length omitted",
|
|
"s$ = \"abcdef\"\n"
|
|
"MID$(s$, 2) = \"XY\"\n"
|
|
"PRINT s$\n"
|
|
"MID$(s$, 4, 1) = \"QQ\"\n"
|
|
"PRINT s$\n",
|
|
"aXYdef\naXYQef\n"
|
|
);
|
|
|
|
// An INTEGER/LONG FOR counter stays whole: limit and STEP convert,
|
|
// a constant fractional STEP is rejected
|
|
expectCompileError("Fractional STEP for an INTEGER counter rejected",
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 1 TO 2 STEP 0.5\n"
|
|
"NEXT\n",
|
|
"FOR STEP must be a whole number"
|
|
);
|
|
|
|
runProgram("Computed FOR STEP rounds to an INTEGER/LONG counter",
|
|
"DIM k AS INTEGER\n"
|
|
"st = 1.6\n"
|
|
"FOR k = 1 TO 3 STEP st\n"
|
|
"PRINT k;\n"
|
|
"NEXT\n"
|
|
"PRINT\n"
|
|
"FOR k = 1 TO 2.6\n"
|
|
"PRINT k;\n"
|
|
"NEXT\n"
|
|
"PRINT\n"
|
|
"DIM l AS LONG\n"
|
|
"FOR l = 1 TO 3 STEP -1.5 + 2.5\n"
|
|
"PRINT l;\n"
|
|
"NEXT\n"
|
|
"PRINT\n",
|
|
"1 3 \n1 2 \n1 2 3 \n"
|
|
);
|
|
|
|
// RESUME NEXT after an error in a CASE test or an ON selector keeps the
|
|
// eval stack balanced (OP_STMT per CASE clause, selector temporary);
|
|
// the failed CASE test counts as false, so the next CASE is tried.
|
|
runProgram("RESUME NEXT from a CASE test and an ON selector",
|
|
"ON ERROR GOTO h\n"
|
|
"z = 0\n"
|
|
"x = 2\n"
|
|
"SELECT CASE x\n"
|
|
"CASE 1 / z\n"
|
|
" PRINT \"one\"\n"
|
|
"CASE 2\n"
|
|
" PRINT \"two\"\n"
|
|
"END SELECT\n"
|
|
"ON 1 / z GOTO l1, l2\n"
|
|
"PRINT \"after on\"\n"
|
|
"END\n"
|
|
"l1:\n"
|
|
"PRINT \"l1\"\n"
|
|
"END\n"
|
|
"l2:\n"
|
|
"PRINT \"l2\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"err11 \ntwo\nerr11 \nafter on\n"
|
|
);
|
|
|
|
// Compiler temporaries are reused per statement (S2-071): 600 element
|
|
// SWAPs need a handful of temporaries, not one global slot each.
|
|
char *src = (char *)malloc(TEST_LIMIT_SRC_CAP);
|
|
int32_t n = 0;
|
|
|
|
if (src == NULL) {
|
|
printf("FAIL: temporaries source buffer\n");
|
|
gFailCount++;
|
|
return;
|
|
}
|
|
|
|
n += snprintf(src + n, TEST_LIMIT_SRC_CAP - n, "DIM a(2)\na(1) = 1\n");
|
|
|
|
for (int32_t i = 0; i < TEST_SWAP_LINES; i++) {
|
|
n += snprintf(src + n, TEST_LIMIT_SRC_CAP - n, "SWAP a(1), a(2)\n");
|
|
}
|
|
|
|
snprintf(src + n, TEST_LIMIT_SRC_CAP - n, "PRINT a(1); a(2)\n");
|
|
runProgram("Compiler temporaries are reused", src, "1 0 \n");
|
|
free(src);
|
|
|
|
// DECLARE LIBRARY arguments arrive typed as declared (contract C2)
|
|
runExternProgram("Extern arguments converted to the declared types",
|
|
"DECLARE LIBRARY \"x\"\n"
|
|
" DECLARE SUB F(BYVAL a AS INTEGER, BYVAL b AS DOUBLE, BYVAL c AS STRING, BYVAL d AS SINGLE, BYVAL e AS LONG, BYVAL f AS BOOLEAN)\n"
|
|
" DECLARE SUB G(OPTIONAL BYVAL a AS SINGLE)\n"
|
|
"END DECLARE\n"
|
|
"F 1.4, 2, 3, 4, 5.5, 7\n"
|
|
"G\n",
|
|
"F(I,D,$,S,L,B) G(S)"
|
|
);
|
|
|
|
// BINARY STRING parameters and results reach the host flagged
|
|
runExternProgram("Extern BINARY STRING parameters and result flagged",
|
|
"DECLARE LIBRARY \"x\"\n"
|
|
" DECLARE FUNCTION H$(BYVAL a AS BINARY STRING, BYVAL b AS LONG, BYVAL c AS STRING, BYVAL d AS BINARY STRING) AS BINARY STRING\n"
|
|
" DECLARE FUNCTION K(BYVAL a AS STRING) AS BINARY STRING\n"
|
|
"END DECLARE\n"
|
|
"s$ = H$(\"a\" + CHR$(0), 2, \"c\", 4)\n"
|
|
"s$ = K(\"z\")\n",
|
|
"H(b,L,$,b)b K($)b"
|
|
);
|
|
}
|
|
|
|
|
|
// Compiler hard limits that need generated sources: constant pool
|
|
// overflow, global and local slot tables; and a module past 64 KB of
|
|
// code (no limit there: jumps, calls, FOR, GOSUB and ON ERROR all span it).
|
|
static void testCompilerLimits(void) {
|
|
char *src = (char *)malloc(TEST_LIMIT_SRC_CAP);
|
|
|
|
if (src == NULL) {
|
|
printf("FAIL: limits source buffer\n");
|
|
gFailCount++;
|
|
return;
|
|
}
|
|
|
|
int32_t len = 0;
|
|
|
|
// One more distinct string constant than the pool can index.
|
|
for (int32_t i = 0; i < TEST_LIMIT_CONSTS; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "A$ = \"c%d\"\n", (int)i);
|
|
}
|
|
expectCompileError("Constant pool overflow rejected", src, "Too many string constants");
|
|
|
|
// More than 64 KB of code: an IF body and a FOR body wider than a
|
|
// 16-bit jump, then a GOSUB, a SUB call and an ON ERROR handler whose
|
|
// targets lie past 64 KB.
|
|
len = snprintf(src, TEST_LIMIT_SRC_CAP, "DIM z AS INTEGER\nL = 0\nON ERROR GOTO Handler\nIF z = 0 THEN\n");
|
|
for (int32_t i = 0; i < TEST_LIMIT_JUMPBODY; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "L = L + 1\n");
|
|
}
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "END IF\nFOR i = 1 TO 2\n");
|
|
for (int32_t i = 0; i < TEST_LIMIT_FORBODY; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "L = L + 1\n");
|
|
}
|
|
snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "NEXT\nGOSUB Far\nFarSub 5\nERROR 5\nPRINT L\nEND\nHandler:\nPRINT \"handled\"; ERR\nRESUME NEXT\nFar:\nL = L + %d\nRETURN\nSUB FarSub(n)\nPRINT \"far\"; n\nEND SUB\n", (int32_t)TEST_LIMIT_GOSUB_ADD);
|
|
|
|
char expected[TEST_LIMIT_EXPECT_LEN];
|
|
|
|
snprintf(expected, sizeof(expected), "far5 \nhandled5 \n%d \n", (int32_t)(TEST_LIMIT_JUMPBODY + 2 * TEST_LIMIT_FORBODY + TEST_LIMIT_GOSUB_ADD));
|
|
runProgram("Module past 64 KB runs", src, expected);
|
|
|
|
// More module-level variables than the VM has global slots.
|
|
len = 0;
|
|
for (int32_t i = 0; i < TEST_LIMIT_GLOBALS; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "DIM v%d AS INTEGER\n", (int)i);
|
|
}
|
|
expectCompileError("Too many globals rejected", src, "Too many module-level variables");
|
|
|
|
// More member variables or form variables than their 16-bit operands
|
|
// address.
|
|
len = snprintf(src, TEST_LIMIT_SRC_CAP, "BEGINCLASS \"Big\"\n");
|
|
for (int32_t i = 0; i <= BAS_VM_MAX_MEMBER_VARS; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "DIM v%d AS INTEGER\n", (int)i);
|
|
}
|
|
snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "ENDCLASS\n");
|
|
expectCompileError("Too many member variables rejected", src, "Too many member variables in Big");
|
|
|
|
len = snprintf(src, TEST_LIMIT_SRC_CAP, "BEGINFORM \"F1\"\n");
|
|
for (int32_t i = 0; i <= BAS_VM_MAX_MEMBER_VARS; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "DIM v%d AS INTEGER\n", (int)i);
|
|
}
|
|
snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "ENDFORM\n");
|
|
expectCompileError("Too many form variables rejected", src, "Too many form-level variables");
|
|
|
|
// More locals than a call frame holds fails at compile time, not with
|
|
// a runtime "Invalid local variable index".
|
|
len = snprintf(src, TEST_LIMIT_SRC_CAP, "SUB S\n");
|
|
for (int32_t i = 0; i < TEST_LIMIT_LOCALS; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "DIM v%d AS INTEGER\n", (int)i);
|
|
}
|
|
snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "END SUB\nS\n");
|
|
expectCompileError("Too many locals rejected", src, "Too many local variables in S");
|
|
|
|
// A frame just under the limit whose statements take hidden
|
|
// temporaries: the SWAP's element temps must fit too.
|
|
len = snprintf(src, TEST_LIMIT_SRC_CAP, "SUB S\n");
|
|
for (int32_t i = 0; i < BAS_VM_MAX_LOCALS - 1; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "DIM v%d AS INTEGER\n", (int)i);
|
|
}
|
|
snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "SWAP v0, v1\nDIM b(2, 2)\nSWAP b(1, 1), b(2, 2)\nEND SUB\nS\n");
|
|
expectCompileError("Temporaries past the frame rejected", src, "Too many local variables in S");
|
|
|
|
// READ into many array elements reuses each target's temporaries, so
|
|
// the SUB stays well inside its frame.
|
|
len = snprintf(src, TEST_LIMIT_SRC_CAP, "S\nSUB S\nDIM a(%d) AS INTEGER\nREAD a(1)", (int32_t)TEST_LIMIT_READ_ELEMS);
|
|
for (int32_t i = 2; i <= TEST_LIMIT_READ_ELEMS; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, ", a(%d)", (int)i);
|
|
}
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "\nPRINT a(1); a(%d)\nEND SUB\nDATA 1", (int32_t)TEST_LIMIT_READ_ELEMS);
|
|
for (int32_t i = 2; i <= TEST_LIMIT_READ_ELEMS; i++) {
|
|
len += snprintf(src + len, TEST_LIMIT_SRC_CAP - len, ", %d", (int)i);
|
|
}
|
|
snprintf(src + len, TEST_LIMIT_SRC_CAP - len, "\n");
|
|
runProgram("READ many elements in a SUB", src, "1 40 \n");
|
|
|
|
free(src);
|
|
}
|
|
|
|
|
|
// The keyword enumeration API used by the IDE's syntax highlighter.
|
|
// Phase 3: constant expressions, ENUM and ParamArray.
|
|
// Phase 4: the program screen (console text, SCREEN 12 / 13 graphics,
|
|
// INKEY$ / INPUT from typed keys, PALETTE, VIEW / WINDOW, FULLSCREEN).
|
|
static void testConsoleGraphics(void) {
|
|
CaptureT cap;
|
|
TestKeysT keys;
|
|
char row[TEST_ROW_TEXT_LEN];
|
|
BasVmT *vm = NULL;
|
|
|
|
basGfxSetFont(font8x16);
|
|
|
|
// PRINT goes to the host until the program uses the screen
|
|
vm = screenRun("Console: PRINT moves to the screen after CLS",
|
|
"PRINT \"before\"\n"
|
|
"CLS\n"
|
|
"PRINT \"HI\"; 12\n"
|
|
"PRINT \"A\"; TAB(10); \"B\"; SPC(2); \"C\"\n"
|
|
"PRINT \"X\", \"Y\"\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("host got only the first PRINT", strcmp(cap.buf, "before\n") == 0);
|
|
checkTrue("screen made in SCREEN 0 80x25", scr->mode == BAS_SCREEN_MODE_TEXT && scr->cols == 80 && scr->rows == 25 && scr->width == 640 && scr->height == 400);
|
|
rowText(scr, 0, row);
|
|
checkTrue("row 1 text", strcmp(row, "HI12") == 0);
|
|
rowText(scr, 1, row);
|
|
checkTrue("TAB and SPC", strcmp(row, "A B C") == 0);
|
|
rowText(scr, 2, row);
|
|
checkTrue("comma zones", strcmp(row, "X Y") == 0);
|
|
checkTrue("cursor on row 4", scr->row == 3 && scr->col == 0);
|
|
|
|
// 'H' at (0,0): some pixels in the foreground (7), background 0
|
|
int32_t on = 0;
|
|
|
|
for (int32_t y = 0; y < BAS_GFX_GLYPH_TALL; y++) {
|
|
for (int32_t x = 0; x < BAS_GFX_GLYPH_W; x++) {
|
|
on += fbAt(scr, x, y) == 7;
|
|
}
|
|
}
|
|
|
|
checkTrue("glyph drawn in colour 7", on > 0 && fbAt(scr, 0, 0) == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("Console: LOCATE, COLOR, CSRLIN, POS, SCREEN()",
|
|
"LOCATE 5, 10\n"
|
|
"COLOR 14, 1\n"
|
|
"PRINT \"Z\";\n"
|
|
"r = CSRLIN\n"
|
|
"c = POS(0)\n"
|
|
"ch = SCREEN(5, 10)\n"
|
|
"at = SCREEN(5, 10, 1)\n"
|
|
"LOCATE , , 1\n"
|
|
"LOCATE 25, 80\n"
|
|
"PRINT \"E\";\n"
|
|
"c2 = POS(0)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("character at row 5 col 10", scr->chars[4 * 80 + 9] == 'Z');
|
|
checkTrue("attribute yellow on blue", scr->attrs[4 * 80 + 9] == (14 | 1 << 4));
|
|
checkTrue("CSRLIN", globalNum(vm, "r") == 5);
|
|
checkTrue("POS after Z", globalNum(vm, "c") == 11);
|
|
checkTrue("SCREEN() char", globalNum(vm, "ch") == 'Z');
|
|
checkTrue("SCREEN() colour", globalNum(vm, "at") == (14 | 1 << 4));
|
|
checkTrue("cursor visible", scr->cursorVisible && scr->cursorDrawn);
|
|
checkTrue("last cell, no scroll yet", scr->chars[24 * 80 + 79] == 'E' && scr->row == 24 && globalNum(vm, "c2") == 80);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("Console: scrolling and CLS colours",
|
|
"COLOR 7, 4\n"
|
|
"CLS\n"
|
|
"FOR i = 1 TO 26\n"
|
|
" PRINT i\n"
|
|
"NEXT i\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
rowText(scr, 0, row);
|
|
checkTrue("scrolled two lines", strcmp(row, "3") == 0);
|
|
rowText(scr, 23, row);
|
|
checkTrue("last number", strcmp(row, "26") == 0);
|
|
checkTrue("background 4 kept", fbAt(scr, 600, 5) == 4 && fbAt(scr, 600, 399) == 4);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// INKEY$: a character, an extended key, then nothing
|
|
memset(&keys, 0, sizeof(keys));
|
|
keys.keys[keys.count++] = 'a';
|
|
keys.keys[keys.count++] = BAS_SCREEN_KEY_EXT | 0x48;
|
|
vm = screenRun("Console: INKEY$",
|
|
"CLS\n"
|
|
"DoEvents\n"
|
|
"a$ = INKEY$\n"
|
|
"b$ = INKEY$\n"
|
|
"c$ = INKEY$\n"
|
|
"n1 = ASC(a$)\n"
|
|
"n2 = LEN(b$)\n"
|
|
"n3 = ASC(MID$(b$, 2))\n"
|
|
"n4 = ASC(b$)\n"
|
|
"n5 = LEN(c$)\n",
|
|
&cap, &keys);
|
|
|
|
if (vm) {
|
|
checkTrue("INKEY$ character", globalNum(vm, "n1") == 'a');
|
|
checkTrue("INKEY$ extended = CHR$(0) + scan", globalNum(vm, "n2") == 2 && globalNum(vm, "n3") == 0x48 && globalNum(vm, "n4") == 0);
|
|
checkTrue("INKEY$ empty", globalNum(vm, "n5") == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// INPUT and LINE INPUT at the console, with Backspace
|
|
memset(&keys, 0, sizeof(keys));
|
|
keys.keys[keys.count++] = '4';
|
|
keys.keys[keys.count++] = '3';
|
|
keys.keys[keys.count++] = 8;
|
|
keys.keys[keys.count++] = '2';
|
|
keys.keys[keys.count++] = 13;
|
|
keys.keys[keys.count++] = 'h';
|
|
keys.keys[keys.count++] = ',';
|
|
keys.keys[keys.count++] = 'i';
|
|
keys.keys[keys.count++] = 13;
|
|
vm = screenRun("Console: INPUT and LINE INPUT",
|
|
"CLS\n"
|
|
"INPUT \"N\"; n\n"
|
|
"LINE INPUT \"Say: \"; t$\n"
|
|
"PRINT n * 2; t$\n",
|
|
&cap, &keys);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("INPUT value", globalNum(vm, "n") == 42);
|
|
rowText(scr, 0, row);
|
|
checkTrue("INPUT echo", strcmp(row, "N? 42") == 0);
|
|
rowText(scr, 1, row);
|
|
checkTrue("LINE INPUT echo", strcmp(row, "Say: h,i") == 0);
|
|
rowText(scr, 2, row);
|
|
checkTrue("result line", strcmp(row, "84 h,i") == 0);
|
|
checkTrue("cursor hidden again", !scr->cursorDrawn && !scr->inputActive);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 13: PSET, PRESET, LINE, B, BF, STEP, POINT",
|
|
"SCREEN 13\n"
|
|
"PSET (10, 10), 4\n"
|
|
"PSET STEP(1, 1)\n"
|
|
"PRESET (12, 12)\n"
|
|
"LINE (0, 20)-(9, 20), 2\n"
|
|
"LINE -STEP(0, 5), 3\n"
|
|
"LINE (30, 30)-(40, 40), 5, B\n"
|
|
"LINE (50, 30)-(60, 40), 6, BF\n"
|
|
"LINE (70, 30)-(85, 30), 7, , &HFF00\n"
|
|
"p = POINT(10, 10)\n"
|
|
"q = POINT(500, 10)\n"
|
|
"lx = POINT(0)\n"
|
|
"ly = POINT(1)\n"
|
|
"COLOR 9\n"
|
|
"PSET (100, 100)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("SCREEN 13 is 320x200", scr->mode == BAS_SCREEN_MODE_VGA256 && scr->width == 320 && scr->height == 200 && scr->cols == 40);
|
|
checkTrue("PSET colour", fbAt(scr, 10, 10) == 4);
|
|
checkTrue("PSET STEP in foreground 15", fbAt(scr, 11, 11) == 15);
|
|
checkTrue("PRESET background", fbAt(scr, 12, 12) == 0);
|
|
checkTrue("LINE horizontal", fbAt(scr, 0, 20) == 2 && fbAt(scr, 8, 20) == 2 && fbAt(scr, 10, 20) == 0);
|
|
checkTrue("LINE -STEP from the last point", fbAt(scr, 9, 25) == 3 && fbAt(scr, 9, 23) == 3);
|
|
checkTrue("LINE B outline", fbAt(scr, 30, 30) == 5 && fbAt(scr, 40, 40) == 5 && fbAt(scr, 30, 35) == 5 && fbAt(scr, 35, 35) == 0);
|
|
checkTrue("LINE BF filled", fbAt(scr, 55, 35) == 6 && fbAt(scr, 60, 40) == 6);
|
|
checkTrue("LINE style", fbAt(scr, 70, 30) == 7 && fbAt(scr, 77, 30) == 7 && fbAt(scr, 78, 30) == 0 && fbAt(scr, 85, 30) == 0);
|
|
checkTrue("POINT", globalNum(vm, "p") == 4 && globalNum(vm, "q") == -1);
|
|
checkTrue("POINT(0/1) = last point", globalNum(vm, "lx") == 85 && globalNum(vm, "ly") == 30);
|
|
checkTrue("COLOR sets the foreground", fbAt(scr, 100, 100) == 9);
|
|
checkTrue("default VGA palette", scr->palette[32 * 3 + 2] == 255 && scr->palette[32 * 3] == 0 && scr->palette[40 * 3] == 255 && scr->palette[40 * 3 + 1] == 0 && scr->palette[31 * 3] == 255 && scr->palette[248 * 3 + 1] == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 13: CIRCLE, arcs, aspect, PAINT",
|
|
"SCREEN 13\n"
|
|
"CIRCLE (160, 100), 40, 5, , , 1\n"
|
|
"PAINT (160, 100), 6, 5\n"
|
|
"CIRCLE (60, 60), 20, 3\n"
|
|
"CIRCLE (60, 150), 20, 4, 0, 3.14159\n"
|
|
"CIRCLE (260, 150), 20, 2, -0.0001, -1.5708\n"
|
|
"cx = POINT(2)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("circle outline", fbAt(scr, 200, 100) == 5 && fbAt(scr, 120, 100) == 5 && fbAt(scr, 160, 60) == 5 && fbAt(scr, 160, 140) == 5);
|
|
checkTrue("PAINT inside", fbAt(scr, 160, 100) == 6 && fbAt(scr, 190, 100) == 6);
|
|
checkTrue("PAINT stops at the border", fbAt(scr, 205, 100) == 0 && fbAt(scr, 0, 0) == 0);
|
|
checkTrue("default aspect: round on 4:3", fbAt(scr, 80, 60) == 3 && fbAt(scr, 60, 60 - 17) == 3 && fbAt(scr, 60, 40) == 0);
|
|
checkTrue("upper half arc only", fbAt(scr, 60, 150 - 17) == 4 && fbAt(scr, 60, 150 + 17) == 0);
|
|
checkTrue("radius lines of negative angles", fbAt(scr, 270, 150) == 2 && fbAt(scr, 260, 145) == 2);
|
|
checkTrue("CIRCLE sets the last point", globalNum(vm, "cx") == 260);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 13: DRAW",
|
|
"SCREEN 13\n"
|
|
"DRAW \"C2 BM100,100 R10 D10 L10 U10\"\n"
|
|
"DRAW \"BM200,50 C3 E5 F5 NG3 H2\"\n"
|
|
"DRAW \"BM50,150 S8 C4 R5\"\n"
|
|
"DRAW \"BM20,180 TA90 C5 R10\"\n"
|
|
"DRAW \"BM10,10 A2 C6 R4 P7,6\"\n"
|
|
"DRAW \"BM150,150 S4 TA0 C1 M+10,+0\"\n"
|
|
"px = POINT(0)\n"
|
|
"py = POINT(1)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("DRAW square", fbAt(scr, 105, 100) == 2 && fbAt(scr, 110, 105) == 2 && fbAt(scr, 105, 110) == 2 && fbAt(scr, 100, 105) == 2 && fbAt(scr, 105, 105) == 0);
|
|
checkTrue("DRAW diagonals", fbAt(scr, 205, 45) == 3 && fbAt(scr, 210, 50) == 3);
|
|
checkTrue("DRAW N returns", fbAt(scr, 207, 53) == 3 && fbAt(scr, 208, 48) == 3);
|
|
checkTrue("DRAW S8 doubles", fbAt(scr, 60, 150) == 4 && fbAt(scr, 61, 150) == 0);
|
|
checkTrue("DRAW TA90 turns R upwards", fbAt(scr, 20, 170) == 5 && fbAt(scr, 30, 180) == 0);
|
|
checkTrue("DRAW A2 turns R left", fbAt(scr, 6, 10) == 6);
|
|
checkTrue("DRAW relative M and the pen position", fbAt(scr, 160, 150) == 1 && globalNum(vm, "px") == 160 && globalNum(vm, "py") == 150);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("PALETTE, PALETTE USING, SCREEN 12",
|
|
"SCREEN 12\n"
|
|
"PALETTE 1, &H3F0000\n"
|
|
"b1 = 1\n"
|
|
"DIM pal(15) AS LONG\n"
|
|
"FOR i = 0 TO 15\n"
|
|
" pal(i) = -1\n"
|
|
"NEXT i\n"
|
|
"pal(2) = 63\n"
|
|
"PALETTE USING pal\n"
|
|
"CIRCLE (320, 240), 100, 2\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("SCREEN 12 is 640x480, 80x30", scr->mode == BAS_SCREEN_MODE_VGA16 && scr->width == 640 && scr->height == 480 && scr->rows == 30);
|
|
checkTrue("PALETTE blue", scr->palette[3] == 0 && scr->palette[5] == 255 && scr->paletteChanged);
|
|
checkTrue("PALETTE USING red, -1 keeps", scr->palette[6] == 255 && scr->palette[7] == 0 && scr->palette[5] == 255);
|
|
checkTrue("SCREEN 12 circle is round (aspect 1)", fbAt(scr, 420, 240) == 2 && fbAt(scr, 320, 140) == 2);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("PALETTE reset, SCREEN 0 EGA numbers",
|
|
"PALETTE 1, 63\n"
|
|
"w = 1\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("EGA 63 is white", vm->screen->palette[3] == 255 && vm->screen->palette[4] == 255 && vm->screen->palette[5] == 255);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("VIEW and WINDOW",
|
|
"SCREEN 13\n"
|
|
"VIEW (10, 10)-(50, 50), 1, 2\n"
|
|
"PSET (0, 0), 7\n"
|
|
"PSET (100, 100), 7\n"
|
|
"vx = POINT(0, 0)\n"
|
|
"VIEW SCREEN (100, 100)-(150, 150)\n"
|
|
"PSET (100, 100), 8\n"
|
|
"PSET (10, 10), 8\n"
|
|
"VIEW\n"
|
|
"WINDOW (0, 0)-(100, 100)\n"
|
|
"PSET (0, 0), 9\n"
|
|
"PSET (100, 100), 9\n"
|
|
"WINDOW SCREEN (0, 0)-(100, 100)\n"
|
|
"PSET (0, 0), 10\n"
|
|
"WINDOW\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("VIEW fill and border", fbAt(scr, 30, 30) == 1 && fbAt(scr, 9, 9) == 2 && fbAt(scr, 51, 30) == 2);
|
|
checkTrue("VIEW origin and clipping", fbAt(scr, 10, 10) == 7 && fbAt(scr, 110, 110) == 0);
|
|
checkTrue("VIEW POINT is view-relative", globalNum(vm, "vx") == 7);
|
|
checkTrue("VIEW SCREEN absolute", fbAt(scr, 100, 100) == 8 && fbAt(scr, 10, 10) == 7);
|
|
checkTrue("WINDOW y up", fbAt(scr, 0, 199) == 9 && fbAt(scr, 319, 0) == 9);
|
|
checkTrue("WINDOW SCREEN y down", fbAt(scr, 0, 0) == 10);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("CLS 1 clears only the view; WIDTH; FULLSCREEN without a host",
|
|
"SCREEN 13\n"
|
|
"LINE (0, 0)-(319, 199), 4, BF\n"
|
|
"VIEW (10, 10)-(20, 20)\n"
|
|
"CLS\n"
|
|
"VIEW\n"
|
|
"SCREEN 0\n"
|
|
"WIDTH 80, 50\n"
|
|
"FULLSCREEN\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("WIDTH 80, 50", scr->mode == BAS_SCREEN_MODE_TEXT && scr->rows == 50 && scr->cellH == BAS_GFX_GLYPH_SHORT);
|
|
checkTrue("FULLSCREEN flag", scr->fullScreen);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("CLS in a view",
|
|
"SCREEN 13\n"
|
|
"LINE (0, 0)-(319, 199), 4, BF\n"
|
|
"VIEW (10, 10)-(20, 20)\n"
|
|
"CLS\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("CLS cleared the view only", fbAt(vm->screen, 15, 15) == 0 && fbAt(vm->screen, 5, 5) == 4);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("Errors: graphics in SCREEN 0, bad colours, bad WIDTH",
|
|
"ON ERROR GOTO h\n"
|
|
"PSET (1, 1)\n"
|
|
"SCREEN 13\n"
|
|
"COLOR 300\n"
|
|
"COLOR 1, 2\n"
|
|
"WIDTH 80\n"
|
|
"SCREEN 4\n"
|
|
"DRAW \"Q\"\n"
|
|
"PALETTE 1, &H400000\n"
|
|
"LOCATE 26\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"n = n + 1\n"
|
|
"IF ERR <> 5 THEN bad = bad + 1\n"
|
|
"RESUME NEXT\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("eight Illegal function calls", globalNum(vm, "n") == 8 && globalNum(vm, "bad") == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// The program's own names win; LINE syntax errors
|
|
runProgram("A variable named COLOR and a SUB named Cls",
|
|
"color = 5\n"
|
|
"PRINT color\n"
|
|
"Cls 3\n"
|
|
"SUB Cls (n)\n"
|
|
" PRINT \"mine\"; n\n"
|
|
"END SUB\n",
|
|
"5 \nmine3 \n"
|
|
);
|
|
|
|
expectCompileError("LINE needs B or BF",
|
|
"SCREEN 13\nLINE (0, 0)-(1, 1), 2, X\n",
|
|
"B or BF"
|
|
);
|
|
|
|
expectCompileError("VIEW PRINT needs TO",
|
|
"VIEW PRINT 1, 5\n",
|
|
"TO"
|
|
);
|
|
|
|
expectCompileError("PALETTE USING needs an array",
|
|
"x = 1\nPALETTE USING x\n",
|
|
"array name"
|
|
);
|
|
|
|
compileOnly("Drawing methods compile on objects",
|
|
"Picture1.Line (0, 0)-(10, 10), RGB(255, 0, 0), BF\n"
|
|
"Picture1.Circle STEP(5, 5), 10\n"
|
|
"Me.PSet (1, 2)\n"
|
|
"Picture1.Print \"a\"; 1, TAB(5); SPC(2); \"b\";\n"
|
|
"Picture1.Cls\n"
|
|
"x = Picture1.Point(1, 1)\n"
|
|
);
|
|
}
|
|
|
|
|
|
static void testConstEnumParamArray(void) {
|
|
// ---- CONST with constant expressions ----
|
|
|
|
runProgram("CONST arithmetic and earlier constants",
|
|
"CONST A = 2 + 3 * 4\n"
|
|
"CONST B = (A - 4) \\ 3\n"
|
|
"CONST C = A MOD 5, D = -A\n"
|
|
"CONST E = 2 ^ 10\n"
|
|
"CONST F = 7 / 2\n"
|
|
"PRINT A; B; C; D; E; F\n",
|
|
"14 3 4 -14 1024 3.5 \n"
|
|
);
|
|
|
|
runProgram("CONST comparison and logic",
|
|
"CONST T = 3 > 2\n"
|
|
"CONST U = NOT T\n"
|
|
"CONST M = &HF0 AND &H3C OR 1\n"
|
|
"CONST X = 5 XOR 3\n"
|
|
"CONST Q = (1 = 1) AND (2 <> 3)\n"
|
|
"PRINT T; U; M; X; Q\n",
|
|
// NOT and AND of Booleans give Booleans here as they do at run time
|
|
"True False 49 6 True \n"
|
|
);
|
|
|
|
runProgram("CONST string expressions and pure built-ins",
|
|
"CONST P = \"DVX\"\n"
|
|
"CONST S = P & \" \" + \"BASIC\"\n"
|
|
"CONST L = LEN(S)\n"
|
|
"CONST CR = CHR$(13)\n"
|
|
"CONST H = HEX$(255) & LCASE$(\"AB\") & UCASE$(LEFT$(\"xyz\", 2))\n"
|
|
"CONST K = ASC(\"A\") + ABS(-2) + INT(2.7) + FIX(-2.7) + SGN(-9)\n"
|
|
"CONST R = RGB(1, 2, 3)\n"
|
|
"CONST G = GetGreen(R)\n"
|
|
"CONST M2 = MID$(S, 5), T2 = TRIM$(\" a \") & STRING$(3, \"-\")\n"
|
|
"CONST I = IIf(L > 5, \"long\", \"short\")\n"
|
|
"PRINT S; L; ASC(CR); H; K\n"
|
|
"PRINT R; G; M2; T2; I\n",
|
|
"DVX BASIC9 13 FFabXY66 \n197121 2 BASICa---long\n"
|
|
);
|
|
|
|
runProgram("CONST holding NUL characters",
|
|
"CONST Z = \"a\" & CHR$(0) & \"b\"\n"
|
|
"PRINT LEN(Z); ASC(MID$(Z, 2, 1)); RIGHT$(Z, 1)\n",
|
|
"3 0 b\n"
|
|
);
|
|
|
|
runProgram("CONST AS type converts the expression",
|
|
"CONST N AS INTEGER = 10 / 4\n"
|
|
"CONST D AS DOUBLE = 1 + 2\n"
|
|
"CONST B AS BOOLEAN = 3 - 3\n"
|
|
"CONST S AS STRING = \"a\" & \"b\"\n"
|
|
"CONST DT AS DATE = DateSerial(2026, 9, 29)\n"
|
|
"PRINT N; D; B; S; Year(DT)\n",
|
|
"2 3 False ab2026 \n"
|
|
);
|
|
|
|
runProgram("CONST in a SUB and in SELECT CASE",
|
|
"CONST LO = 1, HI = LO + 9\n"
|
|
"SUB Disp(v)\n"
|
|
" CONST MSG = \"v=\" & \"\"\n"
|
|
" SELECT CASE v\n"
|
|
" CASE LO TO HI: PRINT MSG; v\n"
|
|
" CASE ELSE: PRINT \"out\"\n"
|
|
" END SELECT\n"
|
|
"END SUB\n"
|
|
"Disp 5\n"
|
|
"Disp HI + 1\n",
|
|
"v=5 \nout\n"
|
|
);
|
|
|
|
runProgram("OPTION COMPARE TEXT applies to constant comparisons",
|
|
"OPTION COMPARE TEXT\n"
|
|
"CONST SAME = \"abc\" = \"ABC\"\n"
|
|
"PRINT SAME\n",
|
|
"True \n"
|
|
);
|
|
|
|
expectCompileError("CONST of a FUNCTION call rejected",
|
|
"FUNCTION F()\nF = 1\nEND FUNCTION\n"
|
|
"CONST A = F()\n",
|
|
"Constant expression required: 'F' is not a constant"
|
|
);
|
|
|
|
expectCompileError("CONST of an undeclared name rejected",
|
|
"CONST A = Nope + 1\n",
|
|
"Constant expression required: 'Nope' is not a constant"
|
|
);
|
|
|
|
expectCompileError("CONST of a clock built-in rejected",
|
|
"CONST A = TIMER\n",
|
|
"Constant expression required"
|
|
);
|
|
|
|
expectCompileError("CONST of RND rejected",
|
|
"CONST A = RND(1)\n",
|
|
"Constant expression required"
|
|
);
|
|
|
|
expectCompileError("CONST of NOW rejected",
|
|
"CONST A = Now\n",
|
|
"Constant expression required"
|
|
);
|
|
|
|
expectCompileError("CONST referring to itself rejected",
|
|
"CONST A = A + 1\n",
|
|
"'A' is not a constant"
|
|
);
|
|
|
|
expectCompileError("CONST division by zero reported",
|
|
"CONST A = 1 \\ 0\n",
|
|
"Error in constant expression: Division by zero"
|
|
);
|
|
|
|
expectCompileError("CONST INTEGER overflow reported",
|
|
"CONST A AS INTEGER = 200 * 200\n",
|
|
"Overflow in CONST"
|
|
);
|
|
|
|
expectCompileError("CONST string too long rejected",
|
|
"CONST A = STRING$(300, \"x\")\n",
|
|
"Constant string longer than"
|
|
);
|
|
|
|
expectCompileError("CONST string into a number rejected",
|
|
"CONST A AS LONG = \"1\" & \"2\"\n",
|
|
"Type mismatch in CONST"
|
|
);
|
|
|
|
expectCompileError("CONST list duplicate rejected",
|
|
"CONST A = 1, A = 2\n",
|
|
"Duplicate constant"
|
|
);
|
|
|
|
// ---- ENUM ----
|
|
|
|
runProgram("ENUM auto-numbering, explicit values and continuation",
|
|
"ENUM Color\n"
|
|
" Red\n"
|
|
" Green\n"
|
|
" Blue = 10\n"
|
|
" Cyan\n"
|
|
" Dark = -5\n"
|
|
" Darker\n"
|
|
"END ENUM\n"
|
|
"PRINT Red; Green; Blue; Cyan; Dark; Darker\n"
|
|
"PRINT Color.Red; Color.Cyan\n",
|
|
"0 1 10 11 -5 -4 \n0 11 \n"
|
|
);
|
|
|
|
runProgram("ENUM values from constant expressions",
|
|
"CONST START0 = 100\n"
|
|
"ENUM Flags\n"
|
|
" fNone = 0\n"
|
|
" fA = 1\n"
|
|
" fB = fA * 2\n"
|
|
" fC = Flags.fB * 2\n"
|
|
" fAll = fA OR fB OR fC\n"
|
|
" fBase = START0 + 1\n"
|
|
"END ENUM\n"
|
|
"PRINT fB; fC; fAll; fBase\n",
|
|
"2 4 7 101 \n"
|
|
);
|
|
|
|
runProgram("ENUM as a type: DIM, parameters, returns, TYPE fields",
|
|
"ENUM Shape\n"
|
|
" Circle = 1\n"
|
|
" Square\n"
|
|
"END ENUM\n"
|
|
"TYPE Item\n"
|
|
" kind AS Shape\n"
|
|
" size AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"FUNCTION Other(s AS Shape) AS Shape\n"
|
|
" IF s = Circle THEN Other = Square ELSE Other = Circle\n"
|
|
"END FUNCTION\n"
|
|
"DIM s AS Shape\n"
|
|
"DIM it AS Item\n"
|
|
"s = 2.6\n"
|
|
"it.kind = Other(s)\n"
|
|
"PRINT s; it.kind; Other(Shape.Circle)\n",
|
|
"3 1 2 \n"
|
|
);
|
|
|
|
runProgram("ENUM used before its SUB definition and in SELECT CASE",
|
|
"ENUM Heading\n"
|
|
" North\n"
|
|
" South\n"
|
|
"END ENUM\n"
|
|
"Go South\n"
|
|
"SUB Go(d AS Heading)\n"
|
|
" SELECT CASE d\n"
|
|
" CASE North: PRINT \"N\"\n"
|
|
" CASE Heading.South: PRINT \"S\"\n"
|
|
" END SELECT\n"
|
|
"END SUB\n",
|
|
"S\n"
|
|
);
|
|
|
|
runProgram("ENUM member shared by two ENUMs is usable qualified",
|
|
"ENUM A\n"
|
|
" Same = 1\n"
|
|
" OnlyA\n"
|
|
"END ENUM\n"
|
|
"ENUM B\n"
|
|
" Same = 5\n"
|
|
"END ENUM\n"
|
|
"PRINT A.Same; B.Same; OnlyA\n",
|
|
"1 5 2 \n"
|
|
);
|
|
|
|
compileOnly("DECLARE with an ENUM parameter matches its definition",
|
|
"ENUM E\n"
|
|
" One = 1\n"
|
|
"END ENUM\n"
|
|
"DECLARE SUB S(v AS E)\n"
|
|
"SUB S(v AS E)\n"
|
|
"END SUB\n"
|
|
);
|
|
|
|
expectCompileError("Ambiguous ENUM member rejected unqualified",
|
|
"ENUM A\n Same\nEND ENUM\n"
|
|
"ENUM B\n Same\nEND ENUM\n"
|
|
"PRINT Same\n",
|
|
"Ambiguous name 'Same'"
|
|
);
|
|
|
|
expectCompileError("Duplicate ENUM member rejected",
|
|
"ENUM E\n X\n Y\n X\nEND ENUM\n",
|
|
"Duplicate member 'X' in ENUM 'E'"
|
|
);
|
|
|
|
expectCompileError("Duplicate ENUM rejected",
|
|
"ENUM E\n X\nEND ENUM\n"
|
|
"ENUM E\n Y\nEND ENUM\n",
|
|
"'E' is already defined"
|
|
);
|
|
|
|
expectCompileError("ENUM member clashing with a CONST rejected",
|
|
"CONST X = 1\n"
|
|
"ENUM E\n X\nEND ENUM\n",
|
|
"ENUM member 'X' is already defined"
|
|
);
|
|
|
|
expectCompileError("Unknown qualified ENUM member rejected",
|
|
"ENUM E\n X\nEND ENUM\n"
|
|
"PRINT E.Y\n",
|
|
"'Y' is not a member of ENUM 'E'"
|
|
);
|
|
|
|
expectCompileError("ENUM inside a SUB rejected",
|
|
"SUB S\n"
|
|
"ENUM E\n X\nEND ENUM\n"
|
|
"END SUB\n",
|
|
"ENUM cannot be defined inside SUB or FUNCTION"
|
|
);
|
|
|
|
expectCompileError("ENUM without END ENUM rejected",
|
|
"ENUM E\n X\n",
|
|
"Expected END ENUM"
|
|
);
|
|
|
|
expectCompileError("Empty ENUM rejected",
|
|
"ENUM E\nEND ENUM\n",
|
|
"ENUM 'E' has no members"
|
|
);
|
|
|
|
expectCompileError("ENUM value that is not constant rejected",
|
|
"DIM v\n"
|
|
"ENUM E\n X = v\nEND ENUM\n",
|
|
"Constant expression required: 'v' is not a constant"
|
|
);
|
|
|
|
expectCompileError("ENUM string value rejected",
|
|
"ENUM E\n X = \"a\"\nEND ENUM\n",
|
|
"Type mismatch in ENUM"
|
|
);
|
|
|
|
expectCompileError("ENUM auto value overflow rejected",
|
|
"ENUM E\n X = 2147483647\n Y\nEND ENUM\n",
|
|
"Overflow in ENUM"
|
|
);
|
|
|
|
expectCompileError("ENUM member assignment rejected",
|
|
"ENUM E\n X\nEND ENUM\n"
|
|
"X = 3\n",
|
|
"Cannot assign to a constant"
|
|
);
|
|
|
|
// ---- ParamArray ----
|
|
|
|
runProgram("ParamArray receives the remaining arguments",
|
|
"SUB ShowAll(title AS STRING, ParamArray items())\n"
|
|
" DIM i\n"
|
|
" PRINT title; LBOUND(items); UBOUND(items)\n"
|
|
" FOR i = LBOUND(items) TO UBOUND(items)\n"
|
|
" PRINT items(i);\n"
|
|
" NEXT\n"
|
|
" PRINT\n"
|
|
"END SUB\n"
|
|
"ShowAll \"three:\", 1, \"two\", 3.5\n"
|
|
"ShowAll \"none:\"\n"
|
|
"CALL ShowAll(\"one:\", \"x\")\n",
|
|
"three:0 2 \n1 two3.5 \n"
|
|
"none:0 -1 \n\n"
|
|
"one:0 0 \nx\n"
|
|
);
|
|
|
|
runProgram("Typed ParamArray converts each argument",
|
|
"FUNCTION Sum(ParamArray n() AS DOUBLE) AS DOUBLE\n"
|
|
" DIM i, t AS DOUBLE\n"
|
|
" FOR i = 0 TO UBOUND(n)\n"
|
|
" t = t + n(i)\n"
|
|
" NEXT\n"
|
|
" Sum = t\n"
|
|
"END FUNCTION\n"
|
|
"FUNCTION Cat$(ParamArray s() AS STRING)\n"
|
|
" Cat$ = Join$(s, \"-\")\n"
|
|
"END FUNCTION\n"
|
|
"PRINT Sum(1, 2.5, \"3\"); Sum()\n"
|
|
"PRINT Cat$(1, \"b\", 2.5)\n",
|
|
"6.5 0 \n1-b-2.5\n"
|
|
);
|
|
|
|
runProgram("ParamArray called before its definition",
|
|
"PRINT Count(1, 2, 3); Count()\n"
|
|
"FUNCTION Count(ParamArray a()) AS LONG\n"
|
|
" Count = UBOUND(a) + 1\n"
|
|
"END FUNCTION\n",
|
|
"3 0 \n"
|
|
);
|
|
|
|
expectCompileError("ParamArray not last rejected",
|
|
"SUB S(ParamArray a(), b)\nEND SUB\n",
|
|
"ParamArray must be the last parameter"
|
|
);
|
|
|
|
expectCompileError("ParamArray with Optional rejected",
|
|
"SUB S(OPTIONAL a, ParamArray b())\nEND SUB\n",
|
|
"ParamArray cannot be used with Optional parameters"
|
|
);
|
|
|
|
expectCompileError("ParamArray without () rejected",
|
|
"SUB S(ParamArray b)\nEND SUB\n",
|
|
"ParamArray parameter must be an array"
|
|
);
|
|
|
|
expectCompileError("ParamArray ByVal rejected",
|
|
"SUB S(BYVAL ParamArray b())\nEND SUB\n",
|
|
"ParamArray cannot be ByVal or ByRef"
|
|
);
|
|
|
|
expectCompileError("ParamArray of a TYPE rejected",
|
|
"TYPE T\n x AS INTEGER\nEND TYPE\n"
|
|
"SUB S(ParamArray b() AS T)\nEND SUB\n",
|
|
"ParamArray elements cannot be a TYPE"
|
|
);
|
|
|
|
expectCompileError("ParamArray in DEF FN rejected",
|
|
"DEF FNa(ParamArray b()) = 1\n",
|
|
"ParamArray is not allowed in DEF FN"
|
|
);
|
|
|
|
expectCompileError("BINARY STRING outside DECLARE LIBRARY rejected",
|
|
"SUB S(BYVAL x AS BINARY STRING)\nEND SUB\n",
|
|
"BINARY STRING is only allowed in a DECLARE LIBRARY block"
|
|
);
|
|
|
|
expectCompileError("BINARY STRING in DIM rejected",
|
|
"DIM x AS BINARY STRING\n",
|
|
"BINARY STRING is only allowed in a DECLARE LIBRARY block"
|
|
);
|
|
|
|
expectCompileError("BINARY needs STRING",
|
|
"DECLARE LIBRARY \"x\"\n"
|
|
"DECLARE SUB F(BYVAL b AS BINARY LONG)\n"
|
|
"END DECLARE\n",
|
|
"STRING after BINARY"
|
|
);
|
|
|
|
expectCompileError("ParamArray in DECLARE LIBRARY rejected",
|
|
"DECLARE LIBRARY \"x\"\n"
|
|
"DECLARE SUB F(ParamArray b())\n"
|
|
"END DECLARE\n",
|
|
"ParamArray is not allowed in DECLARE LIBRARY"
|
|
);
|
|
|
|
expectCompileError("Too few arguments before a ParamArray rejected",
|
|
"SUB S(a, b, ParamArray c())\nEND SUB\n"
|
|
"S 1\n",
|
|
"Sub 'S' expects at least 2 arguments, got 1"
|
|
);
|
|
|
|
expectCompileError("Too many ParamArray arguments rejected",
|
|
"SUB S(ParamArray c())\nEND SUB\n"
|
|
"S 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32\n",
|
|
"Too many ParamArray arguments (at most 31)"
|
|
);
|
|
|
|
expectCompileError("DECLARE disagreeing on ParamArray rejected",
|
|
"DECLARE SUB S(a())\n"
|
|
"SUB S(ParamArray a())\nEND SUB\n",
|
|
"DECLARE for 'S' does not match its definition"
|
|
);
|
|
}
|
|
|
|
|
|
// Compile-time member binding (redesign Phase 3): members of objects of a
|
|
// known class reached by index give what late binding by name gives,
|
|
// VB's compile-time member errors, Implements calls through interface
|
|
// maps, events by index, and the late-bound fallback for an object of
|
|
// another class.
|
|
static void testEarlyBinding(void) {
|
|
runBothBindings("Early binding: methods, properties, variables, ByRef / Optional / ParamArray arguments, chains and Collections give what late binding gives",
|
|
"FUNCTION MakeAcct(BYVAL n AS LONG) AS @T@\n"
|
|
" DIM a AS @T@\n"
|
|
" SET a = NEW Acct\n"
|
|
" a.Deposit n\n"
|
|
" SET MakeAcct = a\n"
|
|
"END FUNCTION\n"
|
|
"\n"
|
|
"SUB Exercise(a AS @T@)\n"
|
|
" DIM x AS INTEGER\n"
|
|
" DIM arr(2) AS INTEGER\n"
|
|
" a.Deposit 10\n"
|
|
" a.Rate = 3\n"
|
|
" a.Visits = a.Visits + 1\n"
|
|
" PRINT a.Balance; a.Rate; a.Visits\n"
|
|
" x = 5\n"
|
|
" a.Bump x\n"
|
|
" arr(1) = 7\n"
|
|
" a.Bump arr(1)\n"
|
|
" a.Bump (x)\n"
|
|
" PRINT x; arr(1)\n"
|
|
" PRINT a.Sum(1, 2, 3); a.Sum()\n"
|
|
" a.Sum 4, 5\n"
|
|
" PRINT a.Greet(); \" \"; a.Greet(\"Bob\")\n"
|
|
" a.Tags(1) = \"t1\"\n"
|
|
" a.Items(2) = 9\n"
|
|
" PRINT a.Tags(1); a.Items(2)\n"
|
|
" SET a.Partner = MakeAcct(4)\n"
|
|
" a.Partner.Deposit 1\n"
|
|
" PRINT a.Partner.Balance\n"
|
|
" a.History.Add \"x\", \"k1\"\n"
|
|
" a.History.Add \"y\"\n"
|
|
" PRINT a.History.Count; a.History.Item(1); a.History(\"k1\")\n"
|
|
" a.History.Remove \"k1\"\n"
|
|
" PRINT a.History.Count; a.Self.Balance\n"
|
|
" PRINT a.Describe; a.Rate\n"
|
|
"END SUB\n"
|
|
"\n"
|
|
"DIM g AS @T@\n"
|
|
"SET g = NEW Acct\n"
|
|
"Exercise g\n"
|
|
"PRINT g.Balance\n"
|
|
"\n"
|
|
"BEGINCLASS \"Acct\"\n"
|
|
"Public Visits As Long\n"
|
|
"Public Items(3) As Integer\n"
|
|
"Public History As New Collection\n"
|
|
"Private mBal As Long\n"
|
|
"Private mRate As Integer\n"
|
|
"Private mTags(2) As String\n"
|
|
"Private mPartner As Acct\n"
|
|
"Public Sub Deposit(BYVAL n AS LONG)\n"
|
|
" mBal = mBal + n\n"
|
|
"End Sub\n"
|
|
"Public Sub Bump(n AS INTEGER)\n"
|
|
" n = n + 1\n"
|
|
"End Sub\n"
|
|
"Property Get Balance() As Long\n"
|
|
" Balance = mBal\n"
|
|
"End Property\n"
|
|
"Property Get Rate() As Integer\n"
|
|
" Rate = mRate\n"
|
|
"End Property\n"
|
|
"Property Let Rate(v As Integer)\n"
|
|
" mRate = v\n"
|
|
"End Property\n"
|
|
"Property Get Tags(i As Integer) As String\n"
|
|
" Tags = mTags(i)\n"
|
|
"End Property\n"
|
|
"Property Let Tags(i As Integer, s As String)\n"
|
|
" mTags(i) = s\n"
|
|
"End Property\n"
|
|
"Property Get Partner() As Acct\n"
|
|
" SET Partner = mPartner\n"
|
|
"End Property\n"
|
|
"Property Set Partner(p As Acct)\n"
|
|
" SET mPartner = p\n"
|
|
"End Property\n"
|
|
"Public Function Sum(ParamArray v()) As Long\n"
|
|
" DIM t AS LONG\n"
|
|
" FOR EACH e IN v\n"
|
|
" t = t + e\n"
|
|
" NEXT\n"
|
|
" Sum = t\n"
|
|
"End Function\n"
|
|
"Public Function Greet(Optional who As String = \"World\") As String\n"
|
|
" Greet = \"Hi \" & who\n"
|
|
"End Function\n"
|
|
"Public Function Self() As Acct\n"
|
|
" SET Self = Me\n"
|
|
"End Function\n"
|
|
"Public Function Describe() As String\n"
|
|
" Me.Rate = Me.Rate + 1\n"
|
|
" Describe = \"bal\" & Me.Balance & \" rate\" & Me.Rate & \" \" & Me.Tags(1)\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n",
|
|
"10 3 1 \n"
|
|
"6 8 \n"
|
|
"6 0 \n"
|
|
"Hi World Hi Bob\n"
|
|
"t19 \n"
|
|
"5 \n"
|
|
"2 xx\n"
|
|
"1 10 \n"
|
|
"bal10 rate4 t14 \n"
|
|
"10 \n"
|
|
);
|
|
|
|
runProgram("Early binding: Implements calls reach each class's implementation through its interface map",
|
|
"DIM shapes(2) AS IShape\n"
|
|
"DIM s AS IShape\n"
|
|
"DIM i AS INTEGER\n"
|
|
"DIM n AS INTEGER\n"
|
|
"SET shapes(0) = NEW Square\n"
|
|
"SET shapes(1) = NEW Circle\n"
|
|
"SET shapes(2) = NEW IShape\n"
|
|
"FOR i = 0 TO 2\n"
|
|
" shapes(i).Name = \"s\" & i\n"
|
|
" shapes(i).Resize 2\n"
|
|
" n = 1\n"
|
|
" shapes(i).Grow n\n"
|
|
" PRINT shapes(i).Name; \" \"; shapes(i).Area; \" \"; shapes(i).Kind; n\n"
|
|
"NEXT\n"
|
|
"SET s = shapes(1)\n"
|
|
"PRINT s.Total(1, 2, 3)\n"
|
|
"\n"
|
|
"BEGINCLASS \"IShape\"\n"
|
|
"Public Name As String\n"
|
|
"Public Function Area() As Double\n"
|
|
" Area = -1\n"
|
|
"End Function\n"
|
|
"Public Sub Resize(BYVAL f AS DOUBLE)\n"
|
|
"End Sub\n"
|
|
"Public Sub Grow(n AS INTEGER)\n"
|
|
" n = n + 100\n"
|
|
"End Sub\n"
|
|
"Property Get Kind() As String\n"
|
|
" Kind = \"abstract\"\n"
|
|
"End Property\n"
|
|
"Public Function Total(ParamArray v()) As Long\n"
|
|
" Total = -1\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n"
|
|
"\n"
|
|
"BEGINCLASS \"Square\"\n"
|
|
"Implements IShape\n"
|
|
"Private mName As String\n"
|
|
"Private mSide As Double\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" mSide = 1\n"
|
|
"End Sub\n"
|
|
"Private Property Get IShape_Name() As String\n"
|
|
" IShape_Name = \"sq:\" & mName\n"
|
|
"End Property\n"
|
|
"Private Property Let IShape_Name(v As String)\n"
|
|
" mName = v\n"
|
|
"End Property\n"
|
|
"Private Function IShape_Area() As Double\n"
|
|
" IShape_Area = mSide * mSide\n"
|
|
"End Function\n"
|
|
"Private Sub IShape_Resize(BYVAL f AS DOUBLE)\n"
|
|
" mSide = mSide * f\n"
|
|
"End Sub\n"
|
|
"Private Sub IShape_Grow(BYVAL n AS INTEGER)\n"
|
|
" n = n + 10\n"
|
|
"End Sub\n"
|
|
"Private Property Get IShape_Kind() As String\n"
|
|
" IShape_Kind = \"square\"\n"
|
|
"End Property\n"
|
|
"Private Function IShape_Total(ParamArray v()) As Long\n"
|
|
" IShape_Total = UBOUND(v) + 1\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n"
|
|
"\n"
|
|
"BEGINCLASS \"Circle\"\n"
|
|
"Implements IShape\n"
|
|
"Private mName As String\n"
|
|
"Private mR As Double\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" mR = 1\n"
|
|
"End Sub\n"
|
|
"Private Property Get IShape_Name() As String\n"
|
|
" IShape_Name = \"ci:\" & mName\n"
|
|
"End Property\n"
|
|
"Private Property Let IShape_Name(v As String)\n"
|
|
" mName = v\n"
|
|
"End Property\n"
|
|
"Private Function IShape_Area() As Double\n"
|
|
" IShape_Area = 3 * mR * mR\n"
|
|
"End Function\n"
|
|
"Private Sub IShape_Resize(BYVAL f AS DOUBLE)\n"
|
|
" mR = mR * f\n"
|
|
"End Sub\n"
|
|
"Private Sub IShape_Grow(n AS INTEGER)\n"
|
|
" n = n + 1\n"
|
|
"End Sub\n"
|
|
"Private Property Get IShape_Kind() As String\n"
|
|
" IShape_Kind = \"circle\"\n"
|
|
"End Property\n"
|
|
"Private Function IShape_Total(ParamArray v()) As Long\n"
|
|
" DIM t AS LONG\n"
|
|
" FOR EACH e IN v\n"
|
|
" t = t + e\n"
|
|
" NEXT\n"
|
|
" IShape_Total = t\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n",
|
|
"sq:s0 4 square1 \n"
|
|
"ci:s1 12 circle2 \n"
|
|
"s2 -1 abstract101 \n"
|
|
"6 \n"
|
|
);
|
|
|
|
runProgram("Early binding: Nothing, members used before their declaration, Me with Private members, an object of another class by name",
|
|
"ON ERROR GOTO h\n"
|
|
"DIM k AS Keeper\n"
|
|
"k.Show\n"
|
|
"PRINT \"a\"\n"
|
|
"SET k = NEW Keeper\n"
|
|
"k.Show\n"
|
|
"PRINT k.Peek\n"
|
|
"DIM o AS Object\n"
|
|
"SET o = NEW Other\n"
|
|
"Poke o\n"
|
|
"PRINT o.count\n"
|
|
"k.Count = 7\n"
|
|
"PRINT k.Count; k.Twice\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"SUB Poke(x AS Keeper)\n"
|
|
" x.Count = 41\n"
|
|
" x.Show\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Keeper\"\n"
|
|
"Public Function Twice() As Integer\n"
|
|
" Twice = Count * 2 + mHidden\n"
|
|
"End Function\n"
|
|
"Public Sub Show()\n"
|
|
" mHidden = mHidden + 1\n"
|
|
" PRINT \"show\"; Me.mHidden\n"
|
|
"End Sub\n"
|
|
"Public Function Peek() As Integer\n"
|
|
" Peek = Me.mHidden\n"
|
|
"End Function\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Count As Integer\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Other\"\n"
|
|
"Public Count As Integer\n"
|
|
"Public Sub Show()\n"
|
|
" PRINT \"other show\"; Count\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"err91 \n"
|
|
"a\n"
|
|
"show1 \n"
|
|
"1 \n"
|
|
"other show41 \n"
|
|
"41 \n"
|
|
"7 15 \n"
|
|
);
|
|
|
|
runProgram("Early binding: events dispatch by index",
|
|
"DIM WithEvents a AS Alpha\n"
|
|
"DIM WithEvents b AS Beta\n"
|
|
"SET a = NEW Alpha\n"
|
|
"SET b = NEW Beta\n"
|
|
"a.Fire\n"
|
|
"b.Fire\n"
|
|
"SUB a_Second(BYVAL n AS INTEGER)\n"
|
|
" PRINT \"a2\"; n\n"
|
|
"END SUB\n"
|
|
"SUB a_First(BYVAL n AS INTEGER)\n"
|
|
" PRINT \"a1\"; n\n"
|
|
"END SUB\n"
|
|
"SUB b_First(BYVAL n AS INTEGER)\n"
|
|
" PRINT \"b1\"; n\n"
|
|
"END SUB\n"
|
|
"SUB b_Second(BYVAL n AS INTEGER)\n"
|
|
" PRINT \"b2\"; n\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Alpha\"\n"
|
|
"Event First(BYVAL n AS INTEGER)\n"
|
|
"Event Second(BYVAL n AS INTEGER)\n"
|
|
"Public Sub Fire()\n"
|
|
" RaiseEvent Second(2)\n"
|
|
" RaiseEvent First(1)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Beta\"\n"
|
|
"Event Second(BYVAL n AS INTEGER)\n"
|
|
"Event First(BYVAL n AS INTEGER)\n"
|
|
"Public Sub Fire()\n"
|
|
" RaiseEvent First(10)\n"
|
|
" RaiseEvent Second(20)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"a22 \n"
|
|
"a11 \n"
|
|
"b110 \n"
|
|
"b220 \n"
|
|
);
|
|
|
|
expectCompileError("Early binding: an unknown member is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"kk.Nope = 1\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Line 3, Col 4: Method or data member not found: 'Nope' is not a member of class 'Klass'"
|
|
);
|
|
|
|
expectCompileError("Early binding: a Private member is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"PRINT kk.mHidden\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"'mHidden' is Private in class 'Klass'"
|
|
);
|
|
|
|
expectCompileError("Early binding: too many arguments is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"kk.Go 1, 2\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Sub 'Klass.Go' expects 1 arguments, got 2"
|
|
);
|
|
|
|
expectCompileError("Early binding: too few arguments is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"kk.Go\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Sub 'Klass.Go' expects 1 arguments, got 0"
|
|
);
|
|
|
|
expectCompileError("Early binding: arguments for a Function without parameters is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"x = kk.F(1)\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Function 'Klass.F' expects 0 arguments, got 1"
|
|
);
|
|
|
|
expectCompileError("Early binding: a Sub used as a value is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"x = kk.Go(1)\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Expected Function or variable: 'Go' is a Sub of class 'Klass'"
|
|
);
|
|
|
|
expectCompileError("Early binding: a variable used as a statement is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"kk.V\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Invalid use of property: 'V' of class 'Klass' is not a method"
|
|
);
|
|
|
|
expectCompileError("Early binding: a read-only property assigned is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"kk.RO = 3\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Can't assign to read-only property"
|
|
);
|
|
|
|
expectCompileError("Early binding: a write-only property read is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"PRINT kk.WO\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"'WO' of class 'Klass' has no Property Get"
|
|
);
|
|
|
|
expectCompileError("Early binding: a method assigned is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"kk.F = 2\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Cannot assign to method 'F' of class 'Klass'"
|
|
);
|
|
|
|
expectCompileError("Early binding: an unknown Collection member is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"c.Push 1\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"'Push' is not a member of Collection"
|
|
);
|
|
|
|
expectCompileError("Early binding: Collection.Add used as a value is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"x = c.Add(1)\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Collection.Add is a method"
|
|
);
|
|
|
|
expectCompileError("Early binding: Collection.Count given an argument is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"PRINT c.Count(1)\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Collection.Count takes 0, got 1"
|
|
);
|
|
|
|
expectCompileError("Early binding: Collection.Count assigned is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"c.Count = 3\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Can't assign to Collection.Count"
|
|
);
|
|
|
|
expectCompileError("Early binding: a literal for an object parameter is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"TakeK 5\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Type mismatch: argument 1 of 'TakeK' must be an object"
|
|
);
|
|
|
|
expectCompileError("Early binding: an object of another class is a compile error",
|
|
"DIM kk AS NEW Klass\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"TakeK NEW Jlass\n"
|
|
"BEGINCLASS \"Klass\"\n"
|
|
"Public V As Integer\n"
|
|
"Private mHidden As Integer\n"
|
|
"Public Sub Go(BYVAL n AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"Public Function F() As Integer\n"
|
|
"End Function\n"
|
|
"Property Get RO() As Integer\n"
|
|
"End Property\n"
|
|
"Property Let WO(v As Integer)\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Jlass\"\n"
|
|
"ENDCLASS\n"
|
|
"SUB TakeK(x AS Klass)\n"
|
|
"END SUB\n",
|
|
"Type mismatch: argument 1 of 'TakeK' expects Klass, got Jlass"
|
|
);
|
|
|
|
expectCompileError("Early binding: an implementation must keep the interface's ParamArray",
|
|
"BEGINCLASS \"Iface\"\n"
|
|
"Public Function Total(ParamArray v()) As Long\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Impl\"\n"
|
|
"Implements Iface\n"
|
|
"Private Function Iface_Total(v As Variant) As Long\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n",
|
|
"with 1 parameter(s) ending in a ParamArray for interface 'Iface'"
|
|
);
|
|
}
|
|
|
|
|
|
// Events (Event / RaiseEvent / WithEvents), Implements and the cycle
|
|
// collector.
|
|
static void testEventsAndInterfaces(void) {
|
|
runProgram("Events: WithEvents handlers, ByRef arguments, two holders, rebinding",
|
|
"DIM WithEvents w AS Worker\n"
|
|
"DIM WithEvents w2 AS Worker\n"
|
|
"DIM n AS INTEGER\n"
|
|
"SET w = NEW Worker\n"
|
|
"SET w2 = w\n"
|
|
"n = 5\n"
|
|
"w.Go n\n"
|
|
"PRINT \"after\"; n\n"
|
|
"SET w2 = NEW Worker\n"
|
|
"w.Go n\n"
|
|
"PRINT \"second\"; n\n"
|
|
"SET w = Nothing\n"
|
|
"w2.Go n\n"
|
|
"PRINT \"third\"; n\n"
|
|
"SUB w_Progress(ByVal pct AS INTEGER, cancel AS BOOLEAN)\n"
|
|
" PRINT \"w\"; pct;\n"
|
|
" IF pct >= 50 THEN cancel = TRUE\n"
|
|
"END SUB\n"
|
|
"SUB w2_Progress(ByVal pct AS INTEGER, cancel AS BOOLEAN)\n"
|
|
" PRINT \"w2\"; pct;\n"
|
|
"END SUB\n"
|
|
"SUB w_Done(x AS INTEGER)\n"
|
|
" PRINT \"done\"; x\n"
|
|
" x = x * 2\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Worker\"\n"
|
|
"Public Event Progress(ByVal pct AS INTEGER, cancel AS BOOLEAN)\n"
|
|
"Event Done(x AS INTEGER)\n"
|
|
"Public Sub Go(v AS INTEGER)\n"
|
|
" DIM c AS BOOLEAN\n"
|
|
" DIM i AS INTEGER\n"
|
|
" FOR i = 25 TO 100 STEP 25\n"
|
|
" RaiseEvent Progress(i, c)\n"
|
|
" IF c THEN EXIT FOR\n"
|
|
" NEXT\n"
|
|
" RaiseEvent Done(v)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"w25 w225 w50 w250 done5 \n"
|
|
"after10 \n"
|
|
"w25 w50 done10 \n"
|
|
"second20 \n"
|
|
"w225 w250 w275 w2100 third20 \n"
|
|
);
|
|
|
|
runProgram("Events: a member variable passed ByRef, no holder, raised from Class_Initialize",
|
|
"DIM WithEvents c AS Counter\n"
|
|
"SET c = NEW Counter\n"
|
|
"c.Tick\n"
|
|
"c.Tick\n"
|
|
"PRINT c.Count\n"
|
|
"DIM lone AS NEW Counter\n"
|
|
"lone.Tick\n"
|
|
"PRINT lone.Count\n"
|
|
"SUB c_Changed(total AS INTEGER)\n"
|
|
" total = total + 100\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Counter\"\n"
|
|
"Public Count AS INTEGER\n"
|
|
"Event Changed(total AS INTEGER)\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" RaiseEvent Changed(Count)\n"
|
|
"End Sub\n"
|
|
"Public Sub Tick()\n"
|
|
" Count = Count + 1\n"
|
|
" RaiseEvent Changed(Count)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"202 \n"
|
|
"1 \n"
|
|
);
|
|
|
|
runProgram("Events: TYPE fields and array elements go ByRef, every handler writes through the same reference (fixed length kept); a parenthesised value is one temporary they share",
|
|
"TYPE Pt\n"
|
|
" x AS INTEGER\n"
|
|
" s AS STRING * 4\n"
|
|
"END TYPE\n"
|
|
"DIM SHARED g(3) AS Pt\n"
|
|
"DIM WithEvents a AS Src\n"
|
|
"DIM WithEvents b AS Src\n"
|
|
"SET a = NEW Src\n"
|
|
"SET b = a\n"
|
|
"a.Go\n"
|
|
"SUB a_Moved(v AS INTEGER, t AS STRING)\n"
|
|
" PRINT \"a\"; v; \"[\"; t; \"]\"\n"
|
|
" v = v + 10\n"
|
|
" t = t + \"x\"\n"
|
|
"END SUB\n"
|
|
"SUB b_Moved(v AS INTEGER, t AS STRING)\n"
|
|
" PRINT \"b\"; v; \"[\"; t; \"]\"\n"
|
|
" v = v * 2\n"
|
|
" t = \"q\" + t\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Src\"\n"
|
|
"Event Moved(v AS INTEGER, t AS STRING)\n"
|
|
"Public Sub Go()\n"
|
|
" DIM p AS Pt\n"
|
|
" DIM arr(2) AS Pt\n"
|
|
" DIM n(3) AS INTEGER\n"
|
|
" DIM s AS STRING\n"
|
|
" p.x = 1\n"
|
|
" p.s = \"ab\"\n"
|
|
" RaiseEvent Moved(p.x, p.s)\n"
|
|
" PRINT p.x; \"[\"; p.s; \"]\"\n"
|
|
" arr(1).x = 5\n"
|
|
" RaiseEvent Moved(arr(1).x, arr(1).s)\n"
|
|
" PRINT arr(1).x; \"[\"; arr(1).s; \"]\"\n"
|
|
" n(2) = 7\n"
|
|
" RaiseEvent Moved(n(2), s)\n"
|
|
" PRINT n(2); \"[\"; s; \"]\"\n"
|
|
" g(2).x = 3\n"
|
|
" RaiseEvent Moved(g(2).x, (g(2).s))\n"
|
|
" PRINT g(2).x; \"[\"; g(2).s; \"]\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"a1 [ab ]\n"
|
|
"b11 [ab ]\n"
|
|
"22 [qab ]\n"
|
|
"a5 [ ]\n"
|
|
"b15 [ ]\n"
|
|
"30 [q ]\n"
|
|
"a7 []\n"
|
|
"b17 [x]\n"
|
|
"34 [qx]\n"
|
|
"a3 [ ]\n"
|
|
"b13 [ x]\n"
|
|
"26 [ ]\n"
|
|
);
|
|
|
|
runProgram("Events: ByRef element and field arrays locked (error 10), stores convert (overflow in the handler)",
|
|
"TYPE Pt\n"
|
|
" x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM SHARED g(3) AS Pt\n"
|
|
"DIM SHARED n(3) AS LONG\n"
|
|
"DIM WithEvents a AS Src\n"
|
|
"SET a = NEW Src\n"
|
|
"a.Go\n"
|
|
"SUB a_Moved(v)\n"
|
|
" ON ERROR GOTO bad\n"
|
|
" PRINT \"h\"; v\n"
|
|
" v = v + 1.6\n"
|
|
" REDIM g(5)\n"
|
|
" REDIM n(5)\n"
|
|
" ERASE g\n"
|
|
" EXIT SUB\n"
|
|
"bad:\n"
|
|
" PRINT \"err\"; ERR\n"
|
|
" RESUME NEXT\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Src\"\n"
|
|
"Event Moved(v)\n"
|
|
"Public Sub Go()\n"
|
|
" g(2).x = 3\n"
|
|
" RaiseEvent Moved(g(2).x)\n"
|
|
" PRINT g(2).x\n"
|
|
" REDIM g(4)\n"
|
|
" PRINT UBOUND(g)\n"
|
|
" n(1) = 4\n"
|
|
" RaiseEvent Moved(n(1))\n"
|
|
" PRINT n(1)\n"
|
|
" ON ERROR GOTO over\n"
|
|
" g(1).x = 32767\n"
|
|
" RaiseEvent Moved(g(1).x)\n"
|
|
" PRINT \"no\"\n"
|
|
" EXIT SUB\n"
|
|
"over:\n"
|
|
" PRINT \"over\"; ERR; g(1).x\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"h3 \n"
|
|
"err10 \n"
|
|
"0 \n"
|
|
"4 \n"
|
|
"h4 \n"
|
|
"err10 \n"
|
|
"6 \n"
|
|
"h32767 \n"
|
|
"err6 \n"
|
|
"err10 \n"
|
|
"no\n"
|
|
);
|
|
|
|
expectCompileError("Events: a handler must match the event",
|
|
"DIM WithEvents w AS K\n"
|
|
"SUB w_E(a AS STRING)\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Event E(a AS INTEGER)\n"
|
|
"ENDCLASS\n",
|
|
"does not match the declaration of event E"
|
|
);
|
|
|
|
expectCompileError("Events: RaiseEvent of an undeclared event",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Sub S()\n"
|
|
" RaiseEvent Nope\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"Event 'Nope' is not declared"
|
|
);
|
|
|
|
expectCompileError("Events: RaiseEvent argument count",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Event E(a AS INTEGER)\n"
|
|
"Sub S()\n"
|
|
" RaiseEvent E\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"takes 1 argument(s), got 0"
|
|
);
|
|
|
|
expectCompileError("Events: RaiseEvent outside a class",
|
|
"SUB S\n"
|
|
" RaiseEvent E\n"
|
|
"END SUB\n",
|
|
"RaiseEvent belongs in a procedure of a class module"
|
|
);
|
|
|
|
expectCompileError("Events: WithEvents inside a procedure",
|
|
"SUB S\n"
|
|
" DIM WithEvents x AS K\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"ENDCLASS\n",
|
|
"WithEvents variables belong at module level"
|
|
);
|
|
|
|
expectCompileError("Events: WithEvents needs a class",
|
|
"DIM WithEvents x AS INTEGER\n",
|
|
"declared As a class module"
|
|
);
|
|
|
|
expectCompileError("Events: WithEvents cannot use New",
|
|
"DIM WithEvents x AS NEW K\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"ENDCLASS\n",
|
|
"(without New)"
|
|
);
|
|
|
|
expectCompileError("Events: optional event parameter",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Event E(OPTIONAL a AS INTEGER)\n"
|
|
"ENDCLASS\n",
|
|
"cannot be Optional or a ParamArray"
|
|
);
|
|
|
|
expectCompileError("Events: an event is always public",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Private Event E()\n"
|
|
"ENDCLASS\n",
|
|
"An Event cannot be Private"
|
|
);
|
|
|
|
expectCompileError("Events: an event and a method share a name",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Event E()\n"
|
|
"Public Sub E()\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"'E' is an Event of class 'K'"
|
|
);
|
|
|
|
runProgram("Events: Event and WithEvents are ordinary names elsewhere",
|
|
"DIM event AS INTEGER, withevents AS INTEGER\n"
|
|
"event = 3\n"
|
|
"withevents = 4\n"
|
|
"PRINT event + withevents\n",
|
|
"7 \n"
|
|
);
|
|
|
|
runProgram("Implements: members through the interface, own members, TypeOf, Set checks",
|
|
"DIM s AS IShape\n"
|
|
"DIM c AS NEW Circle\n"
|
|
"SET s = c\n"
|
|
"PRINT s.Area; s.Name; \" \"; c.Name\n"
|
|
"s.Scale 2\n"
|
|
"PRINT s.Area\n"
|
|
"s.Tag = \"hi\"\n"
|
|
"PRINT s.Tag\n"
|
|
"PRINT TypeOf s Is IShape; TypeOf s Is Circle; TypeOf c Is Collection; TypeName(s)\n"
|
|
"DIM plain AS NEW IShape\n"
|
|
"SET s = plain\n"
|
|
"PRINT s.Name\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = c\n"
|
|
"PRINT o.Name\n"
|
|
"ON ERROR GOTO bad\n"
|
|
"DIM k AS NEW Collection\n"
|
|
"SET s = k\n"
|
|
"PRINT \"end\"\n"
|
|
"END\n"
|
|
"bad:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"BEGINCLASS \"IShape\"\n"
|
|
"Public Tag AS STRING\n"
|
|
"Public Function Area() AS DOUBLE\n"
|
|
"End Function\n"
|
|
"Public Function Name() AS STRING\n"
|
|
" Name = \"ishape\"\n"
|
|
"End Function\n"
|
|
"Public Sub Scale(f AS DOUBLE)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Circle\"\n"
|
|
"Implements IShape\n"
|
|
"Private r AS DOUBLE\n"
|
|
"Private t AS STRING\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" r = 1\n"
|
|
"End Sub\n"
|
|
"Public Function Name() AS STRING\n"
|
|
" Name = \"circle\"\n"
|
|
"End Function\n"
|
|
"Private Function IShape_Area() AS DOUBLE\n"
|
|
" IShape_Area = 3 * r * r\n"
|
|
"End Function\n"
|
|
"Private Function IShape_Name() AS STRING\n"
|
|
" IShape_Name = \"circle-as-ishape\"\n"
|
|
"End Function\n"
|
|
"Private Sub IShape_Scale(f AS DOUBLE)\n"
|
|
" r = r * f\n"
|
|
"End Sub\n"
|
|
"Private Property Get IShape_Tag() AS STRING\n"
|
|
" IShape_Tag = t\n"
|
|
"End Property\n"
|
|
"Private Property Let IShape_Tag(v AS STRING)\n"
|
|
" t = \"[\" & v & \"]\"\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n",
|
|
"3 circle-as-ishape circle\n"
|
|
"12 \n"
|
|
"[hi]\n"
|
|
"True True False Circle\n"
|
|
"ishape\n"
|
|
"circle\n"
|
|
"err13 \n"
|
|
"end\n"
|
|
);
|
|
|
|
expectCompileError("Implements: every member must be implemented",
|
|
"BEGINCLASS \"I\"\n"
|
|
"Public Sub M(a AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Implements I\n"
|
|
"Private Sub I_M()\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"Class 'K' must implement Sub I_M with 1 parameter(s) for interface 'I'"
|
|
);
|
|
|
|
expectCompileError("Implements: needs a class module",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Implements Nowhere\n"
|
|
"ENDCLASS\n",
|
|
"the name of a class module after Implements"
|
|
);
|
|
|
|
expectCompileError("Implements: not itself",
|
|
"BEGINCLASS \"K\"\n"
|
|
"Implements K\n"
|
|
"ENDCLASS\n",
|
|
"A class cannot implement itself"
|
|
);
|
|
|
|
runProgram("Cycles: collected while the program runs, Class_Terminate once",
|
|
"DIM SHARED ended AS LONG\n"
|
|
"DIM keep AS Node\n"
|
|
"FOR i = 1 TO 2500\n"
|
|
" DIM a AS Node, b AS Node\n"
|
|
" SET a = NEW Node\n"
|
|
" SET b = NEW Node\n"
|
|
" SET a.Other = b\n"
|
|
" SET b.Other = a\n"
|
|
"NEXT\n"
|
|
"SET a = Nothing\n"
|
|
"SET b = Nothing\n"
|
|
"PRINT ended > 4000\n"
|
|
"BEGINCLASS \"Node\"\n"
|
|
"Public Other AS Node\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" ended = ended + 1\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"True \n"
|
|
);
|
|
|
|
runProgram("Cycles: a Class_Terminate that keeps its object; oldest first at the end",
|
|
"DIM SHARED saved AS Node\n"
|
|
"DIM a AS NEW Node, b AS NEW Node\n"
|
|
"a.Id = 1\n"
|
|
"b.Id = 2\n"
|
|
"SET a.Other = b\n"
|
|
"SET b.Other = a\n"
|
|
"SET a = Nothing\n"
|
|
"SET b = Nothing\n"
|
|
"PRINT \"end\"\n"
|
|
"BEGINCLASS \"Node\"\n"
|
|
"Public Id AS INTEGER\n"
|
|
"Public Other AS Node\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"bye\"; Id\n"
|
|
" IF Id = 2 THEN SET saved = Me\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"end\n"
|
|
"bye1 \n"
|
|
"bye2 \n"
|
|
);
|
|
}
|
|
|
|
|
|
// The fast loop (runtime/vm.c runFast) against the reference
|
|
// implementation: type limits, conversions, fused compares and jumps,
|
|
// FOR counters, objects let go of by stores and returns, the
|
|
// superinstructions (OP_*_K16, OP_STORE_*_CONV) and their errors.
|
|
static void testFastLoop(void) {
|
|
runFastAndStepped("Fast loop: integer and floating arithmetic at the type limits",
|
|
"DIM a AS INTEGER\n"
|
|
"DIM l AS LONG\n"
|
|
"DIM v AS VARIANT\n"
|
|
"a = 32767\n"
|
|
"v = a + 1: PRINT v; TYPENAME(v)\n"
|
|
"v = a * 2: PRINT v; TYPENAME(v)\n"
|
|
"v = a - 1: PRINT v; TYPENAME(v)\n"
|
|
"l = 5\n"
|
|
"PRINT TYPENAME(l + 1); TYPENAME(l - a); TYPENAME(l * 2); TYPENAME(l \\ 2); TYPENAME(l MOD 2); TYPENAME(-l); TYPENAME(l AND 1)\n"
|
|
"l = -2147483647 - 1\n"
|
|
"v = l MOD -1: PRINT v\n"
|
|
"PRINT 100 \\ 7; 100 MOD 7; -7 \\ 2; -7 MOD 2\n"
|
|
"v = 2.5\n"
|
|
"PRINT v + 1; v * 3; v - 1; v / 2; TYPENAME(v + 1)\n"
|
|
"v = NULL\n"
|
|
"PRINT ISNULL(v + 1); ISNULL(v * 2)\n"
|
|
"PRINT -a; -(l + 1); -v\n",
|
|
"32768 Long\n"
|
|
"65534 Long\n"
|
|
"32766 Integer\n"
|
|
"LongLongLongLongLongLongLong\n"
|
|
"0 \n"
|
|
"14 2 -3 -1 \n"
|
|
"3.5 7.5 1.5 1.25 Double\n"
|
|
"True True \n"
|
|
"-32767 2147483647 Null\n"
|
|
);
|
|
|
|
// A LONG result that does not fit is an Overflow (VB; two INTEGERs
|
|
// widen to a LONG)
|
|
runProgram("LONG arithmetic that overflows",
|
|
"DIM l AS LONG\n"
|
|
"DIM v AS VARIANT\n"
|
|
"l = 2147483647\n"
|
|
"ON ERROR RESUME NEXT\n"
|
|
"v = 0: v = l + 1: PRINT ERR.NUMBER; v: ERR.CLEAR\n"
|
|
"v = 0: v = l * 3: PRINT ERR.NUMBER; v: ERR.CLEAR\n"
|
|
"v = 0: v = l + l: PRINT ERR.NUMBER; v: ERR.CLEAR\n"
|
|
"l = -2147483647 - 1\n"
|
|
"v = 0: v = l \\ -1: PRINT ERR.NUMBER; v: ERR.CLEAR\n"
|
|
"v = 0: v = -l: PRINT ERR.NUMBER; v: ERR.CLEAR\n"
|
|
"v = 0: v = l - 1: PRINT ERR.NUMBER; v: ERR.CLEAR\n"
|
|
"v = 0: v = l * 1.5: PRINT ERR.NUMBER; v: ERR.CLEAR\n",
|
|
"6 0 \n6 0 \n6 0 \n6 0 \n6 0 \n6 0 \n0 -3221225472 \n"
|
|
);
|
|
|
|
runFastAndStepped("Fast loop: comparisons fused with the jump that tests them",
|
|
"DIM s AS STRING\n"
|
|
"DIM i AS LONG\n"
|
|
"s = \"abc\": i = 5\n"
|
|
"IF s < \"abd\" THEN PRINT \"lt\"\n"
|
|
"IF s = \"abc\" THEN PRINT \"eq\"\n"
|
|
"IF s > \"ABC\" THEN PRINT \"gt\"\n"
|
|
"IF 1.5 > 1 THEN PRINT \"dbl\"\n"
|
|
"IF 2 = 2.0 THEN PRINT \"mixed\"\n"
|
|
"IF i >= 5 AND i <= 5 THEN PRINT \"range\"\n"
|
|
"IF NOT (i < 5) THEN PRINT \"not\"\n"
|
|
"IF i <> 5 THEN PRINT \"wrong\" ELSE PRINT \"else\"\n"
|
|
"PRINT (i = 5); (s <> \"abc\")\n",
|
|
"lt\n"
|
|
"eq\n"
|
|
"gt\n"
|
|
"dbl\n"
|
|
"mixed\n"
|
|
"range\n"
|
|
"not\n"
|
|
"else\n"
|
|
"True False \n"
|
|
);
|
|
|
|
runFastAndStepped("Fast loop: FOR counters at their limits, stores that convert",
|
|
"DIM i AS INTEGER\n"
|
|
"DIM n AS LONG\n"
|
|
"DIM k AS INTEGER\n"
|
|
"DIM g AS SINGLE\n"
|
|
"FOR i = 32760 TO 32767\n"
|
|
" n = n + 1\n"
|
|
"NEXT i\n"
|
|
"PRINT n; i; TYPENAME(i)\n"
|
|
"FOR i = 10 TO 1 STEP -3: PRINT i;: NEXT: PRINT\n"
|
|
"FOR n = 2147483645 TO 2147483647: PRINT n;: NEXT: PRINT\n"
|
|
"k = 300 * 100 \\ 1000: PRINT k\n"
|
|
"g = 1 / 3: PRINT g\n"
|
|
"k = 2.5: PRINT k\n"
|
|
"k = 3.5: PRINT k\n",
|
|
"8 32768 Long\n"
|
|
"10 7 4 1 \n"
|
|
"2147483645 2147483646 2147483647 \n"
|
|
"30 \n"
|
|
"0.3333333 \n"
|
|
"2 \n"
|
|
"4 \n"
|
|
);
|
|
|
|
runFastAndStepped("Fast loop: objects let go of by stores and returns",
|
|
"SUB Pair()\n"
|
|
" DIM a AS Thing\n"
|
|
" DIM b AS Thing\n"
|
|
" SET a = NEW Thing\n"
|
|
" a.Tag = \"pair\"\n"
|
|
" SET b = a\n"
|
|
"END SUB\n"
|
|
"FUNCTION Make(nm AS STRING) AS Thing\n"
|
|
" DIM t AS Thing\n"
|
|
" SET t = NEW Thing\n"
|
|
" t.Tag = nm\n"
|
|
" SET Make = t\n"
|
|
"END FUNCTION\n"
|
|
"DIM x AS Thing\n"
|
|
"Pair\n"
|
|
"PRINT \"after pair\"\n"
|
|
"SET x = Make(\"kept\")\n"
|
|
"PRINT x.Tag\n"
|
|
"SET x = Make(\"second\")\n"
|
|
"PRINT \"after second\"\n"
|
|
"PRINT Make(\"temp\").Tag\n"
|
|
"SET x = NOTHING\n"
|
|
"PRINT \"end\"\n"
|
|
"BEGINCLASS \"Thing\"\n"
|
|
"Public Tag As String\n"
|
|
"SUB Class_Terminate()\n"
|
|
" PRINT \"bye \"; Tag\n"
|
|
"END SUB\n"
|
|
"ENDCLASS\n",
|
|
"bye pair\n"
|
|
"after pair\n"
|
|
"kept\n"
|
|
"bye kept\n"
|
|
"after second\n"
|
|
"bye temp\n"
|
|
"temp\n"
|
|
"bye second\n"
|
|
"end\n"
|
|
);
|
|
|
|
runProgram("Fast loop: a store that overflows raises the error at the statement",
|
|
"ON ERROR GOTO h\n"
|
|
"DIM i AS INTEGER\n"
|
|
"DIM l AS LONG\n"
|
|
"i = 1\n"
|
|
"i = 40000\n"
|
|
"PRINT \"after\"; i\n"
|
|
"l = 2147483647\n"
|
|
"l = l + 1\n"
|
|
"PRINT \"long\"; l\n"
|
|
"i = i \\ 0\n"
|
|
"PRINT \"div\"; i\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"err6 \n"
|
|
"after1 \n"
|
|
"err6 \n"
|
|
"long2147483647 \n"
|
|
"err11 \n"
|
|
"div1 \n"
|
|
);
|
|
}
|
|
|
|
|
|
// The follow-up round: Byte and Currency, error 13 for text that is not
|
|
// a number, VB's &HBBGGRR colours, named arguments, QBasic line numbers,
|
|
// STATIC arrays and TYPEs, and typed variables that start typed.
|
|
static void testFollowUp(void) {
|
|
runProgram("Follow-up: Byte holds 0 to 255",
|
|
"DIM b AS BYTE\n"
|
|
"ON ERROR GOTO h\n"
|
|
"b = 200\n"
|
|
"PRINT b; VARTYPE(b); TYPENAME(b)\n"
|
|
"b = b + 55\n"
|
|
"PRINT b; VARTYPE(b + b); -b; VARTYPE(-b)\n"
|
|
"b = 256\n"
|
|
"PRINT \"no\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR; CBYTE(3.5); CBYTE(4.5)\n",
|
|
"200 17 Byte\n"
|
|
"255 2 -255 2 \n"
|
|
"err6 4 4 \n"
|
|
);
|
|
|
|
runProgram("Follow-up: Currency is exact to four places",
|
|
"DIM c AS CURRENCY\n"
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 1 TO 10\n"
|
|
" c = c + 0.1@\n"
|
|
"NEXT\n"
|
|
"PRINT c; c = 1; VARTYPE(c); TYPENAME(c)\n"
|
|
"PRINT CCUR(1.23456); CCUR(2.00005); CCUR(2.00015)\n"
|
|
"c = 12.5\n"
|
|
"PRINT c * 3; c / 4; c \\ 4; FORMAT(c, \"0.00\"); STR$(c)\n"
|
|
"c = 922337203685477.5807@\n"
|
|
"PRINT c\n"
|
|
"ON ERROR GOTO h\n"
|
|
"c = c + 1\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n",
|
|
"1 True 6 Currency\n"
|
|
"1.2346 2 2.0002 \n"
|
|
"37.5 3.125 3 12.50 12.5\n"
|
|
"922337203685477.5807 \n"
|
|
"err6 \n"
|
|
);
|
|
|
|
runProgram("Follow-up: Currency counters and DEFCUR",
|
|
"DEFCUR C\n"
|
|
"FOR cnt = 0 TO 0.3 STEP 0.1\n"
|
|
" PRINT cnt;\n"
|
|
"NEXT\n"
|
|
"PRINT VARTYPE(cnt)\n",
|
|
"0 0.1 0.2 0.3 6 \n"
|
|
);
|
|
|
|
runProgram("Follow-up: text that is not a number is error 13 and stores nothing",
|
|
"DIM n AS INTEGER\n"
|
|
"ON ERROR GOTO h\n"
|
|
"n = \"12\"\n"
|
|
"PRINT n\n"
|
|
"n = \" 3.6 \"\n"
|
|
"PRINT n\n"
|
|
"n = \"abc\"\n"
|
|
"PRINT n\n"
|
|
"PRINT n + \"x\"\n"
|
|
"PRINT VAL(\"12abc\"); ISNUMERIC(\"12abc\"); ISNUMERIC(\"1E3\")\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"12 \n"
|
|
"4 \n"
|
|
"err13 \n"
|
|
"4 \n"
|
|
"err13 \n"
|
|
"12 False True \n"
|
|
);
|
|
|
|
runProgram("Follow-up: RGB and QBColor are &HBBGGRR",
|
|
"PRINT RGB(255, 0, 0); RGB(0, 0, 255); HEX$(RGB(1, 2, 3))\n"
|
|
"PRINT QBCOLOR(4); QBCOLOR(9); vbRed; vbBlue\n"
|
|
"PRINT GETRED(RGB(10, 20, 30)); GETGREEN(RGB(10, 20, 30)); GETBLUE(RGB(10, 20, 30))\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT QBCOLOR(16)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n",
|
|
"255 16711680 30201\n"
|
|
"128 16711680 255 16711680 \n"
|
|
"10 20 30 \n"
|
|
"err5 \n"
|
|
);
|
|
|
|
runProgram("Follow-up: named arguments",
|
|
"SUB Info(a AS INTEGER, OPTIONAL b AS STRING = \"B\", OPTIONAL c AS INTEGER = 9)\n"
|
|
" PRINT a; b; c\n"
|
|
"END SUB\n"
|
|
"FUNCTION Sum(x AS INTEGER, y AS INTEGER) AS INTEGER\n"
|
|
" Sum = x * 10 + y\n"
|
|
"END FUNCTION\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"PUBLIC FUNCTION F(x AS INTEGER, OPTIONAL y AS INTEGER = 2) AS INTEGER\n"
|
|
" F = x * 10 + y\n"
|
|
"END FUNCTION\n"
|
|
"ENDCLASS\n"
|
|
"Info c:=3, a:=1\n"
|
|
"Info 2, c:=5\n"
|
|
"PRINT Sum(y:=1, x:=2)\n"
|
|
"PRINT MID$(start:=2, string:=\"hello\", length:=3)\n"
|
|
"PRINT INSTR(String1:=\"abcabc\", String2:=\"c\")\n"
|
|
"DIM col AS NEW Collection\n"
|
|
"col.Add \"one\", Key:=\"k1\"\n"
|
|
"col.Add Item:=\"two\", Key:=\"k2\", Before:=1\n"
|
|
"PRINT col(1); col(\"k1\")\n"
|
|
"DIM kk AS NEW K\n"
|
|
"PRINT kk.F(y:=5, x:=1)\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = NEW K\n"
|
|
"PRINT o.F(y:=5, x:=1); o.F(x:=3)\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT o.F(z:=1)\n"
|
|
"PRINT o.F(1, x:=1)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"1 B3 \n"
|
|
"2 B5 \n"
|
|
"21 \n"
|
|
"ell\n"
|
|
"3 \n"
|
|
"twoone\n"
|
|
"15 \n"
|
|
"15 32 \n"
|
|
"err448 \n"
|
|
"err450 \n"
|
|
);
|
|
|
|
expectCompileError("Follow-up: a named argument the SUB does not have",
|
|
"SUB S(a)\nEND SUB\nS b:=2\n",
|
|
"b"
|
|
);
|
|
|
|
runProgram("Follow-up: QBasic line numbers",
|
|
"10 n = 1\n"
|
|
"20 ON n GOTO 100, 200\n"
|
|
"100 PRINT \"at 100\"\n"
|
|
"110 IF n = 1 THEN 200 ELSE 300\n"
|
|
"200 PRINT \"at 200\"\n"
|
|
"210 n = n + 1\n"
|
|
"215 IF n < 3 GOTO 110\n"
|
|
"220 RESTORE 500\n"
|
|
"230 READ a, b\n"
|
|
"240 PRINT a; b\n"
|
|
"250 ON ERROR GOTO 400\n"
|
|
"260 x = 1 / 0\n"
|
|
"270 GOSUB 600\n"
|
|
"290 END\n"
|
|
"300 PRINT \"at 300\"\n"
|
|
"310 GOTO 220\n"
|
|
"400 PRINT \"err\"; ERR; ERL\n"
|
|
"410 RESUME 270\n"
|
|
"450 DATA 1, 2\n"
|
|
"500 DATA 7, 8\n"
|
|
"600 PRINT \"sub\"\n"
|
|
"610 RETURN\n",
|
|
"at 100\n"
|
|
"at 200\n"
|
|
"at 300\n"
|
|
"7 8 \n"
|
|
"err11 260 \n"
|
|
"sub\n"
|
|
);
|
|
|
|
expectCompileError("Follow-up: a line number past 65529",
|
|
"65530 PRINT 1\n",
|
|
"Line number out of range"
|
|
);
|
|
|
|
runProgram("Follow-up: STATIC arrays and TYPEs keep their values",
|
|
"TYPE Pt\n"
|
|
" x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"SUB S\n"
|
|
" STATIC a(2) AS INTEGER, p AS Pt\n"
|
|
" a(1) = a(1) + 1\n"
|
|
" p.x = p.x + 2\n"
|
|
" PRINT a(1); p.x\n"
|
|
"END SUB\n"
|
|
"S\n"
|
|
"S\n",
|
|
"1 2 \n"
|
|
"2 4 \n"
|
|
);
|
|
|
|
runProgram("Follow-up: typed variables start as their type",
|
|
"DIM a AS LONG, s AS STRING, d AS DOUBLE, b AS BYTE, c AS CURRENCY\n"
|
|
"PRINT VARTYPE(a); VARTYPE(s); VARTYPE(d); VARTYPE(b); VARTYPE(c)\n"
|
|
"SUB T\n"
|
|
" DIM l AS SINGLE\n"
|
|
" PRINT VARTYPE(l)\n"
|
|
"END SUB\n"
|
|
"T\n",
|
|
"3 8 5 17 6 \n"
|
|
"4 \n"
|
|
);
|
|
}
|
|
|
|
|
|
// The front end: what names mean (the resolver's rules), error positions,
|
|
// compile time against program size, and TYPE values assigned into the
|
|
// record that is there.
|
|
static void testFrontEnd(void) {
|
|
// Rule 1: a declared name wins -- a local over a module variable, a
|
|
// FUNCTION or variable over a built-in of the name; an unshared module
|
|
// variable is not seen inside a procedure, a DEF FN sees it
|
|
runProgram("Resolver: declared names win, scopes",
|
|
"DIM SHARED x AS INTEGER\n"
|
|
"DIM y AS INTEGER\n"
|
|
"x = 1\n"
|
|
"y = 3\n"
|
|
"S\n"
|
|
"PRINT x; y\n"
|
|
"DEF FNtwice(n) = n * 2 + y\n"
|
|
"PRINT FNtwice(5)\n"
|
|
"PRINT StrReverse(\"abc\")\n"
|
|
"DIM Sgn AS INTEGER\n"
|
|
"Sgn = 7\n"
|
|
"PRINT Sgn\n"
|
|
"SUB S\n"
|
|
" DIM x AS INTEGER\n"
|
|
" x = 2\n"
|
|
" PRINT x; y\n"
|
|
"END SUB\n"
|
|
"FUNCTION StrReverse(s AS STRING) AS STRING\n"
|
|
" StrReverse = \"[\" + s + \"]\"\n"
|
|
"END FUNCTION\n",
|
|
"2 0 \n1 3 \n13 \n[abc]\n7 \n"
|
|
);
|
|
|
|
// Rule 1 in a class: its member wins over a module variable of the name
|
|
runProgram("Resolver: a class member wins over a module variable",
|
|
"DIM SHARED n AS INTEGER\n"
|
|
"n = 5\n"
|
|
"DIM o AS NEW Box\n"
|
|
"o.SetN 9\n"
|
|
"PRINT n; o.n\n"
|
|
"BEGINCLASS \"Box\"\n"
|
|
"Public n AS INTEGER\n"
|
|
"Public Sub SetN(BYVAL v AS INTEGER)\n"
|
|
" n = v\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"5 9 \n"
|
|
);
|
|
|
|
// Rule 4: OPTION EXPLICIT refuses a name nothing declares
|
|
expectCompileError("Resolver: OPTION EXPLICIT refuses an implicit variable",
|
|
"OPTION EXPLICIT\n"
|
|
"DIM a AS INTEGER\n"
|
|
"a = b + 1\n",
|
|
"Line 3, Col 5: Variable not declared: b"
|
|
);
|
|
|
|
// Errors carry the column of what is wrong
|
|
expectCompileError("Errors: missing operand", "x = 1 +\n", "Line 1, Col 8: Expected expression, got newline");
|
|
expectCompileError("Errors: a SUB used as a value", "PRINT Foo(1)\nSUB Foo(a)\nEND SUB\n", "Line 1, Col 7: Sub 'Foo' cannot be used in an expression");
|
|
expectCompileError("Errors: constant expression", "CONST K = 1 / 0\n", "Line 1, Col 13: Error in constant expression: Division by zero");
|
|
expectCompileError("Errors: unknown field", "TYPE T\nx AS INTEGER\nEND TYPE\nDIM v AS T\nPRINT v.y\n", "Line 5, Col 9: Unknown field 'y' in TYPE 'T'");
|
|
expectCompileError("Errors: NEXT of another loop", "FOR i = 1 TO 3\nNEXT j\n", "Line 2, Col 6: NEXT j does not match FOR i");
|
|
|
|
// Compile time grows with the program, not faster
|
|
double small = bestCompileSeconds(TEST_SCALE_PROCS);
|
|
double large = bestCompileSeconds(TEST_SCALE_PROCS * TEST_SCALE_FACTOR);
|
|
|
|
printf("=== Compile time against procedure count ===\n");
|
|
|
|
if (small < 0.0 || large < 0.0) {
|
|
printf("FAIL: generated program did not compile\n\n");
|
|
gFailCount++;
|
|
} else if (small > 0.0 && large > small * TEST_SCALE_LIMIT) {
|
|
printf("FAIL: %d procedures took %.4fs, %d took %.4fs\n\n", TEST_SCALE_PROCS, small, TEST_SCALE_PROCS * TEST_SCALE_FACTOR, large);
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK (%.4fs, %.4fs)\n\n", small, large);
|
|
}
|
|
|
|
// A TYPE value assigned to a TYPE variable, element or field is copied
|
|
// into the record there (VB): copies stay apart, and a ByRef reference
|
|
// to a field taken before the assignment sees the new value
|
|
runProgram("Records: assignment copies into the record",
|
|
"TYPE Inner\n"
|
|
" v AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"TYPE Rec\n"
|
|
" n AS LONG\n"
|
|
" s AS STRING * 4\n"
|
|
" i AS Inner\n"
|
|
"END TYPE\n"
|
|
"DIM a AS Rec\n"
|
|
"DIM b AS Rec\n"
|
|
"DIM arr(2) AS Rec\n"
|
|
"a.n = 1: a.s = \"ab\": a.i.v = 9\n"
|
|
"b = a\n"
|
|
"a.n = 2\n"
|
|
"PRINT b.n; a.n; \"[\"; b.s; \"]\"; b.i.v\n"
|
|
"arr(1) = a\n"
|
|
"a.n = 3\n"
|
|
"PRINT arr(1).n; a.n\n"
|
|
"Bump a.n, a\n"
|
|
"PRINT a.n; a.s\n"
|
|
"arr(2).i = b.i\n"
|
|
"b.i.v = 4\n"
|
|
"PRINT arr(2).i.v; b.i.v\n"
|
|
"SUB Bump(f AS LONG, r AS Rec)\n"
|
|
" DIM t AS Rec\n"
|
|
" t.n = 100\n"
|
|
" t.s = \"zz\"\n"
|
|
" r = t\n"
|
|
" f = f + 1\n"
|
|
"END SUB\n",
|
|
"1 2 [ab ]9 \n2 3 \n101 zz \n9 4 \n"
|
|
);
|
|
}
|
|
|
|
|
|
// Gap closure (basicGapsPlan.md): the language limits closed in the
|
|
// final pass, one program each.
|
|
static void testGapClosure(void) {
|
|
runProgram("Gap closure: a call's result indexed (c(1)(0), Split(s)(n))",
|
|
"DIM c AS NEW Collection\n"
|
|
"DIM a(2) AS INTEGER\n"
|
|
"a(0) = 11\n"
|
|
"c.Add a\n"
|
|
"PRINT c(1)(0); SPLIT(\"x,y,z\", \",\")(2); c.Item(1)(0)\n"
|
|
"DIM v AS VARIANT\n"
|
|
"v = c\n"
|
|
"PRINT v(1)(0)\n",
|
|
"11 z11 \n"
|
|
"11 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: Null through the Variant string, search and date functions; the $ forms raise error 94",
|
|
"DIM v AS VARIANT\n"
|
|
"v = NULL\n"
|
|
"PRINT ISNULL(LEFT(v, 1)); ISNULL(MID(v, 1)); ISNULL(MID(v, 1, 2)); ISNULL(UCASE(v)); ISNULL(TRIM(v)); ISNULL(LEN(v))\n"
|
|
"PRINT ISNULL(INSTR(v, \"a\")); ISNULL(INSTR(1, \"a\", v)); ISNULL(STRCOMP(v, \"a\")); ISNULL(INSTRREV(\"a\", v)); ISNULL(STR(v)); ISNULL(HEX(v)); ISNULL(STRING(3, v)); ISNULL(YEAR(v)); ISNULL(DATEPART(\"yyyy\", v))\n"
|
|
"PRINT LEFT(\"abc\", 2); MID(\"abcdef\", 2, 3); UCASE(\"x\"); STRING(3, \"z\"); STR(5); HEX(255); CHR(65); SPACE(2); \"|\"; LEN(\"abcd\"); TRIM(\" q \")\n"
|
|
"v = \"hello\"\n"
|
|
"PRINT LEFT(v, 2); LEN(v)\n"
|
|
"ON ERROR GOTO h\n"
|
|
"v = NULL\n"
|
|
"PRINT LEFT$(v, 1)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"True True True True True True \n"
|
|
"True True True True True True True True True \n"
|
|
"abbcdXzzz 5FFA |4 q\n"
|
|
"he5 \n"
|
|
"err94 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: CLOSE with a list or nothing, RESET, ERASE of a list",
|
|
"OPEN \"gapc1.txt\" FOR OUTPUT AS #1: OPEN \"gapc2.txt\" FOR OUTPUT AS #2: OPEN \"gapc3.txt\" FOR OUTPUT AS #3\n"
|
|
"PRINT #1, \"one\": PRINT #2, \"two\": PRINT #3, \"three\"\n"
|
|
"CLOSE #1, #2\n"
|
|
"PRINT FREEFILE\n"
|
|
"CLOSE\n"
|
|
"PRINT FREEFILE\n"
|
|
"OPEN \"gapc1.txt\" FOR INPUT AS #4\n"
|
|
"RESET\n"
|
|
"PRINT FREEFILE\n"
|
|
"DIM a(3), b(3) AS STRING\n"
|
|
"a(1) = 5: b(1) = \"x\"\n"
|
|
"ERASE a, b\n"
|
|
"PRINT a(1); \"[\"; b(1); \"]\"\n"
|
|
"CLOSE #9\n"
|
|
"ON ERROR GOTO h\n"
|
|
"CLOSE 1, 99\n"
|
|
"END\n"
|
|
"h: PRINT \"err\"; ERR: RESUME NEXT\n",
|
|
"1 \n"
|
|
"1 \n"
|
|
"1 \n"
|
|
"0 []\n"
|
|
"err52 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: STATIC lists, fixed-length strings, each object's own copies",
|
|
"DIM a AS NEW Ctr, b AS NEW Ctr\n"
|
|
"PRINT a.Hit; a.Hit; b.Hit; a.Hit; \"[\"; a.Name; \"]\"; a.Tot(2); b.Tot(5); a.Tot(1)\n"
|
|
"BEGINCLASS \"Ctr\"\n"
|
|
"Public Function Hit() As Integer\n"
|
|
" STATIC n AS INTEGER\n"
|
|
" n = n + 1\n"
|
|
" Hit = n\n"
|
|
"End Function\n"
|
|
"Public Function Name() As String\n"
|
|
" STATIC s AS STRING\n"
|
|
" Name = s & \"x\"\n"
|
|
"End Function\n"
|
|
"Public Function Tot(k AS INTEGER) AS LONG\n"
|
|
" STATIC t\n"
|
|
" t = t + k\n"
|
|
" Tot = t\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n"
|
|
"SUB L\n"
|
|
" STATIC a, b AS STRING, f AS STRING * 3\n"
|
|
" a = a + 1: b = b + \"y\"\n"
|
|
" PRINT a; b; \"[\"; f; \"]\"\n"
|
|
" f = \"q\"\n"
|
|
"END SUB\n"
|
|
"L\n"
|
|
"L\n",
|
|
"1 2 1 3 [x]2 5 3 \n"
|
|
"1 y[]\n"
|
|
"2 yy[q ]\n"
|
|
);
|
|
|
|
runProgram("Gap closure: SUB / FUNCTION ... STATIC keep every local between calls (each object its own)",
|
|
"S\n"
|
|
"S\n"
|
|
"PRINT F(2); F(3)\n"
|
|
"DIM o AS NEW K\n"
|
|
"DIM p AS NEW K\n"
|
|
"PRINT o.Hit; o.Hit; p.Hit\n"
|
|
"SUB S STATIC\n"
|
|
" DIM t AS STRING\n"
|
|
" n = n + 1\n"
|
|
" t = t + \"x\"\n"
|
|
" PRINT n; t\n"
|
|
"END SUB\n"
|
|
"FUNCTION F(k AS INTEGER) AS INTEGER STATIC\n"
|
|
" tot = tot + k\n"
|
|
" F = tot\n"
|
|
"END FUNCTION\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Public Function Hit() As Integer Static\n"
|
|
" c = c + 1\n"
|
|
" Hit = c\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n",
|
|
"1 x\n"
|
|
"2 xx\n"
|
|
"2 5 \n"
|
|
"1 2 1 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: WITH ... END WITH on records, nested, objects, New and Me",
|
|
"TYPE P\n"
|
|
" x AS INTEGER\n"
|
|
" y AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"TYPE Q\n"
|
|
" pt AS P\n"
|
|
" n AS STRING\n"
|
|
"END TYPE\n"
|
|
"DIM pt AS P, qs(3) AS Q\n"
|
|
"WITH pt\n"
|
|
" .x = 3\n"
|
|
" .y = .x + 1\n"
|
|
"END WITH\n"
|
|
"PRINT pt.x; pt.y\n"
|
|
"i = 2\n"
|
|
"WITH qs(i)\n"
|
|
" .n = \"two\"\n"
|
|
" WITH .pt\n"
|
|
" .x = 7\n"
|
|
" Bump .y\n"
|
|
" END WITH\n"
|
|
"END WITH\n"
|
|
"PRINT qs(2).n; qs(2).pt.x; qs(2).pt.y\n"
|
|
"DIM b AS NEW Box\n"
|
|
"WITH b\n"
|
|
" .Value = 5\n"
|
|
" .Add 3\n"
|
|
" PRINT .Value; .Twice()\n"
|
|
"END WITH\n"
|
|
"WITH New Box\n"
|
|
" .Value = 9\n"
|
|
" PRINT .Value\n"
|
|
"END WITH\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = b\n"
|
|
"WITH o\n"
|
|
" .Add 1\n"
|
|
" PRINT .Value\n"
|
|
"END WITH\n"
|
|
"SUB Bump(n AS INTEGER)\n"
|
|
" n = n + 100\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Box\"\n"
|
|
"Public Value AS INTEGER\n"
|
|
"Public Sub Add(k AS INTEGER)\n"
|
|
" Value = Value + k\n"
|
|
"End Sub\n"
|
|
"Public Function Twice() AS INTEGER\n"
|
|
" WITH Me\n"
|
|
" Twice = .Value * 2\n"
|
|
" END WITH\n"
|
|
"End Function\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[term\"; Value; \"]\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"3 4 \n"
|
|
"two7 100 \n"
|
|
"8 16 \n"
|
|
"9 \n"
|
|
"[term9 ]\n"
|
|
"9 \n"
|
|
"[term9 ]\n"
|
|
);
|
|
|
|
runProgram("Gap closure: Friend procedures and properties for the program's own code",
|
|
"DIM o AS NEW K\n"
|
|
"PRINT o.F(2); o.Size\n"
|
|
"o.Size = 5\n"
|
|
"PRINT o.Size\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Private m AS INTEGER\n"
|
|
"Friend Function F(n AS INTEGER) AS INTEGER\n"
|
|
" DIM t AS INTEGER\n"
|
|
" t = n * 3\n"
|
|
" F = t\n"
|
|
"End Function\n"
|
|
"Friend Property Get Size() AS INTEGER\n"
|
|
" Size = m\n"
|
|
"End Property\n"
|
|
"Friend Property Let Size(v AS INTEGER)\n"
|
|
" m = v\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n",
|
|
"6 0 \n"
|
|
"5 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: a Friend member is not reached through late binding (error 438)",
|
|
"DIM o AS NEW K\n"
|
|
"DIM x AS OBJECT\n"
|
|
"SET x = o\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT x.F(2)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"END\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Private m AS INTEGER\n"
|
|
"Friend Function F(n AS INTEGER) AS INTEGER\n"
|
|
" DIM t AS INTEGER\n"
|
|
" t = n * 3\n"
|
|
" F = t\n"
|
|
"End Function\n"
|
|
"Friend Property Get Size() AS INTEGER\n"
|
|
" Size = m\n"
|
|
"End Property\n"
|
|
"Friend Property Let Size(v AS INTEGER)\n"
|
|
" m = v\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n",
|
|
"err438 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: Property procedures in a standard module",
|
|
"DIM SHARED m AS INTEGER\n"
|
|
"DIM SHARED arr(5) AS STRING\n"
|
|
"Size = 4\n"
|
|
"PRINT Size\n"
|
|
"Item(2) = \"two\"\n"
|
|
"PRINT Item(2); \"|\"; arr(2)\n"
|
|
"SUB T\n"
|
|
" Size = Size + 1\n"
|
|
" PRINT Size\n"
|
|
"END SUB\n"
|
|
"T\n"
|
|
"DIM o AS NEW K\n"
|
|
"o.Go\n"
|
|
"PROPERTY GET Size() AS INTEGER\n"
|
|
" Size = m * 2\n"
|
|
"END PROPERTY\n"
|
|
"PROPERTY LET Size(n AS INTEGER)\n"
|
|
" m = n\n"
|
|
"END PROPERTY\n"
|
|
"PROPERTY GET Item(i AS INTEGER) AS STRING\n"
|
|
" Item = arr(i)\n"
|
|
"END PROPERTY\n"
|
|
"PROPERTY LET Item(i AS INTEGER, v AS STRING)\n"
|
|
" arr(i) = UCASE$(v)\n"
|
|
"END PROPERTY\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Private mv AS INTEGER\n"
|
|
"Public Property Get V() AS INTEGER\n"
|
|
" V = mv\n"
|
|
"End Property\n"
|
|
"Public Property Let V(n AS INTEGER)\n"
|
|
" mv = n\n"
|
|
"End Property\n"
|
|
"Public Sub Go()\n"
|
|
" V = 7\n"
|
|
" PRINT V; Size\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"8 \n"
|
|
"TWO|TWO\n"
|
|
"18 \n"
|
|
"7 18 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: Private CONST / ENUM belong to their class",
|
|
"PRINT K1\n"
|
|
"DIM o AS NEW C\n"
|
|
"o.Show1\n"
|
|
"BEGINCLASS \"C\"\n"
|
|
"PRIVATE CONST K1 = 7\n"
|
|
"PRIVATE ENUM EE\n"
|
|
" Zap = 4\n"
|
|
"END ENUM\n"
|
|
"Public Sub Show1()\n"
|
|
" PRINT K1; Zap\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"0 \n"
|
|
"7 4 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: Private CONST / ENUM belong to their module file; Public ones are seen everywhere",
|
|
"BEGINMODULE \"m1\"\n"
|
|
"PRIVATE CONST K = 1\n"
|
|
"PRIVATE ENUM E\n"
|
|
" Zed = 10\n"
|
|
"END ENUM\n"
|
|
"SUB A\n"
|
|
" PRINT K; Zed\n"
|
|
"END SUB\n"
|
|
"ENDMODULE\n"
|
|
"BEGINMODULE \"m2\"\n"
|
|
"PRIVATE CONST K = 2\n"
|
|
"PUBLIC CONST P = 3\n"
|
|
"SUB B\n"
|
|
" PRINT K; P\n"
|
|
"END SUB\n"
|
|
"A\n"
|
|
"B\n"
|
|
"ENDMODULE\n",
|
|
"1 10 \n"
|
|
"2 3 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: the constants of a class module or form belong to their file",
|
|
"BEGINCLASS \"C\"\n"
|
|
"CONST KC = 7\n"
|
|
"ENDCLASS\n"
|
|
"BEGINFORM \"F\"\n"
|
|
"CONST KF = 8\n"
|
|
"ENDFORM\n"
|
|
"BEGINFORM \"G\"\n"
|
|
"CONST KF = 9\n"
|
|
"ENDFORM\n"
|
|
"PRINT KC; KF\n",
|
|
"0 0 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: PUBLIC / PRIVATE on ENUM and CONST at module level",
|
|
"PUBLIC ENUM Colors\n"
|
|
" Red\n"
|
|
" Green = 5\n"
|
|
"END ENUM\n"
|
|
"PRIVATE CONST K = 3\n"
|
|
"PUBLIC CONST L AS LONG = 4\n"
|
|
"PRINT Red; Green; K; L; Colors.Green\n",
|
|
"0 5 3 4 5 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: typed parameters convert their arguments (ByVal, values, late binding, copies for mismatched variables)",
|
|
"SUB V(BYVAL x AS INTEGER)\n"
|
|
" PRINT x;\n"
|
|
"END SUB\n"
|
|
"SUB R(x AS INTEGER)\n"
|
|
" x = x + 1\n"
|
|
" PRINT x;\n"
|
|
"END SUB\n"
|
|
"SUB S(t AS STRING, d AS DATE, b AS BOOLEAN, g AS DOUBLE)\n"
|
|
" PRINT t; \"|\"; d; \"|\"; b; \"|\"; g\n"
|
|
"END SUB\n"
|
|
"V 3.7\n"
|
|
"R 3.7\n"
|
|
"DIM d AS DOUBLE\n"
|
|
"d = 2.6\n"
|
|
"V d\n"
|
|
"R ((d))\n"
|
|
"DIM n AS INTEGER\n"
|
|
"n = 5\n"
|
|
"R n\n"
|
|
"PRINT n\n"
|
|
"S 5, \"1/2/2020\", 1, \"2.5\"\n"
|
|
"u = 7.6\n"
|
|
"R u\n"
|
|
"PRINT u\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = NEW K\n"
|
|
"o.M 4.6\n"
|
|
"DIM lng AS LONG\n"
|
|
"lng = 9\n"
|
|
"o.N lng\n"
|
|
"PRINT lng\n"
|
|
"o.N n\n"
|
|
"PRINT n\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Public Sub M(x AS INTEGER)\n"
|
|
" PRINT x\n"
|
|
"End Sub\n"
|
|
"Public Sub N(x AS INTEGER)\n"
|
|
" x = x * 10\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"4 5 3 4 6 6 \n"
|
|
"5|1/2/2020|True |2.5 \n"
|
|
"9 9 \n"
|
|
"5 \n"
|
|
"9 \n"
|
|
"60 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: name (x) without CALL passes x by value",
|
|
"SUB V(BYVAL x AS INTEGER)\n"
|
|
" PRINT x;\n"
|
|
"END SUB\n"
|
|
"SUB R(x AS INTEGER)\n"
|
|
" PRINT x;\n"
|
|
"END SUB\n"
|
|
"FUNCTION F(x AS LONG) AS LONG\n"
|
|
" F = x\n"
|
|
"END FUNCTION\n"
|
|
"V 3.7\n"
|
|
"R 3.7\n"
|
|
"d# = 2.6\n"
|
|
"V d#\n"
|
|
"R (d#)\n"
|
|
"PRINT F(2.5); F(3.5)\n"
|
|
"DIM o AS NEW K\n"
|
|
"o.M 4.6\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Public Sub M(x AS INTEGER)\n"
|
|
" PRINT x\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"4 4 3 3 2 4 \n"
|
|
"5 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: stores into STRING and DOUBLE variables convert",
|
|
"DIM s AS STRING\n"
|
|
"s = 5\n"
|
|
"PRINT LEN(s); VARTYPE(s); \"[\"; s; \"]\"\n"
|
|
"DIM d AS DOUBLE\n"
|
|
"d = \"2.5\"\n"
|
|
"PRINT VARTYPE(d); d * 2\n",
|
|
"1 8 [5]\n"
|
|
"5 5 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: an object's default member stands for it in expressions (no default: error 13)",
|
|
"DIM o AS NEW Box\n"
|
|
"o.Value = 7\n"
|
|
"DIM x AS INTEGER\n"
|
|
"x = o\n"
|
|
"PRINT x; o + 1; \"[\"; o; \"]\"\n"
|
|
"DIM v AS OBJECT\n"
|
|
"SET v = o\n"
|
|
"PRINT v * 2; v = 7; LEN(v & \"\")\n"
|
|
"IF v THEN PRINT \"true\"\n"
|
|
"DIM s AS STRING\n"
|
|
"s = o\n"
|
|
"PRINT s; \"|\"; UCASE$(o)\n"
|
|
"DIM n AS NEW Named\n"
|
|
"PRINT n & \"!\"; n.Twice\n"
|
|
"ON ERROR GOTO h\n"
|
|
"DIM w AS NEW NoDef\n"
|
|
"PRINT w + 1\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"END\n"
|
|
"BEGINCLASS \"Box\"\n"
|
|
"Private m As Integer\n"
|
|
"Public Property Get Value() As Integer\n"
|
|
"Attribute Value.VB_UserMemId = 0\n"
|
|
" Value = m\n"
|
|
"End Property\n"
|
|
"Public Property Let Value(n As Integer)\n"
|
|
" m = n\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Named\"\n"
|
|
"Public Label As String\n"
|
|
"Attribute Label.VB_UserMemId = 0\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" Label = \"nm\"\n"
|
|
"End Sub\n"
|
|
"Public Function Twice() As String\n"
|
|
" Twice = Me & Me\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"NoDef\"\n"
|
|
"Public q As Integer\n"
|
|
"ENDCLASS\n",
|
|
"7 8 [7 ]\n"
|
|
"14 True 1 \n"
|
|
"true\n"
|
|
"7|7\n"
|
|
"nm!nmnm\n"
|
|
"err13 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: a store into an object variable without SET goes to its default member",
|
|
"DIM o AS NEW Box\n"
|
|
"DIM p AS Box\n"
|
|
"p = o\n"
|
|
"PRINT TYPENAME(p)\n"
|
|
"DIM q AS OBJECT\n"
|
|
"q = o\n"
|
|
"PRINT TYPENAME(q)\n"
|
|
"o = 9\n"
|
|
"PRINT TYPENAME(o)\n"
|
|
"BEGINCLASS \"Box\"\n"
|
|
"Public v AS INTEGER\n"
|
|
"Attribute v.VB_UserMemId = 0\n"
|
|
"ENDCLASS\n",
|
|
"Box\n"
|
|
"Box\n"
|
|
"Box\n"
|
|
);
|
|
|
|
runProgram("Gap closure: Property Let as the default member, through Object too",
|
|
"DIM o AS NEW Box\n"
|
|
"o = 9\n"
|
|
"PRINT o.Value; o\n"
|
|
"DIM q AS OBJECT\n"
|
|
"SET q = o\n"
|
|
"q = 3 + 4\n"
|
|
"PRINT o\n"
|
|
"BEGINCLASS \"Box\"\n"
|
|
"Private m As Integer\n"
|
|
"Public Property Get Value() As Integer\n"
|
|
"Attribute Value.VB_UserMemId = 0\n"
|
|
" Value = m\n"
|
|
"End Property\n"
|
|
"Public Property Let Value(n As Integer)\n"
|
|
" m = n\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n",
|
|
"9 9 \n"
|
|
"7 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: PRINT # columns, zones, TAB, SPC, USING and WIDTH #",
|
|
"OPEN \"gapw.txt\" FOR OUTPUT AS #1\n"
|
|
"WIDTH #1, 5\n"
|
|
"PRINT #1, \"abcdefghijkl\"\n"
|
|
"PRINT #1, \"ab\"; \"cdef\"\n"
|
|
"WIDTH #1, 255\n"
|
|
"PRINT #1, \"a\", \"b\"; TAB(20); \"c\"; SPC(2); \"d\"\n"
|
|
"PRINT #1, USING \"##.#\"; 3.14159; 2.5\n"
|
|
"PRINT #1, 1; 2\n"
|
|
"PRINT #1,\n"
|
|
"CLOSE #1\n"
|
|
"OPEN \"gapw.txt\" FOR INPUT AS #1\n"
|
|
"DO WHILE NOT EOF(1)\n"
|
|
"LINE INPUT #1, a$\n"
|
|
"PRINT \"[\"; a$; \"]\"\n"
|
|
"LOOP\n"
|
|
"CLOSE\n",
|
|
"[abcde]\n"
|
|
"[fghij]\n"
|
|
"[kl]\n"
|
|
"[ab]\n"
|
|
"[cdef]\n"
|
|
"[a b c d]\n"
|
|
"[ 3.1 2.5]\n"
|
|
"[1 2 ]\n"
|
|
"[]\n"
|
|
);
|
|
|
|
runProgram("Gap closure: WIDTH of devices and files: errors 64, 52 and 5; PRINT # stopped by an error",
|
|
"ON ERROR GOTO h\n"
|
|
"WIDTH \"COM9:\", 10\n"
|
|
"WIDTH #3, 10\n"
|
|
"WIDTH LPRINT 0\n"
|
|
"WIDTH \"LPT2:\", 255\n"
|
|
"OPEN \"gapx.txt\" FOR OUTPUT AS #2\n"
|
|
"PRINT #2, 1 / 0; \"after\"\n"
|
|
"PRINT \"console\"\n"
|
|
"CLOSE #2\n"
|
|
"END\n"
|
|
"h: PRINT \"err\"; ERR: RESUME NEXT\n",
|
|
"err64 \n"
|
|
"err52 \n"
|
|
"err5 \n"
|
|
"err11 \n"
|
|
"console\n"
|
|
);
|
|
|
|
runProgram("Gap closure: a parenthesised RaiseEvent value is one temporary every handler shares",
|
|
"DIM WithEvents a AS Src\n"
|
|
"DIM WithEvents b AS Src\n"
|
|
"SET a = NEW Src\n"
|
|
"SET b = a\n"
|
|
"a.Fire\n"
|
|
"SUB a_E(n AS INTEGER)\n"
|
|
" PRINT \"a\"; n;\n"
|
|
" n = n + 1\n"
|
|
"END SUB\n"
|
|
"SUB b_E(n AS INTEGER)\n"
|
|
" PRINT \"b\"; n;\n"
|
|
" n = n + 10\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Src\"\n"
|
|
"Event E(n AS INTEGER)\n"
|
|
"Public Sub Fire()\n"
|
|
" DIM x AS INTEGER\n"
|
|
" x = 5\n"
|
|
" RaiseEvent E((x))\n"
|
|
" RaiseEvent E(x + 0)\n"
|
|
" RaiseEvent E(x)\n"
|
|
" PRINT \"x\"; x\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"a5 b6 a5 b6 a5 b6 x16 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: a left-out argument through an interface takes the interface's default",
|
|
"DIM i AS IFoo\n"
|
|
"SET i = NEW Impl\n"
|
|
"i.Go\n"
|
|
"BEGINCLASS \"IFoo\"\n"
|
|
"Public Sub Go(Optional n AS INTEGER = 5)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"Impl\"\n"
|
|
"Implements IFoo\n"
|
|
"Private Sub IFoo_Go(Optional n AS INTEGER = 9)\n"
|
|
" PRINT n\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"5 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: Class_Terminate runs for objects still held when the program ends",
|
|
"DIM o AS K\n"
|
|
"SET o = NEW K\n"
|
|
"PRINT \"end of code\"\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"terminate\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"end of code\n"
|
|
"terminate\n"
|
|
);
|
|
|
|
runProgram("Gap closure: a late-bound ByVal parameter given a TYPE field leaves the field alone",
|
|
"TYPE R\n"
|
|
" f AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM r1 AS R\n"
|
|
"r1.f = 5\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = NEW K\n"
|
|
"o.M r1.f\n"
|
|
"PRINT r1.f\n"
|
|
"o.N r1.f\n"
|
|
"PRINT r1.f\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Public Sub M(ByVal x AS INTEGER)\n"
|
|
" x = 99\n"
|
|
"End Sub\n"
|
|
"Public Sub N(x AS INTEGER)\n"
|
|
" x = 77\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"5 \n"
|
|
"77 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: RaiseEvent passes a TYPE field by reference, a parenthesised one by value",
|
|
"TYPE R\n"
|
|
" f AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM r1 AS R\n"
|
|
"DIM WithEvents s AS Src\n"
|
|
"SET s = NEW Src\n"
|
|
"s.Go\n"
|
|
"SUB s_Ping(n AS INTEGER)\n"
|
|
" n = n + 10\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Src\"\n"
|
|
"Event Ping(n AS INTEGER)\n"
|
|
"Public Sub Go()\n"
|
|
" DIM q AS R\n"
|
|
" q.f = 1\n"
|
|
" RaiseEvent Ping(q.f)\n"
|
|
" PRINT q.f\n"
|
|
" RaiseEvent Ping((q.f))\n"
|
|
" PRINT q.f\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"11 \n"
|
|
"11 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: ON ERROR RESUME NEXT, in the procedure and in ones it calls; Err.Number / Description; Err.Clear",
|
|
"ON ERROR RESUME NEXT\n"
|
|
"x = 1 / 0\n"
|
|
"PRINT \"after\"; ERR; Err.Number; \"[\"; Err.Description; \"]\"\n"
|
|
"Err.Clear\n"
|
|
"PRINT ERR\n"
|
|
"S\n"
|
|
"PRINT \"back\"; ERR\n"
|
|
"SUB S\n"
|
|
" PRINT 1 / 0\n"
|
|
" PRINT \"not here\"\n"
|
|
"END SUB\n",
|
|
"after11 11 [Division by zero]\n"
|
|
"0 \n"
|
|
"back11 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: Err.Raise with number, source and description",
|
|
"ON ERROR GOTO h\n"
|
|
"ERROR 5\n"
|
|
"Err.Raise 1001, \"Mine\", \"Custom thing\"\n"
|
|
"Err.Raise 9\n"
|
|
"END\n"
|
|
"h: PRINT ERR; Err.Number; Err.Description; \"|\"; Err.Source: RESUME NEXT\n",
|
|
"5 5 Illegal function call|\n"
|
|
"1001 1001 Custom thing|Mine\n"
|
|
"9 9 Subscript out of range|\n"
|
|
);
|
|
|
|
runProgram("Gap closure: Err.Number = n sets the error without raising it",
|
|
"Err.Number = 11\n"
|
|
"PRINT ERR; Err.Description\n"
|
|
"Err.Clear\n"
|
|
"PRINT ERR; \"[\"; Err.Description; \"]\"\n",
|
|
"11 Division by zero\n"
|
|
"0 []\n"
|
|
);
|
|
|
|
runProgram("Gap closure: LIKE patterns (* ? # [list] [!list]), OPTION COMPARE TEXT, Null, error 93",
|
|
"PRINT \"abc\" LIKE \"a*\"; \"abc\" LIKE \"a?d\"; \"a1\" LIKE \"a#\"; \"b\" LIKE \"[a-c]\"; \"x\" LIKE \"[!a-c]\"; \"ABC\" LIKE \"abc\"; \"a*b\" LIKE \"a[*]b\"; \"\" LIKE \"*\"; \"abc\" LIKE \"*c\"; \"aXbXc\" LIKE \"a*b*c\"\n"
|
|
"OPTION COMPARE TEXT\n"
|
|
"PRINT \"ABC\" LIKE \"abc\"\n"
|
|
"v = NULL\n"
|
|
"PRINT ISNULL(v LIKE \"a\")\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT \"a\" LIKE \"[ab\"\n"
|
|
"END\n"
|
|
"h: PRINT \"err\"; ERR: RESUME NEXT\n",
|
|
"True False True True True False True True True True \n"
|
|
"True \n"
|
|
"True \n"
|
|
"err93 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: ERROR$ / ERROR give an error's text",
|
|
"PRINT ERROR$(5); \"|\"; ERROR(11); \"|\"; ERROR$(0); \"|\"\n"
|
|
"ON ERROR RESUME NEXT\n"
|
|
"ERROR 6\n"
|
|
"PRINT ERROR$; \"|\"; ERROR\n",
|
|
"Illegal function call|Division by zero||\n"
|
|
"Overflow|Overflow\n"
|
|
);
|
|
|
|
runProgram("Gap closure: FILEATTR gives a file's mode and handle",
|
|
"OPEN \"gapf1.txt\" FOR OUTPUT AS #1\n"
|
|
"OPEN \"gapf2.txt\" FOR BINARY AS #2\n"
|
|
"PRINT FILEATTR(1, 1); FILEATTR(2, 1); FILEATTR(1, 2) > 0\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT FILEATTR(3, 1)\n"
|
|
"PRINT FILEATTR(1, 7)\n"
|
|
"END\n"
|
|
"h: PRINT \"err\"; ERR: RESUME NEXT\n",
|
|
"2 32 True \n"
|
|
"err52 \n"
|
|
"err5 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: ASC of an empty string is error 5",
|
|
"a$ = \"\"\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT ASC(a$)\n"
|
|
"PRINT ASC(\"Q\")\n"
|
|
"END\n"
|
|
"h: PRINT \"err\"; ERR: RESUME NEXT\n",
|
|
"err5 \n"
|
|
"81 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: ARRAY builds a Variant array",
|
|
"DIM v AS VARIANT, w AS VARIANT\n"
|
|
"v = ARRAY(1, \"two\", 3.5)\n"
|
|
"PRINT LBOUND(v); UBOUND(v); v(1); TYPENAME(v)\n"
|
|
"w = ARRAY()\n"
|
|
"PRINT UBOUND(w)\n"
|
|
"FOR EACH x IN ARRAY(4, 5)\n"
|
|
"PRINT x;\n"
|
|
"NEXT\n"
|
|
"PRINT\n",
|
|
"0 2 twoVariant()\n"
|
|
"-1 \n"
|
|
"4 5 \n"
|
|
);
|
|
|
|
runProgram("Gap closure: ARRAY under OPTION BASE 1 starts at 1",
|
|
"OPTION BASE 1\n"
|
|
"DIM v AS VARIANT\n"
|
|
"v = ARRAY(7, 8)\n"
|
|
"PRINT LBOUND(v); UBOUND(v); v(1)\n",
|
|
"1 2 7 \n"
|
|
);
|
|
|
|
expectCompileError("Gap closure: a variable of another type given ByRef to a typed parameter",
|
|
"SUB S(x AS INTEGER)\nEND SUB\nDIM d AS DOUBLE\nS d\n",
|
|
"ByRef argument type mismatch: argument 1 of 'S' is Double, the parameter is Integer"
|
|
);
|
|
|
|
expectCompileError("Gap closure: Public CONST in a class module",
|
|
"BEGINCLASS \"C\"\nPUBLIC CONST K = 1\nENDCLASS\n",
|
|
"Constants are not allowed as Public members of a class module or form"
|
|
);
|
|
|
|
expectCompileError("Gap closure: EnumName.Member = x",
|
|
"ENUM E\n A\n B\nEND ENUM\nE.A = 3\n",
|
|
"Cannot assign to a constant"
|
|
);
|
|
|
|
runProgram("Follow-up: an array in a STATIC procedure keeps its values",
|
|
"SUB S STATIC\n DIM a(3)\n a(1) = a(1) + 1\n PRINT a(1)\nEND SUB\nS\nS\n",
|
|
"1 \n2 \n"
|
|
);
|
|
|
|
expectCompileError("Gap closure: Err has no such value",
|
|
"PRINT Err.Foo\n",
|
|
"Err has no value 'Foo'"
|
|
);
|
|
|
|
expectCompileError("Gap closure: Err has no such statement",
|
|
"Err.Bogus\n",
|
|
"Err has no statement 'Bogus'"
|
|
);
|
|
|
|
// PEN: the mouse on the program screen stands in for the light pen
|
|
CaptureT cap;
|
|
TestKeysT keys;
|
|
|
|
memset(&keys, 0, sizeof(keys));
|
|
keys.mouseX[0] = TEST_PEN_X1;
|
|
keys.mouseY[0] = TEST_PEN_Y1;
|
|
keys.mouseDown[0] = true;
|
|
keys.mouseX[1] = TEST_PEN_X2;
|
|
keys.mouseY[1] = TEST_PEN_Y2;
|
|
keys.mouseCount = 2;
|
|
|
|
BasVmT *vm = screenRun("Gap closure: PEN ON, PEN(0) to PEN(9), PEN OFF",
|
|
"SCREEN 12\n"
|
|
"PEN ON\n"
|
|
"DOEVENTS\n"
|
|
"d1 = PEN(3): x1 = PEN(1): y1 = PEN(2): r1 = PEN(6): c1 = PEN(7)\n"
|
|
"DOEVENTS\n"
|
|
"p1 = PEN(0): p2 = PEN(0): d2 = PEN(3): x2 = PEN(4): y2 = PEN(5): r2 = PEN(8): c2 = PEN(9)\n"
|
|
"PEN OFF\n"
|
|
"ON ERROR GOTO h\n"
|
|
"z = PEN(3)\n"
|
|
"END\n"
|
|
"h: e = ERR: RESUME NEXT\n",
|
|
&cap, &keys);
|
|
|
|
if (vm) {
|
|
checkTrue("PEN: down at the press", globalNum(vm, "d1") == -1 && globalNum(vm, "x1") == TEST_PEN_X1 && globalNum(vm, "y1") == TEST_PEN_Y1);
|
|
checkTrue("PEN: the press's text cell", globalNum(vm, "r1") == 4 && globalNum(vm, "c1") == 13);
|
|
checkTrue("PEN(0) once per press", globalNum(vm, "p1") == -1 && globalNum(vm, "p2") == 0 && globalNum(vm, "d2") == 0);
|
|
checkTrue("PEN: where it is now", globalNum(vm, "x2") == TEST_PEN_X2 && globalNum(vm, "y2") == TEST_PEN_Y2 && globalNum(vm, "r2") == 13 && globalNum(vm, "c2") == 38);
|
|
checkTrue("PEN after PEN OFF is error 5", globalNum(vm, "e") == 5);
|
|
screenRunFree(vm);
|
|
}
|
|
}
|
|
|
|
|
|
// DoEvents stub of the screen tests: types the test's keys once.
|
|
static bool testKeysDoEvents(void *ctx) {
|
|
TestKeysT *k = (TestKeysT *)ctx;
|
|
int32_t call = k->calls++;
|
|
|
|
if (call == 0 && k->vm->screen) {
|
|
for (int32_t i = 0; i < k->count; i++) {
|
|
basScreenPushKey(k->vm->screen, k->keys[i]);
|
|
}
|
|
}
|
|
|
|
if (call < k->mouseCount && k->vm->screen) {
|
|
basScreenMouse(k->vm->screen, k->mouseX[call], k->mouseY[call], k->mouseDown[call]);
|
|
}
|
|
|
|
return true;
|
|
}
|
|
|
|
|
|
static void testKeywordApi(void) {
|
|
printf("=== lexer keyword API ===\n");
|
|
|
|
int32_t n = basLexerKeywordCount();
|
|
bool ok = (n > 0);
|
|
|
|
if (basLexerKeywordAt(-1) != NULL || basLexerKeywordAt(n) != NULL) {
|
|
ok = false;
|
|
}
|
|
|
|
if (basLexerKeywordClass(-1) != BAS_KW_CLASS_OTHER || basLexerKeywordClass(n) != BAS_KW_CLASS_OTHER) {
|
|
ok = false;
|
|
}
|
|
|
|
int32_t typeCount = 0;
|
|
int32_t literalCount = 0;
|
|
|
|
for (int32_t i = 0; i < n; i++) {
|
|
if (basLexerKeywordAt(i) == NULL) {
|
|
ok = false;
|
|
}
|
|
|
|
BasKeywordClassE cls = basLexerKeywordClass(i);
|
|
|
|
if (cls == BAS_KW_CLASS_TYPE) {
|
|
typeCount++;
|
|
} else if (cls == BAS_KW_CLASS_LITERAL) {
|
|
literalCount++;
|
|
}
|
|
}
|
|
|
|
if (typeCount == 0 || literalCount == 0) {
|
|
ok = false;
|
|
}
|
|
|
|
if (ok) {
|
|
printf("OK (%d keywords)\n\n", (int)n);
|
|
} else {
|
|
printf("FAIL: keyword API\n\n");
|
|
gFailCount++;
|
|
}
|
|
}
|
|
|
|
|
|
// Lexer limits needing generated sources: over-long string literal.
|
|
static void testLexerLimits(void) {
|
|
char src[TEST_LONG_STRING_SRC];
|
|
int32_t len = snprintf(src, sizeof(src), "A$ = \"");
|
|
|
|
for (int32_t i = 0; i < TEST_LONG_STRING_LEN; i++) {
|
|
src[len++] = 'x';
|
|
}
|
|
|
|
snprintf(src + len, sizeof(src) - len, "\"\n");
|
|
expectCompileError("Over-long string literal rejected", src, "String literal too long");
|
|
}
|
|
|
|
|
|
// Missing and skipped Optional arguments, ParamArray arguments by
|
|
// reference, arrays copied into Variants, LSET of TYPE records and
|
|
// Format$ without a format.
|
|
static void testMissingAndValues(void) {
|
|
runProgram("Optional: IsMissing, skipped arguments, Missing passed on",
|
|
"SUB F(a AS INTEGER, OPTIONAL b AS VARIANT, OPTIONAL c AS INTEGER, OPTIONAL d AS VARIANT)\n"
|
|
" PRINT a; IsMissing(b); c; IsMissing(d); VarType(b); TypeName(d);\n"
|
|
" G b\n"
|
|
"END SUB\n"
|
|
"SUB G(OPTIONAL x AS VARIANT)\n"
|
|
" PRINT \" G\"; IsMissing(x)\n"
|
|
"END SUB\n"
|
|
"FUNCTION H(OPTIONAL x AS VARIANT) AS STRING\n"
|
|
" H = IIF(IsMissing(x), \"none\", \"some\")\n"
|
|
"END FUNCTION\n"
|
|
"F 1\n"
|
|
"F 1, 2\n"
|
|
"F 1, , 3\n"
|
|
"F 1, , , \"d\"\n"
|
|
"F(1, , 3, )\n"
|
|
"PRINT H(); H(0); IsMissing(5)\n",
|
|
"1 True 0 True 10 Error GTrue \n"
|
|
"1 False 0 True 2 Error GFalse \n"
|
|
"1 True 3 True 10 Error GTrue \n"
|
|
"1 True 0 False 10 String GTrue \n"
|
|
"1 True 3 True 10 Error GTrue \n"
|
|
"nonesomeFalse \n"
|
|
);
|
|
|
|
runProgram("Optional: using a Missing argument is error 448",
|
|
"ON ERROR GOTO h\n"
|
|
"SUB M(OPTIONAL x AS VARIANT)\n"
|
|
" PRINT x + 1\n"
|
|
" PRINT \"[\"; x; \"]\"\n"
|
|
"END SUB\n"
|
|
"M\n"
|
|
"PRINT \"ok\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"err448 \n"
|
|
"ok\n"
|
|
);
|
|
|
|
runProgram("Optional: skipped method arguments, required ones, Missing through Object",
|
|
"DIM kk AS NEW K\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = kk\n"
|
|
"kk.M 1, , \"z\"\n"
|
|
"o.M 2, , \"y\"\n"
|
|
"ON ERROR GOTO h\n"
|
|
"o.M , 5\n"
|
|
"PRINT \"end\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"BEGINCLASS \"K\"\n"
|
|
"Public Sub M(a AS INTEGER, OPTIONAL b AS VARIANT, OPTIONAL c AS STRING)\n"
|
|
" PRINT a; IsMissing(b); c\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"1 True z\n"
|
|
"2 True y\n"
|
|
"err449 \n"
|
|
"end\n"
|
|
);
|
|
|
|
expectCompileError("Optional: a skipped argument must be Optional",
|
|
"SUB S(a AS INTEGER, b AS INTEGER)\n"
|
|
"END SUB\n"
|
|
"S , 2\n",
|
|
"Argument not optional"
|
|
);
|
|
|
|
runProgram("ParamArray: variables are passed by reference",
|
|
"SUB Bump(ParamArray v())\n"
|
|
" FOR i = 0 TO UBOUND(v)\n"
|
|
" v(i) = v(i) * 10\n"
|
|
" NEXT\n"
|
|
"END SUB\n"
|
|
"FUNCTION Sum(ParamArray v()) AS INTEGER\n"
|
|
" DIM t AS INTEGER\n"
|
|
" FOR EACH e IN v\n"
|
|
" t = t + e\n"
|
|
" NEXT\n"
|
|
" v(0) = 99\n"
|
|
" Sum = t\n"
|
|
"END FUNCTION\n"
|
|
"SUB ShowArgs(ParamArray v())\n"
|
|
" PRINT UBOUND(v); IsMissing(v(1))\n"
|
|
"END SUB\n"
|
|
"DIM a AS INTEGER, b AS DOUBLE\n"
|
|
"a = 1\n"
|
|
"b = 2.5\n"
|
|
"Bump a, b, 7\n"
|
|
"PRINT a; b\n"
|
|
"PRINT Sum(a, b + 1); a\n"
|
|
"ShowArgs 1, , 3\n",
|
|
"10 25 \n"
|
|
"36 99 \n"
|
|
"2 True \n"
|
|
);
|
|
|
|
runProgram("Variants: an array stored in a Variant is a copy",
|
|
"DIM q(2) AS INTEGER\n"
|
|
"DIM v AS VARIANT, w AS VARIANT\n"
|
|
"q(0) = 1\n"
|
|
"v = q\n"
|
|
"q(0) = 5\n"
|
|
"PRINT v(0); q(0)\n"
|
|
"w = v\n"
|
|
"w(0) = 7\n"
|
|
"PRINT v(0); w(0)\n"
|
|
"SUB Change(BYVAL x AS VARIANT)\n"
|
|
" x(0) = 9\n"
|
|
"END SUB\n"
|
|
"Change q\n"
|
|
"PRINT q(0)\n"
|
|
"DIM c AS NEW Collection\n"
|
|
"c.Add q\n"
|
|
"q(0) = 6\n"
|
|
"v = c(1)\n"
|
|
"PRINT v(0)\n",
|
|
"1 5 \n"
|
|
"1 7 \n"
|
|
"5 \n"
|
|
"5 \n"
|
|
);
|
|
|
|
runProgram("LSET: whole TYPE records, different TYPEs",
|
|
"TYPE A\n"
|
|
" n AS INTEGER\n"
|
|
" s AS STRING * 4\n"
|
|
"END TYPE\n"
|
|
"TYPE B\n"
|
|
" s AS STRING * 6\n"
|
|
"END TYPE\n"
|
|
"TYPE C\n"
|
|
" s AS STRING * 2\n"
|
|
"END TYPE\n"
|
|
"DIM x AS A, y AS B, z AS C\n"
|
|
"x.n = 16706\n"
|
|
"x.s = \"wxyz\"\n"
|
|
"LSET y = x\n"
|
|
"PRINT \"[\"; y.s; \"]\"\n"
|
|
"y.s = \"12\"\n"
|
|
"LSET x = y\n"
|
|
"PRINT x.n; \"[\"; x.s; \"]\"\n"
|
|
"z.s = \"AB\"\n"
|
|
"LSET y = z\n"
|
|
"PRINT \"[\"; y.s; \"]\"\n",
|
|
"[BAwxyz]\n"
|
|
"12849 [ ]\n"
|
|
"[AB ]\n"
|
|
);
|
|
|
|
expectCompileError("LSET: a record needs a record",
|
|
"TYPE A\n"
|
|
" n AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM x AS A\n"
|
|
"LSET x = \"abc\"\n",
|
|
"LSET of a TYPE variable needs another TYPE variable"
|
|
);
|
|
|
|
runProgram("Format$ without a format",
|
|
"PRINT Format$(3.5); \"|\"; Format$(1000000); \"|\"; Format(-2); \"|\"; Format$(\"x\"); \"|\"; Format$(#1/2/2020#); \"|\"; Format$(True); \"|\"; Format$(2.5, \"\")\n",
|
|
"3.5|1000000|-2|x|1/2/2020|True|2.5\n"
|
|
);
|
|
}
|
|
|
|
|
|
// Phase 5: Variants, class modules, Collection and FOR EACH.
|
|
static void testObjectsAndVariants(void) {
|
|
runProgram("Variant: Empty, VarType and TypeName",
|
|
"DIM v AS VARIANT\n"
|
|
"PRINT IsEmpty(v); VarType(v); TypeName(v); \"[\"; v; \"]\"\n"
|
|
"PRINT v + 1; \"x\" & v & \"y\"; v = 0; v = \"\"\n"
|
|
"v = 5\n"
|
|
"PRINT VarType(v); TypeName(v)\n"
|
|
"v = 2.5\n"
|
|
"PRINT VarType(v); TypeName(v)\n"
|
|
"v = \"12.5\"\n"
|
|
"PRINT VarType(v); TypeName(v)\n"
|
|
"v = #1/2/2000#\n"
|
|
"PRINT VarType(v); TypeName(v); IsDate(v)\n"
|
|
"v = TRUE\n"
|
|
"PRINT VarType(v); TypeName(v)\n"
|
|
"PRINT vbEmpty; vbNull; vbInteger; vbString; vbObject; vbVariant; vbArray\n",
|
|
"True 0 Empty[]\n"
|
|
"1 xyTrue True \n"
|
|
"2 Integer\n"
|
|
"5 Double\n"
|
|
"8 String\n"
|
|
"7 DateTrue \n"
|
|
"11 Boolean\n"
|
|
"0 1 2 8 9 12 8192 \n"
|
|
);
|
|
|
|
runProgram("Variant: IsNumeric, IsObject, IsArray, CVar",
|
|
"PRINT IsNumeric(\"12.5\"); IsNumeric(\"abc\"); IsNumeric(\" -1e3 \"); IsNumeric(\"&HFF\"); IsNumeric(\"\"); IsNumeric(7); IsNumeric(#1/1/2000#)\n"
|
|
"DIM o AS OBJECT\n"
|
|
"PRINT IsObject(o); IsObject(Nothing); IsObject(5); o Is Nothing\n"
|
|
"DIM a(2) AS INTEGER\n"
|
|
"DIM v AS VARIANT\n"
|
|
"v = a\n"
|
|
"PRINT IsArray(v); IsArray(a); IsArray(5); VarType(v); TypeName(v); UBOUND(v)\n"
|
|
"DIM w(1) AS VARIANT\n"
|
|
"PRINT VarType(w); TypeName(w); IsEmpty(w(0))\n"
|
|
"PRINT CVar(3) + 1; TypeName(CVar(\"s\")); TypeName(Nothing); VarType(Nothing)\n",
|
|
"True False True True False True False \n"
|
|
"True True False True \n"
|
|
"True True False 8194 Integer()2 \n"
|
|
"8204 Variant()True \n"
|
|
"4 StringNothing9 \n"
|
|
);
|
|
|
|
runProgram("Variant: Null propagates",
|
|
"DIM v AS VARIANT\n"
|
|
"v = Null\n"
|
|
"PRINT IsNull(v); VarType(v); TypeName(v); v\n"
|
|
"PRINT IsNull(v + 1); IsNull(v * 2); IsNull(-v); IsNull(v = 1); IsNull(v & Null)\n"
|
|
"PRINT \"a\" & v & \"b\"\n"
|
|
"PRINT IsNull(v AND TRUE); v AND FALSE; v OR TRUE; IsNull(v OR FALSE); IsNull(NOT v); IsNull(v XOR 1)\n"
|
|
"IF v THEN PRINT \"yes\" ELSE PRINT \"no\"\n"
|
|
"PRINT IsNull(ABS(v)); IsNull(INT(v)); IsNull(FIX(v)); IsNull(SGN(v))\n"
|
|
"PRINT IsNull(Choose(9, 1, 2))\n",
|
|
"True 1 NullNull\n"
|
|
"True True True True True \n"
|
|
"ab\n"
|
|
"True False True True True True \n"
|
|
"no\n"
|
|
"True True True True \n"
|
|
"True \n"
|
|
);
|
|
|
|
runProgram("Variant: Invalid use of Null",
|
|
"ON ERROR GOTO h\n"
|
|
"DIM i AS INTEGER\n"
|
|
"i = Null\n"
|
|
"PRINT LEN(CSTR(Null))\n"
|
|
"PRINT Null + 1 > 0\n"
|
|
"PRINT MID$(Null, 1)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"err94 \n"
|
|
"err94 \n"
|
|
"Null\n"
|
|
"err94 \n"
|
|
);
|
|
|
|
runProgram("Class: variables, properties and methods",
|
|
"DIM p AS Person\n"
|
|
"PRINT p Is Nothing; TypeName(p)\n"
|
|
"SET p = NEW Person\n"
|
|
"p.First = \"Ada\"\n"
|
|
"p.Age = \"36\"\n"
|
|
"PRINT p.First; p.Age; VarType(p.Age); p.Describe; \" \"; TypeName(p); VarType(p)\n"
|
|
"p.Tag(2) = \"two\"\n"
|
|
"PRINT p.Tag(2); \"|\"; p.Tag(1); \"|\"\n"
|
|
"SET p.Friend = NEW Person\n"
|
|
"p.Friend.First = \"Bob\"\n"
|
|
"PRINT p.Friend.First; p.Friend.Friend Is Nothing\n"
|
|
"PRINT p.Total(1, 2, 3); p.Total()\n"
|
|
"SET p = Nothing\n"
|
|
"PRINT \"end\"\n"
|
|
"BEGINCLASS \"Person\"\n"
|
|
"Public First As String\n"
|
|
"Private mAge As Integer\n"
|
|
"Private mFriend As Person\n"
|
|
"Private tags(3) As String\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" PRINT \"[new]\";\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[bye \"; First; \"]\"\n"
|
|
"End Sub\n"
|
|
"Property Get Age() As Integer\n"
|
|
" Age = mAge\n"
|
|
"End Property\n"
|
|
"Property Let Age(v As Integer)\n"
|
|
" mAge = v\n"
|
|
"End Property\n"
|
|
"Property Get Friend() As Person\n"
|
|
" SET Friend = mFriend\n"
|
|
"End Property\n"
|
|
"Property Set Friend(f As Person)\n"
|
|
" SET mFriend = f\n"
|
|
"End Property\n"
|
|
"Property Get Tag(i As Integer) As String\n"
|
|
" Tag = tags(i)\n"
|
|
"End Property\n"
|
|
"Property Let Tag(i As Integer, s As String)\n"
|
|
" tags(i) = s\n"
|
|
"End Property\n"
|
|
"Public Function Describe() As String\n"
|
|
" Describe = First & \" is \" & Me.Age\n"
|
|
"End Function\n"
|
|
"Public Sub AddTo(n As Integer)\n"
|
|
" n = n + mAge\n"
|
|
"End Sub\n"
|
|
"Public Function Total(ParamArray v()) As Integer\n"
|
|
" DIM t AS INTEGER\n"
|
|
" FOR EACH e IN v\n"
|
|
" t = t + e\n"
|
|
" NEXT\n"
|
|
" Total = t + UBOUND(v) + 1\n"
|
|
"End Function\n"
|
|
"Private Sub Secret()\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"True Nothing\n"
|
|
"[new]Ada36 2 Ada is 36 Person9 \n"
|
|
"two||\n"
|
|
"[new]BobTrue \n"
|
|
"9 0 \n"
|
|
"[bye Ada]\n"
|
|
"[bye Bob]\n"
|
|
"end\n"
|
|
);
|
|
|
|
runProgram("Class: ByRef arguments of a known class's method and late bound (VB: by reference)",
|
|
"DIM p AS NEW Person\n"
|
|
"DIM x AS INTEGER\n"
|
|
"p.Age = 36\n"
|
|
"x = 1\n"
|
|
"p.AddTo x\n"
|
|
"PRINT x\n"
|
|
"p.AddTo (x)\n"
|
|
"PRINT x\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = p\n"
|
|
"o.AddTo x\n"
|
|
"PRINT x\n"
|
|
"SET o = Nothing\n"
|
|
"SET p = Nothing\n"
|
|
"BEGINCLASS \"Person\"\n"
|
|
"Public First As String\n"
|
|
"Private mAge As Integer\n"
|
|
"Private mFriend As Person\n"
|
|
"Private tags(3) As String\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" PRINT \"[new]\";\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[bye \"; First; \"]\"\n"
|
|
"End Sub\n"
|
|
"Property Get Age() As Integer\n"
|
|
" Age = mAge\n"
|
|
"End Property\n"
|
|
"Property Let Age(v As Integer)\n"
|
|
" mAge = v\n"
|
|
"End Property\n"
|
|
"Property Get Friend() As Person\n"
|
|
" SET Friend = mFriend\n"
|
|
"End Property\n"
|
|
"Property Set Friend(f As Person)\n"
|
|
" SET mFriend = f\n"
|
|
"End Property\n"
|
|
"Property Get Tag(i As Integer) As String\n"
|
|
" Tag = tags(i)\n"
|
|
"End Property\n"
|
|
"Property Let Tag(i As Integer, s As String)\n"
|
|
" tags(i) = s\n"
|
|
"End Property\n"
|
|
"Public Function Describe() As String\n"
|
|
" Describe = First & \" is \" & Me.Age\n"
|
|
"End Function\n"
|
|
"Public Sub AddTo(n As Integer)\n"
|
|
" n = n + mAge\n"
|
|
"End Sub\n"
|
|
"Public Function Total(ParamArray v()) As Integer\n"
|
|
" DIM t AS INTEGER\n"
|
|
" FOR EACH e IN v\n"
|
|
" t = t + e\n"
|
|
" NEXT\n"
|
|
" Total = t + UBOUND(v) + 1\n"
|
|
"End Function\n"
|
|
"Private Sub Secret()\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"[new]37 \n"
|
|
"37 \n"
|
|
"73 \n"
|
|
"[bye ]\n"
|
|
);
|
|
|
|
runProgram("Class: references, Is and Class_Terminate",
|
|
"DIM p AS Person\n"
|
|
"DIM q AS Person\n"
|
|
"SET p = NEW Person\n"
|
|
"p.First = \"Ada\"\n"
|
|
"SET p.Friend = NEW Person\n"
|
|
"p.Friend.First = \"Bob\"\n"
|
|
"SET q = p\n"
|
|
"PRINT q Is p; q Is p.Friend; p Is Nothing\n"
|
|
"SET p = Nothing\n"
|
|
"PRINT \"p cleared\"\n"
|
|
"SET q = Nothing\n"
|
|
"PRINT \"q cleared\"\n"
|
|
"Scoped\n"
|
|
"PRINT \"after Scoped\"\n"
|
|
"SUB Scoped\n"
|
|
" DIM t AS NEW Person\n"
|
|
" t.First = \"Tmp\"\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Person\"\n"
|
|
"Public First As String\n"
|
|
"Private mAge As Integer\n"
|
|
"Private mFriend As Person\n"
|
|
"Private tags(3) As String\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" PRINT \"[new]\";\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[bye \"; First; \"]\"\n"
|
|
"End Sub\n"
|
|
"Property Get Age() As Integer\n"
|
|
" Age = mAge\n"
|
|
"End Property\n"
|
|
"Property Let Age(v As Integer)\n"
|
|
" mAge = v\n"
|
|
"End Property\n"
|
|
"Property Get Friend() As Person\n"
|
|
" SET Friend = mFriend\n"
|
|
"End Property\n"
|
|
"Property Set Friend(f As Person)\n"
|
|
" SET mFriend = f\n"
|
|
"End Property\n"
|
|
"Property Get Tag(i As Integer) As String\n"
|
|
" Tag = tags(i)\n"
|
|
"End Property\n"
|
|
"Property Let Tag(i As Integer, s As String)\n"
|
|
" tags(i) = s\n"
|
|
"End Property\n"
|
|
"Public Function Describe() As String\n"
|
|
" Describe = First & \" is \" & Me.Age\n"
|
|
"End Function\n"
|
|
"Public Sub AddTo(n As Integer)\n"
|
|
" n = n + mAge\n"
|
|
"End Sub\n"
|
|
"Public Function Total(ParamArray v()) As Integer\n"
|
|
" DIM t AS INTEGER\n"
|
|
" FOR EACH e IN v\n"
|
|
" t = t + e\n"
|
|
" NEXT\n"
|
|
" Total = t + UBOUND(v) + 1\n"
|
|
"End Function\n"
|
|
"Private Sub Secret()\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"[new][new]True False False \n"
|
|
"p cleared\n"
|
|
"[bye Ada]\n"
|
|
"[bye Bob]\n"
|
|
"q cleared\n"
|
|
"[new][bye Tmp]\n"
|
|
"after Scoped\n"
|
|
);
|
|
|
|
runProgram("Class: member errors (late bound: run time)",
|
|
"ON ERROR GOTO h\n"
|
|
"DIM r AS Person\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET r = NEW Person\n"
|
|
"SET o = r\n"
|
|
"o.Missing = 1\n"
|
|
"o.Secret\n"
|
|
"PRINT o.Age(1)\n"
|
|
"SET r = NEW Collection\n"
|
|
"SET r = 5\n"
|
|
"o.Total\n"
|
|
"PRINT \"end\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"BEGINCLASS \"Person\"\n"
|
|
"Public First As String\n"
|
|
"Private mAge As Integer\n"
|
|
"Private mFriend As Person\n"
|
|
"Private tags(3) As String\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" PRINT \"[new]\";\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[bye \"; First; \"]\"\n"
|
|
"End Sub\n"
|
|
"Property Get Age() As Integer\n"
|
|
" Age = mAge\n"
|
|
"End Property\n"
|
|
"Property Let Age(v As Integer)\n"
|
|
" mAge = v\n"
|
|
"End Property\n"
|
|
"Property Get Friend() As Person\n"
|
|
" SET Friend = mFriend\n"
|
|
"End Property\n"
|
|
"Property Set Friend(f As Person)\n"
|
|
" SET mFriend = f\n"
|
|
"End Property\n"
|
|
"Property Get Tag(i As Integer) As String\n"
|
|
" Tag = tags(i)\n"
|
|
"End Property\n"
|
|
"Property Let Tag(i As Integer, s As String)\n"
|
|
" tags(i) = s\n"
|
|
"End Property\n"
|
|
"Public Function Describe() As String\n"
|
|
" Describe = First & \" is \" & Me.Age\n"
|
|
"End Function\n"
|
|
"Public Sub AddTo(n As Integer)\n"
|
|
" n = n + mAge\n"
|
|
"End Sub\n"
|
|
"Public Function Total(ParamArray v()) As Integer\n"
|
|
" DIM t AS INTEGER\n"
|
|
" FOR EACH e IN v\n"
|
|
" t = t + e\n"
|
|
" NEXT\n"
|
|
" Total = t + UBOUND(v) + 1\n"
|
|
"End Function\n"
|
|
"Private Sub Secret()\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"[new]err438 \n"
|
|
"err438 \n"
|
|
"err450 \n"
|
|
"err13 \n"
|
|
"err424 \n"
|
|
"end\n"
|
|
);
|
|
|
|
runProgram("Class: a reference cycle is collected at the end of the program",
|
|
"DIM a AS Node, b AS Node\n"
|
|
"SET a = NEW Node\n"
|
|
"SET b = NEW Node\n"
|
|
"a.Id = 1\n"
|
|
"b.Id = 2\n"
|
|
"SET a.NextNode = b\n"
|
|
"SET b.NextNode = a\n"
|
|
"SET a = Nothing\n"
|
|
"SET b = Nothing\n"
|
|
"PRINT \"cycle dropped\"\n"
|
|
"BEGINCLASS \"Node\"\n"
|
|
"Public Id As Integer\n"
|
|
"Public NextNode As Node\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[term\"; Id; \"]\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"cycle dropped\n"
|
|
"[term1 ]\n"
|
|
"[term2 ]\n"
|
|
);
|
|
|
|
runProgram("Collection: Add, Item, Remove, Count and keys",
|
|
"DIM c AS NEW Collection\n"
|
|
"FOR i = 1 TO 3\n"
|
|
" DIM n AS Node\n"
|
|
" SET n = NEW Node\n"
|
|
" n.Id = i * 10\n"
|
|
" c.Add n, \"k\" & i\n"
|
|
"NEXT\n"
|
|
"SET n = Nothing\n"
|
|
"c.Add \"first\", , 1\n"
|
|
"c.Add \"last\", , , c.Count\n"
|
|
"c.Add \"mid\", \"m\", \"k2\"\n"
|
|
"FOR EACH it IN c\n"
|
|
" IF IsObject(it) THEN PRINT it.Id; ELSE PRINT it; \" \";\n"
|
|
"NEXT\n"
|
|
"PRINT\n"
|
|
"PRINT c(\"K2\").Id; c(2).Id; c.Item(\"m\"); TypeName(c); VarType(c)\n"
|
|
"c.Remove 1\n"
|
|
"c.Remove \"k3\"\n"
|
|
"PRINT c.Count\n"
|
|
"ON ERROR GOTO h\n"
|
|
"c.Add 1, \"m\"\n"
|
|
"PRINT c(99)\n"
|
|
"PRINT c(\"nope\")\n"
|
|
"c.Add 1, 5\n"
|
|
"c.Add 1, , 1, 2\n"
|
|
"c(1) = 5\n"
|
|
"PRINT \"end\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"BEGINCLASS \"Node\"\n"
|
|
"Public Id As Integer\n"
|
|
"Public NextNode As Node\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[term\"; Id; \"]\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"first 10 mid 20 30 last \n"
|
|
"20 10 midCollection9 \n"
|
|
"[term30 ]\n"
|
|
"4 \n"
|
|
"err457 \n"
|
|
"err9 \n"
|
|
"err5 \n"
|
|
"err13 \n"
|
|
"err5 \n"
|
|
"err438 \n"
|
|
"end\n"
|
|
);
|
|
|
|
runProgram("For Each over arrays, Variants, ParamArrays and Collections",
|
|
"DIM a(3) AS INTEGER\n"
|
|
"FOR i = 0 TO 3\n"
|
|
" a(i) = i * i\n"
|
|
"NEXT\n"
|
|
"FOR EACH x IN a\n"
|
|
" PRINT x;\n"
|
|
"NEXT\n"
|
|
"PRINT\n"
|
|
"DIM tot AS INTEGER\n"
|
|
"FOR EACH k IN Array3()\n"
|
|
" tot = tot + k\n"
|
|
" IF tot > 3 THEN EXIT FOR\n"
|
|
"NEXT\n"
|
|
"PRINT tot\n"
|
|
"FOR EACH ch IN Split(\"a,b,c\", \",\")\n"
|
|
" FOR EACH d IN Split(\"1,2\", \",\")\n"
|
|
" PRINT ch; d; \" \";\n"
|
|
" NEXT d\n"
|
|
"NEXT ch\n"
|
|
"PRINT\n"
|
|
"DIM e AS NEW Collection\n"
|
|
"FOR EACH z IN e\n"
|
|
" PRINT \"never\"\n"
|
|
"NEXT\n"
|
|
"e.Add 1\n"
|
|
"e.Add 2\n"
|
|
"e.Add 3\n"
|
|
"FOR EACH z IN e\n"
|
|
" PRINT z;\n"
|
|
" e.Remove 1\n"
|
|
"NEXT\n"
|
|
"PRINT e.Count\n"
|
|
"ShowArgs 1, \"two\", 3.5\n"
|
|
"ON ERROR GOTO h\n"
|
|
"FOR EACH z IN 5\n"
|
|
"NEXT\n"
|
|
"PRINT \"end\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"FUNCTION Array3() AS VARIANT\n"
|
|
" DIM t(2) AS INTEGER\n"
|
|
" t(0) = 1\n"
|
|
" t(1) = 2\n"
|
|
" t(2) = 3\n"
|
|
" Array3 = t\n"
|
|
"END FUNCTION\n"
|
|
"SUB ShowArgs(ParamArray args())\n"
|
|
" PRINT VarType(args); TypeName(args);\n"
|
|
" FOR EACH v IN args\n"
|
|
" PRINT \" \"; TypeName(v);\n"
|
|
" NEXT\n"
|
|
" PRINT\n"
|
|
"END SUB\n",
|
|
"0 1 4 9 \n"
|
|
"6 \n"
|
|
"a1 a2 b1 b2 c1 c2 \n"
|
|
"1 3 1 \n"
|
|
"8204 Variant() Integer String Double\n"
|
|
"err13 \n"
|
|
"end\n"
|
|
);
|
|
|
|
runProgram("Objects in arrays and TYPE fields",
|
|
"DIM arr(2) AS Node\n"
|
|
"SET arr(1) = NEW Node\n"
|
|
"arr(1).Id = 77\n"
|
|
"PRINT arr(1).Id; arr(0) Is Nothing; TypeName(arr)\n"
|
|
"TYPE Holder\n"
|
|
" obj AS Node\n"
|
|
" v AS VARIANT\n"
|
|
"END TYPE\n"
|
|
"DIM hd AS Holder\n"
|
|
"PRINT hd.obj Is Nothing; IsEmpty(hd.v)\n"
|
|
"SET hd.obj = arr(1)\n"
|
|
"hd.v = \"var\"\n"
|
|
"hd.obj.Id = 78\n"
|
|
"PRINT hd.obj.Id; arr(1).Id; hd.v\n"
|
|
"SET arr(1) = Nothing\n"
|
|
"SET hd.obj = Nothing\n"
|
|
"PRINT \"gone\"\n"
|
|
"BEGINCLASS \"Node\"\n"
|
|
"Public Id As Integer\n"
|
|
"Public NextNode As Node\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[term\"; Id; \"]\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"77 True Object()\n"
|
|
"True True \n"
|
|
"78 78 var\n"
|
|
"[term78 ]\n"
|
|
"gone\n"
|
|
);
|
|
|
|
runProgram("Class: default member, Me and its own procedures",
|
|
"DIM l AS NEW List\n"
|
|
"l.Add \"a\"\n"
|
|
"l.Add \"b\"\n"
|
|
"PRINT l(1); l.Item(2); l.Count; TypeOf l Is List; TypeOf l Is Object; TypeOf l Is Collection\n"
|
|
"l(1) = \"z\"\n"
|
|
"PRINT l(1); l.Self Is l; l.Self.Self.Count\n"
|
|
"PRINT l.Joined(\", \")\n"
|
|
"BEGINCLASS \"List\"\n"
|
|
"Private items As New Collection\n"
|
|
"Private sep As String\n"
|
|
"Property Get Item(i As Integer) As Variant\n"
|
|
"Attribute Item.VB_UserMemId = 0\n"
|
|
" Item = items(i)\n"
|
|
"End Property\n"
|
|
"Property Let Item(i As Integer, v As Variant)\n"
|
|
" items.Add v, , i\n"
|
|
" items.Remove i + 1\n"
|
|
"End Property\n"
|
|
"Public Sub Add(v As Variant)\n"
|
|
" items.Add v\n"
|
|
"End Sub\n"
|
|
"Public Function Count() As Long\n"
|
|
" Count = items.Count\n"
|
|
"End Function\n"
|
|
"Public Function Self() As List\n"
|
|
" SET Self = Me\n"
|
|
"End Function\n"
|
|
"Public Function Joined(s As String) As String\n"
|
|
" sep = s\n"
|
|
" Joined = JoinFrom(1)\n"
|
|
"End Function\n"
|
|
"Private Function JoinFrom(i As Integer) As String\n"
|
|
" DIM r AS STRING\n"
|
|
" IF i > Count THEN EXIT FUNCTION\n"
|
|
" r = Item(i)\n"
|
|
" IF i < Count THEN r = r & sep & JoinFrom(i + 1)\n"
|
|
" JoinFrom = r\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n",
|
|
"ab2 True True False \n"
|
|
"zTrue 2 \n"
|
|
"z, b\n"
|
|
);
|
|
|
|
runProgram("Class: member variables start typed; Class_Initialize runs after them",
|
|
"DIM t AS NEW Typed\n"
|
|
"t.Report\n"
|
|
"DIM o AS OBJECT\n"
|
|
"SET o = t\n"
|
|
"o.Opt\n"
|
|
"o.Opt 5\n"
|
|
"o.Opt , \"x\"\n"
|
|
"BEGINCLASS \"Typed\"\n"
|
|
"Private i As Integer\n"
|
|
"Private d As Double\n"
|
|
"Private s As String\n"
|
|
"Private v As Variant\n"
|
|
"Private b As Boolean\n"
|
|
"Private obj As Object\n"
|
|
"Private Sub Class_Initialize()\n"
|
|
" PRINT \"init\"; i; d; \"[\"; s; \"]\"; IsEmpty(v); b; obj Is Nothing\n"
|
|
" i = 7\n"
|
|
"End Sub\n"
|
|
"Public Sub Report()\n"
|
|
" PRINT \"i =\"; i\n"
|
|
"End Sub\n"
|
|
"Public Sub Opt(Optional a As Integer, Optional t As String)\n"
|
|
" PRINT \"opt\"; a; \"[\"; t; \"]\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"init0 0 []True False True \n"
|
|
"i =7 \n"
|
|
"opt0 []\n"
|
|
"opt5 []\n"
|
|
"opt0 [x]\n"
|
|
);
|
|
|
|
runProgram("PUBLIC and PRIVATE at module level",
|
|
"PUBLIC shared1 AS INTEGER\n"
|
|
"PRIVATE own1 AS INTEGER\n"
|
|
"shared1 = 5\n"
|
|
"own1 = 6\n"
|
|
"Report\n"
|
|
"PRIVATE SUB Report\n"
|
|
" PRINT shared1\n"
|
|
"END SUB\n",
|
|
"5 \n"
|
|
);
|
|
|
|
runProgram("Class: Terminate of a result released inside an expression",
|
|
"PRINT Make(3).Id + 1\n"
|
|
"PRINT \"after\"\n"
|
|
"FUNCTION Make(n AS INTEGER) AS Node\n"
|
|
" SET Make = NEW Node\n"
|
|
" Make.Id = n\n"
|
|
"END FUNCTION\n"
|
|
"BEGINCLASS \"Node\"\n"
|
|
"Public Id As Integer\n"
|
|
"Public NextNode As Node\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"[term\"; Id; \"]\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"[term3 ]\n"
|
|
"4 \n"
|
|
"after\n"
|
|
);
|
|
|
|
expectCompileError("Code outside procedures in a class rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"PRINT 1\n"
|
|
"ENDCLASS\n",
|
|
"Only declarations are allowed outside procedures in a class module"
|
|
);
|
|
|
|
expectCompileError("Duplicate class member rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"PUBLIC x AS INTEGER\n"
|
|
"PUBLIC SUB x\n"
|
|
"END SUB\n"
|
|
"ENDCLASS\n",
|
|
"'x' already declared"
|
|
);
|
|
|
|
expectCompileError("NEW of a non-class rejected",
|
|
"x = NEW Foo\n",
|
|
"class name, form name, or Collection after New"
|
|
);
|
|
|
|
// New FormName: a copy of a form of the project (headless, the
|
|
// missing form runtime raises error 1000 where the copy is made)
|
|
runProgram("NEW and AS NEW of a form name",
|
|
"BEGINFORM \"Form1\"\n"
|
|
"ENDFORM\n"
|
|
"DIM f AS Form1\n"
|
|
"ON ERROR RESUME NEXT\n"
|
|
"SET f = NEW Form1\n"
|
|
"PRINT ERR\n"
|
|
"ERR.CLEAR\n"
|
|
"MakeCopy\n"
|
|
"PRINT ERR\n"
|
|
"SUB MakeCopy\n"
|
|
" ON ERROR RESUME NEXT\n"
|
|
" DIM g AS NEW Form1\n"
|
|
" PRINT ERR;\n"
|
|
"END SUB\n",
|
|
"1000 \n1000 0 \n"
|
|
);
|
|
|
|
expectCompileError("AS NEW of a form name in an array rejected",
|
|
"BEGINFORM \"Form1\"\n"
|
|
"ENDFORM\n"
|
|
"DIM f(2) AS NEW Form1\n",
|
|
"New cannot be used with an array"
|
|
);
|
|
|
|
expectCompileError("AS NEW needs a class",
|
|
"DIM x AS NEW INTEGER\n",
|
|
"New needs a class name"
|
|
);
|
|
|
|
expectCompileError("AS NEW array rejected",
|
|
"DIM x(3) AS NEW Collection\n",
|
|
"New cannot be used with an array"
|
|
);
|
|
|
|
expectCompileError("EXIT PROPERTY outside PROPERTY rejected",
|
|
"SUB S\n"
|
|
"EXIT PROPERTY\n"
|
|
"END SUB\n",
|
|
"EXIT PROPERTY outside PROPERTY"
|
|
);
|
|
|
|
expectCompileError("BEGINCLASS without ENDCLASS rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"SUB S\n"
|
|
"END SUB\n",
|
|
"BEGINCLASS without ENDCLASS"
|
|
);
|
|
|
|
expectCompileError("Class_Initialize with parameters rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"SUB Class_Initialize(a)\n"
|
|
"END SUB\n"
|
|
"ENDCLASS\n",
|
|
"Class_Initialize must be a Sub without parameters"
|
|
);
|
|
|
|
expectCompileError("SHARED in a class rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"SUB S\n"
|
|
"SHARED q\n"
|
|
"END SUB\n"
|
|
"ENDCLASS\n",
|
|
"SHARED is not allowed in a class module"
|
|
);
|
|
|
|
expectCompileError("DIM SHARED in a class rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"DIM SHARED q\n"
|
|
"ENDCLASS\n",
|
|
"DIM SHARED is not allowed in a class module"
|
|
);
|
|
|
|
expectCompileError("Property Let without a value parameter rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"PROPERTY LET P()\n"
|
|
"END PROPERTY\n"
|
|
"ENDCLASS\n",
|
|
"Property Let and Property Set take the value"
|
|
);
|
|
|
|
expectCompileError("Class defined twice rejected",
|
|
"BEGINCLASS \"C\"\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"C\"\n"
|
|
"ENDCLASS\n",
|
|
"cannot be used as a class name"
|
|
);
|
|
runProgram("Class: members named by reserved words",
|
|
"DIM f AS NEW Doc\n"
|
|
"f.Name = \"x\"\n"
|
|
"f.Open\n"
|
|
"PRINT f.Name; f.IsOpen; f.Close\n"
|
|
"BEGINCLASS \"Doc\"\n"
|
|
"Private mName As String\n"
|
|
"Public IsOpen As Boolean\n"
|
|
"Property Get Name() As String\n"
|
|
" Name = \"<\" & mName & \">\"\n"
|
|
"End Property\n"
|
|
"Property Let Name(s As String)\n"
|
|
" mName = s\n"
|
|
"End Property\n"
|
|
"Public Sub Open()\n"
|
|
" IsOpen = True\n"
|
|
"End Sub\n"
|
|
"Public Function Close() As Boolean\n"
|
|
" Close = IsOpen\n"
|
|
" IsOpen = False\n"
|
|
"End Function\n"
|
|
"ENDCLASS\n",
|
|
"<x>True True \n"
|
|
);
|
|
|
|
runProgram("Class: STATIC variables are per class (shared by its instances)",
|
|
"DIM a AS NEW A1\n"
|
|
"DIM b AS NEW B1\n"
|
|
"a.Tick\n"
|
|
"a.Tick\n"
|
|
"b.Tick\n"
|
|
"Tick\n"
|
|
"BEGINCLASS \"A1\"\n"
|
|
"Public Sub Tick()\n"
|
|
" STATIC n AS INTEGER\n"
|
|
" n = n + 1\n"
|
|
" PRINT \"A\"; n\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"BEGINCLASS \"B1\"\n"
|
|
"Public Sub Tick()\n"
|
|
" STATIC n AS INTEGER\n"
|
|
" n = n + 10\n"
|
|
" PRINT \"B\"; n\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n"
|
|
"SUB Tick\n"
|
|
" STATIC n AS INTEGER\n"
|
|
" n = n + 100\n"
|
|
" PRINT \"M\"; n\n"
|
|
"END SUB\n",
|
|
"A1 \nA2 \nB10 \nM100 \n"
|
|
);
|
|
|
|
}
|
|
|
|
|
|
// ParamArray arguments by reference (variables, elements, fields,
|
|
// members; procedures, class methods and late-bound calls) and the array
|
|
// locks they take.
|
|
static void testParamArrayByRef(void) {
|
|
runProgram("ParamArray ByRef: array elements, TYPE fields, indexes evaluated once",
|
|
"TYPE Inner\n"
|
|
" q AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"TYPE Rec\n"
|
|
" f AS INTEGER\n"
|
|
" s AS STRING * 4\n"
|
|
" inn AS Inner\n"
|
|
"END TYPE\n"
|
|
"DIM SHARED calls AS INTEGER\n"
|
|
"DIM a(5) AS INTEGER\n"
|
|
"DIM m(2, 2) AS LONG\n"
|
|
"DIM r AS Rec\n"
|
|
"DIM rs(3) AS Rec\n"
|
|
"a(2) = 1: m(1, 2) = 2: r.f = 3: rs(1).f = 4: r.inn.q = 5: r.s = \"ab\"\n"
|
|
"Bump a(2), m(1, 2), r.f, rs(1).f, r.inn.q, a(Idx()), r.s\n"
|
|
"PRINT a(2); m(1, 2); r.f; rs(1).f; r.inn.q; a(3); calls; \"[\"; r.s; \"]\"\n"
|
|
"PRINT Total(a(2), a(2) + 1, (a(2)))\n"
|
|
"PRINT a(2)\n"
|
|
"FUNCTION Idx() AS INTEGER\n"
|
|
" calls = calls + 1\n"
|
|
" Idx = 3\n"
|
|
"END FUNCTION\n"
|
|
"SUB Bump(ParamArray v())\n"
|
|
" FOR i = 0 TO UBOUND(v) - 1\n"
|
|
" v(i) = v(i) * 10 + 7\n"
|
|
" NEXT\n"
|
|
" v(UBOUND(v)) = \"xyzzy\"\n"
|
|
"END SUB\n"
|
|
"FUNCTION Total(ParamArray v()) AS INTEGER\n"
|
|
" Total = v(0) + v(1) + v(2)\n"
|
|
" v(0) = 0: v(1) = 0: v(2) = 0\n"
|
|
"END FUNCTION\n",
|
|
"17 27 37 47 57 7 1 [xyzz]\n"
|
|
"52 \n"
|
|
"0 \n"
|
|
);
|
|
|
|
runProgram("ParamArray / ByRef: REDIM or ERASE of an array whose element is given raises error 10",
|
|
"DIM SHARED d() AS INTEGER\n"
|
|
"REDIM d(4)\n"
|
|
"d(1) = 1: d(4) = 4\n"
|
|
"ON ERROR GOTO h\n"
|
|
"Shrink d(1), d(4)\n"
|
|
"PRINT UBOUND(d); d(1); d(4)\n"
|
|
"Gone d(1)\n"
|
|
"PRINT UBOUND(d); d(1)\n"
|
|
"REDIM d(2)\n"
|
|
"d(0) = 5: d(2) = 6\n"
|
|
"Cut d(0), d(2)\n"
|
|
"PRINT d(0); d(2)\n"
|
|
"Plain d(0)\n"
|
|
"PRINT d(0); UBOUND(d)\n"
|
|
"REDIM d(3)\n"
|
|
"PRINT UBOUND(d)\n"
|
|
"Fine d(1)\n"
|
|
"PRINT UBOUND(d)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"SUB Shrink(ParamArray v())\n"
|
|
" v(0) = 10: v(1) = 40\n"
|
|
" REDIM PRESERVE d(2)\n"
|
|
" PRINT \"not here\"\n"
|
|
"END SUB\n"
|
|
"SUB Gone(ParamArray v())\n"
|
|
" ERASE d\n"
|
|
"END SUB\n"
|
|
"SUB Cut(ParamArray v())\n"
|
|
" v(0) = 50: v(1) = 60\n"
|
|
" REDIM v(0)\n"
|
|
" v(0) = 70\n"
|
|
"END SUB\n"
|
|
"SUB Plain(x AS INTEGER)\n"
|
|
" x = 9\n"
|
|
" REDIM d(1)\n"
|
|
"END SUB\n"
|
|
"SUB Fine(x AS INTEGER)\n"
|
|
" DIM e() AS INTEGER\n"
|
|
" REDIM e(2)\n"
|
|
" ERASE e\n"
|
|
" x = 1\n"
|
|
"END SUB\n",
|
|
"err10 \n"
|
|
"4 10 40 \n"
|
|
"err10 \n"
|
|
"4 10 \n"
|
|
"50 60 \n"
|
|
"err10 \n"
|
|
"9 2 \n"
|
|
"3 \n"
|
|
"3 \n"
|
|
);
|
|
|
|
runProgram("ParamArray ByRef: member variables in a class, known class and late-bound calls",
|
|
"DIM k AS NEW Keeper\n"
|
|
"DIM x AS INTEGER\n"
|
|
"DIM y AS STRING\n"
|
|
"DIM arr(3) AS INTEGER\n"
|
|
"x = 1: y = \"a\": arr(1) = 2\n"
|
|
"k.Twice x, y, arr(1), x + 1\n"
|
|
"PRINT x; y; arr(1)\n"
|
|
"DIM o AS Object\n"
|
|
"SET o = k\n"
|
|
"o.Twice x, arr(1)\n"
|
|
"PRINT x; arr(1)\n"
|
|
"DIM v AS Variant\n"
|
|
"SET v = k\n"
|
|
"v.Twice x\n"
|
|
"PRINT x\n"
|
|
"o.Keep x\n"
|
|
"PRINT x\n"
|
|
"PRINT o.Sum(x, arr(1)); x; arr(1)\n"
|
|
"k.Self\n"
|
|
"BEGINCLASS \"Keeper\"\n"
|
|
"Private cnt AS INTEGER\n"
|
|
"Private vals(2) AS INTEGER\n"
|
|
"Public Sub Twice(ParamArray v())\n"
|
|
" FOR i = 0 TO UBOUND(v)\n"
|
|
" v(i) = v(i) + v(i)\n"
|
|
" NEXT\n"
|
|
"End Sub\n"
|
|
"Public Sub Keep(ByVal n AS INTEGER)\n"
|
|
" n = 999\n"
|
|
"End Sub\n"
|
|
"Public Function Sum(ParamArray v()) AS INTEGER\n"
|
|
" Sum = v(0) + v(1)\n"
|
|
" v(0) = -1\n"
|
|
"End Function\n"
|
|
"Public Sub Self()\n"
|
|
" cnt = 3: vals(1) = 4\n"
|
|
" Twice cnt, vals(1)\n"
|
|
" PRINT cnt; vals(1)\n"
|
|
" Me.Twice cnt\n"
|
|
" PRINT cnt\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"2 aa4 \n"
|
|
"4 8 \n"
|
|
"8 \n"
|
|
"8 \n"
|
|
"16 -1 8 \n"
|
|
"6 8 \n"
|
|
"12 \n"
|
|
);
|
|
|
|
runProgram("ParamArray ByRef: late bound, REDIM of a given element's array raises error 10, writes made before an error stay",
|
|
"DIM SHARED d() AS INTEGER\n"
|
|
"REDIM d(3)\n"
|
|
"d(3) = 3\n"
|
|
"DIM o AS Object\n"
|
|
"SET o = NEW Cutter\n"
|
|
"ON ERROR GOTO h\n"
|
|
"o.CutIt d(3), d(0)\n"
|
|
"PRINT UBOUND(d); d(0)\n"
|
|
"DIM z AS INTEGER\n"
|
|
"z = 5\n"
|
|
"Fail z\n"
|
|
"PRINT z; ERR\n"
|
|
"o.FailIt z\n"
|
|
"PRINT z; ERR\n"
|
|
"o.Solo d(2)\n"
|
|
"PRINT UBOUND(d); d(2)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"SUB Fail(ParamArray v())\n"
|
|
" v(0) = 50\n"
|
|
" ERROR 5\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Cutter\"\n"
|
|
"Public Sub CutIt(ParamArray v())\n"
|
|
" v(0) = 30: v(1) = 7\n"
|
|
" REDIM PRESERVE d(1)\n"
|
|
"End Sub\n"
|
|
"Public Sub FailIt(ParamArray v())\n"
|
|
" v(0) = 60\n"
|
|
" ERROR 6\n"
|
|
"End Sub\n"
|
|
"Public Sub Solo(x)\n"
|
|
" x = 8\n"
|
|
" ERASE d\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"err10 \n"
|
|
"3 7 \n"
|
|
"err5 \n"
|
|
"50 0 \n"
|
|
"err6 \n"
|
|
"60 0 \n"
|
|
"err10 \n"
|
|
"3 8 \n"
|
|
);
|
|
|
|
runProgram("Method calls: references convert to the caller's variable type (writes, also through the ParamArray)",
|
|
"DIM n AS INTEGER\n"
|
|
"DIM a(3) AS INTEGER\n"
|
|
"DIM v AS VARIANT\n"
|
|
"DIM o AS Object\n"
|
|
"DIM k AS Cls\n"
|
|
"SET k = NEW Cls\n"
|
|
"SET o = k\n"
|
|
"n = 1\n"
|
|
"o.M n\n"
|
|
"PRINT n; TypeName(n)\n"
|
|
"o.P n, a(2)\n"
|
|
"PRINT n; a(2); TypeName(n); TypeName(a(2))\n"
|
|
"v = 1\n"
|
|
"o.P v, v\n"
|
|
"PRINT v; TypeName(v)\n"
|
|
"k.M n\n"
|
|
"PRINT n; TypeName(n)\n"
|
|
"k.T n\n"
|
|
"PRINT n\n"
|
|
"k.P a(1), n\n"
|
|
"PRINT a(1); n\n"
|
|
"ON ERROR GOTO h\n"
|
|
"o.Big n\n"
|
|
"PRINT n\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"BEGINCLASS \"Cls\"\n"
|
|
"Public Sub M(x)\n"
|
|
" x = x + 2.5\n"
|
|
"End Sub\n"
|
|
"Public Sub T(x AS INTEGER)\n"
|
|
" x = x * 2\n"
|
|
"End Sub\n"
|
|
"Public Sub P(ParamArray v())\n"
|
|
" v(0) = 7.25\n"
|
|
" v(1) = \"9\"\n"
|
|
"End Sub\n"
|
|
"Public Sub Big(ParamArray v())\n"
|
|
" v(0) = 100000\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"4 Integer\n"
|
|
"7 9 IntegerInteger\n"
|
|
"9String\n"
|
|
"10 Integer\n"
|
|
"20 \n"
|
|
"7 9 \n"
|
|
"err6 \n"
|
|
"9 \n"
|
|
);
|
|
|
|
runProgram("Method calls: TYPE fields go by reference (converted; ByVal and host methods unchanged)",
|
|
"TYPE Pt\n"
|
|
" x AS INTEGER\n"
|
|
" s AS STRING\n"
|
|
"END TYPE\n"
|
|
"DIM r AS Pt\n"
|
|
"DIM pts(2) AS Pt\n"
|
|
"DIM o AS Object\n"
|
|
"DIM k AS Cls\n"
|
|
"SET k = NEW Cls\n"
|
|
"SET o = k\n"
|
|
"r.x = 5\n"
|
|
"o.M r.x\n"
|
|
"PRINT r.x\n"
|
|
"k.M r.x\n"
|
|
"PRINT r.x\n"
|
|
"r.s = \"a\"\n"
|
|
"o.S r.s\n"
|
|
"PRINT r.s\n"
|
|
"pts(1).x = 3\n"
|
|
"o.M pts(1).x\n"
|
|
"PRINT pts(1).x\n"
|
|
"k.V r.x\n"
|
|
"PRINT r.x\n"
|
|
"PRINT o.F(r.x); r.x\n"
|
|
"k.Inner\n"
|
|
"BEGINCLASS \"Cls\"\n"
|
|
"Private q AS Pt\n"
|
|
"Public Sub M(x)\n"
|
|
" x = x + 2.5\n"
|
|
"End Sub\n"
|
|
"Public Sub S(t AS STRING)\n"
|
|
" t = t + \"!\"\n"
|
|
"End Sub\n"
|
|
"Public Sub V(ByVal x AS INTEGER)\n"
|
|
" x = 99\n"
|
|
"End Sub\n"
|
|
"Public Function F(x) AS INTEGER\n"
|
|
" x = 1\n"
|
|
" F = 2\n"
|
|
"End Function\n"
|
|
"Public Sub Inner()\n"
|
|
" DIM other AS Object\n"
|
|
" SET other = NEW Cls\n"
|
|
" q.x = 1\n"
|
|
" other.M q.x\n"
|
|
" Me.M q.x\n"
|
|
" PRINT q.x\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"8 \n"
|
|
"10 \n"
|
|
"a!\n"
|
|
"6 \n"
|
|
"10 \n"
|
|
"2 1 \n"
|
|
"6 \n"
|
|
);
|
|
}
|
|
|
|
|
|
static void testParamDefaults(void) {
|
|
runProgram("Optional defaults: SUB / FUNCTION, skipped and trailing, forward calls, IsMissing",
|
|
"CONST SIDE = 10\n"
|
|
"PRINT Area(); Area(2); Area(, 3); Area(2, 3)\n"
|
|
"Greet\n"
|
|
"Greet \"Bob\"\n"
|
|
"Greet , \"?\"\n"
|
|
"ShowIt\n"
|
|
"ShowIt 7\n"
|
|
"PRINT Scale#(2); Stamp(); Pick$()\n"
|
|
"FUNCTION Area(OPTIONAL w AS INTEGER = SIDE, OPTIONAL h AS INTEGER = SIDE * 2) AS LONG\n"
|
|
" Area = w * h\n"
|
|
"END FUNCTION\n"
|
|
"SUB Greet(OPTIONAL who AS STRING = \"World\", OPTIONAL mark$ = \"!\")\n"
|
|
" PRINT \"Hello \" + who + mark$\n"
|
|
"END SUB\n"
|
|
"SUB ShowIt(OPTIONAL v AS VARIANT = \"dflt\", OPTIONAL n AS VARIANT)\n"
|
|
" PRINT v; IsMissing(v); IsMissing(n); TypeName(v)\n"
|
|
"END SUB\n"
|
|
"FUNCTION Scale#(x AS DOUBLE, OPTIONAL f AS DOUBLE = 1 / 4)\n"
|
|
" Scale# = x * f\n"
|
|
"END FUNCTION\n"
|
|
"FUNCTION Stamp(OPTIONAL d AS DATE = #2000-01-02#) AS INTEGER\n"
|
|
" Stamp = Day(d)\n"
|
|
"END FUNCTION\n"
|
|
"FUNCTION Pick$(OPTIONAL c AS STRING = CHR$(65) + \"B\")\n"
|
|
" Pick$ = c\n"
|
|
"END FUNCTION\n",
|
|
"200 40 30 6 \n"
|
|
"Hello World!\n"
|
|
"Hello Bob!\n"
|
|
"Hello World?\n"
|
|
"dfltFalse True String\n"
|
|
"7 False True Integer\n"
|
|
"0.5 2 AB\n"
|
|
);
|
|
|
|
runProgram("Optional defaults: typed conversion, ByRef parameter, DECLARE, recursion",
|
|
"DECLARE SUB Bump(OPTIONAL n AS INTEGER = 3)\n"
|
|
"DIM k AS INTEGER\n"
|
|
"k = 1\n"
|
|
"Bump k\n"
|
|
"PRINT k\n"
|
|
"Bump\n"
|
|
"PRINT Fact(); Rnd1()\n"
|
|
"SUB Bump(OPTIONAL n AS INTEGER = 3)\n"
|
|
" n = n + 1\n"
|
|
" PRINT \"n=\"; n\n"
|
|
"END SUB\n"
|
|
"FUNCTION Fact(OPTIONAL n AS LONG = 5) AS LONG\n"
|
|
" IF n <= 1 THEN Fact = 1 ELSE Fact = n * Fact(n - 1)\n"
|
|
"END FUNCTION\n"
|
|
"FUNCTION Rnd1(OPTIONAL x AS INTEGER = 2.5) AS INTEGER\n"
|
|
" Rnd1 = x\n"
|
|
"END FUNCTION\n",
|
|
"n=2 \n"
|
|
"2 \n"
|
|
"n=4 \n"
|
|
"120 2 \n"
|
|
);
|
|
|
|
runProgram("Optional defaults: class methods, Property procedures, late-bound calls",
|
|
"DIM s AS Shape\n"
|
|
"SET s = NEW Shape\n"
|
|
"s.Move\n"
|
|
"s.Move 5\n"
|
|
"s.Move , 7\n"
|
|
"DIM o AS Object\n"
|
|
"SET o = s\n"
|
|
"o.Move\n"
|
|
"o.Move , 9\n"
|
|
"PRINT s.Label; s.Label(\"x\"); o.Label()\n"
|
|
"s.Tag = \"t\"\n"
|
|
"PRINT s.Tag\n"
|
|
"PRINT s.Tag(\"k\")\n"
|
|
"s.Twice\n"
|
|
"BEGINCLASS \"Shape\"\n"
|
|
"CONST STEPSIZE = 2\n"
|
|
"Private t AS STRING\n"
|
|
"Public Sub Move(Optional dx AS INTEGER = STEPSIZE, Optional dy AS SINGLE = -1)\n"
|
|
" PRINT \"move\"; dx; dy\n"
|
|
"End Sub\n"
|
|
"Public Function Label(Optional pre AS STRING = \"L\") AS STRING\n"
|
|
" Label = pre + \":\"\n"
|
|
"End Function\n"
|
|
"Public Property Get Tag(Optional key AS STRING = \"none\") AS STRING\n"
|
|
" Tag = key + \"=\" + t\n"
|
|
"End Property\n"
|
|
"Public Property Let Tag(v AS STRING)\n"
|
|
" t = v\n"
|
|
"End Property\n"
|
|
"Public Sub Twice()\n"
|
|
" Move\n"
|
|
" Move 1\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"move2 -1 \n"
|
|
"move5 -1 \n"
|
|
"move2 7 \n"
|
|
"move2 -1 \n"
|
|
"move2 9 \n"
|
|
"L:x:L:\n"
|
|
"none=t\n"
|
|
"k=t\n"
|
|
"move2 -1 \n"
|
|
"move1 -1 \n"
|
|
);
|
|
|
|
expectCompileError("Optional defaults: only Optional parameters",
|
|
"SUB F(a AS INTEGER = 1)\nEND SUB\n",
|
|
"Only an Optional parameter");
|
|
|
|
expectCompileError("Optional defaults: constant expression required",
|
|
"DIM v AS INTEGER\nSUB F(OPTIONAL a AS INTEGER = v)\nEND SUB\n",
|
|
"Constant expression required");
|
|
|
|
expectCompileError("Optional defaults: type mismatch",
|
|
"SUB F(OPTIONAL a AS INTEGER = \"x\")\nEND SUB\n",
|
|
"Type mismatch in Optional default value");
|
|
|
|
expectCompileError("Optional defaults: overflow",
|
|
"SUB F(OPTIONAL a AS INTEGER = 40000)\nEND SUB\n",
|
|
"Overflow in Optional default value");
|
|
|
|
expectCompileError("Optional defaults: an object parameter's default is Nothing",
|
|
"SUB F(OPTIONAL a AS OBJECT = 0)\nEND SUB\n",
|
|
"can only be Nothing");
|
|
|
|
expectCompileError("Optional defaults: Nothing is not a number's default",
|
|
"SUB F(OPTIONAL a AS INTEGER = Nothing)\nEND SUB\n",
|
|
"Constant expression required");
|
|
|
|
runProgram("Optional defaults: = Nothing on Object, class and Variant parameters",
|
|
"DIM s AS Shape\n"
|
|
"SET s = NEW Shape\n"
|
|
"Peek\n"
|
|
"Peek s\n"
|
|
"Kind\n"
|
|
"Kind , 3\n"
|
|
"PRINT Twin() IS Nothing\n"
|
|
"s.Pair\n"
|
|
"DIM o AS Object\n"
|
|
"SET o = s\n"
|
|
"o.Pair s\n"
|
|
"SUB Peek(OPTIONAL x AS Object = Nothing)\n"
|
|
" PRINT x IS Nothing\n"
|
|
"END SUB\n"
|
|
"SUB Kind(OPTIONAL v AS VARIANT = Nothing, OPTIONAL n AS INTEGER = 1)\n"
|
|
" PRINT TypeName(v); IsMissing(v); IsObject(v); n\n"
|
|
"END SUB\n"
|
|
"FUNCTION Twin(OPTIONAL c AS Shape = Nothing) AS Shape\n"
|
|
" SET Twin = c\n"
|
|
"END FUNCTION\n"
|
|
"BEGINCLASS \"Shape\"\n"
|
|
"Public Sub Pair(Optional other AS Shape = Nothing)\n"
|
|
" PRINT \"pair\"; other IS Nothing\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"True \n"
|
|
"False \n"
|
|
"NothingFalse True 1 \n"
|
|
"NothingFalse True 3 \n"
|
|
"True \n"
|
|
"pairTrue \n"
|
|
"pairFalse \n"
|
|
);
|
|
|
|
expectCompileError("Optional defaults: not on an array parameter",
|
|
"SUB F(OPTIONAL a() AS INTEGER = 0)\nEND SUB\n",
|
|
"Only an Optional parameter");
|
|
|
|
expectCompileError("Optional defaults: not in DEF FN",
|
|
"DEF FNa(OPTIONAL x = 1) = x\n",
|
|
"not allowed here");
|
|
|
|
expectCompileError("Optional defaults: not in DECLARE LIBRARY",
|
|
"DECLARE LIBRARY \"basrt\"\nDECLARE FUNCTION Foo(OPTIONAL x AS INTEGER = 1) AS INTEGER\nEND DECLARE\n",
|
|
"not allowed here");
|
|
|
|
expectCompileError("Optional defaults: DECLARE must match the definition",
|
|
"DECLARE SUB F(OPTIONAL a AS INTEGER)\nSUB F(OPTIONAL a AS INTEGER = 2)\nEND SUB\n",
|
|
"does not match");
|
|
}
|
|
|
|
|
|
// One reference value (redesign Phase 1): every kind of target a ByRef
|
|
// argument can name -- variables, array elements, TYPE fields (nested,
|
|
// in array elements, fixed length), class member variables, elements of
|
|
// an array a Variant holds, ParamArray elements passed on -- and the
|
|
// safety rules: array locks (error 10), records and objects kept alive by
|
|
// the references to them, no reference escaping its frame.
|
|
static void testReferences(void) {
|
|
runProgram("References: TYPE fields ByRef to a SUB (variable, array element, nested, fixed length)",
|
|
"TYPE Inner\n"
|
|
" q AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"TYPE Rec\n"
|
|
" f AS LONG\n"
|
|
" s AS STRING * 4\n"
|
|
" inn AS Inner\n"
|
|
"END TYPE\n"
|
|
"DIM r AS Rec\n"
|
|
"DIM rs(3) AS Rec\n"
|
|
"DIM fx AS STRING * 3\n"
|
|
"r.f = 1: rs(2).f = 2: r.inn.q = 3: rs(1).inn.q = 4: r.s = \"ab\": fx = \"z\"\n"
|
|
"Bump r.f\n"
|
|
"Bump rs(2).f\n"
|
|
"Twice r.inn.q\n"
|
|
"Twice rs(1).inn.q\n"
|
|
"Grow r.s\n"
|
|
"Grow rs(3).s\n"
|
|
"Grow fx\n"
|
|
"PRINT r.f; rs(2).f; r.inn.q; rs(1).inn.q; \"[\"; r.s; \"][\"; rs(3).s; \"][\"; fx; \"]\"\n"
|
|
"SUB Bump(n AS LONG)\n"
|
|
" n = n + 10\n"
|
|
"END SUB\n"
|
|
"SUB Twice(n AS INTEGER)\n"
|
|
" n = n * 2\n"
|
|
"END SUB\n"
|
|
"SUB Grow(t AS STRING)\n"
|
|
" t = t + \"xyz\"\n"
|
|
" PRINT \"[\"; t; \"]\"\n"
|
|
"END SUB\n",
|
|
"[ab ]\n"
|
|
"[ ]\n"
|
|
"[z ]\n"
|
|
"11 12 6 8 [ab ][ ][z ]\n"
|
|
);
|
|
|
|
runProgram("References: a ByRef parameter is the variable (aliasing seen at once, as VB)",
|
|
"DIM SHARED g AS INTEGER\n"
|
|
"DIM SHARED a(2) AS INTEGER\n"
|
|
"g = 1\n"
|
|
"Pair g, g\n"
|
|
"PRINT g\n"
|
|
"a(1) = 5\n"
|
|
"Peek a(1)\n"
|
|
"PRINT a(1)\n"
|
|
"SUB Pair(x AS INTEGER, y AS INTEGER)\n"
|
|
" x = x + 1\n"
|
|
" PRINT y;\n"
|
|
" y = y * 10\n"
|
|
" PRINT x\n"
|
|
"END SUB\n"
|
|
"SUB Peek(e AS INTEGER)\n"
|
|
" a(1) = 9\n"
|
|
" PRINT e;\n"
|
|
" e = e + 1\n"
|
|
"END SUB\n",
|
|
"2 20 \n"
|
|
"20 \n"
|
|
"9 10 \n"
|
|
);
|
|
|
|
runProgram("References: stores convert to the target's declared type; a reference passed on keeps it",
|
|
"DIM n AS INTEGER\n"
|
|
"DIM d AS DOUBLE\n"
|
|
"DIM b(2) AS LONG\n"
|
|
"SetHalf n\n"
|
|
"SetHalf d\n"
|
|
"SetHalf b(1)\n"
|
|
"PRINT n; d; b(1); TypeName(n); TypeName(b(1))\n"
|
|
"ON ERROR GOTO h\n"
|
|
"SetBig n\n"
|
|
"PRINT n\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"SUB SetHalf(v)\n"
|
|
" Inner v\n"
|
|
"END SUB\n"
|
|
"SUB Inner(w)\n"
|
|
" w = 2.5\n"
|
|
"END SUB\n"
|
|
"SUB SetBig(v)\n"
|
|
" v = 40000\n"
|
|
"END SUB\n",
|
|
"2 2.5 2 IntegerLong\n"
|
|
"err6 \n"
|
|
"2 \n"
|
|
);
|
|
|
|
runProgram("References: REDIM / ERASE while an element or an element's field is passed raise error 10; the lock ends with the call",
|
|
"TYPE P\n"
|
|
" x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM SHARED d() AS INTEGER\n"
|
|
"DIM SHARED ps() AS P\n"
|
|
"REDIM d(3)\n"
|
|
"REDIM ps(3)\n"
|
|
"ON ERROR GOTO h\n"
|
|
"d(2) = 1\n"
|
|
"Grow d(2)\n"
|
|
"PRINT UBOUND(d); d(2)\n"
|
|
"ps(1).x = 4\n"
|
|
"GrowP ps(1).x\n"
|
|
"PRINT UBOUND(ps); ps(1).x\n"
|
|
"Nest ps(2).x\n"
|
|
"PRINT ps(2).x\n"
|
|
"REDIM d(5)\n"
|
|
"REDIM ps(5)\n"
|
|
"PRINT UBOUND(d); UBOUND(ps)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n"
|
|
"SUB Grow(v AS INTEGER)\n"
|
|
" v = v + 1\n"
|
|
" REDIM PRESERVE d(9)\n"
|
|
"END SUB\n"
|
|
"SUB GrowP(v AS INTEGER)\n"
|
|
" v = v + 1\n"
|
|
" ERASE ps\n"
|
|
"END SUB\n"
|
|
"SUB Nest(v AS INTEGER)\n"
|
|
" Deeper v\n"
|
|
"END SUB\n"
|
|
"SUB Deeper(w AS INTEGER)\n"
|
|
" w = 7\n"
|
|
" REDIM ps(1)\n"
|
|
"END SUB\n",
|
|
"err10 \n"
|
|
"3 2 \n"
|
|
"err10 \n"
|
|
"3 5 \n"
|
|
"err10 \n"
|
|
"7 \n"
|
|
"5 5 \n"
|
|
);
|
|
|
|
runProgram("References: the record and the object a reference names stay alive while it exists",
|
|
"TYPE Rec\n"
|
|
" f AS LONG\n"
|
|
"END TYPE\n"
|
|
"DIM SHARED r AS Rec\n"
|
|
"DIM SHARED k AS Holder\n"
|
|
"r.f = 1\n"
|
|
"Change r.f\n"
|
|
"PRINT r.f\n"
|
|
"SET k = NEW Holder\n"
|
|
"k.Run\n"
|
|
"PRINT \"end\"\n"
|
|
"SUB Change(v AS LONG)\n"
|
|
" DIM t AS Rec\n"
|
|
" t.f = 5\n"
|
|
" r = t\n"
|
|
" v = 7\n"
|
|
" PRINT v; r.f\n"
|
|
"END SUB\n"
|
|
"SUB Drop(v AS INTEGER, w AS LONG)\n"
|
|
" SET k = Nothing\n"
|
|
" v = v + 5\n"
|
|
" w = w + 1\n"
|
|
" PRINT \"set\"; v; w\n"
|
|
"END SUB\n"
|
|
"BEGINCLASS \"Holder\"\n"
|
|
"Public n AS INTEGER\n"
|
|
"Private kept AS Rec\n"
|
|
"Public Sub Run()\n"
|
|
" n = 1\n"
|
|
" kept.f = 2\n"
|
|
" Drop n, kept.f\n"
|
|
" PRINT \"run\"; n; kept.f\n"
|
|
"End Sub\n"
|
|
"Private Sub Class_Terminate()\n"
|
|
" PRINT \"gone\"\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"7 7 \n"
|
|
"7 \n"
|
|
"set6 3 \n"
|
|
"run6 3 \n"
|
|
"gone\n"
|
|
"end\n"
|
|
);
|
|
|
|
runProgram("References: elements of an array a Variant holds, ParamArray elements passed on, no reference escapes its frame",
|
|
"DIM SHARED keep AS Variant\n"
|
|
"DIM a(2) AS INTEGER\n"
|
|
"DIM v AS Variant\n"
|
|
"DIM x AS INTEGER\n"
|
|
"a(1) = 4\n"
|
|
"v = a\n"
|
|
"Bump v(1)\n"
|
|
"PRINT v(1); a(1)\n"
|
|
"x = 1\n"
|
|
"Pass x, v(2)\n"
|
|
"PRINT x; v(2)\n"
|
|
"Outer\n"
|
|
"PRINT keep(0); UBOUND(keep)\n"
|
|
"SUB Bump(e AS INTEGER)\n"
|
|
" e = e + 100\n"
|
|
"END SUB\n"
|
|
"SUB Pass(ParamArray p())\n"
|
|
" Bump p(0)\n"
|
|
" Bump p(1)\n"
|
|
" PRINT JOIN(p, \",\");\n"
|
|
" FOR EACH e IN p\n"
|
|
" PRINT \" \"; e;\n"
|
|
" NEXT\n"
|
|
" PRINT\n"
|
|
"END SUB\n"
|
|
"SUB Outer\n"
|
|
" DIM y AS INTEGER\n"
|
|
" y = 3\n"
|
|
" Stash y\n"
|
|
" y = 4\n"
|
|
"END SUB\n"
|
|
"SUB Stash(ParamArray p())\n"
|
|
" keep = p\n"
|
|
" p(0) = 9\n"
|
|
"END SUB\n",
|
|
"104 4 \n"
|
|
"101,100 101 100 \n"
|
|
"101 100 \n"
|
|
"3 0 \n"
|
|
);
|
|
|
|
runProgram("References: late-bound and known methods write through TYPE fields and member variables at once",
|
|
"TYPE Rec\n"
|
|
" f AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM r AS Rec\n"
|
|
"DIM rs(2) AS Rec\n"
|
|
"DIM o AS Object\n"
|
|
"DIM c AS Counter\n"
|
|
"SET c = NEW Counter\n"
|
|
"SET o = c\n"
|
|
"r.f = 1: rs(1).f = 2\n"
|
|
"o.Add r.f, rs(1).f\n"
|
|
"PRINT r.f; rs(1).f\n"
|
|
"c.Add r.f, rs(1).f\n"
|
|
"PRINT r.f; rs(1).f\n"
|
|
"c.Self\n"
|
|
"BEGINCLASS \"Counter\"\n"
|
|
"Private m AS INTEGER\n"
|
|
"Private mr AS Rec\n"
|
|
"Public Sub Add(a AS INTEGER, b AS INTEGER)\n"
|
|
" a = a + 10\n"
|
|
" PRINT b;\n"
|
|
" b = b + a\n"
|
|
"End Sub\n"
|
|
"Public Sub Self()\n"
|
|
" m = 1: mr.f = 2\n"
|
|
" Add m, mr.f\n"
|
|
" PRINT m; mr.f\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"2 11 13 \n"
|
|
"13 21 34 \n"
|
|
"2 11 13 \n"
|
|
);
|
|
}
|
|
|
|
|
|
// Deferred graphics round 2: the other SCREEN modes, WIDTH, pages and
|
|
// PCOPY, VIEW PRINT, PMAP, blinking, PAINT tiles, DRAW X and "=".
|
|
static void testScreenModesPages(void) {
|
|
typedef struct {
|
|
const char *source;
|
|
int32_t width;
|
|
int32_t height;
|
|
int32_t pixelW;
|
|
int32_t pixelH;
|
|
int32_t colors;
|
|
int32_t cols;
|
|
int32_t rows;
|
|
int32_t cellH;
|
|
int32_t pages;
|
|
} ModeCaseT;
|
|
|
|
static const ModeCaseT modes[] = {
|
|
{ "SCREEN 1\n", 320, 200, 1, 1, 4, 40, 25, 8, 1 },
|
|
{ "SCREEN 2\n", 640, 200, 1, 2, 2, 80, 25, 8, 1 },
|
|
{ "SCREEN 7\n", 320, 200, 1, 1, 16, 40, 25, 8, 8 },
|
|
{ "SCREEN 8\n", 640, 200, 1, 2, 16, 80, 25, 8, 4 },
|
|
{ "SCREEN 9\n", 640, 350, 1, 1, 16, 80, 25, 14, 2 },
|
|
{ "SCREEN 9\nWIDTH 80, 43\n", 640, 350, 1, 1, 16, 80, 43, 8, 2 },
|
|
{ "SCREEN 10\n", 640, 350, 1, 1, 4, 80, 25, 14, 2 },
|
|
{ "SCREEN 11\n", 640, 480, 1, 1, 2, 80, 30, 16, 1 },
|
|
{ "SCREEN 11\nWIDTH , 60\n", 640, 480, 1, 1, 2, 80, 60, 8, 1 },
|
|
{ "SCREEN 12\n", 640, 480, 1, 1, 16, 80, 30, 16, 1 },
|
|
{ "SCREEN 13\n", 320, 200, 1, 1, 256, 40, 25, 8, 1 },
|
|
{ "WIDTH 40\n", 320, 400, 2, 1, 16, 40, 25, 16, 8 },
|
|
{ "WIDTH 80, 43\n", 640, 344, 1, 1, 16, 80, 43, 8, 4 },
|
|
{ "WIDTH 40, 50\n", 320, 400, 2, 1, 16, 40, 50, 8, 8 }
|
|
};
|
|
|
|
CaptureT cap;
|
|
char row[TEST_ROW_TEXT_LEN];
|
|
BasVmT *vm = NULL;
|
|
|
|
basGfxSetFont(font8x16);
|
|
|
|
for (int32_t i = 0; i < (int32_t)(sizeof(modes) / sizeof(modes[0])); i++) {
|
|
const ModeCaseT *m = &modes[i];
|
|
|
|
vm = screenRun(m->source, m->source, &cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
bool ok = scr->width == m->width && scr->height == m->height && scr->pixelW == m->pixelW && scr->pixelH == m->pixelH;
|
|
|
|
ok = ok && scr->colors == m->colors && scr->cols == m->cols && scr->rows == m->rows && scr->cellH == m->cellH && scr->pages == m->pages;
|
|
checkTrue("mode geometry, colours, text and pages", ok);
|
|
screenRunFree(vm);
|
|
}
|
|
}
|
|
|
|
vm = screenRun("SCREEN 1 CGA palettes, SCREEN 9 background colour",
|
|
"SCREEN 1\n"
|
|
"c1 = 1\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("SCREEN 1 palette 1: cyan, magenta, white", scr->palette[3] == 0 && scr->palette[4] == 170 && scr->palette[5] == 170 && scr->palette[6] == 170 && scr->palette[9] == 255);
|
|
checkTrue("SCREEN 1 foreground 3", scr->fore == 3);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 1 COLOR background, palette 0",
|
|
"SCREEN 1\n"
|
|
"COLOR 1, 0\n"
|
|
"PSET (1, 1), 3\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("COLOR 1: attribute 0 blue", scr->palette[0] == 0 && scr->palette[2] == 170);
|
|
checkTrue("palette 0: green, red, brown", scr->palette[3] == 0 && scr->palette[4] == 170 && scr->palette[6] == 170 && scr->palette[9] == 170 && scr->palette[10] == 85);
|
|
checkTrue("attribute 3 drawn", fbAt(scr, 1, 1) == 3);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 9 COLOR fore, EGA background; SCREEN 2 white",
|
|
"SCREEN 9\n"
|
|
"COLOR 14, 1\n"
|
|
"PSET (1, 1)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("background colour 1 on attribute 0", scr->palette[0] == 0 && scr->palette[1] == 0 && scr->palette[2] == 170);
|
|
checkTrue("foreground 14", fbAt(scr, 1, 1) == 14);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// Graphics pages: draw on a hidden page, copy it, show another
|
|
vm = screenRun("SCREEN 7 pages: active, visual, PCOPY",
|
|
"SCREEN 7, , 1, 0\n"
|
|
"PSET (5, 5), 4\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("page 1 active, page 0 shown", scr->activePage == 1 && scr->visualPage == 0);
|
|
checkTrue("drawn on the active page only", fbAt(scr, 5, 5) == 4 && shownAt(scr, 5, 5) == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 7 PCOPY and showing page 1",
|
|
"SCREEN 7, , 1, 0\n"
|
|
"PSET (5, 5), 4\n"
|
|
"PCOPY 1, 0\n"
|
|
"SCREEN 7, , 0\n"
|
|
"PSET (6, 6), 2\n"
|
|
"SCREEN 7, 0, 1, 1\n"
|
|
"p = POINT(6, 6)\n"
|
|
"q = POINT(5, 5)\n"
|
|
"SCREEN 7\n"
|
|
"r = POINT(5, 5)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("page 1 shown", scr->visualPage == 1 && shownAt(scr, 5, 5) == 4 && shownAt(scr, 6, 6) == 0);
|
|
checkTrue("PCOPY copied page 1 onto page 0", scr->fbAll[5 * 320 + 5] == 4 && scr->fbAll[6 * 320 + 6] == 2);
|
|
checkTrue("POINT reads the active page", globalNum(vm, "p") == 0 && globalNum(vm, "q") == 4);
|
|
checkTrue("SCREEN of the same mode keeps the picture", globalNum(vm, "r") == 4);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// SCREEN 0 pages hold text; only the visual page has pixels
|
|
vm = screenRun("SCREEN 0 pages",
|
|
"SCREEN 0, , 1, 0\n"
|
|
"PRINT \"PAGE1\"\n"
|
|
"a = SCREEN(1, 1)\n"
|
|
"SCREEN 0, , 0, 0\n"
|
|
"b = SCREEN(1, 1)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("text on page 1, page 0 blank", globalNum(vm, "a") == 'P' && globalNum(vm, "b") == ' ');
|
|
checkTrue("the hidden page's text drew nothing", cellPixels(scr, 0, 0, 7) == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 0 PCOPY onto the visual page",
|
|
"SCREEN 0, , 1, 0\n"
|
|
"PRINT \"PAGE1\"\n"
|
|
"SCREEN 0, , 0, 0\n"
|
|
"PCOPY 1, 0\n"
|
|
"c = SCREEN(1, 1)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("copied text shown", globalNum(vm, "c") == 'P' && cellPixels(vm->screen, 0, 0, 7) > 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// VIEW PRINT: scrolling inside the text viewport
|
|
vm = screenRun("VIEW PRINT scrolls its rows",
|
|
"CLS\n"
|
|
"PRINT \"TOP\"\n"
|
|
"VIEW PRINT 3 TO 5\n"
|
|
"r1 = CSRLIN\n"
|
|
"FOR i = 1 TO 5\n"
|
|
" PRINT \"L\"; i\n"
|
|
"NEXT i\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("cursor to the viewport's top", globalNum(vm, "r1") == 3);
|
|
rowText(scr, 0, row);
|
|
checkTrue("row above the viewport kept", strcmp(row, "TOP") == 0);
|
|
rowText(scr, 2, row);
|
|
checkTrue("viewport scrolled (row 3)", strcmp(row, "L4") == 0);
|
|
rowText(scr, 3, row);
|
|
checkTrue("viewport scrolled (row 4)", strcmp(row, "L5") == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("CLS 2 and CLS under VIEW PRINT clear the viewport",
|
|
"CLS\n"
|
|
"PRINT \"TOP\"\n"
|
|
"VIEW PRINT 3 TO 5\n"
|
|
"PRINT \"MID\"\n"
|
|
"CLS\n"
|
|
"VIEW PRINT\n"
|
|
"r2 = CSRLIN\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
rowText(scr, 0, row);
|
|
checkTrue("CLS kept the row above", strcmp(row, "TOP") == 0);
|
|
rowText(scr, 2, row);
|
|
checkTrue("CLS cleared the viewport", row[0] == '\0');
|
|
checkTrue("VIEW PRINT alone: whole screen, cursor home", globalNum(vm, "r2") == 1 && scr->textTop == 0 && scr->textBottom == 24);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// PMAP with WINDOW and VIEW
|
|
vm = screenRun("PMAP",
|
|
"SCREEN 13\n"
|
|
"WINDOW (0, 0)-(100, 100)\n"
|
|
"a = PMAP(0, 0)\n"
|
|
"b = PMAP(100, 0)\n"
|
|
"c = PMAP(0, 1)\n"
|
|
"d = PMAP(319, 2)\n"
|
|
"e = PMAP(0, 3)\n"
|
|
"VIEW (10, 10)-(109, 109)\n"
|
|
"WINDOW SCREEN (0, 0)-(99, 99)\n"
|
|
"f = PMAP(99, 0)\n"
|
|
"g = PMAP(0, 2)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("PMAP world -> physical", globalNum(vm, "a") == 0 && globalNum(vm, "b") == 319 && globalNum(vm, "c") == 199);
|
|
checkTrue("PMAP physical -> world", globalNum(vm, "d") == 100 && globalNum(vm, "e") == 100);
|
|
checkTrue("PMAP is view-relative", globalNum(vm, "f") == 99 && globalNum(vm, "g") == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// Blinking text: COLOR 16..31, and backgrounds 8..15 as on a VGA
|
|
vm = screenRun("SCREEN 0 blinking colours",
|
|
"COLOR 20, 1\n"
|
|
"PRINT \"B\";\n"
|
|
"COLOR 7, 9\n"
|
|
"PRINT \"C\";\n"
|
|
"a = SCREEN(1, 1, 1)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
int32_t on = cellPixels(scr, 0, 0, 4);
|
|
|
|
checkTrue("blink attribute", globalNum(vm, "a") == (4 | 1 << 4 | 0x80) && scr->blinkUsed);
|
|
checkTrue("background 9 shows as 1", cellPixels(scr, 0, 1, 1) > 0 && cellPixels(scr, 0, 1, 9) == 0);
|
|
checkTrue("blink phase hides the text", on > 0 && basScreenBlink(scr) && cellPixels(scr, 0, 0, 4) == 0 && cellPixels(scr, 0, 0, 1) == 128);
|
|
checkTrue("and shows it again", basScreenBlink(scr) && cellPixels(scr, 0, 0, 4) == on);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 10 blinking shades",
|
|
"SCREEN 10\n"
|
|
"PSET (1, 1), 2\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("attribute 2 on, then off", scr->palette[6] == 170 && basScreenBlink(scr) && scr->palette[6] == 0 && scr->paletteChanged);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("SCREEN 10 without blinking shades; SCREEN 13 never blinks",
|
|
"SCREEN 10\n"
|
|
"PALETTE 2, 4\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("nothing blinks", !basScreenBlink(vm->screen) && vm->screen->palette[6] == 170);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// PAINT tiles: planes (SCREEN 12), bytes (13), two-bit pixels (1)
|
|
vm = screenRun("PAINT tiles",
|
|
"SCREEN 12\n"
|
|
"LINE (0, 0)-(20, 20), 15, B\n"
|
|
"PAINT (5, 5), CHR$(&HAA) + STRING$(3, 0), 15\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("plane tile: blue on even columns", fbAt(scr, 2, 5) == 1 && fbAt(scr, 3, 5) == 0 && fbAt(scr, 18, 19) == 1 && fbAt(scr, 1, 1) == 0);
|
|
checkTrue("tile stays inside the border", fbAt(scr, 0, 5) == 15 && fbAt(scr, 20, 5) == 15 && fbAt(scr, 22, 5) == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("PAINT tiles in SCREEN 13 and SCREEN 1",
|
|
"SCREEN 13\n"
|
|
"LINE (30, 0)-(50, 20), 15, B\n"
|
|
"PAINT (35, 5), CHR$(4) + CHR$(5), 15\n"
|
|
"a = POINT(35, 4)\n"
|
|
"b = POINT(40, 5)\n"
|
|
"SCREEN 1\n"
|
|
"LINE (0, 0)-(20, 20), 3, B\n"
|
|
"PAINT (5, 5), CHR$(&H1B), 3\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("byte tile rows", globalNum(vm, "a") == 4 && globalNum(vm, "b") == 5);
|
|
checkTrue("two-bit tile", fbAt(scr, 4, 5) == 0 && fbAt(scr, 5, 5) == 1 && fbAt(scr, 6, 5) == 2 && fbAt(scr, 7, 5) == 3 && fbAt(scr, 9, 9) == 1);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
// DRAW X and "=" with VARPTR$
|
|
vm = screenRun("DRAW X and = with VARPTR$",
|
|
"SCREEN 13\n"
|
|
"s$ = \"R10\"\n"
|
|
"DRAW \"C4 BM10,10 X\" + VARPTR$(s$) + \";\"\n"
|
|
"n = 5\n"
|
|
"DRAW \"BM50,50 C=\" + VARPTR$(n) + \"; R=\" + VARPTR$(n) + \";\"\n"
|
|
"t$ = \"D3 X\" + VARPTR$(s$)\n"
|
|
"DRAW \"C6 BM100,100 X\" + VARPTR$(t$)\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
BasScreenT *scr = vm->screen;
|
|
|
|
checkTrue("X ran the string", fbAt(scr, 10, 10) == 4 && fbAt(scr, 20, 10) == 4 && fbAt(scr, 21, 10) == 0);
|
|
checkTrue("= numbers", fbAt(scr, 55, 50) == 5 && fbAt(scr, 56, 50) == 0);
|
|
checkTrue("nested X", fbAt(scr, 100, 103) == 6 && fbAt(scr, 110, 103) == 6);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("Errors: pages, COLOR in SCREEN 2, WIDTH, PMAP, VIEW PRINT, tiles, DRAW X",
|
|
"ON ERROR GOTO h\n"
|
|
"SCREEN 7, , 8\n"
|
|
"SCREEN 13, , 1\n"
|
|
"PCOPY 0, 9\n"
|
|
"SCREEN 2\n"
|
|
"COLOR 1\n"
|
|
"SCREEN 13\n"
|
|
"WIDTH 40, 43\n"
|
|
"x = PMAP(0, 4)\n"
|
|
"DRAW \"XAB\"\n"
|
|
"SCREEN 0\n"
|
|
"x = PMAP(1, 0)\n"
|
|
"VIEW PRINT 5 TO 3\n"
|
|
"VIEW PRINT 0 TO 3\n"
|
|
"WIDTH 60\n"
|
|
"SCREEN 1\n"
|
|
"PSET (1, 1), 4\n"
|
|
"SCREEN 12\n"
|
|
"PAINT (5, 5), STRING$(12, 0), 15, CHR$(0)\n"
|
|
"PAINT (5, 5), STRING$(8, 0), 15, CHR$(0)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"n = n + 1\n"
|
|
"IF ERR <> 5 THEN bad = bad + 1\n"
|
|
"RESUME NEXT\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("thirteen Illegal function calls", globalNum(vm, "n") == 13 && globalNum(vm, "bad") == 0);
|
|
screenRunFree(vm);
|
|
}
|
|
|
|
vm = screenRun("Each page keeps its own text cursor",
|
|
"SCREEN 7, , 1, 0\n"
|
|
"LOCATE 5, 10\n"
|
|
"PRINT \"x\";\n"
|
|
"SCREEN 7, , 0, 0\n"
|
|
"LOCATE 2, 3\n"
|
|
"SCREEN 7, , 1, 0\n"
|
|
"r1 = CSRLIN: c1 = POS(0)\n"
|
|
"SCREEN 7, , 0, 0\n"
|
|
"r0 = CSRLIN: c0 = POS(0)\n"
|
|
"SCREEN 7, , 2, 0\n"
|
|
"r2 = CSRLIN: c2 = POS(0)\n"
|
|
"SCREEN 7, , 0, 0\n",
|
|
&cap, NULL);
|
|
|
|
if (vm) {
|
|
checkTrue("page 1 cursor kept across page switches", globalNum(vm, "r1") == 5 && globalNum(vm, "c1") == 11);
|
|
checkTrue("page 0 cursor kept across page switches", globalNum(vm, "r0") == 2 && globalNum(vm, "c0") == 3);
|
|
checkTrue("an unused page's cursor is home", globalNum(vm, "r2") == 1 && globalNum(vm, "c2") == 1);
|
|
screenRunFree(vm);
|
|
}
|
|
}
|
|
|
|
|
|
// Phase 1 library functions: the string functions (REPLACE$, SPLIT, JOIN$,
|
|
// INSTRREV, STRCOMP, STRREVERSE$, FILTER, LSET / RSET, IIF, CHOOSE) and
|
|
// the DATE type with its functions, literals, arithmetic and Format$.
|
|
static void testStringsAndDates(void) {
|
|
runProgram("Replace$",
|
|
"PRINT Replace$(\"aXbXc\", \"X\", \"-\")\n"
|
|
"PRINT Replace(\"aXbXc\", \"X\", \"-\", 3)\n"
|
|
"PRINT Replace(\"aXbXc\", \"X\", \"-\", 1, 1)\n"
|
|
"PRINT Replace(\"aXbXc\", \"x\", \"-\", 1, -1, vbTextCompare)\n"
|
|
"PRINT Replace(\"aXbXc\", \"x\", \"-\")\n"
|
|
"PRINT \"[\" & Replace(\"abc\", \"\", \"-\") & \"]\"\n"
|
|
"PRINT \"[\" & Replace(\"abc\", \"b\", \"\") & \"]\"\n"
|
|
"PRINT \"[\" & Replace(\"abc\", \"b\", \"x\", 9) & \"]\"\n"
|
|
"PRINT Replace(\"aaa\", \"a\", \"aa\")\n"
|
|
"PRINT Replace(\"aXbXc\", \"X\", \"-\", 1, 0)\n",
|
|
"a-b-c\nb-c\na-bXc\na-b-c\naXbXc\n[abc]\n[ac]\n[]\naaaaaa\naXbXc\n"
|
|
);
|
|
|
|
runProgram("Split with delimiters, limits and empty input",
|
|
"DIM p() AS STRING\n"
|
|
"DIM i AS INTEGER\n"
|
|
"p = Split(\"a,b,,c\", \",\")\n"
|
|
"PRINT UBOUND(p); LBOUND(p)\n"
|
|
"FOR i = 0 TO UBOUND(p): PRINT \"[\" & p(i) & \"]\";: NEXT: PRINT\n"
|
|
"p = Split(\"a b c\")\n"
|
|
"PRINT UBOUND(p)\n"
|
|
"p = Split(\"a,b,c\", \",\", 2)\n"
|
|
"FOR i = 0 TO UBOUND(p): PRINT \"[\" & p(i) & \"]\";: NEXT: PRINT\n"
|
|
"p = Split(\"\", \",\")\n"
|
|
"PRINT UBOUND(p); LBOUND(p)\n"
|
|
"p = Split(\"abc\", \"\")\n"
|
|
"PRINT UBOUND(p); p(0)\n"
|
|
"p = Split(\"aXbxc\", \"x\", -1, vbTextCompare)\n"
|
|
"FOR i = 0 TO UBOUND(p): PRINT \"[\" & p(i) & \"]\";: NEXT: PRINT\n"
|
|
"p = Split(\"a,b\", \",\", 0)\n"
|
|
"PRINT UBOUND(p)\n"
|
|
"p = Split(\"a,b,\", \",\")\n"
|
|
"PRINT UBOUND(p)\n"
|
|
"p = Split(\"a::b\", \"::\")\n"
|
|
"PRINT p(0); p(1)\n",
|
|
"3 0 \n[a][b][][c]\n2 \n[a][b,c]\n-1 0 \n0 abc\n[a][b][c]\n-1 \n2 \nab\n"
|
|
);
|
|
|
|
runProgram("Join$ and Filter",
|
|
"DIM p() AS STRING\n"
|
|
"DIM n(2) AS INTEGER\n"
|
|
"DIM f() AS STRING\n"
|
|
"p = Split(\"apple,banana,cherry\", \",\")\n"
|
|
"PRINT Join$(p, \"-\")\n"
|
|
"PRINT Join(p)\n"
|
|
"PRINT Join(Split(\"x y z\"), \"\")\n"
|
|
"n(0) = 1: n(1) = 22: n(2) = 333\n"
|
|
"PRINT Join(n, \",\")\n"
|
|
"PRINT \"[\" & Join(Split(\"\", \",\"), \",\") & \"]\"\n"
|
|
"f = Filter(p, \"an\")\n"
|
|
"PRINT UBOUND(f); f(0)\n"
|
|
"f = Filter(p, \"an\", False)\n"
|
|
"PRINT Join(f, \"+\")\n"
|
|
"f = Filter(p, \"AN\", True, vbTextCompare)\n"
|
|
"PRINT Join(f, \"+\")\n"
|
|
"f = Filter(p, \"zz\")\n"
|
|
"PRINT UBOUND(f)\n",
|
|
"apple-banana-cherry\napple banana cherry\nxyz\n1,22,333\n[]\n0 banana\napple+cherry\nbanana\n-1 \n"
|
|
);
|
|
|
|
runProgram("InStrRev, StrComp and StrReverse$",
|
|
"PRINT InStrRev(\"abcabc\", \"bc\")\n"
|
|
"PRINT InStrRev(\"abcabc\", \"bc\", 4)\n"
|
|
"PRINT InStrRev(\"abc\", \"x\")\n"
|
|
"PRINT InStrRev(\"abc\", \"\")\n"
|
|
"PRINT InStrRev(\"ABC\", \"b\", -1, vbTextCompare)\n"
|
|
"PRINT InStrRev(\"abc\", \"c\", 9)\n"
|
|
"PRINT InStrRev(\"\", \"a\")\n"
|
|
"PRINT StrComp(\"a\", \"b\"); StrComp(\"b\", \"a\"); StrComp(\"a\", \"a\")\n"
|
|
"PRINT StrComp(\"A\", \"a\"); StrComp(\"A\", \"a\", vbTextCompare); StrComp(\"A\", \"a\", vbBinaryCompare)\n"
|
|
"PRINT StrReverse$(\"abc\"); \"[\" & StrReverse(\"\") & \"]\"\n",
|
|
"5 \n2 \n0 \n3 \n2 \n0 \n0 \n-1 1 0 \n-1 0 -1 \ncba[]\n"
|
|
);
|
|
|
|
runProgram("Drag and clipboard constants; Control, Form and Object types",
|
|
"PRINT vbManual; vbAutomatic; vbBeginDrag; vbEndDrag\n"
|
|
"PRINT vbEnter; vbLeave; vbOver; vbCFText\n"
|
|
"DIM c AS Control\n"
|
|
"SET c = Nothing\n"
|
|
"T Nothing, Nothing, c\n"
|
|
"SUB T(s AS Control, f AS Form, o AS Object)\n"
|
|
" PRINT \"objects\"\n"
|
|
"END SUB\n",
|
|
"0 1 1 2 \n0 1 2 1 \nobjects\n"
|
|
);
|
|
|
|
runProgram("StrComp and Replace follow OPTION COMPARE TEXT",
|
|
"OPTION COMPARE TEXT\n"
|
|
"PRINT StrComp(\"A\", \"a\"); StrComp(\"A\", \"a\", vbBinaryCompare)\n"
|
|
"PRINT Replace(\"aXbxc\", \"x\", \"-\")\n"
|
|
"PRINT InStrRev(\"aXbx\", \"X\")\n",
|
|
"0 -1 \na-b-c\n4 \n"
|
|
);
|
|
|
|
runProgram("LSET and RSET",
|
|
"DIM s AS STRING\n"
|
|
"DIM f AS STRING * 4\n"
|
|
"DIM a(1) AS STRING\n"
|
|
"s = \"12345\"\n"
|
|
"LSET s = \"ab\"\n"
|
|
"PRINT \"[\" & s & \"]\"\n"
|
|
"RSET s = \"xy\"\n"
|
|
"PRINT \"[\" & s & \"]\"\n"
|
|
"LSET s = \"toolongvalue\"\n"
|
|
"PRINT \"[\" & s & \"]\"\n"
|
|
"RSET s = \"toolongvalue\"\n"
|
|
"PRINT \"[\" & s & \"]\"\n"
|
|
"RSET f = \"7\"\n"
|
|
"PRINT \"[\" & f & \"]\"\n"
|
|
"a(1) = \"....\"\n"
|
|
"LSET a(1) = \"x\"\n"
|
|
"PRINT \"[\" & a(1) & \"]\"\n",
|
|
"[ab ]\n[ xy]\n[toolo]\n[toolo]\n[ 7]\n[x ]\n"
|
|
);
|
|
|
|
runProgram("IIf and Choose",
|
|
"PRINT IIf(1 > 0, \"yes\", \"no\")\n"
|
|
"PRINT IIf(0, 1, 2)\n"
|
|
"PRINT Choose(2, \"a\", \"b\", \"c\")\n"
|
|
"PRINT Choose(3.7, \"a\", \"b\", \"c\")\n"
|
|
"PRINT Choose(4, \"a\", \"b\", \"c\")\n"
|
|
"PRINT IsNull(Choose(0, \"a\"))\n",
|
|
"yes\n2 \nb\nc\nNull\nTrue \n"
|
|
);
|
|
|
|
runProgram("Library errors",
|
|
"DIM s AS INTEGER\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT Join(5)\n"
|
|
"PRINT Replace(\"a\", \"a\", \"b\", 0)\n"
|
|
"PRINT Split(\"a\", \",\", -2)\n"
|
|
"PRINT InStrRev(\"a\", \"a\", 0)\n"
|
|
"PRINT StrComp(\"a\", \"b\", 7)\n"
|
|
"LSET s = \"x\"\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"err13 \nerr5 \nerr5 \nerr5 \nerr5 \nerr13 \n"
|
|
);
|
|
|
|
runProgram("New built-in names stay free for the program",
|
|
"DIM day AS INTEGER\n"
|
|
"day = 5\n"
|
|
"PRINT day\n"
|
|
"FUNCTION Replace(a AS STRING) AS STRING\n"
|
|
" Replace = \"mine \" & a\n"
|
|
"END FUNCTION\n"
|
|
"PRINT Replace(\"x\")\n"
|
|
"PRINT Month(#3/4/2005#)\n",
|
|
"5 \nmine x\n3 \n"
|
|
);
|
|
|
|
runProgram("DATE variables, literals and printing",
|
|
"DIM d AS DATE\n"
|
|
"PRINT d\n"
|
|
"d = #1/15/2000#\n"
|
|
"PRINT d\n"
|
|
"PRINT Year(d); Month(d); Day(d); Weekday(d)\n"
|
|
"d = #1/15/2000 3:04:05 PM#\n"
|
|
"PRINT d\n"
|
|
"PRINT Hour(d); Minute(d); Second(d)\n"
|
|
"PRINT CDbl(#1/1/2000#)\n"
|
|
"PRINT #12:00:00 PM#\n"
|
|
"PRINT CDate(36526.5)\n"
|
|
"PRINT \"[\" & STR$(d) & \"][\" & CSTR(d) & \"]\"\n"
|
|
"PRINT \"Date: \" & #2000-02-29#\n"
|
|
"PRINT #March 5, 2001#; \"|\"; #5 Mar 2001 16:30#\n"
|
|
"PRINT #1/1/100#; \" \"; #12/31/9999 11:59:59 PM#\n",
|
|
"12:00:00 AM\n1/15/2000\n2000 1 15 7 \n1/15/2000 3:04:05 PM\n15 4 5 \n36526 \n12:00:00 PM\n1/1/2000 12:00:00 PM\n"
|
|
"[1/15/2000 3:04:05 PM][1/15/2000 3:04:05 PM]\nDate: 2/29/2000\n3/5/2001|3/5/2001 4:30:00 PM\n1/1/100 12/31/9999 11:59:59 PM\n"
|
|
);
|
|
|
|
runProgram("DateSerial and TimeSerial rules",
|
|
"PRINT DateSerial(2000, 2, 29)\n"
|
|
"PRINT DateSerial(2001, 2, 29)\n"
|
|
"PRINT DateSerial(2000, 13, 1)\n"
|
|
"PRINT DateSerial(2000, 0, 1)\n"
|
|
"PRINT DateSerial(2000, 3, 0)\n"
|
|
"PRINT DateSerial(2000, -11, 1)\n"
|
|
"PRINT DateSerial(99, 1, 1); \" \"; DateSerial(29, 1, 1); \" \"; DateSerial(30, 1, 1)\n"
|
|
"PRINT DateSerial(1900, 2, 29)\n"
|
|
"PRINT DateSerial(2000, 1, 366)\n"
|
|
"PRINT TimeSerial(25, 0, 0)\n"
|
|
"PRINT TimeSerial(-1, 0, 0)\n"
|
|
"PRINT TimeSerial(1, 90, 0)\n"
|
|
"PRINT CDbl(TimeSerial(-1, 0, 0))\n"
|
|
"PRINT TimeSerial(0, 0, -1)\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT DateSerial(10000, 1, 1)\n"
|
|
"PRINT DateSerial(100, 1, 0)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"2/29/2000\n3/1/2001\n1/1/2001\n12/1/1999\n2/29/2000\n1/1/1999\n1/1/1999 1/1/2029 1/1/1930\n3/1/1900\n12/31/2000\n"
|
|
"12/31/1899 1:00:00 AM\n12/29/1899 11:00:00 PM\n2:30:00 AM\n-1.95833333333333 \n12/29/1899 11:59:59 PM\nerr5 \nerr5 \n"
|
|
);
|
|
|
|
runProgram("DateValue, TimeValue and dates before 1900",
|
|
"DIM d AS DATE\n"
|
|
"PRINT DateValue(\"March 5, 2001 4:00 PM\")\n"
|
|
"PRINT TimeValue(\"March 5, 2001 4:00 PM\")\n"
|
|
"d = CDate(-1.25)\n"
|
|
"PRINT d\n"
|
|
"PRINT DateValue(d); \" \"; TimeValue(d)\n"
|
|
"PRINT d + 1\n"
|
|
"PRINT d - 1\n"
|
|
"PRINT CDbl(d - 1)\n"
|
|
"PRINT CDate(-1.25) > CDate(-1)\n"
|
|
"PRINT Weekday(CDate(-1)); Year(d); Month(d); Day(d); Hour(d)\n"
|
|
"PRINT #12/29/1899 6:00 AM# = d\n",
|
|
"3/5/2001\n4:00:00 PM\n12/29/1899 6:00:00 AM\n12/29/1899 6:00:00 AM\n6:00:00 AM\n12/28/1899 6:00:00 AM\n-2.25 \nTrue \n6 1899 12 29 6 \nTrue \n"
|
|
);
|
|
|
|
runProgram("DateAdd with month-end clamping and overflow",
|
|
"PRINT DateAdd(\"m\", 1, #1/31/2000#)\n"
|
|
"PRINT DateAdd(\"m\", 1, #1/31/2001#)\n"
|
|
"PRINT DateAdd(\"yyyy\", 1, #2/29/2000#)\n"
|
|
"PRINT DateAdd(\"q\", 1, #11/30/2000#)\n"
|
|
"PRINT DateAdd(\"m\", -13, #1/31/2000#)\n"
|
|
"PRINT DateAdd(\"d\", -1, #3/1/2000#)\n"
|
|
"PRINT DateAdd(\"y\", 1, #12/31/2000#); \" \"; DateAdd(\"w\", 1, #12/31/2000#)\n"
|
|
"PRINT DateAdd(\"ww\", 2, #1/1/2000#)\n"
|
|
"PRINT DateAdd(\"h\", 25, #1/1/2000#)\n"
|
|
"PRINT DateAdd(\"n\", -1, #1/1/2000#)\n"
|
|
"PRINT DateAdd(\"s\", 86400, #1/1/2000#)\n"
|
|
"PRINT DateAdd(\"M\", 2.9, #1/15/2000#)\n"
|
|
"PRINT DateAdd(\"m\", 1, #1/31/2000 10:30#)\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT DateAdd(\"x\", 1, #1/1/2000#)\n"
|
|
"PRINT DateAdd(\"yyyy\", 8000, #1/1/2000#)\n"
|
|
"PRINT DateAdd(\"d\", -1, #1/1/100#)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"2/29/2000\n2/28/2001\n2/28/2001\n2/28/2001\n12/31/1998\n2/29/2000\n1/1/2001 1/1/2001\n1/15/2000\n1/2/2000 1:00:00 AM\n"
|
|
"12/31/1999 11:59:00 PM\n1/2/2000\n3/15/2000\n2/29/2000 10:30:00 AM\nerr5 \nerr5 \nerr5 \n"
|
|
);
|
|
|
|
runProgram("DateDiff intervals and week rules",
|
|
"PRINT DateDiff(\"d\", #1/1/2000#, #3/1/2000#)\n"
|
|
"PRINT DateDiff(\"d\", #3/1/2000#, #1/1/2000#)\n"
|
|
"PRINT DateDiff(\"d\", #1/1/2000 11:00 PM#, #1/2/2000 1:00 AM#)\n"
|
|
"PRINT DateDiff(\"yyyy\", #12/31/1999#, #1/1/2000#)\n"
|
|
"PRINT DateDiff(\"m\", #1/31/2000#, #2/1/2000#)\n"
|
|
"PRINT DateDiff(\"q\", #3/31/2000#, #4/1/2000#)\n"
|
|
"PRINT DateDiff(\"w\", #1/3/2000#, #1/16/2000#); DateDiff(\"w\", #1/3/2000#, #1/17/2000#)\n"
|
|
"PRINT DateDiff(\"ww\", #1/1/2000#, #1/2/2000#); DateDiff(\"ww\", #1/2/2000#, #1/8/2000#)\n"
|
|
"PRINT DateDiff(\"ww\", #1/1/2000#, #1/2/2000#, vbMonday); DateDiff(\"ww\", #1/1/2000#, #12/31/2000#)\n"
|
|
"PRINT DateDiff(\"h\", #1/1/2000 10:59 AM#, #1/1/2000 11:00 AM#)\n"
|
|
"PRINT DateDiff(\"n\", #1/1/2000 10:59:59 AM#, #1/1/2000 11:00 AM#)\n"
|
|
"PRINT DateDiff(\"s\", #1/1/2000#, #1/2/2000#)\n"
|
|
"PRINT DateDiff(\"d\", CDate(-1.25), CDate(0.5))\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT DateDiff(\"s\", #1/1/100#, #12/31/9999#)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"60 \n-60 \n1 \n1 \n1 \n1 \n1 2 \n1 0 \n0 53 \n1 \n1 \n86400 \n1 \nerr6 \n"
|
|
);
|
|
|
|
runProgram("DatePart, Weekday and week-of-year rules",
|
|
"PRINT DatePart(\"yyyy\", #5/15/2000#); DatePart(\"q\", #5/15/2000#); DatePart(\"m\", #5/15/2000#)\n"
|
|
"PRINT DatePart(\"y\", #3/1/2000#); DatePart(\"y\", #3/1/2001#); DatePart(\"d\", #3/1/2001#)\n"
|
|
"PRINT DatePart(\"w\", #1/1/2000#); DatePart(\"w\", #1/1/2000#, vbMonday)\n"
|
|
"PRINT DatePart(\"ww\", #1/1/2000#); DatePart(\"ww\", #1/1/2000#, vbSunday, vbFirstFourDays); DatePart(\"ww\", #1/1/2000#, vbSunday, vbFirstFullWeek)\n"
|
|
"PRINT DatePart(\"ww\", #12/31/2000#); DatePart(\"ww\", #1/2/2000#, vbSunday, vbFirstFullWeek)\n"
|
|
"PRINT DatePart(\"h\", #1/1/2000 1:02:03 PM#); DatePart(\"n\", #1/1/2000 1:02:03 PM#); DatePart(\"s\", #1/1/2000 1:02:03 PM#)\n"
|
|
"PRINT Weekday(#1/1/2000#, vbMonday); Weekday(#1/2/2000#); Weekday(#1/2/2000#, vbUseSystemDayOfWeek)\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT Weekday(#1/1/2000#, 9)\n"
|
|
"PRINT DatePart(\"ww\", #1/1/2000#, vbSunday, 4)\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"2000 2 5 \n61 60 1 \n7 6 \n1 52 52 \n54 1 \n13 2 3 \n6 1 1 \nerr5 \nerr5 \n"
|
|
);
|
|
|
|
runProgram("IsDate, CDate, MonthName and WeekdayName",
|
|
"DIM d AS DATE\n"
|
|
"PRINT IsDate(\"1/1/2000\"); IsDate(\"hello\"); IsDate(#1/1/2000#); IsDate(5); IsDate(\"2/30/2000\"); IsDate(\"13:00\"); IsDate(\"25:00\")\n"
|
|
"PRINT MonthName(1); \" \"; MonthName(12, True)\n"
|
|
"PRINT WeekdayName(1); \" \"; WeekdayName(1, True); \" \"; WeekdayName(1, False, vbMonday); \" \"; WeekdayName(7, False, vbMonday)\n"
|
|
"d = \"2/3/2004\"\n"
|
|
"PRINT d\n"
|
|
"d = \"13/1/2000\"\n"
|
|
"PRINT d\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT MonthName(13)\n"
|
|
"d = \"garbage\"\n"
|
|
"d = 1E10\n"
|
|
"PRINT CDate(\"2/30/2000\")\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"True False True False False True False \nJanuary Dec\nSunday Sun Monday Sunday\n2/3/2004\n1/13/2000\nerr5 \nerr13 \nerr6 \nerr13 \n"
|
|
);
|
|
|
|
runProgram("Format$ with date patterns",
|
|
"DIM d AS DATE\n"
|
|
"d = #1/5/2000 3:04:05 PM#\n"
|
|
"PRINT Format$(d, \"yyyy-mm-dd hh:nn:ss\")\n"
|
|
"PRINT Format$(d, \"m/d/yy\")\n"
|
|
"PRINT Format$(d, \"dddd, mmmm d, yyyy\")\n"
|
|
"PRINT Format$(d, \"ddd mmm\")\n"
|
|
"PRINT Format$(d, \"h:mm AM/PM\"); \"|\"; Format$(d, \"hh:mm am/pm\"); \"|\"; Format$(d, \"h A/P\")\n"
|
|
"PRINT Format$(d, \"Long Date\"); \"|\"; Format$(d, \"Short Date\"); \"|\"; Format$(d, \"Medium Date\")\n"
|
|
"PRINT Format$(d, \"Long Time\"); \"|\"; Format$(d, \"Medium Time\"); \"|\"; Format$(d, \"Short Time\")\n"
|
|
"PRINT Format$(d, \"q\"); \"|\"; Format$(d, \"\\d\\a\\y d\"); \"|\"; Format$(d, CHR$(34) & \"Year\" & CHR$(34) & \" yyyy\")\n"
|
|
"PRINT Format$(d, \"c\"); \"|\"; Format$(d, \"\"); \"|\"; Format$(d, \"General Date\")\n"
|
|
"PRINT Format$(d, \"ddddd\"); \"|\"; Format$(d, \"ttttt\"); \"|\"; Format$(d, \"y w ww\")\n"
|
|
"PRINT Format(36526, \"mm/dd/yyyy\"); \"|\"; Format$(\"1/2/2000\", \"yyyy\")\n"
|
|
"PRINT Format$(1234.5, \"#,##0.00\"); \"|\"; Format$(0.5, \"Percent\")\n"
|
|
"PRINT Format$(#1/1/2000 12:05 AM#, \"h:nn AM/PM\"); \"|\"; Format$(#1/1/2000 12:05 PM#, \"hh:nn\")\n"
|
|
"ON ERROR GOTO h\n"
|
|
"PRINT Format$(\"xyz\", \"yyyy\")\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"2000-01-05 15:04:05\n1/5/00\nWednesday, January 5, 2000\nWed Jan\n3:04 PM|03:04 pm|3 P\n"
|
|
"Wednesday, January 5, 2000|1/5/2000|05-Jan-00\n3:04:05 PM|03:04 PM|15:04\n1|day 5|Year 2000\n"
|
|
"1/5/2000 3:04:05 PM|1/5/2000 3:04:05 PM|1/5/2000 3:04:05 PM\n1/5/2000|3:04:05 PM|5 4 2\n01/01/2000|2000\n1,234.50|50%\n12:05 AM|12:05\nerr13 \n"
|
|
);
|
|
|
|
runProgram("Date arithmetic and comparison",
|
|
"DIM a AS DATE\n"
|
|
"DIM b AS DATE\n"
|
|
"a = #1/1/2000#\n"
|
|
"b = #1/2/2000 12:00 PM#\n"
|
|
"PRINT b > a; a = #1/1/2000#; a < \"1/2/2000\"; a = \"1/1/2000\"\n"
|
|
"PRINT b - a\n"
|
|
"PRINT a + 1.5\n"
|
|
"PRINT 2 + a\n"
|
|
"PRINT a - 366\n"
|
|
"a = a + 1\n"
|
|
"PRINT a\n"
|
|
"ON ERROR GOTO h\n"
|
|
"a = #12/31/9999# + 1\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"PRINT \"err\"; ERR\n"
|
|
"RESUME NEXT\n",
|
|
"True True True True \n1.5 \n1/2/2000 12:00:00 PM\n1/3/2000\n12/31/1998\n1/2/2000\nerr6 \n"
|
|
);
|
|
|
|
runProgram("DATE constants, arrays, TYPE fields and functions",
|
|
"CONST Y2K = #1/1/2000#\n"
|
|
"CONST NOON AS DATE = 0.5\n"
|
|
"TYPE Rec\n"
|
|
" stamp AS DATE\n"
|
|
"END TYPE\n"
|
|
"DIM a(2) AS DATE\n"
|
|
"DIM r AS Rec\n"
|
|
"FUNCTION NextDay(x AS DATE) AS DATE\n"
|
|
" NextDay = x + 1\n"
|
|
"END FUNCTION\n"
|
|
"PRINT Y2K; \"|\"; NOON; \"|\"; Year(Y2K)\n"
|
|
"PRINT a(0)\n"
|
|
"a(1) = \"1/1/2000\"\n"
|
|
"PRINT a(1)\n"
|
|
"r.stamp = #2/2/2002#\n"
|
|
"PRINT r.stamp\n"
|
|
"PRINT NextDay(#2/28/2000#)\n"
|
|
"PRINT NextDay(CDate(\"12/31/1999\"))\n",
|
|
"1/1/2000|12:00:00 PM|2000 \n12:00:00 AM\n1/1/2000\n2/2/2002\n2/29/2000\n1/1/2000\n"
|
|
);
|
|
|
|
runProgram("Now, Date and Time",
|
|
"DIM d AS DATE\n"
|
|
"d = Now\n"
|
|
"PRINT Year(d) >= 2024; Int(CDbl(Date)) = CDbl(Date); CDbl(Time) < 1; DateValue(Now) = Date; Now() >= Date()\n",
|
|
"True True True True True \n"
|
|
);
|
|
|
|
runProgram("WRITE # and INPUT # round-trip a date",
|
|
"DIM d AS DATE\n"
|
|
"OPEN \"datert.txt\" FOR OUTPUT AS #1\n"
|
|
"WRITE #1, #1/2/2000 3:04 PM#, 5\n"
|
|
"CLOSE #1\n"
|
|
"OPEN \"datert.txt\" FOR INPUT AS #1\n"
|
|
"INPUT #1, d\n"
|
|
"CLOSE #1\n"
|
|
"KILL \"datert.txt\"\n"
|
|
"PRINT d\n",
|
|
"1/2/2000 3:04:00 PM\n"
|
|
);
|
|
|
|
compileOnly("File numbers are not date literals",
|
|
"PRINT #1, 5: PRINT #2, 6\n"
|
|
"WRITE #1, a, b: CLOSE #1\n"
|
|
);
|
|
|
|
expectCompileError("Built-in argument count is checked",
|
|
"x = Replace(\"a\")\n",
|
|
"Built-in 'REPLACE' expects 3-6 arguments, got 1"
|
|
);
|
|
|
|
expectCompileError("Zero-argument built-in rejects arguments",
|
|
"x = Now(1)\n",
|
|
"Built-in 'NOW' expects 0-0 arguments, got 1"
|
|
);
|
|
}
|
|
|
|
|
|
// Every token type must map to a printable name (unknowns report "?").
|
|
static void testTokenNames(void) {
|
|
printf("=== token names ===\n");
|
|
|
|
bool ok = true;
|
|
|
|
for (int32_t i = 0; i < TEST_TOKEN_NAME_SWEEP; i++) {
|
|
if (basTokenName((BasTokenTypeE)i) == NULL) {
|
|
ok = false;
|
|
}
|
|
}
|
|
|
|
if (ok) {
|
|
printf("OK\n\n");
|
|
} else {
|
|
printf("FAIL: basTokenName returned NULL\n\n");
|
|
gFailCount++;
|
|
}
|
|
}
|
|
|
|
|
|
// A UserControl class (BEGINCLASS "Name" USERCONTROL): the module keeps
|
|
// its flag, the slot of its UserControl object, its UserControl_<event>
|
|
// procedures and its events with their parameters; the host makes
|
|
// objects, reads, writes and calls members and runs the event procedures
|
|
// with Me; RaiseEvent reaches the event host, which writes ByRef
|
|
// arguments back.
|
|
static void testUserControl(void) {
|
|
static const char *source =
|
|
"BEGINCLASS \"Gauge\" USERCONTROL\n"
|
|
"Public Event ItemOpen(ByVal Index AS INTEGER, Title AS STRING)\n"
|
|
"Public Event Ping()\n"
|
|
"Private mLevel AS DOUBLE\n"
|
|
"Public Caption AS STRING\n"
|
|
"Public Property Get Level() AS DOUBLE\n"
|
|
" Level = mLevel\n"
|
|
"End Property\n"
|
|
"Public Property Let Level(v AS DOUBLE)\n"
|
|
" mLevel = v\n"
|
|
"End Property\n"
|
|
"Public Function Open(i AS INTEGER) AS STRING\n"
|
|
" DIM n AS STRING\n"
|
|
" n = \"item\"\n"
|
|
" RaiseEvent ItemOpen(i, n)\n"
|
|
" Open = n\n"
|
|
"End Function\n"
|
|
"Private Sub UserControl_Initialize()\n"
|
|
" mLevel = 1.25\n"
|
|
" PRINT \"init\"; TypeName(UserControl)\n"
|
|
"End Sub\n"
|
|
"Private Sub UserControl_MouseDown(Button AS INTEGER, Shift AS INTEGER, X AS SINGLE, Y AS SINGLE)\n"
|
|
" PRINT \"down\"; Button; X\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n";
|
|
|
|
printf("=== UserControl: module, host calls, events ===\n");
|
|
|
|
BasCompilerT *compiler = basCompilerCreate(source, (int32_t)strlen(source));
|
|
bool ok = basCompile(compiler);
|
|
BasModuleT *mod = ok ? basCompilerBuildModule(compiler) : NULL;
|
|
|
|
if (!ok) {
|
|
printf("FAIL: compile: %s\n", basCompilerError(compiler));
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
checkTrue("UserControl compiles", mod != NULL);
|
|
|
|
if (mod == NULL) {
|
|
gFailCount++;
|
|
return;
|
|
}
|
|
|
|
const BasClassInfoT *cls = &mod->classes[0];
|
|
|
|
checkTrue("class flag", cls->flags == BAS_CLASS_USERCONTROL);
|
|
checkTrue("UserControl slot is the first member variable", cls->ucSlot == 0);
|
|
checkTrue("Initialize and MouseDown handlers found", cls->ucProcs[BAS_UC_EVT_INITIALIZE] >= 0 && cls->ucProcs[BAS_UC_EVT_MOUSEDOWN] >= 0);
|
|
checkTrue("no Paint handler", cls->ucProcs[BAS_UC_EVT_PAINT] == -1);
|
|
checkTrue("two events", cls->eventCount == 2);
|
|
checkTrue("event parameters", cls->eventCount == 2 && strcmp(cls->events[0].name, "ItemOpen") == 0 && cls->events[0].paramCount == 2 && cls->events[0].paramTypes[0] == BAS_TYPE_INTEGER && cls->events[0].paramTypes[1] == BAS_TYPE_STRING && cls->events[0].byValParams == 1u && cls->events[0].paramNames && strcmp(cls->events[0].paramNames, "Index,Title") == 0);
|
|
checkTrue("event without parameters", cls->eventCount == 2 && cls->events[1].paramCount == 0 && cls->events[1].paramNames == NULL);
|
|
|
|
// The module format keeps all of it
|
|
int32_t len = 0;
|
|
uint8_t *data = basModuleSerialize(mod, &len);
|
|
BasModuleT *back = data ? basModuleDeserialize(data, len) : NULL;
|
|
|
|
free(data);
|
|
checkTrue("round trip", back != NULL && back->classes[0].flags == BAS_CLASS_USERCONTROL && back->classes[0].ucSlot == 0 && memcmp(back->classes[0].ucProcs, cls->ucProcs, sizeof(cls->ucProcs)) == 0 && back->classes[0].eventCount == 2 && strcmp(back->classes[0].events[0].paramNames, "Index,Title") == 0 && back->classes[0].events[0].byValParams == 1u);
|
|
|
|
if (back) {
|
|
basModuleFree(back);
|
|
}
|
|
|
|
// The host's side
|
|
CaptureT cap;
|
|
int32_t hostCalls = 0;
|
|
BasVmT *vm = basVmCreate();
|
|
|
|
captureReset(&cap);
|
|
basVmSetPrintCallback(vm, capturePrint, &cap);
|
|
basVmLoadModule(vm, mod);
|
|
basVmSetEventHost(vm, ucEventHost, &hostCalls);
|
|
basVmRun(vm);
|
|
|
|
BasObjectT *obj = basVmNewObject(vm, 0);
|
|
BasValueT ctl = basValObject(&hostCalls);
|
|
BasValueT res;
|
|
|
|
checkTrue("object made", obj != NULL);
|
|
|
|
if (obj) {
|
|
basValRelease(&obj->fields[cls->ucSlot]);
|
|
obj->fields[cls->ucSlot] = ctl;
|
|
checkTrue("UserControl_Initialize runs with Me", basVmCallProc(vm, obj, cls->ucProcs[BAS_UC_EVT_INITIALIZE], NULL, 0, NULL, 0) && strcmp(cap.buf, "initObject\n") == 0);
|
|
checkTrue("Property Get", basVmCallMember(vm, obj, "Level", BAS_MEMBER_OP_GET, NULL, 0, &res) && res.type == BAS_TYPE_DOUBLE && res.dblVal == 1.25);
|
|
basValRelease(&res);
|
|
|
|
BasValueT v = basValDouble(0.1);
|
|
|
|
checkTrue("Property Let", basVmCallMember(vm, obj, "Level", BAS_MEMBER_OP_LET, &v, 1, NULL));
|
|
checkTrue("Double kept", basVmCallMember(vm, obj, "Level", BAS_MEMBER_OP_GET, NULL, 0, &res) && res.dblVal == 0.1);
|
|
basValRelease(&res);
|
|
|
|
BasValueT txt = basValStringFromC("hello");
|
|
|
|
checkTrue("public variable", basVmCallMember(vm, obj, "Caption", BAS_MEMBER_OP_LET, &txt, 1, NULL) && basVmCallMember(vm, obj, "Caption", BAS_MEMBER_OP_GET, NULL, 0, &res) && res.type == BAS_TYPE_STRING && strcmp(res.strVal->data, "hello") == 0);
|
|
basValRelease(&res);
|
|
basValRelease(&txt);
|
|
|
|
BasValueT idx = basValInteger(3);
|
|
|
|
checkTrue("method raising an event: the host writes back the ByRef argument", basVmCallMember(vm, obj, "Open", BAS_MEMBER_OP_GET, &idx, 1, &res) && hostCalls == 1 && res.type == BAS_TYPE_STRING && strcmp(res.strVal->data, "item3") == 0);
|
|
basValRelease(&res);
|
|
checkTrue("unknown member fails", !basVmCallMember(vm, obj, "Nope", BAS_MEMBER_OP_GET, NULL, 0, &res));
|
|
vm->errorNumber = 0;
|
|
vm->errorMsg[0] = '\0';
|
|
|
|
BasValueT mouse[4];
|
|
|
|
mouse[0] = basValInteger(1);
|
|
mouse[1] = basValInteger(0);
|
|
mouse[2] = basValSingle(7.0f);
|
|
mouse[3] = basValSingle(9.0f);
|
|
captureReset(&cap);
|
|
checkTrue("MouseDown handler", basVmCallProc(vm, obj, cls->ucProcs[BAS_UC_EVT_MOUSEDOWN], mouse, 4, NULL, 0) && strcmp(cap.buf, "down1 7 \n") == 0);
|
|
basObjectUnref(obj);
|
|
}
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
|
|
expectCompileError("UserControl: a handler with the wrong parameters",
|
|
"BEGINCLASS \"C\" USERCONTROL\n"
|
|
"Private Sub UserControl_KeyDown(KeyCode AS INTEGER)\n"
|
|
"End Sub\n"
|
|
"ENDCLASS\n",
|
|
"UserControl_KeyDown must be a Sub with 2 parameter(s)");
|
|
|
|
// Enum-typed properties (the module's Enum table; also a fuzz seed)
|
|
runProgram("UserControl: Enum properties",
|
|
"Enum ShapeE\n"
|
|
" Square\n"
|
|
" Circle\n"
|
|
"End Enum\n"
|
|
"BEGINCLASS \"Shaped\" USERCONTROL\n"
|
|
"Public Look AS ShapeE\n"
|
|
"Public Property Get Kind() AS ShapeE\n"
|
|
" Kind = Look\n"
|
|
"End Property\n"
|
|
"Public Property Let Kind(v AS ShapeE)\n"
|
|
" Look = v\n"
|
|
"End Property\n"
|
|
"ENDCLASS\n"
|
|
"PRINT Circle; ShapeE.Square\n",
|
|
"1 0 \n");
|
|
}
|
|
|
|
|
|
// The test's event host: counts the calls and answers ItemOpen by
|
|
// appending the index to the ByRef name.
|
|
static void ucEventHost(void *ctx, const BasObjectT *obj, int32_t eventIdx, BasValueT *args, int32_t argc) {
|
|
(void)obj;
|
|
(*(int32_t *)ctx)++;
|
|
|
|
if (eventIdx == 0 && argc == 2 && args[1].type == BAS_TYPE_STRING) {
|
|
char text[TEST_ROW_TEXT_LEN];
|
|
|
|
snprintf(text, sizeof(text), "%s%" PRId32, args[1].strVal->data, basValToInt32(args[0]));
|
|
basValRelease(&args[1]);
|
|
args[1] = basValStringFromC(text);
|
|
}
|
|
}
|
|
|
|
|
|
int main(void) {
|
|
printf("DVX BASIC Compiler Tests\n");
|
|
printf("========================\n\n");
|
|
|
|
// Test 1: Hello World
|
|
runProgram("Hello World",
|
|
"PRINT \"Hello, World!\"\n",
|
|
"Hello, World!\n"
|
|
);
|
|
|
|
// Test 2: Arithmetic
|
|
runProgram("Arithmetic",
|
|
"PRINT 2 + 3 * 4\n"
|
|
"PRINT 10 \\ 3\n"
|
|
"PRINT 10 MOD 3\n"
|
|
"PRINT 2 ^ 8\n",
|
|
"14 \n3 \n1 \n256 \n"
|
|
);
|
|
|
|
// Test 3: String operations
|
|
runProgram("String Ops",
|
|
"DIM s AS STRING\n"
|
|
"s = \"Hello, BASIC!\"\n"
|
|
"PRINT s\n"
|
|
"PRINT LEN(s)\n"
|
|
"PRINT LEFT$(s, 5)\n"
|
|
"PRINT RIGHT$(s, 6)\n"
|
|
"PRINT MID$(s, 8, 5)\n"
|
|
"PRINT UCASE$(s)\n",
|
|
"Hello, BASIC!\n13 \nHello\nBASIC!\nBASIC\nHELLO, BASIC!\n"
|
|
);
|
|
|
|
// Test 4: IF/THEN/ELSE
|
|
runProgram("IF/THEN/ELSE",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 42\n"
|
|
"IF x > 100 THEN\n"
|
|
" PRINT \"big\"\n"
|
|
"ELSEIF x > 10 THEN\n"
|
|
" PRINT \"medium\"\n"
|
|
"ELSE\n"
|
|
" PRINT \"small\"\n"
|
|
"END IF\n",
|
|
"medium\n"
|
|
);
|
|
|
|
// Test 5: FOR loop
|
|
runProgram("FOR Loop",
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 1 TO 10\n"
|
|
" PRINT i;\n"
|
|
"NEXT i\n"
|
|
"PRINT\n",
|
|
"1 2 3 4 5 6 7 8 9 10 \n"
|
|
);
|
|
|
|
// Test 6: DO/WHILE loop
|
|
runProgram("DO/WHILE Loop",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 1\n"
|
|
"DO WHILE n <= 5\n"
|
|
" PRINT n;\n"
|
|
" n = n + 1\n"
|
|
"LOOP\n"
|
|
"PRINT\n",
|
|
"1 2 3 4 5 \n"
|
|
);
|
|
|
|
// Test 7: SUB and FUNCTION
|
|
runProgram("SUB and FUNCTION",
|
|
"DECLARE SUB Greet(who AS STRING)\n"
|
|
"DECLARE FUNCTION Square(x AS INTEGER) AS INTEGER\n"
|
|
"\n"
|
|
"CALL Greet(\"World\")\n"
|
|
"PRINT Square(7)\n"
|
|
"\n"
|
|
"SUB Greet(who AS STRING)\n"
|
|
" PRINT \"Hello, \" & who & \"!\"\n"
|
|
"END SUB\n"
|
|
"\n"
|
|
"FUNCTION Square(x AS INTEGER) AS INTEGER\n"
|
|
" Square = x * x\n"
|
|
"END FUNCTION\n",
|
|
"Hello, World!\n49 \n"
|
|
);
|
|
|
|
// Test 8: SELECT CASE
|
|
runProgram("SELECT CASE",
|
|
"DIM grade AS STRING\n"
|
|
"grade = \"B\"\n"
|
|
"SELECT CASE grade\n"
|
|
" CASE \"A\"\n"
|
|
" PRINT \"Excellent\"\n"
|
|
" CASE \"B\", \"C\"\n"
|
|
" PRINT \"Good\"\n"
|
|
" CASE ELSE\n"
|
|
" PRINT \"Other\"\n"
|
|
"END SELECT\n",
|
|
"Good\n"
|
|
);
|
|
|
|
// Test 9: Fibonacci
|
|
runProgram("Fibonacci",
|
|
"DIM a AS INTEGER\n"
|
|
"DIM b AS INTEGER\n"
|
|
"DIM temp AS INTEGER\n"
|
|
"DIM i AS INTEGER\n"
|
|
"a = 0\n"
|
|
"b = 1\n"
|
|
"FOR i = 1 TO 10\n"
|
|
" PRINT a;\n"
|
|
" temp = a + b\n"
|
|
" a = b\n"
|
|
" b = temp\n"
|
|
"NEXT i\n"
|
|
"PRINT\n",
|
|
"0 1 1 2 3 5 8 13 21 34 \n"
|
|
);
|
|
|
|
// Test 10: Math functions
|
|
runProgram("Math Functions",
|
|
"PRINT ABS(-42)\n"
|
|
"PRINT SQR(144)\n"
|
|
"PRINT INT(3.7)\n",
|
|
"42 \n12 \n3 \n"
|
|
);
|
|
|
|
// Test 11: File I/O
|
|
runProgram("File I/O",
|
|
"OPEN \"/tmp/dvxbasic_test.txt\" FOR OUTPUT AS #1\n"
|
|
"PRINT #1, \"Hello from BASIC!\"\n"
|
|
"PRINT #1, \"Line two\"\n"
|
|
"PRINT #1, \"42\"\n"
|
|
"CLOSE #1\n"
|
|
"\n"
|
|
"DIM line$ AS STRING\n"
|
|
"DIM count AS INTEGER\n"
|
|
"count = 0\n"
|
|
"OPEN \"/tmp/dvxbasic_test.txt\" FOR INPUT AS #1\n"
|
|
"DO WHILE NOT EOF(#1)\n"
|
|
" INPUT #1, line$\n"
|
|
" PRINT line$\n"
|
|
" count = count + 1\n"
|
|
"LOOP\n"
|
|
"CLOSE #1\n"
|
|
"PRINT count;\n"
|
|
"PRINT \"lines read\"\n",
|
|
"Hello from BASIC!\nLine two\n42\n3 lines read\n"
|
|
);
|
|
|
|
// Test 12: LINE INPUT# and APPEND
|
|
runProgram("LINE INPUT and APPEND",
|
|
"OPEN \"/tmp/dvxbasic_test2.txt\" FOR OUTPUT AS #2\n"
|
|
"PRINT #2, \"First line\"\n"
|
|
"CLOSE #2\n"
|
|
"\n"
|
|
"OPEN \"/tmp/dvxbasic_test2.txt\" FOR APPEND AS #2\n"
|
|
"PRINT #2, \"Appended line\"\n"
|
|
"CLOSE #2\n"
|
|
"\n"
|
|
"DIM s$ AS STRING\n"
|
|
"OPEN \"/tmp/dvxbasic_test2.txt\" FOR INPUT AS #2\n"
|
|
"LINE INPUT #2, s$\n"
|
|
"PRINT s$\n"
|
|
"LINE INPUT #2, s$\n"
|
|
"PRINT s$\n"
|
|
"CLOSE #2\n",
|
|
"First line\nAppended line\n"
|
|
);
|
|
|
|
// Test 13: Array -- 1D with default lbound=0
|
|
runProgram("1D Array",
|
|
"DIM arr(5) AS INTEGER\n"
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 1 TO 5\n"
|
|
" arr(i) = i * i\n"
|
|
"NEXT i\n"
|
|
"FOR i = 1 TO 5\n"
|
|
" PRINT arr(i);\n"
|
|
"NEXT i\n"
|
|
"PRINT\n",
|
|
"1 4 9 16 25 \n"
|
|
);
|
|
// Expected: 1 4 9 16 25
|
|
|
|
// Test 14: Multi-dimensional array
|
|
runProgram("Multi-dim Array",
|
|
"DIM m(2, 2) AS INTEGER\n"
|
|
"m(1, 1) = 11\n"
|
|
"m(1, 2) = 12\n"
|
|
"m(2, 1) = 21\n"
|
|
"m(2, 2) = 22\n"
|
|
"PRINT m(1, 1); m(1, 2); m(2, 1); m(2, 2)\n",
|
|
"11 12 21 22 \n"
|
|
);
|
|
// Expected: 11 12 21 22
|
|
|
|
// Test 15: Array with explicit bounds (TO syntax)
|
|
runProgram("Array with TO bounds",
|
|
"DIM a(1 TO 3) AS INTEGER\n"
|
|
"a(1) = 10\n"
|
|
"a(2) = 20\n"
|
|
"a(3) = 30\n"
|
|
"PRINT a(1); a(2); a(3)\n",
|
|
"10 20 30 \n"
|
|
);
|
|
// Expected: 10 20 30
|
|
|
|
// Test 16: LBOUND and UBOUND
|
|
runProgram("LBOUND/UBOUND",
|
|
"DIM a(5 TO 10) AS INTEGER\n"
|
|
"PRINT LBOUND(a); UBOUND(a)\n",
|
|
"5 10 \n"
|
|
);
|
|
// Expected: 5 10
|
|
|
|
// Test 17: User-defined TYPE
|
|
runProgram("TYPE",
|
|
"TYPE Point\n"
|
|
" x AS INTEGER\n"
|
|
" y AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM p AS Point\n"
|
|
"p.x = 10\n"
|
|
"p.y = 20\n"
|
|
"PRINT p.x; p.y\n",
|
|
"10 20 \n"
|
|
);
|
|
// Expected: 10 20
|
|
|
|
// Test 18: String array
|
|
runProgram("String Array",
|
|
"DIM names(3) AS STRING\n"
|
|
"names(0) = \"Alice\"\n"
|
|
"names(1) = \"Bob\"\n"
|
|
"names(2) = \"Charlie\"\n"
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 0 TO 2\n"
|
|
" PRINT names(i)\n"
|
|
"NEXT i\n",
|
|
"Alice\nBob\nCharlie\n"
|
|
);
|
|
// Expected: Alice / Bob / Charlie
|
|
|
|
// Test 19: REDIM with PRESERVE
|
|
runProgram("REDIM PRESERVE",
|
|
"DIM a(3) AS INTEGER\n"
|
|
"a(0) = 100\n"
|
|
"a(1) = 200\n"
|
|
"a(2) = 300\n"
|
|
"REDIM PRESERVE a(5) AS INTEGER\n"
|
|
"a(4) = 500\n"
|
|
"PRINT a(0); a(1); a(2); a(4)\n",
|
|
"100 200 300 500 \n"
|
|
);
|
|
// Expected: 100 200 300 500
|
|
|
|
// Test 20: ERASE
|
|
runProgram("ERASE",
|
|
"DIM a(3) AS INTEGER\n"
|
|
"a(1) = 42\n"
|
|
"ERASE a\n"
|
|
"DIM b(2) AS INTEGER\n"
|
|
"b(1) = 99\n"
|
|
"PRINT b(1)\n",
|
|
"99 \n"
|
|
);
|
|
// Expected: 99
|
|
|
|
// Test 21: Array in FOR loop accumulation
|
|
runProgram("Array Accumulation",
|
|
"DIM sums(5) AS INTEGER\n"
|
|
"DIM i AS INTEGER\n"
|
|
"DIM j AS INTEGER\n"
|
|
"FOR i = 1 TO 5\n"
|
|
" sums(i) = 0\n"
|
|
" FOR j = 1 TO i\n"
|
|
" sums(i) = sums(i) + j\n"
|
|
" NEXT j\n"
|
|
"NEXT i\n"
|
|
"FOR i = 1 TO 5\n"
|
|
" PRINT sums(i);\n"
|
|
"NEXT i\n"
|
|
"PRINT\n",
|
|
"1 3 6 10 15 \n"
|
|
);
|
|
// Expected: 1 3 6 10 15
|
|
|
|
// ============================================================
|
|
// Batch 1: Control Flow
|
|
// ============================================================
|
|
|
|
// Test: GOTO with forward jump
|
|
runProgram("GOTO Forward",
|
|
"PRINT \"before\"\n"
|
|
"GOTO skip\n"
|
|
"PRINT \"skipped\"\n"
|
|
"skip:\n"
|
|
"PRINT \"after\"\n",
|
|
"before\nafter\n"
|
|
);
|
|
// Expected: before / after
|
|
|
|
// Test: GOTO with backward jump
|
|
runProgram("GOTO Backward",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 0\n"
|
|
"top:\n"
|
|
"n = n + 1\n"
|
|
"IF n < 5 THEN GOTO top\n"
|
|
"PRINT n\n",
|
|
"5 \n"
|
|
);
|
|
// Expected: 5
|
|
|
|
// Test: GOSUB/RETURN
|
|
runProgram("GOSUB/RETURN",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 10\n"
|
|
"GOSUB dbl\n"
|
|
"PRINT x\n"
|
|
"END\n"
|
|
"dbl:\n"
|
|
"x = x * 2\n"
|
|
"RETURN\n",
|
|
"20 \n"
|
|
);
|
|
// Expected: 20
|
|
|
|
// Test: ON ERROR GOTO -- verify error handler catches errors
|
|
// and ERR returns the error number
|
|
runProgram("ON ERROR GOTO",
|
|
"ON ERROR GOTO handler\n"
|
|
"PRINT 10 / 0\n"
|
|
"END\n"
|
|
"handler:\n"
|
|
"PRINT \"caught\"\n"
|
|
"PRINT ERR\n",
|
|
"caught\n11 \n"
|
|
);
|
|
// Expected: caught / 11
|
|
|
|
// Test: Single-line IF
|
|
runProgram("Single-line IF",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 42\n"
|
|
"IF x > 10 THEN PRINT \"big\"\n"
|
|
"IF x < 10 THEN PRINT \"small\"\n"
|
|
"IF x = 42 THEN PRINT \"exact\" ELSE PRINT \"nope\"\n",
|
|
"big\nexact\n"
|
|
);
|
|
// Expected: big / exact
|
|
|
|
// Test: Multi-statement line with :
|
|
runProgram("Multi-statement :",
|
|
"DIM x AS INTEGER\n"
|
|
"DIM y AS INTEGER\n"
|
|
"x = 1 : y = 2 : PRINT x + y\n",
|
|
"3 \n"
|
|
);
|
|
// Expected: 3
|
|
|
|
// ============================================================
|
|
// Batch 2: Misc Features
|
|
// ============================================================
|
|
|
|
// Test: SWAP
|
|
runProgram("SWAP",
|
|
"DIM a AS INTEGER\n"
|
|
"DIM b AS INTEGER\n"
|
|
"a = 10\n"
|
|
"b = 20\n"
|
|
"SWAP a, b\n"
|
|
"PRINT a;\n"
|
|
"PRINT b\n",
|
|
"20 10 \n"
|
|
);
|
|
// Expected: 20 10
|
|
|
|
// Test: TIMER (returns number > 0)
|
|
runProgram("TIMER",
|
|
"DIM t AS DOUBLE\n"
|
|
"t = TIMER\n"
|
|
"IF t > 0 THEN PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// Test: DATE$ (returns non-empty string)
|
|
runProgram("DATE$",
|
|
"DIM d$ AS STRING\n"
|
|
"d$ = DATE$\n"
|
|
"IF LEN(d$) > 0 THEN PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// Test: TIME$ (returns non-empty string)
|
|
runProgram("TIME$",
|
|
"DIM t$ AS STRING\n"
|
|
"t$ = TIME$\n"
|
|
"IF LEN(t$) > 0 THEN PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// Test: ENVIRON$
|
|
runProgram("ENVIRON$",
|
|
"DIM p$ AS STRING\n"
|
|
"p$ = ENVIRON$(\"HOME\")\n"
|
|
"IF LEN(p$) > 0 THEN PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// ============================================================
|
|
// Batch 3: New features (DATA/READ/RESTORE, DIM SHARED,
|
|
// STATIC, DEF FN, OPTION BASE)
|
|
// ============================================================
|
|
|
|
// Test: DATA/READ/RESTORE
|
|
runProgram("DATA/READ/RESTORE",
|
|
"DATA 10, 20, \"hello\"\n"
|
|
"DIM a AS INTEGER\n"
|
|
"DIM b AS INTEGER\n"
|
|
"DIM c AS STRING\n"
|
|
"READ a, b, c\n"
|
|
"PRINT a; b;\n"
|
|
"PRINT c\n"
|
|
"RESTORE\n"
|
|
"READ a\n"
|
|
"PRINT a\n",
|
|
"10 20 hello\n10 \n"
|
|
);
|
|
// Expected: 10 20 hello / 10
|
|
|
|
// Test: DIM SHARED
|
|
runProgram("DIM SHARED",
|
|
"DIM SHARED count AS INTEGER\n"
|
|
"count = 0\n"
|
|
"CALL Increment\n"
|
|
"CALL Increment\n"
|
|
"CALL Increment\n"
|
|
"PRINT count\n"
|
|
"SUB Increment\n"
|
|
" count = count + 1\n"
|
|
"END SUB\n",
|
|
"3 \n"
|
|
);
|
|
// Expected: 3
|
|
|
|
// Test: STATIC
|
|
runProgram("STATIC",
|
|
"CALL Counter\n"
|
|
"CALL Counter\n"
|
|
"CALL Counter\n"
|
|
"SUB Counter\n"
|
|
" STATIC n AS INTEGER\n"
|
|
" n = n + 1\n"
|
|
" PRINT n;\n"
|
|
"END SUB\n"
|
|
"PRINT\n",
|
|
"1 2 3 \n"
|
|
);
|
|
// Expected: 1 2 3
|
|
|
|
// Test: DEF FN
|
|
runProgram("DEF FN",
|
|
"DEF FNdouble(x AS INTEGER) = x * 2\n"
|
|
"PRINT FNdouble(5)\n"
|
|
"PRINT FNdouble(21)\n",
|
|
"10 \n42 \n"
|
|
);
|
|
// Expected: 10 / 42
|
|
|
|
// Test: OPTION BASE
|
|
runProgram("OPTION BASE",
|
|
"OPTION BASE 1\n"
|
|
"DIM arr(3) AS INTEGER\n"
|
|
"arr(1) = 10\n"
|
|
"arr(3) = 30\n"
|
|
"PRINT arr(1); arr(3)\n",
|
|
"10 30 \n"
|
|
);
|
|
// Expected: 10 30
|
|
|
|
// Test: DATA with mixed types
|
|
runProgram("DATA mixed types",
|
|
"DATA 100, 3.14, \"world\"\n"
|
|
"DIM x AS INTEGER\n"
|
|
"DIM y AS DOUBLE\n"
|
|
"DIM z AS STRING\n"
|
|
"READ x, y, z\n"
|
|
"PRINT x\n"
|
|
"PRINT z\n",
|
|
"100 \nworld\n"
|
|
);
|
|
// Expected: 100 / world
|
|
|
|
// Test: Multiple DATA statements scattered
|
|
runProgram("DATA scattered",
|
|
"DIM a AS INTEGER\n"
|
|
"DIM b AS INTEGER\n"
|
|
"DIM c AS INTEGER\n"
|
|
"DATA 1, 2\n"
|
|
"READ a, b\n"
|
|
"DATA 3\n"
|
|
"READ c\n"
|
|
"PRINT a; b; c\n",
|
|
"1 2 3 \n"
|
|
);
|
|
// Expected: 1 2 3
|
|
|
|
// Test: DIM SHARED with SUB modifying shared variable
|
|
runProgram("DIM SHARED multi",
|
|
"DIM SHARED total AS INTEGER\n"
|
|
"DIM SHARED msg AS STRING\n"
|
|
"total = 100\n"
|
|
"msg = \"start\"\n"
|
|
"CALL Modify\n"
|
|
"PRINT total\n"
|
|
"PRINT msg\n"
|
|
"SUB Modify\n"
|
|
" total = total + 50\n"
|
|
" msg = \"done\"\n"
|
|
"END SUB\n",
|
|
"150 \ndone\n"
|
|
);
|
|
// Expected: 150 / done
|
|
|
|
// ============================================================
|
|
// Batch 4: New I/O and string features
|
|
// ============================================================
|
|
|
|
// Test: WRITE #
|
|
runProgram("WRITE #",
|
|
"OPEN \"/tmp/dvxbasic_write.txt\" FOR OUTPUT AS #1\n"
|
|
"WRITE #1, 10, \"hello\", 3.14\n"
|
|
"CLOSE #1\n"
|
|
"OPEN \"/tmp/dvxbasic_write.txt\" FOR INPUT AS #1\n"
|
|
"DIM s AS STRING\n"
|
|
"LINE INPUT #1, s\n"
|
|
"PRINT s\n"
|
|
"CLOSE #1\n",
|
|
"10,\"hello\",3.14\n"
|
|
);
|
|
// Expected: 10,"hello",3.14
|
|
|
|
// Test: FREEFILE
|
|
runProgram("FREEFILE",
|
|
"DIM f AS INTEGER\n"
|
|
"f = FREEFILE\n"
|
|
"PRINT f\n",
|
|
"1 \n"
|
|
);
|
|
// Expected: 1
|
|
|
|
// Test: PRINT USING numeric
|
|
runProgram("PRINT USING numeric",
|
|
"PRINT USING \"###.##\"; 3.14159\n",
|
|
" 3.14\n"
|
|
);
|
|
// Expected: 3.14
|
|
|
|
// Test: PRINT USING string
|
|
runProgram("PRINT USING string",
|
|
"PRINT USING \"!\"; \"Hello\"\n",
|
|
"H\n"
|
|
);
|
|
// Expected: H
|
|
|
|
// Test: SPC and TAB in PRINT
|
|
runProgram("SPC/TAB",
|
|
"PRINT SPC(3); \"hi\"\n",
|
|
" hi\n"
|
|
);
|
|
// Expected: hi
|
|
|
|
// Test: Fixed-length string
|
|
runProgram("STRING * n",
|
|
"DIM s AS STRING * 5\n"
|
|
"s = \"Hi\"\n"
|
|
"PRINT \"[\" & s & \"]\"\n"
|
|
"PRINT LEN(s)\n",
|
|
"[Hi ]\n5 \n"
|
|
);
|
|
// Expected: [Hi ] / 5
|
|
|
|
// Test: MID$ statement
|
|
runProgram("MID$ statement",
|
|
"DIM s AS STRING\n"
|
|
"s = \"Hello World\"\n"
|
|
"MID$(s, 7, 5) = \"BASIC\"\n"
|
|
"PRINT s\n",
|
|
"Hello BASIC\n"
|
|
);
|
|
// Expected: Hello BASIC
|
|
|
|
// Test: OPEN FOR BINARY / GET / PUT
|
|
runProgram("BINARY GET/PUT",
|
|
"DIM v AS INTEGER\n"
|
|
"OPEN \"/tmp/dvxbasic_bin.tmp\" FOR BINARY AS #1\n"
|
|
"v = 12345\n"
|
|
"PUT #1, , v\n"
|
|
"SEEK #1, 1\n"
|
|
"DIM r AS INTEGER\n"
|
|
"GET #1, , r\n"
|
|
"PRINT r\n"
|
|
"CLOSE #1\n",
|
|
"12345 \n"
|
|
);
|
|
// Expected: 12345
|
|
|
|
// Test: LOF and LOC
|
|
runProgram("LOF/LOC",
|
|
"OPEN \"/tmp/dvxbasic_lof.txt\" FOR OUTPUT AS #1\n"
|
|
"PRINT #1, \"test\"\n"
|
|
"CLOSE #1\n"
|
|
"OPEN \"/tmp/dvxbasic_lof.txt\" FOR INPUT AS #1\n"
|
|
"DIM sz AS LONG\n"
|
|
"sz = LOF(1)\n"
|
|
"IF sz > 0 THEN PRINT \"ok\"\n"
|
|
"CLOSE #1\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// Test: INPUT$(n, #channel)
|
|
runProgram("INPUT$",
|
|
"OPEN \"/tmp/dvxbasic_inp.txt\" FOR OUTPUT AS #1\n"
|
|
"PRINT #1, \"ABCDEF\"\n"
|
|
"CLOSE #1\n"
|
|
"OPEN \"/tmp/dvxbasic_inp.txt\" FOR INPUT AS #1\n"
|
|
"DIM s AS STRING\n"
|
|
"s = INPUT$(3, #1)\n"
|
|
"PRINT s\n"
|
|
"CLOSE #1\n",
|
|
"ABC\n"
|
|
);
|
|
// Expected: ABC
|
|
|
|
// Test: SEEK function form
|
|
runProgram("SEEK function",
|
|
"OPEN \"/tmp/dvxbasic_seek.txt\" FOR OUTPUT AS #1\n"
|
|
"PRINT #1, \"test\"\n"
|
|
"CLOSE #1\n"
|
|
"OPEN \"/tmp/dvxbasic_seek.txt\" FOR BINARY AS #1\n"
|
|
"DIM p AS LONG\n"
|
|
"p = SEEK(1)\n"
|
|
"IF p = 1 THEN PRINT \"ok\"\n"
|
|
"CLOSE #1\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// Test: ON n GOTO
|
|
runProgram("ON n GOTO",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 2\n"
|
|
"ON n GOTO ten, twenty, thirty\n"
|
|
"PRINT \"none\"\n"
|
|
"GOTO done\n"
|
|
"ten:\n"
|
|
"PRINT \"ten\"\n"
|
|
"GOTO done\n"
|
|
"twenty:\n"
|
|
"PRINT \"twenty\"\n"
|
|
"GOTO done\n"
|
|
"thirty:\n"
|
|
"PRINT \"thirty\"\n"
|
|
"done:\n",
|
|
"twenty\n"
|
|
);
|
|
// Expected: twenty
|
|
|
|
// Test: ON n GOTO (no match)
|
|
runProgram("ON n GOTO no match",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 5\n"
|
|
"ON n GOTO aa, bb\n"
|
|
"PRINT \"fallthrough\"\n"
|
|
"GOTO done2\n"
|
|
"aa:\n"
|
|
"PRINT \"aa\"\n"
|
|
"GOTO done2\n"
|
|
"bb:\n"
|
|
"PRINT \"bb\"\n"
|
|
"done2:\n",
|
|
"fallthrough\n"
|
|
);
|
|
// Expected: fallthrough
|
|
|
|
// Test: ON n GOSUB
|
|
runProgram("ON n GOSUB",
|
|
"DIM n AS INTEGER\n"
|
|
"DIM result AS INTEGER\n"
|
|
"result = 0\n"
|
|
"n = 2\n"
|
|
"ON n GOSUB addTen, addTwenty, addThirty\n"
|
|
"PRINT result\n"
|
|
"GOTO endProg\n"
|
|
"addTen:\n"
|
|
"result = result + 10\n"
|
|
"RETURN\n"
|
|
"addTwenty:\n"
|
|
"result = result + 20\n"
|
|
"RETURN\n"
|
|
"addThirty:\n"
|
|
"result = result + 30\n"
|
|
"RETURN\n"
|
|
"endProg:\n",
|
|
"20 \n"
|
|
);
|
|
// Expected: 20
|
|
|
|
// Test: FORMAT$
|
|
runProgram("FORMAT$",
|
|
"PRINT FORMAT$(1234.5, \"#,##0.00\")\n"
|
|
"PRINT FORMAT$(0.5, \"0.00\")\n"
|
|
"PRINT FORMAT$(-42, \"+#0\")\n"
|
|
"PRINT FORMAT$(0.75, \"percent\")\n",
|
|
"1,234.50\n0.50\n-42\n75%\n"
|
|
);
|
|
// Expected: 1,234.50\n0.50\n-42\n75%
|
|
|
|
// Test: SHELL as function expression
|
|
runProgram("SHELL function",
|
|
"DIM r AS INTEGER\n"
|
|
"r = SHELL(\"echo hello > /dev/null\")\n"
|
|
"IF r = 0 THEN PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// Test: SHELL as statement
|
|
runProgram("SHELL statement",
|
|
"SHELL \"echo hello > /dev/null\"\n"
|
|
"PRINT \"done\"\n",
|
|
"done\n"
|
|
);
|
|
// Expected: done
|
|
|
|
// Test: OPTION COMPARE TEXT
|
|
runProgram("OPTION COMPARE TEXT",
|
|
"OPTION COMPARE TEXT\n"
|
|
"IF \"hello\" = \"HELLO\" THEN\n"
|
|
" PRINT \"equal\"\n"
|
|
"ELSE\n"
|
|
" PRINT \"not equal\"\n"
|
|
"END IF\n"
|
|
"IF \"abc\" < \"XYZ\" THEN\n"
|
|
" PRINT \"less\"\n"
|
|
"END IF\n",
|
|
"equal\nless\n"
|
|
);
|
|
// Expected: equal\nless
|
|
|
|
// Test: OPTION COMPARE BINARY (default)
|
|
runProgram("OPTION COMPARE BINARY",
|
|
"OPTION COMPARE BINARY\n"
|
|
"IF \"hello\" = \"HELLO\" THEN\n"
|
|
" PRINT \"equal\"\n"
|
|
"ELSE\n"
|
|
" PRINT \"not equal\"\n"
|
|
"END IF\n",
|
|
"not equal\n"
|
|
);
|
|
// Expected: not equal
|
|
|
|
// Test: EQV operator
|
|
runProgram("EQV operator",
|
|
"PRINT -1 EQV -1\n"
|
|
"PRINT 0 EQV 0\n"
|
|
"PRINT -1 EQV 0\n"
|
|
"PRINT 0 EQV -1\n",
|
|
"-1 \n-1 \n0 \n0 \n"
|
|
);
|
|
// Expected: -1\n-1\n0\n0
|
|
|
|
// Test: IMP operator
|
|
runProgram("IMP operator",
|
|
"PRINT 0 IMP -1\n"
|
|
"PRINT -1 IMP 0\n"
|
|
"PRINT -1 IMP -1\n"
|
|
"PRINT 0 IMP 0\n",
|
|
"-1 \n0 \n-1 \n-1 \n"
|
|
);
|
|
// Expected: -1\n0\n-1\n-1
|
|
|
|
// Test: PRINT USING advanced patterns
|
|
runProgram("PRINT USING advanced",
|
|
"PRINT USING \"**#,##0.00\"; 1234.5\n"
|
|
"PRINT USING \"$$#,##0.00\"; 42.5\n"
|
|
"PRINT USING \"+###.##\"; 42.5\n"
|
|
"PRINT USING \"+###.##\"; -42.5\n"
|
|
"PRINT USING \"###.##-\"; -42.5\n"
|
|
"PRINT USING \"###.##-\"; 42.5\n"
|
|
"PRINT USING \"#.##^^^^\"; 1234.5\n",
|
|
"**1,234.50\n $42.50\n +42.50\n -42.50\n 42.50-\n 42.50 \n1.23E+03\n"
|
|
);
|
|
|
|
// Test: DEFINT -- every A-Z variable is INTEGER, so 3.7 rounds on store
|
|
runProgram("DEFINT",
|
|
"DEFINT A-Z\n"
|
|
"a = 42\n"
|
|
"b = 3.7\n"
|
|
"PRINT a; b\n",
|
|
"42 4 \n"
|
|
);
|
|
|
|
// Test: DEFSTR
|
|
runProgram("DEFSTR",
|
|
"DEFSTR S\n"
|
|
"s = \"hello\"\n"
|
|
"PRINT s\n",
|
|
"hello\n"
|
|
);
|
|
|
|
// Test: DEFINT range
|
|
runProgram("DEFINT range",
|
|
"DEFINT I-N\n"
|
|
"i = 10\n"
|
|
"j = 20\n"
|
|
"x = 3.14\n"
|
|
"PRINT i; j; x\n",
|
|
"10 20 3.14 \n"
|
|
);
|
|
|
|
// Test: OPTION EXPLICIT success
|
|
runProgram("OPTION EXPLICIT ok",
|
|
"OPTION EXPLICIT\n"
|
|
"DIM x AS INTEGER\n"
|
|
"x = 42\n"
|
|
"PRINT x\n",
|
|
"42 \n"
|
|
);
|
|
|
|
// Test: OPTION EXPLICIT failure (should error)
|
|
expectCompileError("OPTION EXPLICIT error",
|
|
"OPTION EXPLICIT\n"
|
|
"x = 42\n",
|
|
"Variable not declared: x"
|
|
);
|
|
|
|
// Test: DECLARE LIBRARY compilation (verify it compiles without error)
|
|
{
|
|
printf("=== DECLARE LIBRARY ===\n");
|
|
const char *src =
|
|
"DECLARE LIBRARY \"serial\"\n"
|
|
" DECLARE FUNCTION rs232Open(com AS INTEGER, bps AS LONG) AS INTEGER\n"
|
|
" DECLARE SUB rs232Close(com AS INTEGER)\n"
|
|
"END DECLARE\n"
|
|
"\n"
|
|
"PRINT \"Library declared\"\n";
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
bool ok = basCompile(compiler);
|
|
|
|
if (!ok) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
|
|
if (mod) {
|
|
BasVmT *vm = basVmCreate();
|
|
basVmLoadModule(vm, mod);
|
|
basVmRun(vm);
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// Test: DECLARE LIBRARY with extern call (uses mock callback)
|
|
{
|
|
printf("=== DECLARE LIBRARY call ===\n");
|
|
const char *src =
|
|
"DECLARE LIBRARY \"math\"\n"
|
|
" DECLARE FUNCTION mathAdd(a AS INTEGER, b AS INTEGER) AS INTEGER\n"
|
|
"END DECLARE\n"
|
|
"\n"
|
|
"DIM result AS INTEGER\n"
|
|
"result = mathAdd(10, 20)\n"
|
|
"PRINT result\n";
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
bool ok = basCompile(compiler);
|
|
|
|
if (!ok) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("Compiled OK (extern call test needs host callbacks to run)\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// Regression test: App.Data must parse even though Data is a BASIC keyword
|
|
runProgram("App.Data parses",
|
|
"DIM p AS STRING\n"
|
|
"p = App.Data\n"
|
|
"PRINT p\n",
|
|
"\n"
|
|
);
|
|
|
|
// Regression test: RGB(r,g,b) packs into 0x00RRGGBB
|
|
runProgram("RGB packing",
|
|
"PRINT RGB(255, 128, 0)\n"
|
|
"PRINT RGB(0, 255, 0)\n"
|
|
"PRINT RGB(0, 0, 255)\n",
|
|
"33023 \n65280 \n16711680 \n"
|
|
);
|
|
// Expected (VB's &HBBGGRR): 33023 (&H80FF), 65280 (&HFF00), 16711680 (&HFF0000)
|
|
|
|
// Regression test: GetRed/Green/Blue round-trip
|
|
runProgram("RGB round-trip",
|
|
"DIM c AS LONG\n"
|
|
"c = RGB(17, 99, 200)\n"
|
|
"PRINT GetRed(c); GetGreen(c); GetBlue(c)\n",
|
|
"17 99 200 \n"
|
|
);
|
|
// Expected: 17 99 200
|
|
|
|
// Regression test: MsgBox function accepts optional title (3rd arg)
|
|
// The test harness's default msgBox callback returns 1; we just verify
|
|
// the program compiles and runs.
|
|
runProgram("MsgBox 3-arg compile",
|
|
"DIM r AS INTEGER\n"
|
|
"r = MsgBox(\"hi\", 0, \"My Title\")\n"
|
|
"PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
|
|
// Regression test: CONST accepts AS type
|
|
runProgram("CONST AS type",
|
|
"CONST PI AS DOUBLE = 3.14159\n"
|
|
"CONST N AS INTEGER = 42\n"
|
|
"PRINT PI\n"
|
|
"PRINT N\n",
|
|
"3.14159 \n42 \n"
|
|
);
|
|
|
|
// Regression test: PRINT #ch with ; separator
|
|
runProgram("PRINT # with semicolon",
|
|
"OPEN \"/tmp/dvxbasic_psemi.txt\" FOR OUTPUT AS #1\n"
|
|
"PRINT #1, \"Line one\"\n"
|
|
"PRINT #1, \"ans = \"; 42\n"
|
|
"PRINT #1, \"x\"; \"y\"; \"z\"\n"
|
|
"CLOSE #1\n"
|
|
"DIM s AS STRING\n"
|
|
"OPEN \"/tmp/dvxbasic_psemi.txt\" FOR INPUT AS #1\n"
|
|
"DO WHILE NOT EOF(1)\n"
|
|
" LINE INPUT #1, s\n"
|
|
" PRINT s\n"
|
|
"LOOP\n"
|
|
"CLOSE #1\n",
|
|
"Line one\nans = 42 \nxyz\n"
|
|
);
|
|
// Expected: Line one / ans = 42 (numbers carry QB's trailing space) / xyz
|
|
|
|
// Regression test: IniRead$ with $ suffix must tokenize as keyword
|
|
runProgram("IniRead$ tokenizes",
|
|
"DIM v AS STRING\n"
|
|
"v = IniRead$(\"/tmp/nofile.ini\", \"S\", \"K\", \"default\")\n"
|
|
"PRINT v\n",
|
|
"default\n"
|
|
);
|
|
// Expected: default (file doesn't exist)
|
|
|
|
// Regression test: SUB extern call without parens must emit OP_CALL_EXTERN
|
|
// (previously emitted OP_CALL which called nothing, because no internal
|
|
// proc at address 0 existed for the extern.)
|
|
{
|
|
printf("=== DECLARE LIBRARY SUB no-parens ===\n");
|
|
const char *src =
|
|
"DECLARE LIBRARY \"basrt\"\n"
|
|
" DECLARE SUB DoIt(BYVAL s AS STRING)\n"
|
|
"END DECLARE\n"
|
|
"DoIt \"hello\"\n";
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
bool ok = basCompile(compiler);
|
|
|
|
if (!ok) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
|
|
if (mod) {
|
|
bool found = false;
|
|
|
|
for (int32_t i = 0; i < mod->codeLen; i++) {
|
|
if (mod->code[i] == OP_CALL_EXTERN) {
|
|
found = true;
|
|
break;
|
|
}
|
|
}
|
|
|
|
printf(found ? "PASS: OP_CALL_EXTERN emitted\n" : "FAIL: OP_CALL_EXTERN not emitted\n");
|
|
if (!found) { gFailCount++; }
|
|
basModuleFree(mod);
|
|
} else {
|
|
printf("MODULE BUILD FAILED\n");
|
|
gFailCount++;
|
|
}
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// Test: Procedure table populated for SUBs and FUNCTIONs
|
|
{
|
|
printf("=== Procedure table ===\n");
|
|
const char *src =
|
|
"SUB Command1_Click\n"
|
|
" PRINT \"Clicked!\"\n"
|
|
"END SUB\n"
|
|
"\n"
|
|
"SUB Form1_Load\n"
|
|
" PRINT \"Loaded\"\n"
|
|
"END SUB\n"
|
|
"\n"
|
|
"FUNCTION AddNums(a AS INTEGER, b AS INTEGER) AS INTEGER\n"
|
|
" AddNums = a + b\n"
|
|
"END FUNCTION\n"
|
|
"\n"
|
|
"PRINT \"main\"\n";
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
bool ok = basCompile(compiler);
|
|
|
|
if (!ok) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
|
|
printf("procCount = %d\n", mod->procCount);
|
|
|
|
for (int32_t i = 0; i < mod->procCount; i++) {
|
|
printf(" [%d] %s addr=%d params=%d func=%d\n",
|
|
i, mod->procs[i].name, mod->procs[i].codeAddr,
|
|
mod->procs[i].paramCount, mod->procs[i].isFunction);
|
|
}
|
|
|
|
// Test lookup
|
|
const BasProcEntryT *p = basModuleFindProc(mod, "command1_click");
|
|
|
|
if (p) {
|
|
printf("Found Command1_Click at addr %d\n", p->codeAddr);
|
|
} else {
|
|
printf("FAIL: Command1_Click not found!\n");
|
|
gFailCount++;
|
|
}
|
|
|
|
p = basModuleFindProc(mod, "FORM1_LOAD");
|
|
|
|
if (p) {
|
|
printf("Found Form1_Load at addr %d\n", p->codeAddr);
|
|
} else {
|
|
printf("FAIL: Form1_Load not found!\n");
|
|
gFailCount++;
|
|
}
|
|
|
|
// Test basVmCallSub
|
|
BasVmT *vm = basVmCreate();
|
|
basVmLoadModule(vm, mod);
|
|
|
|
p = basModuleFindProc(mod, "Command1_Click");
|
|
|
|
if (p) {
|
|
printf("Calling Command1_Click via basVmCallSub: ");
|
|
bool callOk = basVmCallSub(vm, p->codeAddr);
|
|
printf("result=%s\n", callOk ? "ok" : "FAIL");
|
|
if (!callOk) { gFailCount++; }
|
|
}
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ByRef parameters
|
|
runProgram("ByRef parameters",
|
|
"DECLARE SUB AddTen(n AS INTEGER)\n"
|
|
"DECLARE SUB ChangeStr(s AS STRING)\n"
|
|
"DECLARE SUB NoChange(BYVAL n AS INTEGER)\n"
|
|
"\n"
|
|
"DIM x AS INTEGER\n"
|
|
"x = 10\n"
|
|
"PRINT \"Before: x =\"; x\n"
|
|
"AddTen x\n"
|
|
"PRINT \"After AddTen: x =\"; x\n"
|
|
"\n"
|
|
"DIM a AS STRING\n"
|
|
"a = \"hello\"\n"
|
|
"PRINT \"Before: a = \"; a\n"
|
|
"ChangeStr a\n"
|
|
"PRINT \"After ChangeStr: a = \"; a\n"
|
|
"\n"
|
|
"' ByVal should NOT modify caller\n"
|
|
"DIM y AS INTEGER\n"
|
|
"y = 100\n"
|
|
"PRINT \"Before: y =\"; y\n"
|
|
"NoChange y\n"
|
|
"PRINT \"After NoChange: y =\"; y\n"
|
|
"\n"
|
|
"' Expression arg to ByRef param: effectively ByVal\n"
|
|
"DIM z AS INTEGER\n"
|
|
"z = 5\n"
|
|
"AddTen(z + 0)\n"
|
|
"PRINT \"After AddTen(z+0): z =\"; z\n"
|
|
"\n"
|
|
"SUB AddTen(n AS INTEGER)\n"
|
|
" n = n + 10\n"
|
|
"END SUB\n"
|
|
"\n"
|
|
"SUB ChangeStr(s AS STRING)\n"
|
|
" s = s + \" world\"\n"
|
|
"END SUB\n"
|
|
"\n"
|
|
"SUB NoChange(BYVAL n AS INTEGER)\n"
|
|
" n = n + 999\n"
|
|
"END SUB\n",
|
|
"Before: x =10 \nAfter AddTen: x =20 \nBefore: a = hello\nAfter ChangeStr: a = hello world\nBefore: y =100 \nAfter NoChange: y =100 \nAfter AddTen(z+0): z =5 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: String functions
|
|
// ============================================================
|
|
|
|
runProgram("LCASE$",
|
|
"PRINT LCASE$(\"HELLO WORLD\")\n",
|
|
"hello world\n"
|
|
);
|
|
// Expected: hello world
|
|
|
|
runProgram("TRIM$ LTRIM$ RTRIM$",
|
|
"PRINT \"[\" & TRIM$(\" hi \") & \"]\"\n"
|
|
"PRINT \"[\" & LTRIM$(\" hi \") & \"]\"\n"
|
|
"PRINT \"[\" & RTRIM$(\" hi \") & \"]\"\n",
|
|
"[hi]\n[hi ]\n[ hi]\n"
|
|
);
|
|
// Expected: [hi] / [hi ] / [ hi]
|
|
|
|
runProgram("INSTR 2-arg",
|
|
"PRINT INSTR(\"hello world\", \"world\")\n"
|
|
"PRINT INSTR(\"hello world\", \"xyz\")\n",
|
|
"7 \n0 \n"
|
|
);
|
|
// Expected: 7 / 0
|
|
|
|
runProgram("INSTR 3-arg",
|
|
"PRINT INSTR(5, \"abcabc\", \"bc\")\n"
|
|
"PRINT INSTR(1, \"abcabc\", \"bc\")\n",
|
|
"5 \n2 \n"
|
|
);
|
|
// Expected: 5 / 2
|
|
|
|
runProgram("CHR$ and ASC",
|
|
"PRINT CHR$(65)\n"
|
|
"PRINT ASC(\"Z\")\n",
|
|
"A\n90 \n"
|
|
);
|
|
// Expected: A / 90
|
|
|
|
runProgram("SPACE$",
|
|
"PRINT \"[\" & SPACE$(5) & \"]\"\n",
|
|
"[ ]\n"
|
|
);
|
|
// Expected: [ ]
|
|
|
|
runProgram("STRING$",
|
|
"PRINT STRING$(5, \"*\")\n",
|
|
"*****\n"
|
|
);
|
|
// Expected: *****
|
|
|
|
runProgram("HEX$",
|
|
"PRINT HEX$(255)\n"
|
|
"PRINT HEX$(16)\n",
|
|
"FF\n10\n"
|
|
);
|
|
// Expected: FF / 10
|
|
|
|
runProgram("VAL",
|
|
"PRINT VAL(\"3.14\")\n"
|
|
"PRINT VAL(\"42\")\n"
|
|
"PRINT VAL(\"abc\")\n",
|
|
"3.14 \n42 \n0 \n"
|
|
);
|
|
// Expected: 3.14 / 42 / 0
|
|
|
|
runProgram("STR$",
|
|
"PRINT \"[\" & STR$(42) & \"]\"\n"
|
|
"PRINT \"[\" & STR$(-7) & \"]\"\n",
|
|
"[ 42]\n[-7]\n"
|
|
);
|
|
// Expected: [ 42] / [-7]
|
|
|
|
runProgram("MID$ 2-arg",
|
|
"PRINT MID$(\"hello world\", 7)\n",
|
|
"world\n"
|
|
);
|
|
// Expected: world
|
|
|
|
runProgram("String concat with +",
|
|
"DIM a AS STRING\n"
|
|
"DIM b AS STRING\n"
|
|
"a = \"hello\"\n"
|
|
"b = \" world\"\n"
|
|
"PRINT a + b\n",
|
|
"hello world\n"
|
|
);
|
|
// Expected: hello world
|
|
|
|
// ============================================================
|
|
// Coverage: Math functions
|
|
// ============================================================
|
|
|
|
runProgram("Trig functions",
|
|
"DIM pi AS DOUBLE\n"
|
|
"pi = ATN(1) * 4\n"
|
|
"PRINT INT(SIN(pi / 2) * 1000)\n"
|
|
"PRINT INT(COS(0) * 1000)\n"
|
|
"PRINT INT(TAN(pi / 4) * 1000)\n",
|
|
"1000 \n1000 \n999 \n"
|
|
);
|
|
// Expected: 1000 / 1000 / 999 (TAN(pi/4)*1000 is 999.99..., INT truncates)
|
|
|
|
runProgram("LOG and EXP",
|
|
"PRINT INT(LOG(1))\n"
|
|
"PRINT INT(EXP(0))\n"
|
|
"PRINT INT(EXP(1) * 100)\n",
|
|
"0 \n1 \n271 \n"
|
|
);
|
|
// Expected: 0 / 1 / 271
|
|
|
|
runProgram("FIX and SGN",
|
|
"PRINT FIX(3.7)\n"
|
|
"PRINT FIX(-3.7)\n"
|
|
"PRINT SGN(42)\n"
|
|
"PRINT SGN(-5)\n"
|
|
"PRINT SGN(0)\n",
|
|
"3 \n-3 \n1 \n-1 \n0 \n"
|
|
);
|
|
// Expected: 3 / -3 / 1 / -1 / 0
|
|
|
|
runProgram("RND and RANDOMIZE",
|
|
"RANDOMIZE 12345\n"
|
|
"DIM r AS DOUBLE\n"
|
|
"r = RND\n"
|
|
"IF r >= 0 AND r < 1 THEN PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// ============================================================
|
|
// Coverage: Loop variants
|
|
// ============================================================
|
|
|
|
runProgram("DO UNTIL pre-test",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 1\n"
|
|
"DO UNTIL n > 5\n"
|
|
" PRINT n;\n"
|
|
" n = n + 1\n"
|
|
"LOOP\n"
|
|
"PRINT\n",
|
|
"1 2 3 4 5 \n"
|
|
);
|
|
// Expected: 1 2 3 4 5
|
|
|
|
runProgram("DO LOOP WHILE post-test",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 1\n"
|
|
"DO\n"
|
|
" PRINT n;\n"
|
|
" n = n + 1\n"
|
|
"LOOP WHILE n <= 5\n"
|
|
"PRINT\n",
|
|
"1 2 3 4 5 \n"
|
|
);
|
|
// Expected: 1 2 3 4 5
|
|
|
|
runProgram("DO LOOP UNTIL post-test",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 1\n"
|
|
"DO\n"
|
|
" PRINT n;\n"
|
|
" n = n + 1\n"
|
|
"LOOP UNTIL n > 5\n"
|
|
"PRINT\n",
|
|
"1 2 3 4 5 \n"
|
|
);
|
|
// Expected: 1 2 3 4 5
|
|
|
|
runProgram("WHILE WEND",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 1\n"
|
|
"WHILE n <= 5\n"
|
|
" PRINT n;\n"
|
|
" n = n + 1\n"
|
|
"WEND\n"
|
|
"PRINT\n",
|
|
"1 2 3 4 5 \n"
|
|
);
|
|
// Expected: 1 2 3 4 5
|
|
|
|
runProgram("FOR with negative STEP",
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 5 TO 1 STEP -1\n"
|
|
" PRINT i;\n"
|
|
"NEXT i\n"
|
|
"PRINT\n",
|
|
"5 4 3 2 1 \n"
|
|
);
|
|
// Expected: 5 4 3 2 1
|
|
|
|
runProgram("FOR with STEP 2",
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 0 TO 10 STEP 2\n"
|
|
" PRINT i;\n"
|
|
"NEXT i\n"
|
|
"PRINT\n",
|
|
"0 2 4 6 8 10 \n"
|
|
);
|
|
// Expected: 0 2 4 6 8 10
|
|
|
|
// ============================================================
|
|
// Coverage: EXIT statements
|
|
// ============================================================
|
|
|
|
runProgram("EXIT FOR",
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 1 TO 100\n"
|
|
" IF i = 3 THEN EXIT FOR\n"
|
|
" PRINT i;\n"
|
|
"NEXT i\n"
|
|
"PRINT\n"
|
|
"PRINT \"after\"\n",
|
|
"1 2 \nafter\n"
|
|
);
|
|
// Expected: 1 2 / after
|
|
|
|
// Regression test: FOR loop inside a SUB with local loop variable
|
|
runProgram("FOR inside SUB with local",
|
|
"CALL MySub\n"
|
|
"SUB MySub\n"
|
|
" DIM i AS LONG\n"
|
|
" FOR i = 0 TO 3\n"
|
|
" PRINT i;\n"
|
|
" NEXT i\n"
|
|
" PRINT\n"
|
|
"END SUB\n",
|
|
"0 1 2 3 \n"
|
|
);
|
|
// Expected: 0 1 2 3
|
|
|
|
// Regression test: resedit pattern -- FOR in SUB with n = FUNC(...)
|
|
runProgram("FOR with func-returned limit",
|
|
"CALL DoIt\n"
|
|
"SUB DoIt\n"
|
|
" DIM n AS LONG\n"
|
|
" n = GetCount()\n"
|
|
" DIM i AS LONG\n"
|
|
" FOR i = 0 TO n - 1\n"
|
|
" PRINT i;\n"
|
|
" NEXT i\n"
|
|
" PRINT\n"
|
|
"END SUB\n"
|
|
"FUNCTION GetCount() AS LONG\n"
|
|
" GetCount = 4\n"
|
|
"END FUNCTION\n",
|
|
"0 1 2 3 \n"
|
|
);
|
|
// Expected: 0 1 2 3
|
|
|
|
// Regression test: resedit pattern -- FOR in SUB inside a FORM
|
|
runProgram("FOR in SUB inside FORM",
|
|
"BEGINFORM \"Form1\"\n"
|
|
"DIM formVar AS LONG\n"
|
|
"formVar = 42\n"
|
|
"CALL DoIt\n"
|
|
"SUB DoIt\n"
|
|
" DIM n AS LONG\n"
|
|
" n = 4\n"
|
|
" DIM ix AS LONG\n"
|
|
" FOR ix = 0 TO n - 1\n"
|
|
" PRINT ix;\n"
|
|
" NEXT ix\n"
|
|
" PRINT\n"
|
|
"END SUB\n"
|
|
"ENDFORM\n",
|
|
""
|
|
);
|
|
// Expected: nothing -- form init code (including the CALL) only runs when
|
|
// the form is loaded, which this harness never does.
|
|
|
|
runProgram("EXIT DO",
|
|
"DIM n AS INTEGER\n"
|
|
"n = 0\n"
|
|
"DO\n"
|
|
" n = n + 1\n"
|
|
" IF n = 4 THEN EXIT DO\n"
|
|
" PRINT n;\n"
|
|
"LOOP\n"
|
|
"PRINT\n"
|
|
"PRINT \"after\"\n",
|
|
"1 2 3 \nafter\n"
|
|
);
|
|
// Expected: 1 2 3 / after
|
|
|
|
runProgram("EXIT SUB",
|
|
"DECLARE SUB EarlyReturn(n AS INTEGER)\n"
|
|
"EarlyReturn 1\n"
|
|
"EarlyReturn 5\n"
|
|
"EarlyReturn 2\n"
|
|
"SUB EarlyReturn(n AS INTEGER)\n"
|
|
" IF n > 3 THEN EXIT SUB\n"
|
|
" PRINT n;\n"
|
|
"END SUB\n"
|
|
"PRINT\n",
|
|
"1 2 \n"
|
|
);
|
|
// Expected: 1 2
|
|
|
|
runProgram("EXIT FUNCTION",
|
|
"DECLARE FUNCTION Clamp(n AS INTEGER) AS INTEGER\n"
|
|
"PRINT Clamp(5)\n"
|
|
"PRINT Clamp(200)\n"
|
|
"FUNCTION Clamp(n AS INTEGER) AS INTEGER\n"
|
|
" IF n > 100 THEN\n"
|
|
" Clamp = 100\n"
|
|
" EXIT FUNCTION\n"
|
|
" END IF\n"
|
|
" Clamp = n\n"
|
|
"END FUNCTION\n",
|
|
"5 \n100 \n"
|
|
);
|
|
// Expected: 5 / 100
|
|
|
|
// ============================================================
|
|
// Coverage: CONST
|
|
// ============================================================
|
|
|
|
runProgram("CONST",
|
|
"CONST PI = 3.14159\n"
|
|
"CONST MAX_SIZE = 100\n"
|
|
"CONST GREETING = \"hello\"\n"
|
|
"PRINT INT(PI * 100)\n"
|
|
"PRINT MAX_SIZE\n"
|
|
"PRINT GREETING\n",
|
|
"314 \n100 \nhello\n"
|
|
);
|
|
// Expected: 314 / 100 / hello
|
|
|
|
// ============================================================
|
|
// Coverage: END statement
|
|
// ============================================================
|
|
|
|
runProgram("END statement",
|
|
"PRINT \"before\"\n"
|
|
"END\n"
|
|
"PRINT \"after\"\n",
|
|
"before\n"
|
|
);
|
|
// Expected: before
|
|
|
|
// ============================================================
|
|
// Coverage: Boolean literals
|
|
// ============================================================
|
|
|
|
runProgram("True and False",
|
|
"DIM b AS BOOLEAN\n"
|
|
"b = True\n"
|
|
"IF b THEN PRINT \"yes\"\n"
|
|
"b = False\n"
|
|
"IF NOT b THEN PRINT \"no\"\n"
|
|
"PRINT True\n"
|
|
"PRINT False\n",
|
|
"yes\nno\nTrue \nFalse \n"
|
|
);
|
|
// Expected: yes / no / True / False
|
|
|
|
// ============================================================
|
|
// Coverage: NOT operator
|
|
// ============================================================
|
|
|
|
runProgram("NOT operator",
|
|
"PRINT NOT 0\n"
|
|
"PRINT NOT -1\n"
|
|
"DIM x AS INTEGER\n"
|
|
"x = 5\n"
|
|
"IF NOT (x > 10) THEN PRINT \"small\"\n",
|
|
"-1 \n0 \nsmall\n"
|
|
);
|
|
// Expected: -1 / 0 / small
|
|
|
|
// ============================================================
|
|
// Coverage: AND OR XOR bitwise
|
|
// ============================================================
|
|
|
|
runProgram("Bitwise AND OR XOR",
|
|
"PRINT 15 AND 9\n"
|
|
"PRINT 12 OR 3\n"
|
|
"PRINT 15 XOR 9\n",
|
|
"9 \n15 \n6 \n"
|
|
);
|
|
// Expected: 9 / 15 / 6
|
|
|
|
// ============================================================
|
|
// Coverage: SLEEP
|
|
// ============================================================
|
|
|
|
runProgram("SLEEP",
|
|
"SLEEP 0\n"
|
|
"PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
// Expected: ok
|
|
|
|
// ============================================================
|
|
// Coverage: Error recovery
|
|
// ============================================================
|
|
|
|
runProgram("RESUME NEXT",
|
|
"ON ERROR GOTO handler\n"
|
|
"DIM x AS INTEGER\n"
|
|
"x = 10 / 0\n"
|
|
"PRINT \"resumed\"\n"
|
|
"END\n"
|
|
"handler:\n"
|
|
"RESUME NEXT\n",
|
|
"resumed\n"
|
|
);
|
|
// Expected: resumed
|
|
|
|
runProgram("RAISE ERROR",
|
|
"ON ERROR GOTO handler\n"
|
|
"ERROR 999\n"
|
|
"PRINT \"should not print\"\n"
|
|
"END\n"
|
|
"handler:\n"
|
|
"PRINT \"caught error\"; ERR\n",
|
|
"caught error999 \n"
|
|
);
|
|
// Expected: caught error999
|
|
|
|
// ============================================================
|
|
// Coverage: Type suffixes and hex literals
|
|
// ============================================================
|
|
|
|
runProgram("Type suffixes",
|
|
"DIM x%\n"
|
|
"DIM s$\n"
|
|
"x% = 42\n"
|
|
"s$ = \"hello\"\n"
|
|
"PRINT x%\n"
|
|
"PRINT s$\n",
|
|
"42 \nhello\n"
|
|
);
|
|
// Expected: 42 / hello
|
|
|
|
runProgram("Hex literals",
|
|
"PRINT &HFF\n"
|
|
"PRINT &H10\n"
|
|
"DIM x AS INTEGER\n"
|
|
"x = &H0A\n"
|
|
"PRINT x\n",
|
|
"255 \n16 \n10 \n"
|
|
);
|
|
// Expected: 255 / 16 / 10
|
|
|
|
// ============================================================
|
|
// Coverage: Long integer type
|
|
// ============================================================
|
|
|
|
runProgram("Long integer",
|
|
"DIM x AS LONG\n"
|
|
"x = 100000\n"
|
|
"x = x * 2\n"
|
|
"PRINT x\n",
|
|
"200000 \n"
|
|
);
|
|
// Expected: 200000
|
|
|
|
// ============================================================
|
|
// Coverage: REDIM without PRESERVE
|
|
// ============================================================
|
|
|
|
runProgram("REDIM no PRESERVE",
|
|
"DIM a(3) AS INTEGER\n"
|
|
"a(1) = 99\n"
|
|
"REDIM a(5) AS INTEGER\n"
|
|
"PRINT a(1)\n",
|
|
"0 \n"
|
|
);
|
|
// Expected: 0 (data cleared)
|
|
|
|
// ============================================================
|
|
// Coverage: PRINT variants
|
|
// ============================================================
|
|
|
|
runProgram("PRINT comma separator",
|
|
"PRINT 1, 2, 3\n",
|
|
"1 2 3 \n"
|
|
);
|
|
// Expected: 1 and 2 and 3 at the start of 14-column print zones
|
|
|
|
runProgram("PRINT bare newline",
|
|
"PRINT \"a\"\n"
|
|
"PRINT\n"
|
|
"PRINT \"b\"\n",
|
|
"a\n\nb\n"
|
|
);
|
|
// Expected: a / (blank) / b
|
|
|
|
// ============================================================
|
|
// Coverage: LET keyword
|
|
// ============================================================
|
|
|
|
runProgram("LET keyword",
|
|
"DIM x AS INTEGER\n"
|
|
"LET x = 42\n"
|
|
"PRINT x\n",
|
|
"42 \n"
|
|
);
|
|
// Expected: 42
|
|
|
|
// ============================================================
|
|
// Coverage: Line continuation
|
|
// ============================================================
|
|
|
|
runProgram("Line continuation",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 1 + _\n"
|
|
" 2 + _\n"
|
|
" 3\n"
|
|
"PRINT x\n",
|
|
"6 \n"
|
|
);
|
|
// Expected: 6
|
|
|
|
// ============================================================
|
|
// Coverage: REM comment
|
|
// ============================================================
|
|
|
|
runProgram("REM comment",
|
|
"REM This is a comment\n"
|
|
"PRINT \"ok\"\n"
|
|
"PRINT \"hi\" REM inline comment\n",
|
|
"ok\nhi\n"
|
|
);
|
|
// Expected: ok / hi
|
|
|
|
// ============================================================
|
|
// Coverage: SELECT CASE with numeric ranges and IS
|
|
// ============================================================
|
|
|
|
runProgram("SELECT CASE numeric",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 15\n"
|
|
"SELECT CASE x\n"
|
|
" CASE 10\n"
|
|
" PRINT \"ten\"\n"
|
|
" CASE 15, 20\n"
|
|
" PRINT \"fifteen or twenty\"\n"
|
|
" CASE ELSE\n"
|
|
" PRINT \"other\"\n"
|
|
"END SELECT\n",
|
|
"fifteen or twenty\n"
|
|
);
|
|
// Expected: fifteen or twenty
|
|
|
|
runProgram("CASE TO range",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 15\n"
|
|
"SELECT CASE x\n"
|
|
" CASE 1 TO 10\n"
|
|
" PRINT \"1-10\"\n"
|
|
" CASE 11 TO 20\n"
|
|
" PRINT \"11-20\"\n"
|
|
" CASE ELSE\n"
|
|
" PRINT \"other\"\n"
|
|
"END SELECT\n",
|
|
"11-20\n"
|
|
);
|
|
// Expected: 11-20
|
|
|
|
runProgram("CASE IS comparison",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 50\n"
|
|
"SELECT CASE x\n"
|
|
" CASE IS < 10\n"
|
|
" PRINT \"small\"\n"
|
|
" CASE IS >= 100\n"
|
|
" PRINT \"big\"\n"
|
|
" CASE ELSE\n"
|
|
" PRINT \"medium\"\n"
|
|
"END SELECT\n",
|
|
"medium\n"
|
|
);
|
|
// Expected: medium
|
|
|
|
runProgram("CASE mixed forms",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 5\n"
|
|
"SELECT CASE x\n"
|
|
" CASE 1, 2, 3\n"
|
|
" PRINT \"low\"\n"
|
|
" CASE 4 TO 6\n"
|
|
" PRINT \"mid\"\n"
|
|
" CASE IS > 6\n"
|
|
" PRINT \"high\"\n"
|
|
"END SELECT\n",
|
|
"mid\n"
|
|
);
|
|
// Expected: mid
|
|
|
|
// ============================================================
|
|
// Coverage: Nested FOR EXIT
|
|
// ============================================================
|
|
|
|
runProgram("Nested FOR EXIT",
|
|
"DIM i AS INTEGER\n"
|
|
"DIM j AS INTEGER\n"
|
|
"FOR i = 1 TO 3\n"
|
|
" FOR j = 1 TO 100\n"
|
|
" IF j > 2 THEN EXIT FOR\n"
|
|
" PRINT i * 10 + j;\n"
|
|
" NEXT j\n"
|
|
"NEXT i\n"
|
|
"PRINT\n",
|
|
"11 12 21 22 31 32 \n"
|
|
);
|
|
// Expected: 11 12 21 22 31 32
|
|
|
|
// ============================================================
|
|
// Coverage: Mixed type arithmetic coercion
|
|
// ============================================================
|
|
|
|
runProgram("Type coercion",
|
|
"DIM d AS DOUBLE\n"
|
|
"d = 2.5\n"
|
|
"PRINT 7 + d\n"
|
|
"PRINT 7 * d\n"
|
|
"DIM i AS INTEGER\n"
|
|
"DIM f AS SINGLE\n"
|
|
"i = 10\n"
|
|
"f = 3.0\n"
|
|
"PRINT i / f\n",
|
|
"9.5 \n17.5 \n3.33333333333333 \n"
|
|
);
|
|
// Expected: 9.5 / 17.5 / 3.333...
|
|
|
|
// ============================================================
|
|
// Coverage: Multiple FUNCTION return paths
|
|
// ============================================================
|
|
|
|
runProgram("FUNCTION return",
|
|
"DECLARE FUNCTION Max(a AS INTEGER, b AS INTEGER) AS INTEGER\n"
|
|
"PRINT Max(10, 20)\n"
|
|
"PRINT Max(30, 5)\n"
|
|
"FUNCTION Max(a AS INTEGER, b AS INTEGER) AS INTEGER\n"
|
|
" IF a > b THEN\n"
|
|
" Max = a\n"
|
|
" ELSE\n"
|
|
" Max = b\n"
|
|
" END IF\n"
|
|
"END FUNCTION\n",
|
|
"20 \n30 \n"
|
|
);
|
|
// Expected: 20 / 30
|
|
|
|
// ============================================================
|
|
// Coverage: Recursive FUNCTION
|
|
// ============================================================
|
|
|
|
runProgram("Recursive FUNCTION",
|
|
"DECLARE FUNCTION Fact(n AS INTEGER) AS LONG\n"
|
|
"PRINT Fact(1)\n"
|
|
"PRINT Fact(5)\n"
|
|
"PRINT Fact(10)\n"
|
|
"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",
|
|
"1 \n120 \n3628800 \n"
|
|
);
|
|
// Expected: 1 / 120 / 3628800
|
|
|
|
// ============================================================
|
|
// Coverage: String comparison operators
|
|
// ============================================================
|
|
|
|
runProgram("String comparison",
|
|
"IF \"abc\" < \"def\" THEN PRINT \"less\"\n"
|
|
"IF \"xyz\" > \"abc\" THEN PRINT \"greater\"\n"
|
|
"IF \"abc\" = \"abc\" THEN PRINT \"equal\"\n"
|
|
"IF \"abc\" <> \"xyz\" THEN PRINT \"notequal\"\n",
|
|
"less\ngreater\nequal\nnotequal\n"
|
|
);
|
|
// Expected: less / greater / equal / notequal
|
|
|
|
// ============================================================
|
|
// Coverage: Apostrophe comment
|
|
// ============================================================
|
|
|
|
runProgram("Apostrophe comment",
|
|
"PRINT \"before\" ' this is a comment\n"
|
|
"' full line comment\n"
|
|
"PRINT \"after\"\n",
|
|
"before\nafter\n"
|
|
);
|
|
// Expected: before / after
|
|
|
|
// ============================================================
|
|
// Coverage: SINGLE data type
|
|
// ============================================================
|
|
|
|
runProgram("SINGLE data type",
|
|
"DIM s AS SINGLE\n"
|
|
"s = 3.14\n"
|
|
"PRINT INT(s * 100)\n",
|
|
"314 \n"
|
|
);
|
|
// Expected: 314
|
|
|
|
// ============================================================
|
|
// Coverage: Conversion functions
|
|
// ============================================================
|
|
|
|
runProgram("CINT CLNG CDBL CSNG CSTR",
|
|
"PRINT CINT(3.7)\n"
|
|
"PRINT CLNG(42)\n"
|
|
"PRINT CDBL(3)\n"
|
|
"PRINT CSNG(3)\n"
|
|
"PRINT \"[\" & CSTR(42) & \"]\"\n",
|
|
"4 \n42 \n3 \n3 \n[42]\n"
|
|
);
|
|
// Expected: 4 / 42 / 3 / 3 / [42]
|
|
|
|
// ============================================================
|
|
// Coverage: Me.Show / Me.Hide as statements
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Me.Show / Me.Hide statements ===\n");
|
|
|
|
// These compile -- runtime needs a form context to actually show/hide
|
|
const char *src =
|
|
"Sub Form1_Load ()\n"
|
|
" Me.Show\n"
|
|
" Me.Hide\n"
|
|
" PRINT \"me ok\"\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n\n", basCompilerError(compiler));
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (mod) {
|
|
printf("Compiled OK, proc=%s\n", mod->procs[0].name);
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Me keyword with form context
|
|
// ============================================================
|
|
{
|
|
printf("=== Me keyword with form context ===\n");
|
|
|
|
const char *src =
|
|
"Sub Form1_Load ()\n"
|
|
" PRINT \"load fired\"\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Sub Command1_Click ()\n"
|
|
" PRINT \"click fired\"\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Sub Text1_KeyPress (KeyAscii As Integer)\n"
|
|
" PRINT \"key:\"; KeyAscii\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Sub Picture1_MouseDown (Button As Integer, X As Integer, Y As Integer)\n"
|
|
" PRINT \"mouse:\"; Button; X; Y\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n\n", basCompilerError(compiler));
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (!mod) {
|
|
printf("MODULE BUILD FAILED\n\n");
|
|
gFailCount++;
|
|
} else {
|
|
BasVmT *vm = basVmCreate();
|
|
basVmLoadModule(vm, mod);
|
|
|
|
// Test: find and call Form1_Load (no args)
|
|
const BasProcEntryT *loadProc = basModuleFindProc(mod, "Form1_Load");
|
|
|
|
if (loadProc) {
|
|
basVmCallSub(vm, loadProc->codeAddr);
|
|
} else {
|
|
printf("Form1_Load not found!\n");
|
|
gFailCount++;
|
|
}
|
|
|
|
// Test: find and call Command1_Click (no args)
|
|
const BasProcEntryT *clickProc = basModuleFindProc(mod, "Command1_Click");
|
|
|
|
if (clickProc) {
|
|
basVmCallSub(vm, clickProc->codeAddr);
|
|
} else {
|
|
printf("Command1_Click not found!\n");
|
|
gFailCount++;
|
|
}
|
|
|
|
// Test: find and call Text1_KeyPress with parameter
|
|
const BasProcEntryT *keyProc = basModuleFindProc(mod, "Text1_KeyPress");
|
|
|
|
if (keyProc) {
|
|
BasValueT args[1];
|
|
args[0] = basValLong(65); // 'A'
|
|
basVmCallSubWithArgs(vm, keyProc->codeAddr, args, 1);
|
|
} else {
|
|
printf("Text1_KeyPress not found!\n");
|
|
}
|
|
|
|
// Test: find and call Picture1_MouseDown with 3 parameters
|
|
const BasProcEntryT *mouseProc = basModuleFindProc(mod, "Picture1_MouseDown");
|
|
|
|
if (mouseProc) {
|
|
BasValueT args[3];
|
|
args[0] = basValLong(1); // left button
|
|
args[1] = basValLong(50); // X
|
|
args[2] = basValLong(100); // Y
|
|
basVmCallSubWithArgs(vm, mouseProc->codeAddr, args, 3);
|
|
} else {
|
|
printf("Picture1_MouseDown not found!\n");
|
|
}
|
|
|
|
// Test: verify proc table
|
|
printf("Proc count: %d\n", (int)mod->procCount);
|
|
|
|
for (int32_t i = 0; i < mod->procCount; i++) {
|
|
printf(" [%d] %s (params=%d)\n", (int)i, mod->procs[i].name, (int)mod->procs[i].paramCount);
|
|
}
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Event parameter mismatch
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Event parameter mismatch ===\n");
|
|
|
|
const char *src =
|
|
"Sub NoParams ()\n"
|
|
" PRINT \"no params ok\"\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Sub OneParam (X As Integer)\n"
|
|
" PRINT \"X =\"; X\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Sub TwoParams (A As Integer, B As Integer)\n"
|
|
" PRINT \"A =\"; A; \"B =\"; B\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n\n", basCompilerError(compiler));
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (mod) {
|
|
BasVmT *vm = basVmCreate();
|
|
basVmLoadModule(vm, mod);
|
|
|
|
// Call NoParams with no args
|
|
const BasProcEntryT *p = basModuleFindProc(mod, "NoParams");
|
|
|
|
if (p) {
|
|
basVmCallSub(vm, p->codeAddr);
|
|
}
|
|
|
|
// Call OneParam with 1 arg
|
|
p = basModuleFindProc(mod, "OneParam");
|
|
|
|
if (p) {
|
|
BasValueT args[1];
|
|
args[0] = basValLong(42);
|
|
basVmCallSubWithArgs(vm, p->codeAddr, args, 1);
|
|
}
|
|
|
|
// Call TwoParams with 2 args
|
|
p = basModuleFindProc(mod, "TwoParams");
|
|
|
|
if (p) {
|
|
BasValueT args[2];
|
|
args[0] = basValLong(10);
|
|
args[1] = basValLong(20);
|
|
basVmCallSubWithArgs(vm, p->codeAddr, args, 2);
|
|
}
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Procedure extraction from source
|
|
// ============================================================
|
|
|
|
runProgram("Mixed module-level and procedures",
|
|
"DIM x As Integer\n"
|
|
"x = 10\n"
|
|
"PRINT \"module:\"; x\n"
|
|
"\n"
|
|
"Sub Helper ()\n"
|
|
" PRINT \"helper called\"\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Function Add (a As Integer, b As Integer) As Integer\n"
|
|
" Add = a + b\n"
|
|
"End Function\n"
|
|
"\n"
|
|
"CALL Helper\n"
|
|
"PRINT \"sum:\"; Add(3, 4)\n",
|
|
"module:10 \nhelper called\nsum:7 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: ? shortcut for PRINT
|
|
// ============================================================
|
|
|
|
runProgram("? shortcut for PRINT",
|
|
"? \"hello\"\n"
|
|
"? 1 + 2\n",
|
|
"hello\n3 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Code in .frm format (Sub after form definition)
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== FRM code extraction ===\n");
|
|
|
|
// Simulate what the IDE does: code section from a .frm
|
|
const char *frmCode =
|
|
"Sub Form1_Load ()\n"
|
|
" PRINT \"form loaded\"\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Sub Command1_Click ()\n"
|
|
" PRINT \"button clicked\"\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(frmCode);
|
|
BasCompilerT *compiler = basCompilerCreate(frmCode, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n\n", basCompilerError(compiler));
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (mod) {
|
|
BasVmT *vm = basVmCreate();
|
|
basVmLoadModule(vm, mod);
|
|
|
|
// Fire both events
|
|
const BasProcEntryT *p1 = basModuleFindProc(mod, "Form1_Load");
|
|
const BasProcEntryT *p2 = basModuleFindProc(mod, "Command1_Click");
|
|
|
|
if (p1) { basVmCallSub(vm, p1->codeAddr); }
|
|
else { printf("Form1_Load NOT FOUND\n"); }
|
|
|
|
if (p2) { basVmCallSub(vm, p2->codeAddr); }
|
|
else { printf("Command1_Click NOT FOUND\n"); }
|
|
|
|
basVmDestroy(vm);
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: RANDOMIZE TIMER
|
|
// ============================================================
|
|
|
|
runProgram("RANDOMIZE TIMER",
|
|
"RANDOMIZE TIMER\n"
|
|
"DIM x AS SINGLE\n"
|
|
"x = RND\n"
|
|
"PRINT \"rnd ok\"\n",
|
|
"rnd ok\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Forward GOSUB
|
|
// ============================================================
|
|
|
|
runProgram("Forward GOSUB",
|
|
"GOSUB doWork\n"
|
|
"PRINT \"back\"\n"
|
|
"END\n"
|
|
"doWork:\n"
|
|
"PRINT \"working\"\n"
|
|
"RETURN\n",
|
|
"working\nback\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Forward GOTO
|
|
// ============================================================
|
|
|
|
runProgram("Forward GOTO to label",
|
|
"GOTO skip\n"
|
|
"PRINT \"should not print\"\n"
|
|
"skip:\n"
|
|
"PRINT \"jumped\"\n",
|
|
"jumped\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Array of UDT
|
|
// ============================================================
|
|
|
|
runProgram("Array of UDT",
|
|
"TYPE PointT\n"
|
|
" x AS INTEGER\n"
|
|
" y AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"\n"
|
|
"DIM pts(3) AS PointT\n"
|
|
"pts(1).x = 10\n"
|
|
"pts(1).y = 20\n"
|
|
"pts(2).x = 30\n"
|
|
"pts(2).y = 40\n"
|
|
"PRINT pts(1).x; pts(1).y\n"
|
|
"PRINT pts(2).x; pts(2).y\n",
|
|
"10 20 \n30 40 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Nested UDTs
|
|
// ============================================================
|
|
|
|
runProgram("Nested UDT",
|
|
"TYPE AddressT\n"
|
|
" city AS STRING\n"
|
|
" zip AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"\n"
|
|
"TYPE PersonT\n"
|
|
" fullName AS STRING\n"
|
|
" addr AS AddressT\n"
|
|
"END TYPE\n"
|
|
"\n"
|
|
"DIM p AS PersonT\n"
|
|
"p.fullName = \"Alice\"\n"
|
|
"p.addr.city = \"NYC\"\n"
|
|
"p.addr.zip = 10001\n"
|
|
"PRINT p.fullName\n"
|
|
"PRINT p.addr.city\n"
|
|
"PRINT p.addr.zip\n",
|
|
"Alice\nNYC\n10001 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Operator precedence stress
|
|
// ============================================================
|
|
|
|
runProgram("Operator precedence",
|
|
"' NOT has highest unary, then AND, OR, XOR, EQV, IMP\n"
|
|
"PRINT NOT 0 AND -1\n" // NOT 0 = -1, -1 AND -1 = -1
|
|
"PRINT (1 > 0) AND (2 > 1)\n" // True AND True = True (two Booleans, VB4+)
|
|
"PRINT (1 > 0) OR (2 < 1)\n" // True OR False = True
|
|
"PRINT 5 AND 3\n" // bitwise: 1
|
|
"PRINT 5 OR 3\n" // bitwise: 7
|
|
"PRINT 5 XOR 3\n" // bitwise: 6
|
|
"PRINT 2 + 3 * 4 - 1\n" // 2 + 12 - 1 = 13
|
|
"PRINT (2 + 3) * (4 - 1)\n" // 5 * 3 = 15
|
|
"PRINT -2 ^ 2\n", // -(2^2) = -4 (VB precedence)
|
|
"-1 \nTrue \nTrue \n1 \n7 \n6 \n13 \n15 \n-4 \n"
|
|
);
|
|
|
|
// Logical operators on Booleans give Booleans, as in VB4+ (NOT too);
|
|
// with a number they give the number's type, and with Null the known
|
|
// operand's
|
|
runProgram("Logical operators: Booleans give Booleans",
|
|
"DIM a AS BOOLEAN\n"
|
|
"DIM b AS BOOLEAN\n"
|
|
"DIM v AS VARIANT\n"
|
|
"a = TRUE\n"
|
|
"PRINT a AND b; a OR b; a XOR b; a EQV b; a IMP b; NOT a\n"
|
|
"PRINT TypeName(a AND b); TypeName(NOT b); TypeName(a EQV b)\n"
|
|
"PRINT TypeName(a AND 1); TypeName(a OR 70000); TypeName(NOT 1)\n"
|
|
"PRINT a AND 3; NOT FALSE\n"
|
|
"v = a\n"
|
|
"PRINT TypeName(v OR b); TypeName(Null AND FALSE); TypeName(0 AND Null)\n"
|
|
"CONST C = TRUE AND NOT FALSE\n"
|
|
"PRINT C; TypeName(C)\n",
|
|
"False True True False False False \n"
|
|
"BooleanBooleanBoolean\n"
|
|
"IntegerLongInteger\n"
|
|
"3 True \n"
|
|
"BooleanBooleanInteger\n"
|
|
"True Boolean\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Nested FOR with EXIT
|
|
// ============================================================
|
|
|
|
runProgram("Nested FOR with EXIT FOR",
|
|
"DIM i AS INTEGER\n"
|
|
"DIM 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; j\n"
|
|
" NEXT j\n"
|
|
"NEXT i\n",
|
|
"1 1 \n2 1 \n3 1 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Forward reference CALL (sub defined after use)
|
|
// ============================================================
|
|
|
|
runProgram("Forward CALL reference",
|
|
"CALL doWork\n"
|
|
"PRINT \"after call\"\n"
|
|
"\n"
|
|
"Sub doWork ()\n"
|
|
" PRINT \"in sub\"\n"
|
|
"End Sub\n",
|
|
"in sub\nafter call\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Multiple CONST declarations
|
|
// ============================================================
|
|
|
|
runProgram("Multiple CONST",
|
|
"CONST PI = 3.14159\n"
|
|
"CONST E = 2.71828\n"
|
|
"CONST APPNAME = \"DVX\"\n"
|
|
"PRINT INT(PI * 100)\n"
|
|
"PRINT INT(E * 100)\n"
|
|
"PRINT APPNAME\n",
|
|
"314 \n271 \nDVX\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: SELECT CASE with strings
|
|
// ============================================================
|
|
|
|
runProgram("SELECT CASE strings",
|
|
"DIM s AS STRING\n"
|
|
"s = \"hello\"\n"
|
|
"SELECT CASE s\n"
|
|
" CASE \"world\"\n"
|
|
" PRINT \"wrong\"\n"
|
|
" CASE \"hello\"\n"
|
|
" PRINT \"right\"\n"
|
|
" CASE ELSE\n"
|
|
" PRINT \"default\"\n"
|
|
"END SELECT\n",
|
|
"right\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Nested IF/ELSEIF chains
|
|
// ============================================================
|
|
|
|
runProgram("Nested IF chains",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 50\n"
|
|
"IF x > 90 THEN\n"
|
|
" PRINT \"A\"\n"
|
|
"ELSEIF x > 80 THEN\n"
|
|
" PRINT \"B\"\n"
|
|
"ELSEIF x > 70 THEN\n"
|
|
" PRINT \"C\"\n"
|
|
"ELSEIF x > 60 THEN\n"
|
|
" PRINT \"D\"\n"
|
|
"ELSE\n"
|
|
" PRINT \"F\"\n"
|
|
"END IF\n",
|
|
"F\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: DO WHILE with EXIT DO
|
|
// ============================================================
|
|
|
|
runProgram("DO WHILE with EXIT DO",
|
|
"DIM i AS INTEGER\n"
|
|
"i = 0\n"
|
|
"DO WHILE i < 100\n"
|
|
" i = i + 1\n"
|
|
" IF i = 5 THEN EXIT DO\n"
|
|
"LOOP\n"
|
|
"PRINT i\n",
|
|
"5 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Recursive Fibonacci
|
|
// ============================================================
|
|
|
|
runProgram("Recursive Fibonacci",
|
|
"Function Fib (n As Integer) As Integer\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"
|
|
"\n"
|
|
"PRINT Fib(0); Fib(1); Fib(5); Fib(10)\n",
|
|
"0 1 5 55 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: String comparison operators
|
|
// ============================================================
|
|
|
|
runProgram("String comparison ops",
|
|
"IF \"abc\" < \"def\" THEN PRINT \"lt ok\"\n"
|
|
"IF \"abc\" <= \"abc\" THEN PRINT \"le ok\"\n"
|
|
"IF \"def\" > \"abc\" THEN PRINT \"gt ok\"\n"
|
|
"IF \"abc\" >= \"abc\" THEN PRINT \"ge ok\"\n"
|
|
"IF \"abc\" <> \"def\" THEN PRINT \"ne ok\"\n"
|
|
"IF \"abc\" = \"abc\" THEN PRINT \"eq ok\"\n",
|
|
"lt ok\nle ok\ngt ok\nge ok\nne ok\neq ok\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: LOAD/UNLOAD/Me statements compile
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Form statements compile ===\n");
|
|
|
|
const char *src =
|
|
"Sub Form1_Load ()\n"
|
|
" Me.Show\n"
|
|
" Me.Hide\n"
|
|
" Load frmOther\n"
|
|
" Unload frmOther\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (mod) {
|
|
printf("OK: %d procs, %d bytes\n", (int)mod->procCount, (int)mod->codeLen);
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Me.Property assignment compiles
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Me.Property assignment ===\n");
|
|
|
|
const char *src =
|
|
"Sub Form1_Load ()\n"
|
|
" Me.Caption = \"Hello\"\n"
|
|
" Me.Visible = 1\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (mod) {
|
|
printf("OK\n");
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Me.Control.Property compiles
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Me.Control.Property ===\n");
|
|
|
|
const char *src =
|
|
"Sub Form1_Load ()\n"
|
|
" Me.Text1.Text = \"hello\"\n"
|
|
" Me.Label1.Caption = \"world\"\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (mod) {
|
|
printf("OK\n");
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: DOEVENTS compiles
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== DOEVENTS compiles ===\n");
|
|
|
|
const char *src =
|
|
"Sub Form1_Load ()\n"
|
|
" DoEvents\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
basCompilerDestroy(compiler);
|
|
} else {
|
|
BasModuleT *mod = basCompilerBuildModule(compiler);
|
|
basCompilerDestroy(compiler);
|
|
|
|
if (mod) {
|
|
printf("OK\n");
|
|
basModuleFree(mod);
|
|
}
|
|
}
|
|
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Bare sub call (no CALL keyword, no parens)
|
|
// ============================================================
|
|
|
|
runProgram("Bare sub call",
|
|
"Sub Greet ()\n"
|
|
" PRINT \"hello\"\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Greet\n",
|
|
"hello\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Bare sub call with forward reference
|
|
// ============================================================
|
|
|
|
runProgram("Bare sub call forward ref",
|
|
"DoWork\n"
|
|
"\n"
|
|
"Sub DoWork ()\n"
|
|
" PRINT \"worked\"\n"
|
|
"End Sub\n",
|
|
"worked\n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Unresolved forward reference error
|
|
// ============================================================
|
|
|
|
expectCompileError("Unresolved forward reference",
|
|
"NeverDefined\n",
|
|
"Undefined Sub: NeverDefined"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Nested UDT field store
|
|
// ============================================================
|
|
|
|
runProgram("Nested UDT store and load",
|
|
"TYPE InnerT\n"
|
|
" val AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"\n"
|
|
"TYPE OuterT\n"
|
|
" child AS InnerT\n"
|
|
" label AS STRING\n"
|
|
"END TYPE\n"
|
|
"\n"
|
|
"DIM o AS OuterT\n"
|
|
"o.label = \"test\"\n"
|
|
"o.child.val = 42\n"
|
|
"PRINT o.label\n"
|
|
"PRINT o.child.val\n",
|
|
"test\n42 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Array of UDT field store
|
|
// ============================================================
|
|
|
|
runProgram("Array of UDT field store",
|
|
"TYPE PointT\n"
|
|
" x AS INTEGER\n"
|
|
" y AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"\n"
|
|
"DIM pts(5) AS PointT\n"
|
|
"pts(1).x = 10\n"
|
|
"pts(1).y = 20\n"
|
|
"pts(3).x = 30\n"
|
|
"pts(3).y = 40\n"
|
|
"PRINT pts(1).x; pts(1).y\n"
|
|
"PRINT pts(3).x; pts(3).y\n",
|
|
"10 20 \n30 40 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: VB operator precedence (^ binds tighter than unary -)
|
|
// ============================================================
|
|
|
|
runProgram("Exponent precedence",
|
|
"PRINT -2 ^ 2\n" // -(2^2) = -4
|
|
"PRINT (-2) ^ 2\n" // (-2)^2 = 4
|
|
"PRINT 3 ^ 2 + 1\n", // 9 + 1 = 10
|
|
"-4 \n4 \n10 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Me.Show compiles in a Sub
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Me.Show in Sub ===\n");
|
|
|
|
const char *src =
|
|
"Sub Form1_Load ()\n"
|
|
" Me.Show\n"
|
|
" Me.Caption = \"Hello\"\n"
|
|
" Me.Hide\n"
|
|
"End Sub\n";
|
|
|
|
int32_t len = (int32_t)strlen(src);
|
|
BasCompilerT *compiler = basCompilerCreate(src, len);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: OPTION EXPLICIT with valid declaration
|
|
// ============================================================
|
|
|
|
runProgram("OPTION EXPLICIT valid",
|
|
"OPTION EXPLICIT\n"
|
|
"DIM x AS INTEGER\n"
|
|
"x = 42\n"
|
|
"PRINT x\n",
|
|
"42 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: STATIC variable retains value
|
|
// ============================================================
|
|
|
|
runProgram("STATIC in sub",
|
|
"Sub Counter ()\n"
|
|
" STATIC n AS INTEGER\n"
|
|
" n = n + 1\n"
|
|
" PRINT n\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Counter\n"
|
|
"Counter\n"
|
|
"Counter\n",
|
|
"1 \n2 \n3 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: MsgBox statement form (no return value)
|
|
// ============================================================
|
|
|
|
runProgram("MsgBox statement",
|
|
"MsgBox \"Hello\"\n",
|
|
""
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: MsgBox statement with flags
|
|
// ============================================================
|
|
|
|
runProgram("MsgBox statement with flags",
|
|
"MsgBox \"Save?\", vbYesNo + vbQuestion\n",
|
|
""
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: MsgBox function form (returns value)
|
|
// ============================================================
|
|
|
|
runProgram("MsgBox function",
|
|
"DIM result AS INTEGER\n"
|
|
"result = MsgBox(\"Continue?\", vbYesNo)\n"
|
|
"PRINT result\n",
|
|
"1 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: MsgBox function with default flags
|
|
// ============================================================
|
|
|
|
runProgram("MsgBox function default flags",
|
|
"DIM r AS INTEGER\n"
|
|
"r = MsgBox(\"OK\")\n"
|
|
"PRINT r\n",
|
|
"1 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: VB3 predefined constants
|
|
// ============================================================
|
|
|
|
runProgram("VB3 predefined constants",
|
|
"PRINT vbOKOnly\n"
|
|
"PRINT vbOKCancel\n"
|
|
"PRINT vbYesNo\n"
|
|
"PRINT vbYesNoCancel\n"
|
|
"PRINT vbRetryCancel\n"
|
|
"PRINT vbInformation\n"
|
|
"PRINT vbExclamation\n"
|
|
"PRINT vbCritical\n"
|
|
"PRINT vbQuestion\n"
|
|
"PRINT vbOK\n"
|
|
"PRINT vbCancel\n"
|
|
"PRINT vbYes\n"
|
|
"PRINT vbNo\n"
|
|
"PRINT vbRetry\n",
|
|
"0 \n1 \n2 \n3 \n4 \n16 \n32 \n48 \n64 \n1 \n2 \n3 \n4 \n5 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: MsgBox result used in If
|
|
// ============================================================
|
|
|
|
runProgram("MsgBox in If condition",
|
|
"If MsgBox(\"Exit?\", vbYesNo) = vbYes Then\n"
|
|
" PRINT \"yes\"\n"
|
|
"End If\n",
|
|
""
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Control array read -- Name(0).Caption
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Control array read ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("DIM x AS STRING\n"
|
|
"x = Command1(0).Caption\n"
|
|
"PRINT x\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Control array write -- Name(idx).Caption = "text"
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Control array write ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("DIM idx AS INTEGER\n"
|
|
"idx = 1\n"
|
|
"Command1(idx).Caption = \"Hello\"\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Control array complex index -- Name(X + 1).Caption
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Control array complex index ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("DIM i AS INTEGER\n"
|
|
"DIM s AS STRING\n"
|
|
"i = 2\n"
|
|
"s = Btn(i + 1).Text\n"
|
|
"PRINT s\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Forward-ref function still works (no dot after paren)
|
|
// ============================================================
|
|
|
|
runProgram("Forward-ref function still works",
|
|
"Function GetValue () As Integer\n"
|
|
" GetValue = 42\n"
|
|
"End Function\n"
|
|
"\n"
|
|
"PRINT GetValue()\n",
|
|
"42 \n"
|
|
);
|
|
|
|
// ============================================================
|
|
// Coverage: Control array in event handler
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Control array event handler ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("Sub Cmd_Click (Index As Integer)\n"
|
|
" Cmd(Index).Caption = \"Clicked\"\n"
|
|
"End Sub\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Me.Control(idx).Property
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Me.Control(idx).Property ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("Sub Cmd_Click (Index As Integer)\n"
|
|
" Me.Cmd(Index).Caption = \"OK\"\n"
|
|
"End Sub\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: BEGINFORM/ENDFORM with form-level DIM
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Form-level variables ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("BEGINFORM \"Form1\"\n"
|
|
"Dim Shared counter As Integer\n"
|
|
"Dim Shared msg As String\n"
|
|
"\n"
|
|
"Sub Form1_Load ()\n"
|
|
" counter = 0\n"
|
|
" msg = \"hello\"\n"
|
|
"End Sub\n"
|
|
"\n"
|
|
"Sub Timer1_Timer ()\n"
|
|
" counter = counter + 1\n"
|
|
"End Sub\n"
|
|
"ENDFORM\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Form-scope arrays compile (init deferred to load)
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Form-scope array ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("BEGINFORM \"Form1\"\n"
|
|
"Dim Shared arr(10) As Integer\n"
|
|
"\n"
|
|
"Sub Form1_Load ()\n"
|
|
" arr(0) = 42\n"
|
|
"End Sub\n"
|
|
"ENDFORM\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Two forms with same-named form vars (independent)
|
|
// ============================================================
|
|
|
|
{
|
|
printf("=== Two forms same var name ===\n");
|
|
BasCompilerT *compiler = basCompilerCreate("BEGINFORM \"Form1\"\n"
|
|
"Dim Shared counter As Integer\n"
|
|
"Sub Form1_Load ()\n"
|
|
" counter = 1\n"
|
|
"End Sub\n"
|
|
"ENDFORM\n"
|
|
"\n"
|
|
"BEGINFORM \"Form2\"\n"
|
|
"Dim Shared counter As Integer\n"
|
|
"Sub Form2_Load ()\n"
|
|
" counter = 2\n"
|
|
"End Sub\n"
|
|
"ENDFORM\n",
|
|
-1);
|
|
|
|
if (!basCompile(compiler)) {
|
|
printf("COMPILE ERROR: %s\n", basCompilerError(compiler));
|
|
gFailCount++;
|
|
} else {
|
|
printf("OK\n");
|
|
}
|
|
|
|
basCompilerDestroy(compiler);
|
|
printf("\n");
|
|
}
|
|
|
|
// ============================================================
|
|
// Coverage: Nested BEGINFORM rejected
|
|
// ============================================================
|
|
|
|
expectCompileError("Nested BEGINFORM rejected",
|
|
"BEGINFORM \"Form1\"\n"
|
|
"BEGINFORM \"Form2\"\n"
|
|
"ENDFORM\n"
|
|
"ENDFORM\n",
|
|
"Nested BEGINFORM is not allowed"
|
|
);
|
|
|
|
// ============================================================
|
|
// Regression: compiler bugs found by the aab9fac review
|
|
// ============================================================
|
|
|
|
expectCompileError("Self-referential TYPE rejected",
|
|
"TYPE T\n"
|
|
" x AS INTEGER\n"
|
|
" y AS T\n"
|
|
"END TYPE\n"
|
|
"DIM v AS T\n",
|
|
"cannot contain a field of its own type"
|
|
);
|
|
|
|
expectCompileError("DEF FN inside SUB rejected",
|
|
"SUB S\n"
|
|
" DIM x AS INTEGER\n"
|
|
" DEF FNd(y) = y * 2\n"
|
|
"END SUB\n",
|
|
"DEF FN is not allowed inside SUB or FUNCTION"
|
|
);
|
|
|
|
// RETURN inside a SELECT CASE must discard the live test value before
|
|
// OP_GOSUB_RET pops the return address.
|
|
runProgram("RETURN inside SELECT CASE",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 1\n"
|
|
"GOSUB Handler\n"
|
|
"PRINT \"back\"\n"
|
|
"END\n"
|
|
"Handler:\n"
|
|
"SELECT CASE x\n"
|
|
" CASE 1\n"
|
|
" PRINT \"one\"\n"
|
|
" RETURN\n"
|
|
"END SELECT\n"
|
|
"RETURN\n",
|
|
"one\nback\n"
|
|
);
|
|
|
|
expectCompileError("Long identifier rejected",
|
|
"DIM abcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghij AS INTEGER\n",
|
|
"Identifier too long"
|
|
);
|
|
|
|
// A variable first used inside a SUB is local to it: the module-level
|
|
// y is a different (zero) variable, and the implicit string local is
|
|
// "" on every call rather than accumulating.
|
|
runProgram("Implicit variable in SUB is local",
|
|
"SUB S\n"
|
|
" y = 4\n"
|
|
" s$ = s$ & \"a\"\n"
|
|
" PRINT y; s$\n"
|
|
"END SUB\n"
|
|
"S\n"
|
|
"S\n"
|
|
"PRINT y\n",
|
|
"4 a\n4 a\n0 \n"
|
|
);
|
|
|
|
runProgram("Implicit locals are per call in recursion",
|
|
"FUNCTION fact(n)\n"
|
|
" IF n <= 1 THEN\n"
|
|
" fact = 1\n"
|
|
" ELSE\n"
|
|
" t = n\n"
|
|
" fact = t * fact(n - 1)\n"
|
|
" END IF\n"
|
|
"END FUNCTION\n"
|
|
"PRINT fact(5)\n",
|
|
"120 \n"
|
|
);
|
|
|
|
expectCompileError("Assignment to another FUNCTION name rejected",
|
|
"FUNCTION F\n"
|
|
" F = 1\n"
|
|
"END FUNCTION\n"
|
|
"SUB S(a)\n"
|
|
" F = 99\n"
|
|
"END SUB\n",
|
|
"Cannot assign to function 'F'"
|
|
);
|
|
|
|
expectCompileError("Assignment to SUB name rejected",
|
|
"SUB S\n"
|
|
"END SUB\n"
|
|
"S = 5\n",
|
|
"Cannot assign to 'S'"
|
|
);
|
|
|
|
// Labels have a namespace of their own (QB): a variable may share
|
|
// a label's name.
|
|
runProgram("Label and variable share a name",
|
|
"Lbl:\n"
|
|
"Lbl = 5\n"
|
|
"PRINT Lbl\n",
|
|
"5 \n"
|
|
);
|
|
|
|
expectCompileError("SUB name as operand rejected",
|
|
"SUB S\n"
|
|
"END SUB\n"
|
|
"PRINT S + 1\n",
|
|
"'S' is not a variable"
|
|
);
|
|
|
|
runProgram("DATA hex literal keeps 32 bits",
|
|
"DATA &HFFFF, &H12345\n"
|
|
"READ a&, b&\n"
|
|
"PRINT a&; b&\n",
|
|
"65535 74565 \n"
|
|
);
|
|
|
|
expectCompileError("EXIT FOR in SUB without loop rejected",
|
|
"SUB S\n"
|
|
" EXIT FOR\n"
|
|
"END SUB\n"
|
|
"FOR i = 1 TO 3\n"
|
|
" S\n"
|
|
"NEXT i\n",
|
|
"EXIT FOR outside FOR loop"
|
|
);
|
|
|
|
expectCompileError("EXIT DO outside loop rejected",
|
|
"EXIT DO\n",
|
|
"EXIT DO outside DO or WHILE loop"
|
|
);
|
|
|
|
expectCompileError("EXIT SUB at module level rejected",
|
|
"EXIT SUB\n",
|
|
"EXIT SUB outside SUB"
|
|
);
|
|
|
|
expectCompileError("EXIT SUB inside FUNCTION rejected",
|
|
"FUNCTION F\n"
|
|
" EXIT SUB\n"
|
|
"END FUNCTION\n",
|
|
"EXIT SUB outside SUB"
|
|
);
|
|
|
|
runProgram("EXIT FOR out of SELECT CASE",
|
|
"FOR i = 1 TO 3\n"
|
|
" SELECT CASE i\n"
|
|
" CASE 2\n"
|
|
" EXIT FOR\n"
|
|
" END SELECT\n"
|
|
" PRINT i\n"
|
|
"NEXT i\n"
|
|
"PRINT \"done\"\n",
|
|
"1 \ndone\n"
|
|
);
|
|
|
|
{
|
|
// Nesting limits: deep parentheses, unary operators and blocks must
|
|
// be compile errors, not stack overflows.
|
|
static char deepSrc[8192];
|
|
int32_t pos = 0;
|
|
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "x = ");
|
|
for (int32_t i = 0; i < BAS_MAX_EXPR_DEPTH + 8; i++) {
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "(");
|
|
}
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "1");
|
|
for (int32_t i = 0; i < BAS_MAX_EXPR_DEPTH + 8; i++) {
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, ")");
|
|
}
|
|
snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "\n");
|
|
expectCompileError("Deep expression nesting rejected", deepSrc, "Expression nested too deeply");
|
|
|
|
pos = 0;
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "x = ");
|
|
for (int32_t i = 0; i < BAS_MAX_EXPR_DEPTH + 8; i++) {
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "-");
|
|
}
|
|
snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "1\n");
|
|
expectCompileError("Deep unary nesting rejected", deepSrc, "Expression nested too deeply");
|
|
|
|
pos = 0;
|
|
for (int32_t i = 0; i < BAS_MAX_BLOCK_DEPTH + 8; i++) {
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "IF 1 THEN\n");
|
|
}
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "PRINT 1\n");
|
|
for (int32_t i = 0; i < BAS_MAX_BLOCK_DEPTH + 8; i++) {
|
|
pos += snprintf(deepSrc + pos, sizeof(deepSrc) - pos, "END IF\n");
|
|
}
|
|
expectCompileError("Deep block nesting rejected", deepSrc, "Statements nested too deeply");
|
|
}
|
|
|
|
// The signature prescan runs before TYPE statements are parsed; a
|
|
// parameter typed AS a user TYPE must still count towards the arity.
|
|
runProgram("Prescan handles UDT parameters",
|
|
"DIM r AS INTEGER\n"
|
|
"r = foo(1, 2)\n"
|
|
"PRINT r\n"
|
|
"TYPE Pt\n"
|
|
" x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"FUNCTION foo(a AS INTEGER, b AS INTEGER) AS INTEGER\n"
|
|
" foo = a + b\n"
|
|
"END FUNCTION\n"
|
|
"SUB bar(q AS Pt)\n"
|
|
" PRINT q.x\n"
|
|
"END SUB\n",
|
|
"3 \n"
|
|
);
|
|
|
|
expectCompileError("Duplicate label rejected",
|
|
"L1:\n"
|
|
"PRINT 1\n"
|
|
"L1:\n"
|
|
"PRINT 2\n",
|
|
"Duplicate label 'L1'"
|
|
);
|
|
|
|
expectCompileError("Duplicate SUB rejected",
|
|
"SUB S\n"
|
|
" PRINT \"first\"\n"
|
|
"END SUB\n"
|
|
"SUB S\n"
|
|
" PRINT \"second\"\n"
|
|
"END SUB\n",
|
|
"Sub 'S' is already defined"
|
|
);
|
|
|
|
expectCompileError("Nested SUB rejected",
|
|
"SUB A\n"
|
|
" SUB B\n"
|
|
" END SUB\n"
|
|
"END SUB\n",
|
|
"SUB cannot be defined inside SUB or FUNCTION"
|
|
);
|
|
|
|
// A procedure inside a block statement is an error (QA bug 1: its
|
|
// scope outlived the block's unit arena -- a use-after-free on the
|
|
// next name lookup; the first source is the fuzzer's reproducer)
|
|
{
|
|
static const char *const procInBlock[] = {
|
|
"FOR i=0TO 3\nSUB L\nEND SUB\nNEXT\nP",
|
|
"IF 1 THEN\nSUB A\nEND SUB\nEND IF\nA\n",
|
|
"IF 1 THEN SUB A\nA\n",
|
|
"DO\nFUNCTION F\nF = 1\nEND FUNCTION\nLOOP\nPRINT F\n",
|
|
"WHILE 0\nPUBLIC SUB A\nEND SUB\nWEND\nA\n",
|
|
"SELECT CASE 1\nCASE 1\nSUB A\nEND SUB\nEND SELECT\nA\n",
|
|
"DIM o AS Object\nWITH o\nSUB A\nEND SUB\nEND WITH\nA\n",
|
|
"FOR i = 1 TO 2\nIF i THEN\nDO\nPROPERTY GET P\nEND PROPERTY\nLOOP\nEND IF\nNEXT\nPRINT P\n",
|
|
"FOR i = 1 TO 2\nSUB A\n"
|
|
};
|
|
|
|
for (int32_t i = 0; i < (int32_t)(sizeof(procInBlock) / sizeof(procInBlock[0])); i++) {
|
|
char name[64];
|
|
|
|
snprintf(name, sizeof(name), "Procedure inside a block rejected %d", (int)i);
|
|
expectCompileError(name, procInBlock[i], "cannot be defined inside IF, FOR, DO, WHILE, SELECT CASE, or WITH");
|
|
}
|
|
}
|
|
|
|
// Named arguments of a late-bound call: the most the VM takes, each
|
|
// with the longest name, fit the names buffer; more are an error found
|
|
// before any name is copied (clang-tidy strcat triage: 17+ long names
|
|
// overflowed the buffer in an expression call)
|
|
{
|
|
static const struct {
|
|
const char *head;
|
|
const char *tail;
|
|
const char *fitName;
|
|
const char *overName;
|
|
} forms[] = {
|
|
{ "x = o.M(", ")", "Most named arguments (expression)", "Too many named arguments (expression)" },
|
|
{ "o.M ", "", "Most named arguments (statement)", "Too many named arguments (statement)" }
|
|
};
|
|
char src[TEST_NAMED_SRC_LEN];
|
|
|
|
for (int32_t f = 0; f < (int32_t)(sizeof(forms) / sizeof(forms[0])); f++) {
|
|
for (int32_t total = BAS_VM_MAX_CALL_ARGS; total <= BAS_VM_MAX_CALL_ARGS + TEST_NAMED_EXTRA; total += TEST_NAMED_EXTRA) {
|
|
int32_t len = snprintf(src, sizeof(src), "DIM o AS Object\n%s", forms[f].head);
|
|
|
|
for (int32_t i = 0; i < total; i++) {
|
|
len += snprintf(src + len, sizeof(src) - len, "%sN%02d%0*d:=1", i > 0 ? ", " : "", (int)i, TEST_NAMED_PAD, 0);
|
|
}
|
|
|
|
snprintf(src + len, sizeof(src) - len, "%s\n", forms[f].tail);
|
|
|
|
if (total > BAS_VM_MAX_CALL_ARGS) {
|
|
expectCompileError(forms[f].overName, src, "Too many arguments");
|
|
} else {
|
|
compileOnly(forms[f].fitName, src);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
// A DEF FN that stops at an error leaves no procedure scope behind
|
|
expectCompileError("DEF FN error closes its scope",
|
|
"x = 1\n"
|
|
"DEF FNa(ParamArray v()) = 1\n"
|
|
"PRINT x\n",
|
|
"ParamArray is not allowed in DEF FN"
|
|
);
|
|
|
|
// PRINT#1 / CLOSE#1 / LINE INPUT#1 with no space before '#'
|
|
runProgram("PRINT# without a space",
|
|
"OPEN \"test_hash.txt\" FOR OUTPUT AS #1\n"
|
|
"PRINT#1, \"hi\"\n"
|
|
"CLOSE#1\n"
|
|
"OPEN \"test_hash.txt\" FOR INPUT AS #1\n"
|
|
"LINE INPUT#1, a$\n"
|
|
"CLOSE#1\n"
|
|
"PRINT a$\n"
|
|
"KILL \"test_hash.txt\"\n",
|
|
"hi\n"
|
|
);
|
|
|
|
expectCompileError("Integer literal wider than 32 bits rejected",
|
|
"x = 4294967297\n",
|
|
"Integer literal out of range"
|
|
);
|
|
|
|
expectCompileError("INTEGER suffix literal out of range rejected",
|
|
"x = 70000%\n",
|
|
"INTEGER literal out of range"
|
|
);
|
|
|
|
expectCompileError("Method arguments require commas",
|
|
"ctl.Method 1 2\n",
|
|
"Expected end of statement"
|
|
);
|
|
|
|
expectCompileError("Show modal flag must be a constant",
|
|
"DIM m AS INTEGER\n"
|
|
"frm.Show m\n",
|
|
"Show modal flag must be a literal or numeric CONST"
|
|
);
|
|
|
|
expectCompileError("DECLARE mismatch rejected",
|
|
"DECLARE SUB S(a AS INTEGER)\n"
|
|
"SUB S(a AS INTEGER, b AS INTEGER)\n"
|
|
"END SUB\n",
|
|
"DECLARE for 'S' does not match its definition"
|
|
);
|
|
|
|
runProgram("DECLARE matching the definition",
|
|
"DECLARE SUB S(a AS INTEGER, b AS INTEGER)\n"
|
|
"S 1, 2\n"
|
|
"SUB S(a AS INTEGER, b AS INTEGER)\n"
|
|
" PRINT a + b\n"
|
|
"END SUB\n",
|
|
"3 \n"
|
|
);
|
|
|
|
expectCompileError("STRING * n out of range rejected",
|
|
"DIM s AS STRING * &H10005\n",
|
|
"STRING * length must be 1 to 65535"
|
|
);
|
|
|
|
expectCompileError("NEXT variable mismatch rejected",
|
|
"FOR i = 1 TO 2\n"
|
|
"FOR j = 1 TO 2\n"
|
|
"NEXT i\n"
|
|
"NEXT j\n",
|
|
"NEXT i does not match FOR j"
|
|
);
|
|
|
|
expectCompileError("CALL of a variable rejected",
|
|
"DIM v AS INTEGER\n"
|
|
"CALL v\n",
|
|
"'v' is not a SUB or FUNCTION"
|
|
);
|
|
|
|
expectCompileError("CALL without required arguments rejected",
|
|
"SUB S(a)\n"
|
|
"END SUB\n"
|
|
"CALL S\n",
|
|
"Sub 'S' expects 1 arguments, got 0"
|
|
);
|
|
|
|
runProgram("OPTIONAL padding on every call form",
|
|
"SUB S(a, OPTIONAL b$)\n"
|
|
" PRINT a; \"[\"; b$; \"]\"\n"
|
|
"END SUB\n"
|
|
"CALL S(1)\n"
|
|
"S 2, \"x\"\n"
|
|
"CALL S(3, \"y\")\n",
|
|
"1 []\n2 [x]\n3 [y]\n"
|
|
);
|
|
|
|
expectCompileError("Duplicate TYPE field rejected",
|
|
"TYPE T\n"
|
|
" x AS INTEGER\n"
|
|
" x AS STRING\n"
|
|
"END TYPE\n",
|
|
"Duplicate field 'x' in TYPE 'T'"
|
|
);
|
|
|
|
expectCompileError("DEFINT reversed range rejected",
|
|
"DEFINT Z-A\n",
|
|
"Letter range must be in ascending order"
|
|
);
|
|
|
|
expectCompileError("CR-only line endings are counted",
|
|
"PRINT 1\rPRINT 2\rPRINT )\r",
|
|
"Line 3, Col 7:"
|
|
);
|
|
|
|
expectCompileError("STATIC mangled name too long rejected",
|
|
"SUB abcdefghijabcdefghijabcdefghijabcdefghijabcdefghij\n"
|
|
" STATIC abcdefghijabcdefghijabcdefghij AS INTEGER\n"
|
|
"END SUB\n",
|
|
"STATIC name"
|
|
);
|
|
|
|
// ---- Coverage completion: lexer edges ----
|
|
|
|
expectCompileError("Unexpected character rejected",
|
|
"PRINT 1 ~\n",
|
|
"Unexpected character"
|
|
);
|
|
|
|
expectCompileError("Empty hex literal rejected",
|
|
"A = &H\n",
|
|
"Empty hexadecimal"
|
|
);
|
|
|
|
expectCompileError("Wide hex literal rejected",
|
|
"A = &H1FFFFFFFF\n",
|
|
"exceeds 32 bits"
|
|
);
|
|
|
|
runProgram("Hex, octal, binary literal forms",
|
|
"PRINT &hff\n"
|
|
"PRINT &O17\n"
|
|
"PRINT &B101\n"
|
|
"PRINT &HAB&\n",
|
|
"255 \n15 \n5 \n171 \n"
|
|
);
|
|
|
|
expectCompileError("Unterminated string literal rejected",
|
|
"A$ = \"abc\n",
|
|
"Unterminated string literal"
|
|
);
|
|
|
|
runProgram("CRLF line endings",
|
|
"PRINT 1\r\nPRINT 2\r\n",
|
|
"1 \n2 \n"
|
|
);
|
|
|
|
runProgram("Line continuation with CRLF",
|
|
"A = 1 + _\r\n2\r\nPRINT A\r\n",
|
|
"3 \n"
|
|
);
|
|
|
|
expectCompileError("Underscore without newline is not a continuation",
|
|
"A = 5 _ x\n",
|
|
"end of statement"
|
|
);
|
|
|
|
expectCompileError("Dangling exponent marker",
|
|
"B = 1E\n",
|
|
"end of statement"
|
|
);
|
|
|
|
runProgram("D exponent marker",
|
|
"PRINT 1D2\n",
|
|
"100 \n"
|
|
);
|
|
|
|
runProgram("All comparison operators",
|
|
"PRINT 1 < 2\n"
|
|
"PRINT 2 <= 2\n"
|
|
"PRINT 3 > 2\n"
|
|
"PRINT 3 >= 4\n"
|
|
"PRINT 1 = 1\n"
|
|
"PRINT 1 <> 1\n",
|
|
"True \nTrue \nTrue \nFalse \nTrue \nFalse \n"
|
|
);
|
|
|
|
// Sound, joystick and frame statements: with no host they are silent
|
|
// and read 0; argument counts are checked when compiling.
|
|
runProgram("Sound statements run silently without a host",
|
|
"BEEP\n"
|
|
"SOUND 440, 18.2\n"
|
|
"Play \"T120 L8 CDE\"\n"
|
|
"PRINT PLAY(0); STICK(0); Strig(1)\n",
|
|
"0 0 0 \n"
|
|
);
|
|
runProgramPlay("PLAY X and = with VARPTR$ (nested, spaces, numbers)",
|
|
"a$ = \"CDE\"\n"
|
|
"b$ = \"O2 X\" + VARPTR$(a$) + \" G\"\n"
|
|
"n = 180\n"
|
|
"PLAY \"T=\" + VARPTR$(n) + \"L8 X \" + VARPTR$(b$) + \"x\" + VARPTR$(a$)\n"
|
|
"PLAY \"O=\" + VARPTR$(3 + 1) + \"N=\" + VARPTR$(-2)\n"
|
|
"PLAY \"MB\"\n",
|
|
"[PLAY T180L8 O2 CDE GCDE]\n"
|
|
"[PLAY O4N-2]\n"
|
|
"[PLAY MB]\n", true);
|
|
|
|
runProgram("PLAY X and = mistakes are Illegal function call",
|
|
"ON ERROR GOTO h\n"
|
|
"PLAY \"T=\" + \"12\"\n"
|
|
"PLAY \"X\" + VARPTR$(5)\n"
|
|
"PLAY \"C\" + CHR$(0) + \"D\"\n"
|
|
"PLAY \"=\" + LEFT$(VARPTR$(1), 3)\n"
|
|
"s$ = \"C\"\n"
|
|
"FOR i = 1 TO 20\n"
|
|
" s$ = \"X\" + VARPTR$(s$)\n"
|
|
"NEXT\n"
|
|
"PLAY s$\n"
|
|
"PRINT n\n"
|
|
"END\n"
|
|
"h:\n"
|
|
"IF ERR = 5 THEN n = n + 1\n"
|
|
"RESUME NEXT\n",
|
|
"5 \n");
|
|
compileOnly("FRAMEWAIT in a game loop", "DO\n FRAMEWAIT 60\n IF STRIG(1) THEN EXIT DO\nLOOP\n");
|
|
expectCompileError("SOUND needs a duration", "SOUND 440\n", "Expected ','");
|
|
expectCompileError("PLAY as a function needs parentheses", "x = PLAY\n", "Expected '('");
|
|
expectCompileError("STICK takes one argument", "PRINT STICK(1, 2)\n", "Built-in 'STICK' expects 1-1 arguments");
|
|
expectCompileError("PLAY is a keyword", "SUB Play\nEND SUB\n", "");
|
|
|
|
testKeywordApi();
|
|
testTokenNames();
|
|
testLexerLimits();
|
|
|
|
// ---- Coverage completion: statements and declarations ----
|
|
|
|
expectCompileError("BEGINFORM without name string rejected",
|
|
"BEGINFORM 1\n",
|
|
"form name string"
|
|
);
|
|
|
|
expectCompileError("Over-long form name rejected",
|
|
"BEGINFORM \"A234567890123456789012345678901234567890123456789012345678901234567890\"\n",
|
|
"Form name too long"
|
|
);
|
|
|
|
expectCompileError("ENDFORM without BEGINFORM rejected",
|
|
"ENDFORM\n",
|
|
"ENDFORM without BEGINFORM"
|
|
);
|
|
|
|
compileOnly("Form scope ended then global lookup",
|
|
"BEGINFORM \"F1\"\n"
|
|
"DIM fv AS INTEGER\n"
|
|
"ENDFORM\n"
|
|
"FUNCTION G\n"
|
|
"G = 1\n"
|
|
"END FUNCTION\n"
|
|
"PRINT G\n"
|
|
);
|
|
|
|
compileOnly("DIM with bounds inside form init block",
|
|
"BEGINFORM \"F1\"\n"
|
|
"DIM fa(3) AS INTEGER\n"
|
|
"ENDFORM\n"
|
|
);
|
|
|
|
expectCompileError("CONST without name rejected",
|
|
"CONST 1 = 2\n",
|
|
"constant name"
|
|
);
|
|
|
|
expectCompileError("CONST of a variable rejected",
|
|
"DIM b AS INTEGER\n"
|
|
"CONST A = b\n",
|
|
"Constant expression required: 'b' is not a constant"
|
|
);
|
|
|
|
expectCompileError("Duplicate CONST rejected",
|
|
"CONST A = 1\n"
|
|
"CONST A = 2\n",
|
|
"Duplicate constant or symbol table full"
|
|
);
|
|
|
|
runProgram("CONST literal forms",
|
|
"CONST A = -5\n"
|
|
"CONST B = -2.5\n"
|
|
"CONST C = TRUE\n"
|
|
"CONST D = FALSE\n"
|
|
"CONST S$ = \"hi\"\n"
|
|
"PRINT A\n"
|
|
"PRINT B\n"
|
|
"PRINT C\n"
|
|
"PRINT D\n"
|
|
"PRINT S$\n",
|
|
"-5 \n-2.5 \nTrue \nFalse \nhi\n"
|
|
);
|
|
|
|
runProgram("DATA negatives and bare values",
|
|
"DATA -5, -2.5, -, hello, 70000, -70000\n"
|
|
"DIM a AS INTEGER\n"
|
|
"DIM b AS DOUBLE\n"
|
|
"DIM s1$\n"
|
|
"DIM s2$\n"
|
|
"DIM l1 AS LONG\n"
|
|
"DIM l2 AS LONG\n"
|
|
"READ a, b, s1$, s2$, l1, l2\n"
|
|
"PRINT a\n"
|
|
"PRINT s1$\n"
|
|
"PRINT s2$\n"
|
|
"PRINT l1\n",
|
|
"-5 \n-\nhello\n70000 \n"
|
|
);
|
|
|
|
expectCompileError("Bad DATA value rejected",
|
|
"DATA 1,\n",
|
|
"Expected DATA value"
|
|
);
|
|
|
|
expectCompileError("READ into CONST rejected",
|
|
"CONST K = 1\n"
|
|
"DATA 2\n"
|
|
"READ K\n",
|
|
"Cannot assign to a constant"
|
|
);
|
|
|
|
expectCompileError("FOR over a SUB name rejected",
|
|
"SUB S\n"
|
|
"END SUB\n"
|
|
"FOR S = 1 TO 2\n"
|
|
"NEXT\n",
|
|
"Cannot assign to 'S'"
|
|
);
|
|
|
|
expectCompileError("DECLARE of something else rejected",
|
|
"DECLARE PRINT\n",
|
|
"Expected SUB, FUNCTION, or LIBRARY after DECLARE"
|
|
);
|
|
|
|
expectCompileError("DECLARE without name rejected",
|
|
"DECLARE SUB 1\n",
|
|
"subroutine/function name"
|
|
);
|
|
|
|
expectCompileError("DECLARE clashing with a variable rejected",
|
|
"DIM X AS INTEGER\n"
|
|
"DECLARE SUB X ()\n",
|
|
"already declared"
|
|
);
|
|
|
|
expectCompileError("DECLARE LIBRARY without name string rejected",
|
|
"DECLARE LIBRARY 1\n",
|
|
"library name string"
|
|
);
|
|
|
|
expectCompileError("Statement inside DECLARE LIBRARY rejected",
|
|
"DECLARE LIBRARY \"foo\"\n"
|
|
"PRINT 1\n"
|
|
"END DECLARE\n",
|
|
"Expected DECLARE or END DECLARE"
|
|
);
|
|
|
|
expectCompileError("DECLARE of non-proc inside LIBRARY block rejected",
|
|
"DECLARE LIBRARY \"foo\"\n"
|
|
"DECLARE PRINT\n"
|
|
"END DECLARE\n",
|
|
"Expected SUB or FUNCTION in DECLARE LIBRARY block"
|
|
);
|
|
|
|
expectCompileError("Library DECLARE without name rejected",
|
|
"DECLARE LIBRARY \"foo\"\n"
|
|
"DECLARE SUB 1\n"
|
|
"END DECLARE\n",
|
|
"function name"
|
|
);
|
|
|
|
expectCompileError("END of wrong block inside DECLARE LIBRARY rejected",
|
|
"DECLARE LIBRARY \"foo\"\n"
|
|
"END IF\n",
|
|
"Expected DECLARE after END in DECLARE LIBRARY block"
|
|
);
|
|
|
|
expectCompileError("Library function clashing with a variable rejected",
|
|
"DIM Q AS INTEGER\n"
|
|
"DECLARE LIBRARY \"foo\"\n"
|
|
"DECLARE SUB Q ()\n"
|
|
"END DECLARE\n",
|
|
"already declared"
|
|
);
|
|
|
|
compileOnly("DECLARE LIBRARY block",
|
|
"DECLARE LIBRARY \"dvx\"\n"
|
|
"DECLARE SUB DoBeep ()\n"
|
|
"DECLARE FUNCTION AddUp% (a AS INTEGER, b AS INTEGER)\n"
|
|
"END DECLARE\n"
|
|
);
|
|
|
|
expectCompileError("DEF without FN name rejected",
|
|
"DEF 1\n",
|
|
"function name (FNname)"
|
|
);
|
|
|
|
expectCompileError("DEF name without FN prefix rejected",
|
|
"DEF Foo(x) = x\n",
|
|
"DEF function name must start with FN"
|
|
);
|
|
|
|
expectCompileError("DEF clashing with a variable rejected",
|
|
"DIM FNA AS INTEGER\n"
|
|
"DEF FNA(x) = x\n",
|
|
"already in use"
|
|
);
|
|
|
|
runProgram("DEF FN definition and call",
|
|
"DEF FNDouble(x) = x * 2\n"
|
|
"PRINT FNDouble(4)\n",
|
|
"8 \n"
|
|
);
|
|
|
|
expectCompileError("DEFINT without letter rejected",
|
|
"DEFINT 1\n",
|
|
"letter or letter range"
|
|
);
|
|
|
|
expectCompileError("DEFINT multi-letter token rejected",
|
|
"DEFINT _x\n",
|
|
"Expected letter A-Z"
|
|
);
|
|
|
|
expectCompileError("DEFINT dangling dash rejected",
|
|
"DEFINT A-\n",
|
|
"letter after '-'"
|
|
);
|
|
|
|
expectCompileError("DEFINT bad range end rejected",
|
|
"DEFINT A-_y\n",
|
|
"Expected letter A-Z"
|
|
);
|
|
|
|
expectCompileError("Duplicate DIM rejected",
|
|
"DIM X AS INTEGER\n"
|
|
"DIM X AS INTEGER\n",
|
|
"already declared"
|
|
);
|
|
|
|
expectCompileError("DIM clashing with a SUB rejected",
|
|
"SUB S\n"
|
|
"END SUB\n"
|
|
"DIM S AS INTEGER\n",
|
|
"already declared"
|
|
);
|
|
|
|
expectCompileError("ERASE of a non-identifier rejected",
|
|
"ERASE 1\n",
|
|
"array variable name"
|
|
);
|
|
|
|
expectCompileError("ERASE of a scalar rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"ERASE x\n",
|
|
"ERASE requires an array variable"
|
|
);
|
|
|
|
runProgram("ERASE static and dynamic arrays",
|
|
"DIM a(3) AS INTEGER\n"
|
|
"a(1) = 5\n"
|
|
"ERASE a\n"
|
|
"PRINT a(1)\n"
|
|
"DIM d() AS INTEGER\n"
|
|
"REDIM d(5)\n"
|
|
"ERASE d\n"
|
|
"PRINT \"ok\"\n",
|
|
"0 \nok\n"
|
|
);
|
|
|
|
expectCompileError("EXIT FUNCTION inside SUB rejected",
|
|
"SUB S\n"
|
|
"EXIT FUNCTION\n"
|
|
"END SUB\n",
|
|
"EXIT FUNCTION outside FUNCTION"
|
|
);
|
|
|
|
expectCompileError("EXIT of a non-loop rejected",
|
|
"EXIT PRINT\n",
|
|
"Expected FOR, DO, SUB, FUNCTION, or PROPERTY after EXIT"
|
|
);
|
|
|
|
compileOnly("GET and PUT of a whole UDT record",
|
|
"TYPE T\n"
|
|
"x AS INTEGER\n"
|
|
"s AS STRING * 8\n"
|
|
"END TYPE\n"
|
|
"DIM v AS T\n"
|
|
"GET #1, , v\n"
|
|
"PUT #1, , v\n"
|
|
);
|
|
|
|
expectCompileError("UDT store of unknown field rejected",
|
|
"TYPE T\n"
|
|
"x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM v AS T\n"
|
|
"v.zz = 1\n",
|
|
"Unknown field 'zz' in TYPE 'T'"
|
|
);
|
|
|
|
expectCompileError("UDT field without assignment rejected",
|
|
"TYPE T\n"
|
|
"x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"DIM v AS T\n"
|
|
"v.x 5\n",
|
|
"Expected '='"
|
|
);
|
|
|
|
expectCompileError("Nested UDT field without assignment rejected",
|
|
"TYPE Inner\n"
|
|
"x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"TYPE Outer\n"
|
|
"i AS Inner\n"
|
|
"END TYPE\n"
|
|
"DIM v AS Outer\n"
|
|
"v.i.x 5\n",
|
|
"Expected '='"
|
|
);
|
|
|
|
expectCompileError("STRING * with non-integer rejected",
|
|
"DIM A AS STRING * X\n",
|
|
"Expected integer after STRING *"
|
|
);
|
|
|
|
expectCompileError("FOR without loop variable rejected",
|
|
"FOR 1 = 1 TO 2\n"
|
|
"NEXT\n",
|
|
"loop variable"
|
|
);
|
|
|
|
expectCompileError("FUNCTION without name rejected",
|
|
"FUNCTION 1\n",
|
|
"function name"
|
|
);
|
|
|
|
expectCompileError("FUNCTION inside SUB rejected",
|
|
"SUB S\n"
|
|
"FUNCTION F\n"
|
|
"END FUNCTION\n"
|
|
"END SUB\n",
|
|
"FUNCTION cannot be defined inside SUB or FUNCTION"
|
|
);
|
|
|
|
expectCompileError("FUNCTION with bad parameter rejected",
|
|
"FUNCTION F(1)\n"
|
|
"END FUNCTION\n",
|
|
"parameter name"
|
|
);
|
|
|
|
expectCompileError("Duplicate FUNCTION body rejected",
|
|
"FUNCTION F\n"
|
|
"F = 1\n"
|
|
"END FUNCTION\n"
|
|
"FUNCTION F\n"
|
|
"END FUNCTION\n",
|
|
"Function 'F' is already defined"
|
|
);
|
|
|
|
compileOnly("END statement inside FUNCTION body",
|
|
"DECLARE FUNCTION F ()\n"
|
|
"PRINT F\n"
|
|
"FUNCTION F\n"
|
|
"IF 1 = 2 THEN\n"
|
|
"END\n"
|
|
"END IF\n"
|
|
"F = 3\n"
|
|
"END FUNCTION\n"
|
|
);
|
|
|
|
expectCompileError("GOSUB to a missing line number rejected",
|
|
"GOSUB 1\n",
|
|
"Label not defined: 1"
|
|
);
|
|
|
|
expectCompileError("GOTO to a missing line number rejected",
|
|
"GOTO 1\n",
|
|
"Label not defined: 1"
|
|
);
|
|
|
|
expectCompileError("IF without END IF rejected",
|
|
"IF 1 = 1 THEN\n"
|
|
"PRINT 1\n",
|
|
"Expected END IF"
|
|
);
|
|
|
|
expectCompileError("ELSEIF chain without END IF rejected",
|
|
"IF 1 = 1 THEN\n"
|
|
"PRINT 1\n"
|
|
"ELSEIF 2 = 2 THEN\n"
|
|
"PRINT 2\n",
|
|
"Expected END IF"
|
|
);
|
|
|
|
compileOnly("IF branches containing END",
|
|
"DIM a AS INTEGER\n"
|
|
"IF a = 1 THEN\n"
|
|
"END\n"
|
|
"ELSEIF a = 2 THEN\n"
|
|
"END\n"
|
|
"ELSE\n"
|
|
"END\n"
|
|
"END IF\n"
|
|
);
|
|
|
|
expectCompileError("INPUT into a non-variable rejected",
|
|
"INPUT 1\n",
|
|
"variable name"
|
|
);
|
|
|
|
expectCompileError("INPUT # into a non-variable rejected",
|
|
"INPUT #1, 1\n",
|
|
"variable name"
|
|
);
|
|
|
|
compileOnly("INPUT prompt and file forms",
|
|
"DIM v$\n"
|
|
"DIM w$\n"
|
|
"INPUT \"prompt\"; v$\n"
|
|
"INPUT \"prompt\", v$\n"
|
|
"INPUT v$\n"
|
|
"INPUT #1, v$, w$\n"
|
|
);
|
|
|
|
expectCompileError("LINE without INPUT or a point rejected",
|
|
"LINE PRINT\n",
|
|
"Expected '-'"
|
|
);
|
|
|
|
compileOnly("LINE INPUT without a channel reads the console",
|
|
"DIM v$\n"
|
|
"LINE INPUT v$\n"
|
|
);
|
|
|
|
expectCompileError("LINE INPUT into a non-variable rejected",
|
|
"LINE INPUT #1, 1\n",
|
|
"variable name"
|
|
);
|
|
|
|
expectCompileError("ON expression without GOTO or GOSUB rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"ON x PRINT\n",
|
|
"Expected GOTO or GOSUB after ON expression"
|
|
);
|
|
|
|
expectCompileError("ON GOTO with bad label rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"ON x GOTO 1\n",
|
|
"Label not defined: 1"
|
|
);
|
|
|
|
expectCompileError("ON GOSUB with bad second label rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"ON x GOSUB a, 1\n"
|
|
"a:\n"
|
|
"RETURN\n",
|
|
"Label not defined: 1"
|
|
);
|
|
|
|
runProgram("ON GOTO dispatch",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 2\n"
|
|
"ON x GOTO a, b\n"
|
|
"a:\n"
|
|
"PRINT \"a\"\n"
|
|
"END\n"
|
|
"b:\n"
|
|
"PRINT \"b\"\n"
|
|
"END\n",
|
|
"b\n"
|
|
);
|
|
|
|
expectCompileError("ON ERROR without GOTO rejected",
|
|
"ON ERROR PRINT\n",
|
|
"Expected GOTO or RESUME NEXT after ON ERROR"
|
|
);
|
|
|
|
expectCompileError("ON ERROR GOTO of non-label rejected",
|
|
"ON ERROR GOTO \"x\"\n",
|
|
"label name or line number"
|
|
);
|
|
|
|
compileOnly("ON ERROR GOTO 0",
|
|
"ON ERROR GOTO 0\n"
|
|
);
|
|
|
|
runProgram("ON ERROR GOTO backward label",
|
|
"GOTO start\n"
|
|
"h:\n"
|
|
"PRINT \"handled\"\n"
|
|
"RESUME NEXT\n"
|
|
"start:\n"
|
|
"ON ERROR GOTO h\n"
|
|
"DIM a AS INTEGER\n"
|
|
"a = 1 \\ 0\n"
|
|
"PRINT \"end\"\n",
|
|
"handled\nend\n"
|
|
);
|
|
|
|
compileOnly("OPEN mode variants",
|
|
"OPEN \"f\" FOR OUTPUT AS #1\n"
|
|
"OPEN \"g\" FOR APPEND AS #2\n"
|
|
"OPEN \"h\" FOR RANDOM AS #3 LEN = 32\n"
|
|
"OPEN \"i\" FOR BINARY AS #4\n"
|
|
"OPEN \"j\" FOR INPUT AS #5\n"
|
|
);
|
|
|
|
expectCompileError("OPEN with bad mode rejected",
|
|
"OPEN \"f\" FOR PRINT AS #1\n",
|
|
"Expected INPUT, OUTPUT, APPEND, RANDOM, or BINARY after FOR"
|
|
);
|
|
|
|
expectCompileError("OPTION BASE without literal rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"OPTION BASE x\n",
|
|
"Expected 0 or 1 after OPTION BASE"
|
|
);
|
|
|
|
expectCompileError("OPTION BASE out of range rejected",
|
|
"OPTION BASE 2\n",
|
|
"OPTION BASE must be 0 or 1"
|
|
);
|
|
|
|
expectCompileError("OPTION COMPARE with bad mode rejected",
|
|
"OPTION COMPARE FOO\n",
|
|
"Expected BINARY or TEXT after OPTION COMPARE"
|
|
);
|
|
|
|
expectCompileError("OPTION with bad selector rejected",
|
|
"OPTION FOO\n",
|
|
"Expected BASE, COMPARE, or EXPLICIT after OPTION"
|
|
);
|
|
|
|
runProgram("OPTION COMPARE BINARY is case sensitive",
|
|
"OPTION COMPARE BINARY\n"
|
|
"PRINT \"a\" = \"A\"\n",
|
|
"False \n"
|
|
);
|
|
|
|
expectCompileError("Required parameter after OPTIONAL rejected",
|
|
"SUB S(OPTIONAL a, b)\n"
|
|
"END SUB\n",
|
|
"Required parameter cannot follow Optional parameter"
|
|
);
|
|
|
|
expectCompileError("Non-identifier parameter rejected",
|
|
"SUB S(1)\n"
|
|
"END SUB\n",
|
|
"parameter name"
|
|
);
|
|
|
|
expectCompileError("Duplicate parameter rejected",
|
|
"SUB S(a, a)\n"
|
|
"END SUB\n",
|
|
"Duplicate parameter name 'a'"
|
|
);
|
|
|
|
expectCompileError("Unknown App member rejected",
|
|
"PRINT App.Foo\n",
|
|
"Expected 'Path', 'User', or 'Data' after 'App.'"
|
|
);
|
|
|
|
compileOnly("App path members",
|
|
"DIM p$\n"
|
|
"p$ = App.Path\n"
|
|
"p$ = App.User\n"
|
|
"p$ = App.Data\n"
|
|
);
|
|
|
|
expectCompileError("SEEK function without parentheses rejected",
|
|
"DIM x AS LONG\n"
|
|
"x = SEEK\n",
|
|
"SEEK requires parentheses when used as a function"
|
|
);
|
|
|
|
compileOnly("Dir function forms",
|
|
"DIM s$\n"
|
|
"s$ = Dir$(\"*.x\")\n"
|
|
"s$ = Dir$()\n"
|
|
"s$ = Dir$\n"
|
|
);
|
|
|
|
compileOnly("InputBox expression defaults",
|
|
"DIM s$\n"
|
|
"s$ = InputBox$(\"p\")\n"
|
|
"s$ = InputBox$(\"p\", \"t\")\n"
|
|
"s$ = InputBox$(\"p\", \"t\", \"d\")\n"
|
|
);
|
|
|
|
expectCompileError("LBOUND with non-constant dimension rejected",
|
|
"DIM a(5) AS INTEGER\n"
|
|
"DIM d AS INTEGER\n"
|
|
"PRINT LBOUND(a, d)\n",
|
|
"LBOUND dimension must be a constant integer"
|
|
);
|
|
|
|
expectCompileError("UBOUND with non-constant dimension rejected",
|
|
"DIM a(5) AS INTEGER\n"
|
|
"DIM d AS INTEGER\n"
|
|
"PRINT UBOUND(a, d)\n",
|
|
"UBOUND dimension must be a constant integer"
|
|
);
|
|
|
|
expectCompileError("Builtin arity rejected",
|
|
"DIM s$\n"
|
|
"s$ = LEFT$(\"x\")\n",
|
|
"arguments, got 1"
|
|
);
|
|
|
|
compileOnly("Control array expression read",
|
|
"X = Text1(2).Caption\n"
|
|
);
|
|
|
|
runProgram("Forward function call resolved later",
|
|
"X = Sq(3)\n"
|
|
"PRINT X\n"
|
|
"DIM A(5)\n"
|
|
"A(1) = X\n"
|
|
"PRINT A(1)\n"
|
|
"FUNCTION Sq(n AS INTEGER) AS INTEGER\n"
|
|
"Sq = n * n\n"
|
|
"END FUNCTION\n",
|
|
"9 \n9 \n"
|
|
);
|
|
|
|
runProgram("EXIT FOR pending across DIM with bounds",
|
|
"DIM i AS INTEGER\n"
|
|
"FOR i = 1 TO 3\n"
|
|
"IF i = 2 THEN EXIT FOR\n"
|
|
"DIM B(4)\n"
|
|
"B(0) = i\n"
|
|
"NEXT i\n"
|
|
"PRINT i\n",
|
|
"2 \n"
|
|
);
|
|
|
|
expectCompileError("Member of expression variable rejected",
|
|
"DIM v AS INTEGER\n"
|
|
"X = v.(\n",
|
|
"property or method name"
|
|
);
|
|
|
|
compileOnly("Variable object property read",
|
|
"DIM v AS INTEGER\n"
|
|
"X = v.Caption\n"
|
|
);
|
|
|
|
compileOnly("PRINT # trailing separators",
|
|
"PRINT #1, \"a\";\n"
|
|
"PRINT #1, \"b\",\n"
|
|
"PRINT #1, \"c\"\n"
|
|
);
|
|
|
|
compileOnly("PUT with expression payload",
|
|
"PUT #1, , 1 + 2\n"
|
|
);
|
|
|
|
expectCompileError("GET into a non-variable rejected",
|
|
"GET #1, , 1\n",
|
|
"variable name"
|
|
);
|
|
|
|
expectCompileError("REDIM of a non-identifier rejected",
|
|
"REDIM 1\n",
|
|
"array variable name"
|
|
);
|
|
|
|
expectCompileError("REDIM of a SUB rejected",
|
|
"SUB S\n"
|
|
"END SUB\n"
|
|
"REDIM S(5)\n",
|
|
"'S' is not a variable"
|
|
);
|
|
|
|
expectCompileError("SELECT body without CASE rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"SELECT CASE x\n"
|
|
"PRINT 1\n"
|
|
"END SELECT\n",
|
|
"Expected CASE or END SELECT"
|
|
);
|
|
|
|
runProgram("CASE IS operator forms",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 5\n"
|
|
"SELECT CASE x\n"
|
|
"CASE IS > 4\n"
|
|
"PRINT \"gt\"\n"
|
|
"END SELECT\n"
|
|
"SELECT CASE x\n"
|
|
"CASE IS <= 5\n"
|
|
"PRINT \"le\"\n"
|
|
"END SELECT\n"
|
|
"SELECT CASE x\n"
|
|
"CASE IS >= 5\n"
|
|
"PRINT \"ge\"\n"
|
|
"END SELECT\n"
|
|
"SELECT CASE x\n"
|
|
"CASE IS = 5\n"
|
|
"PRINT \"eq\"\n"
|
|
"END SELECT\n"
|
|
"SELECT CASE x\n"
|
|
"CASE IS <> 4\n"
|
|
"PRINT \"ne\"\n"
|
|
"END SELECT\n",
|
|
"gt\nle\nge\neq\nne\n"
|
|
);
|
|
|
|
expectCompileError("CASE IS without operator rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"SELECT CASE x\n"
|
|
"CASE IS PRINT\n"
|
|
"END SELECT\n",
|
|
"Expected comparison operator after IS"
|
|
);
|
|
|
|
compileOnly("SELECT bodies containing END",
|
|
"DIM x AS INTEGER\n"
|
|
"SELECT CASE x\n"
|
|
"CASE 1\n"
|
|
"END\n"
|
|
"CASE ELSE\n"
|
|
"END\n"
|
|
"END SELECT\n"
|
|
);
|
|
|
|
expectCompileError("SELECT without END SELECT rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"SELECT CASE x\n"
|
|
"CASE 1\n"
|
|
"PRINT 1\n",
|
|
"Expected END SELECT"
|
|
);
|
|
|
|
runProgram("GOTO out of SELECT CASE",
|
|
"DIM x AS INTEGER\n"
|
|
"x = 1\n"
|
|
"SELECT CASE x\n"
|
|
"CASE 1\n"
|
|
"GOTO done\n"
|
|
"CASE 2\n"
|
|
"PRINT \"no\"\n"
|
|
"END SELECT\n"
|
|
"PRINT \"skipped\"\n"
|
|
"done:\n"
|
|
"PRINT \"d\"\n",
|
|
"d\n"
|
|
);
|
|
|
|
compileOnly("Show modal variants",
|
|
"CONST M = 1\n"
|
|
"Form1.Show\n"
|
|
"Form1.Show 1\n"
|
|
"Form1.Show TRUE\n"
|
|
"Form1.Show FALSE\n"
|
|
"Form1.Show M\n"
|
|
);
|
|
|
|
runProgram("RANDOMIZE forms",
|
|
"RANDOMIZE TIMER\n"
|
|
"RANDOMIZE 42\n"
|
|
"PRINT \"ok\"\n",
|
|
"ok\n"
|
|
);
|
|
|
|
compileOnly("CreateForm statement",
|
|
"CREATEFORM(\"F\", 100, 100)\n"
|
|
);
|
|
|
|
compileOnly("Object statement forms",
|
|
"DIM v AS INTEGER\n"
|
|
"SET v = Nothing\n"
|
|
"Load Form1\n"
|
|
"Unload Form1\n"
|
|
"Unload Me\n"
|
|
"InputBox$ \"p\"\n"
|
|
"InputBox$ \"p\", \"t\"\n"
|
|
"InputBox$ \"p\", \"t\", \"d\"\n"
|
|
);
|
|
|
|
expectCompileError("SET of a non-variable rejected",
|
|
"SET 1 = 2\n",
|
|
"variable name"
|
|
);
|
|
|
|
expectCompileError("Load of a non-identifier rejected",
|
|
"Load 1\n",
|
|
"form name"
|
|
);
|
|
|
|
expectCompileError("Unload of a non-identifier rejected",
|
|
"Unload 1\n",
|
|
"form name"
|
|
);
|
|
|
|
compileOnly("Me statement forms",
|
|
"Me.Show\n"
|
|
"Me.Show 1\n"
|
|
"Me.Hide\n"
|
|
"Me.Caption = \"x\"\n"
|
|
"Me.Text1.Text = \"y\"\n"
|
|
"Me.Text1(1).Text = \"z\"\n"
|
|
"Me.Refresh\n"
|
|
);
|
|
|
|
expectCompileError("Me without dot rejected",
|
|
"Me PRINT\n",
|
|
"'.' after Me"
|
|
);
|
|
|
|
expectCompileError("Me without dot after Me rejected",
|
|
"Me.5\n",
|
|
"'.' after Me"
|
|
);
|
|
|
|
expectCompileError("Me with bad member rejected",
|
|
"Me.(\n",
|
|
"property or method name"
|
|
);
|
|
|
|
expectCompileError("Me control array with bad property rejected",
|
|
"Me.C1(1).( = 1\n",
|
|
"property or method name"
|
|
);
|
|
|
|
runProgram("LET assignment",
|
|
"LET X = 5\n"
|
|
"PRINT X\n",
|
|
"5 \n"
|
|
);
|
|
|
|
expectCompileError("LET of a non-variable rejected",
|
|
"LET 1 = 2\n",
|
|
"variable name after LET"
|
|
);
|
|
|
|
expectCompileError("Label reusing a SUB name rejected",
|
|
"SUB foo\n"
|
|
"END SUB\n"
|
|
"foo:\n"
|
|
"PRINT 1\n",
|
|
"cannot be used as a label"
|
|
);
|
|
|
|
runProgram("REM statement",
|
|
"REM this is a comment\n"
|
|
"PRINT 2\n",
|
|
"2 \n"
|
|
);
|
|
|
|
expectCompileError("Stray token rejected",
|
|
"PRINT 1\n"
|
|
")\n",
|
|
"Unexpected token"
|
|
);
|
|
|
|
expectCompileError("STATIC at module level rejected",
|
|
"STATIC x AS INTEGER\n",
|
|
"STATIC is only valid inside SUB or FUNCTION"
|
|
);
|
|
|
|
expectCompileError("STATIC without name rejected",
|
|
"SUB S\n"
|
|
"STATIC 1\n"
|
|
"END SUB\n",
|
|
"variable name"
|
|
);
|
|
|
|
expectCompileError("STATIC New rejected",
|
|
"TYPE T\n"
|
|
"x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"SUB S\n"
|
|
"STATIC v AS New Collection\n"
|
|
"END SUB\n",
|
|
"STATIC 'v': New and WithEvents are not supported"
|
|
);
|
|
|
|
expectCompileError("Duplicate STATIC rejected",
|
|
"SUB S\n"
|
|
"STATIC x AS INTEGER\n"
|
|
"STATIC x AS INTEGER\n"
|
|
"END SUB\n",
|
|
"Symbol table full or duplicate STATIC variable"
|
|
);
|
|
|
|
expectCompileError("STATIC shadowing a local rejected",
|
|
"SUB S\n"
|
|
"DIM x AS INTEGER\n"
|
|
"STATIC x AS INTEGER\n"
|
|
"END SUB\n",
|
|
"Symbol table full or duplicate variable name"
|
|
);
|
|
|
|
expectCompileError("SUB without name rejected",
|
|
"SUB 1\n",
|
|
"subroutine name"
|
|
);
|
|
|
|
expectCompileError("SUB clashing with a variable rejected",
|
|
"DIM S AS INTEGER\n"
|
|
"SUB S\n"
|
|
"END SUB\n",
|
|
"already declared"
|
|
);
|
|
|
|
expectCompileError("SWAP of a non-variable rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"SWAP 1 + (2), x\n",
|
|
"variable name"
|
|
);
|
|
|
|
expectCompileError("SWAP indexing a scalar rejected",
|
|
"DIM x AS INTEGER\n"
|
|
"DIM y AS INTEGER\n"
|
|
"SWAP x(1), y\n",
|
|
"not an array"
|
|
);
|
|
|
|
runProgram("SWAP of array elements",
|
|
"DIM a(3) AS INTEGER\n"
|
|
"DIM b(3) AS INTEGER\n"
|
|
"a(1) = 5\n"
|
|
"b(2) = 9\n"
|
|
"SWAP a(1), b(2)\n"
|
|
"PRINT a(1)\n"
|
|
"PRINT b(2)\n",
|
|
"9 \n5 \n"
|
|
);
|
|
|
|
expectCompileError("TYPE without name rejected",
|
|
"TYPE 1\n",
|
|
"type name"
|
|
);
|
|
|
|
expectCompileError("Duplicate TYPE rejected",
|
|
"TYPE T\n"
|
|
"x AS INTEGER\n"
|
|
"END TYPE\n"
|
|
"TYPE T\n"
|
|
"y AS INTEGER\n"
|
|
"END TYPE\n",
|
|
"Symbol table full or duplicate TYPE name"
|
|
);
|
|
|
|
expectCompileError("TYPE with bad field line rejected",
|
|
"TYPE T\n"
|
|
"1\n"
|
|
"END TYPE\n",
|
|
"field name or END TYPE"
|
|
);
|
|
|
|
expectCompileError("Error inside WHILE body surfaces",
|
|
"WHILE 1\n"
|
|
"PRINT )\n"
|
|
"WEND\n",
|
|
"Line"
|
|
);
|
|
|
|
expectCompileError("WRITE without channel rejected",
|
|
"WRITE 1\n",
|
|
"Expected # after WRITE"
|
|
);
|
|
|
|
runProgram("BOOLEAN variable",
|
|
"DIM b AS BOOLEAN\n"
|
|
"b = TRUE\n"
|
|
"PRINT b\n",
|
|
"True \n"
|
|
);
|
|
|
|
expectCompileError("Unknown type name rejected",
|
|
"DIM q AS Bogus\n",
|
|
"Expected type name"
|
|
);
|
|
|
|
expectCompileError("Assignment to variable without operator rejected",
|
|
"DIM X AS INTEGER\n"
|
|
"X 5\n",
|
|
"'=' or '('"
|
|
);
|
|
|
|
expectCompileError("Two statements without separator rejected",
|
|
"A = 1 B = 2\n",
|
|
"end of statement"
|
|
);
|
|
|
|
expectCompileError("MID$ statement on a non-variable rejected",
|
|
"MID$(1, 1) = \"x\"\n",
|
|
"string variable name"
|
|
);
|
|
|
|
runProgram("MID$ statement default length",
|
|
"DIM s$\n"
|
|
"s$ = \"hello\"\n"
|
|
"MID$(s$, 2) = \"EL\"\n"
|
|
"PRINT s$\n",
|
|
"hELlo\n"
|
|
);
|
|
|
|
expectCompileError("Member store with bad name rejected",
|
|
"Abc.( = 1\n",
|
|
"property or method name"
|
|
);
|
|
|
|
expectCompileError("Three-part member store with bad name rejected",
|
|
"F1.C1.( = 1\n",
|
|
"property or method name"
|
|
);
|
|
|
|
compileOnly("Var-held form control property store",
|
|
"DIM v AS INTEGER\n"
|
|
"v.C1.Text = \"x\"\n"
|
|
);
|
|
|
|
compileOnly("Method statement forms",
|
|
"DIM v AS INTEGER\n"
|
|
"v.DoThing\n"
|
|
"F1.C1.AddItem \"x\"\n"
|
|
"C1(2).Text = \"x\"\n"
|
|
"C1(3).DoIt\n"
|
|
);
|
|
|
|
// ---- Coverage completion: control validator hooks ----
|
|
|
|
expectValidatorParse("Validator accepts known property",
|
|
"Text1.Text = \"x\"\n",
|
|
NULL
|
|
);
|
|
|
|
expectValidatorParse("Validator rejects property store",
|
|
"Text1.BadProp = 1\n",
|
|
"Unknown property 'Text1.BadProp'"
|
|
);
|
|
|
|
expectValidatorParse("Validator rejects method statement",
|
|
"Text1.BadMethod\n",
|
|
"Unknown method 'Text1.BadMethod'"
|
|
);
|
|
|
|
expectValidatorParse("Validator rejects property read",
|
|
"X = Text1.BadProp\n",
|
|
"Unknown property 'Text1.BadProp'"
|
|
);
|
|
|
|
expectValidatorParse("Validator rejects method call expression",
|
|
"X = Text1.BadMethod(1)\n",
|
|
"Unknown method 'Text1.BadMethod'"
|
|
);
|
|
|
|
expectValidatorParse("Validator checks a control on its own form",
|
|
"BEGINFORM \"F1\"\nSUB S\n Lbl2.BadProp = 1\nEND SUB\nENDFORM\n",
|
|
"Unknown property 'Lbl2.BadProp'"
|
|
);
|
|
|
|
expectValidatorParse("Validator skips a control of another form",
|
|
"BEGINFORM \"F2\"\nSUB S\n Lbl2.BadProp = 1\nEND SUB\nENDFORM\n",
|
|
NULL
|
|
);
|
|
|
|
testCompilerFixes();
|
|
testCompilerLimits();
|
|
testFrontEnd();
|
|
testGapClosure();
|
|
testConsoleGraphics();
|
|
testConstEnumParamArray();
|
|
testEarlyBinding();
|
|
testEventsAndInterfaces();
|
|
testFastLoop();
|
|
testFollowUp();
|
|
testClassWithEvents();
|
|
testMissingAndValues();
|
|
testParamArrayByRef();
|
|
testParamDefaults();
|
|
testReferences();
|
|
testObjectsAndVariants();
|
|
testScreenModesPages();
|
|
testStringsAndDates();
|
|
testUserControl();
|
|
|
|
printf("All tests complete. Failures: %d\n", (int)gFailCount);
|
|
return gFailCount > 0 ? 1 : 0;
|
|
}
|