akbasic/tests/hostvars.c

/**
 * @file hostvars.c
 * @brief Tests the host-facing variable exchange, from the host's side.
 *
 * TODO.md section 6 item 17: a host could not reliably *create* a script
 * variable while a script was suspended, and neither way of trying failed
 * loudly. Through akbasic_environment_get() the variable landed in whichever
 * scope happened to be active -- usually a `FOR` or `GOSUB` body -- and died
 * when that body popped, so the script read it correctly right up until it
 * stopped. Reaching for the root by hand returned NULL through `dest` without
 * raising, because that function only auto-creates in the active environment.
 *
 * akbasic_runtime_global() is the answer to both, and what is asserted here is
 * the part a host actually cares about: a value it set mid-run is still there
 * after the loop it was set from has finished.
 */

#include "harness.h"

/**
 * @brief Step a program until it is suspended inside a nested scope.
 *
 * One step at a time until a child environment is active, rather than a fixed
 * budget: a step processes one *source line index*, and the interpreter files
 * lines under their BASIC line numbers, so `10 FOR` is eleven steps in and any
 * count written here would be a hostage to the line numbers in the fixture.
 *
 * Bounded so a program that never nests fails the assertion below rather than
 * hanging the suite.
 */
static akerr_ErrorContext AKERR_NOIGNORE *run_until_nested(const char *source)
{
    PREPARE_ERROR(errctx);
    int steps = 0;

    PASS(errctx, akbasic_runtime_load(&HARNESS_RUNTIME, source));
    PASS(errctx, akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
    while ( steps < AKBASIC_MAX_SOURCE_LINES &&
	    HARNESS_RUNTIME.mode != AKBASIC_MODE_QUIT &&
	    HARNESS_RUNTIME.environment->parent == NULL ) {
	PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 1));
	steps += 1;
    }
    SUCCEED_RETURN(errctx);
}

/** @brief Set a global to an integer, the way an embedding host would. */
static akerr_ErrorContext AKERR_NOIGNORE *set_global(const char *name, int64_t value)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    int64_t zerosubscript[1] = { 0 };

    PASS(errctx, akbasic_runtime_global(&HARNESS_RUNTIME, name, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
		     "runtime_global returned NULL for %s", name);
    PASS(errctx, akbasic_variable_set_integer(variable, value, zerosubscript, 1));
    SUCCEED_RETURN(errctx);
}

/**
 * @brief A global created while suspended inside a FOR body outlives the loop.
 *
 * The case that motivated the whole entry. `H#` is created from outside while
 * the script sits in the loop, and line 40 -- which runs after `NEXT` has popped
 * the loop's scope -- has to still see it.
 */
static akerr_ErrorContext AKERR_NOIGNORE *test_global_survives_a_for_body(void)
{
    PREPARE_ERROR(errctx);

    TEST_REQUIRE_OK(harness_start(NULL));
    PASS(errctx, run_until_nested("10 FOR I# = 1 TO 3\n"
				  "20 PRINT I#\n"
				  "30 NEXT I#\n"
				  "40 PRINT H#\n"));

    /* Suspended below the root, which is the state that used to break this. */
    TEST_REQUIRE(HARNESS_RUNTIME.environment != NULL, "the runtime must have a scope");
    TEST_REQUIRE(HARNESS_RUNTIME.environment->parent != NULL,
		 "the script should be suspended inside the FOR body");

    PASS(errctx, set_global("H#", 42));
    PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 0));

    /* 1 2 3 from the loop, then 42 from after it. The 42 is the assertion. */
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "1\n2\n3\n42\n");
    harness_stop();
    SUCCEED_RETURN(errctx);
}

/** @brief The same from inside a GOSUB, which is the other nesting a host meets. */
static akerr_ErrorContext AKERR_NOIGNORE *test_global_survives_a_gosub(void)
{
    PREPARE_ERROR(errctx);

    TEST_REQUIRE_OK(harness_start(NULL));
    /*
     * The QUIT is not decoration. Without a terminator the program runs off the
     * end of line 20 into the subroutine again, and its RETURN then has no GOSUB
     * to return to -- which is ordinary BASIC and would only obscure what is
     * being asserted here.
     */
    PASS(errctx, run_until_nested("10 GOSUB 100\n"
				  "20 PRINT H#\n"
				  "30 QUIT\n"
				  "100 PRINT \"IN\"\n"
				  "110 RETURN\n"));

    TEST_REQUIRE(HARNESS_RUNTIME.environment->parent != NULL,
		 "the script should be suspended inside the subroutine");
    PASS(errctx, set_global("H#", 7));
    PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 0));

    TEST_REQUIRE_STR(HARNESS_OUTPUT, "IN\n7\n");
    harness_stop();
    SUCCEED_RETURN(errctx);
}

/**
 * @brief The NULL-without-error path is gone: this always creates or raises.
 *
 * akbasic_environment_get() against a non-active environment is the shape that
 * used to bite, and it is asserted here as well -- unchanged, because it is
 * still the right behaviour for *that* function and it is what makes
 * runtime_global() necessary rather than merely convenient.
 */
static akerr_ErrorContext AKERR_NOIGNORE *test_global_never_returns_null(void)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *root = NULL;
    akbasic_Variable *variable = NULL;

    TEST_REQUIRE_OK(harness_start(NULL));
    root = HARNESS_RUNTIME.environment;
    PASS(errctx, akbasic_runtime_new_environment(&HARNESS_RUNTIME));

    /* The old way, with a child active: NULL, and nothing raised. */
    variable = NULL;
    TEST_REQUIRE_OK(akbasic_environment_get(root, "NEW#", &variable));
    TEST_REQUIRE(variable == NULL,
		 "environment_get must still decline to create in a non-active scope");

    /* The new way: created, in the root, every time. */
    variable = NULL;
    PASS(errctx, akbasic_runtime_global(&HARNESS_RUNTIME, "NEW#", &variable));
    TEST_REQUIRE(variable != NULL, "runtime_global must create rather than return NULL");

    /* And it is genuinely in the root, visible from the child. */
    TEST_REQUIRE_OK(akbasic_environment_get(HARNESS_RUNTIME.environment, "NEW#", &variable));
    TEST_REQUIRE(variable != NULL, "the child must see the global the host created");

    /* Twice is the same variable, not a second one shadowing the first. */
    {
	akbasic_Variable *again = NULL;
	PASS(errctx, akbasic_runtime_global(&HARNESS_RUNTIME, "NEW#", &again));
	TEST_REQUIRE(again == variable, "a repeat call must find the variable it created");
    }

    TEST_REQUIRE_STATUS(akbasic_runtime_global(NULL, "A#", &variable), AKERR_NULLPOINTER);
    TEST_REQUIRE_STATUS(akbasic_runtime_global(&HARNESS_RUNTIME, NULL, &variable),
			AKERR_NULLPOINTER);
    TEST_REQUIRE_STATUS(akbasic_runtime_global(&HARNESS_RUNTIME, "A#", NULL),
			AKERR_NULLPOINTER);

    TEST_REQUIRE_OK(akbasic_runtime_prev_environment(&HARNESS_RUNTIME));
    harness_stop();
    SUCCEED_RETURN(errctx);
}

/** @brief Seeding before the script starts, and reading after it stops, still work. */
static akerr_ErrorContext AKERR_NOIGNORE *test_seed_and_read_back(void)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    akbasic_Value *value = NULL;
    int64_t zerosubscript[1] = { 0 };

    TEST_REQUIRE_OK(harness_start(NULL));
    PASS(errctx, set_global("SEED#", 10));

    PASS(errctx, akbasic_runtime_load(&HARNESS_RUNTIME, "10 OUT# = SEED# * 2\n"
						        "20 PRINT OUT#\n"));
    PASS(errctx, akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
    PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 0));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "20\n");

    PASS(errctx, akbasic_runtime_global(&HARNESS_RUNTIME, "OUT#", &variable));
    PASS(errctx, akbasic_variable_get_subscript(variable, zerosubscript, 1, &value));
    TEST_REQUIRE_INT(value->intval, 20);

    harness_stop();
    SUCCEED_RETURN(errctx);
}

int main(void)
{
    PREPARE_ERROR(errctx);

    ATTEMPT {
	CATCH(errctx, test_global_survives_a_for_body());
	CATCH(errctx, test_global_survives_a_gosub());
	CATCH(errctx, test_global_never_returns_null());
	CATCH(errctx, test_seed_and_read_back());
    } CLEANUP {
    } PROCESS(errctx) {
    } HANDLE_DEFAULT(errctx) {
	LOG_ERROR_WITH_MESSAGE(errctx, "host variable test failed");
	akbasic_test_failures += 1;
    } FINISH_NORETURN(errctx);

    return akbasic_test_failures;
}