akbasic/tests/runtime_evaluate.c

/**
 * @file runtime_evaluate.c
 * @brief Tests the evaluator against hand-built and hand-parsed trees.
 */

#include "harness.h"

/* Parse an expression-bearing line and evaluate what it produced. */
static akerr_ErrorContext AKERR_NOIGNORE *eval_line(const char *line, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *leaf = NULL;

    PASS(errctx, akbasic_environment_zero(HARNESS_RUNTIME.environment));
    PASS(errctx, harness_parse(line, &leaf));
    PASS(errctx, akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, dest));
    SUCCEED_RETURN(errctx);
}

static void expect_int(const char *line, int64_t want)
{
    akbasic_Value *out = NULL;
    akerr_ErrorContext *e = eval_line(line, &out);

    if ( e != NULL ) {
	fprintf(stderr, "FAIL: \"%s\": %s\n", line, e->message);
	akbasic_test_failures += 1;
	test_discard_error(e);
	return;
    }
    TEST_REQUIRE(out->valuetype == AKBASIC_TYPE_INTEGER,
		 "\"%s\" produced type %d, expected integer", line, (int)out->valuetype);
    TEST_REQUIRE(out->intval == want,
		 "\"%s\" produced %lld, expected %lld",
		 line, (long long)out->intval, (long long)want);
}

static void expect_bool(const char *line, bool want)
{
    akbasic_Value *out = NULL;
    akerr_ErrorContext *e = eval_line(line, &out);

    if ( e != NULL ) {
	fprintf(stderr, "FAIL: \"%s\": %s\n", line, e->message);
	akbasic_test_failures += 1;
	test_discard_error(e);
	return;
    }
    TEST_REQUIRE(akbasic_value_is_true(out) == want,
		 "\"%s\" expected %s", line, (want ? "true" : "false"));
}

int main(void)
{
    akbasic_Value *out = NULL;
    akerr_ErrorContext *e = NULL;

    TEST_REQUIRE_OK(harness_start(NULL));

    /* Literals and arithmetic. */
    expect_int("A# = 42", 42);
    expect_int("A# = 1 + 2 * 3", 7);
    expect_int("A# = (1 + 2) * 3", 9);
    expect_int("A# = -5 + 10", 5);
    expect_int("A# = 8 / 2", 4);

    /* Identifiers read back what was assigned. */
    expect_int("A# = 7", 7);
    expect_int("B# = A# + 1", 8);

    /*
     * Comparisons yield BASIC booleans. They are evaluated bare rather than
     * assigned: assign() accepts only INTEGER or FLOAT into a `#` variable, so
     * `A# = 1 == 1` is "Incompatible types in variable assignment" -- which is
     * also why IF works on the comparison directly and never through a variable.
     *
     * They are wrapped in parens because a bare leading integer in token
     * position 0 is consumed as a *line number*, not as a literal.
     */
    expect_bool("(1 == 1)", true);
    expect_bool("(1 == 2)", false);
    expect_bool("(2 > 1)", true);
    expect_bool("(1 <> 2)", true);
    TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
    TEST_REQUIRE_STATUS(eval_line("A# = 1 == 1", &out), AKBASIC_ERR_TYPE);

    /* Bitwise operators. */
    expect_int("A# = 12 AND 10", 8);
    expect_int("A# = 12 OR 10", 14);

    /* Arrays: assign through a subscript and read it back. */
    {
	akbasic_ASTLeaf *leaf = NULL;
	TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
	TEST_REQUIRE_OK(harness_parse("DIM C#(4)", &leaf));
	TEST_REQUIRE_OK(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out));
    }
    expect_int("C#(2) = 99", 99);
    expect_int("D# = C#(2)", 99);
    expect_int("D# = C#(0)", 0);

    /* An out-of-bounds subscript raises with the reference's message. */
    TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
    e = eval_line("D# = C#(9)", &out);
    TEST_REQUIRE(e != NULL, "an out-of-bounds read must raise");
    if ( e != NULL ) {
	TEST_REQUIRE_STR(e->message,
			 "Variable index access out of bounds at dimension 0: 9 (max 3)");
	test_discard_error(e);
    }

    /* Built-in functions dispatch through the table. */
    expect_int("N# = -9", -9);
    expect_int("A# = ABS(N#)", 9);
    expect_int("A# = SGN(N#)", -1);

    /*
     * A negative *literal* argument, which is TODO.md section 6 item 13's
     * regression test. The reference hangs a unary leaf's operand off .right,
     * which is also where an argument list chains its arguments, so `ABS(-9)`
     * counted as two arguments and was refused outright -- no builtin could be
     * called with a negative literal at all. The corpus hid it: sgn.bas assigns
     * -1 to a variable first, which is what the three lines above do.
     */
    expect_int("A# = ABS(-9)", 9);
    expect_int("A# = SGN(-5)", -1);
    /*
     * And with a second argument after the unary one, which is the other half of
     * the same defect: chaining the next argument through .right overwrote the
     * operand the unary leaf was keeping there.
     */
    expect_int("A# = SHL(-1, 0)", -1);
    expect_int("A# = MOD(-7, 3)", -1);
    expect_int("A# = INSTR(\"HELLO\", \"L\")", 2);
    expect_int("A# = LEN(\"HELLO\")", 5);
    expect_int("A# = SHL(1, 4)", 16);
    expect_int("A# = SHR(16, 4)", 1);
    expect_int("A# = XOR(12, 10)", 6);
    expect_int("A# = MOD(7, 3)", 1);
    expect_int("A# = INSTR(\"HELLO\", \"LL\")", 2);
    expect_int("A# = INSTR(\"HELLO\", \"ZZ\")", -1);

    /* An unknown verb is diagnosed rather than silently ignored. */
    TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment));
    TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, NULL, &out),
			AKERR_NULLPOINTER);

    /* A label resolves to its line number through a bare identifier. */
    TEST_REQUIRE_OK(akbasic_environment_set_label(HARNESS_RUNTIME.environment, "TOP", 30));
    expect_int("A# = TOP", 30);

    harness_stop();
    return akbasic_test_failures;
}