akbasic/tests/user_functions.c

/**
 * @file user_functions.c
 * @brief Tests that a `DEF` call is re-entrant.
 *
 * Both of the defects here came from one cause: the function's environment used
 * to be owned by the funcdef and reset on every call, so a second call trampled
 * the first. A call takes one from the pool now, exactly as `GOSUB` does.
 *
 * Neither failure was visible in an ordinary program. The aliasing one gave a
 * wrong number rather than an error, and *only* when the same function appeared
 * twice in one expression -- two different functions were fine, which is what
 * made it hard to see at all. The recursion one produced no output whatsoever.
 * So both are pinned here against the language rather than left to a listing
 * somebody might not write.
 */

#include <string.h>

#include <akbasic/error.h>
#include <akbasic/runtime.h>

#include "harness.h"
#include "testutil.h"

/** @brief Run a program to completion under an explicit step budget. */
static akerr_ErrorContext AKERR_NOIGNORE *run_program_bounded(const char *source, int64_t steps)
{
    PREPARE_ERROR(errctx);

    PASS(errctx, harness_start(NULL));
    PASS(errctx, akbasic_runtime_load(&HARNESS_RUNTIME, source));
    PASS(errctx, akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
    PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, steps));
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Run a program to completion, bounded so a hang fails rather than waits.
 *
 * 20,000 steps, which is generous for every case here except the two that call a
 * function eight thousand times. Those name their own budget rather than raising
 * this one, because a bound loose enough for them would stop the recursion case
 * from failing quickly.
 */
static akerr_ErrorContext AKERR_NOIGNORE *run_program(const char *source)
{
    PREPARE_ERROR(errctx);

    PASS(errctx, run_program_bounded(source, 20000));
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Two calls to one function in one expression do not share a slot.
 *
 * The result used to be a pointer into the funcdef's own environment, so the
 * second call overwrote the first before the operator saw it: `DBL(10) + DBL(1)`
 * came out as 4 rather than 22, both operands having become the last call's
 * answer. A silent wrong number from a two-line program.
 */
static void test_two_calls_in_one_expression(void)
{
    TEST_REQUIRE_OK(run_program("10 DEF DBL(N#) = N# * 2\n"
				"20 DEF TPL(N#) = N# * 3\n"
				"30 PRINT DBL(10) + DBL(1)\n"
				"40 PRINT DBL(1) + DBL(10) + DBL(100)\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "22\n222\n");
    harness_stop();

    /*
     * Two *different* functions were always correct, because each funcdef owned
     * its own environment. Asserted so a future fix that reintroduces sharing
     * cannot pass by getting this case right.
     */
    TEST_REQUIRE_OK(run_program("10 DEF DBL(N#) = N# * 2\n"
				"20 DEF TPL(N#) = N# * 3\n"
				"30 PRINT DBL(1) + TPL(10)\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "32\n");
    harness_stop();
}

/**
 * @brief A recursive multi-line `DEF` returns.
 *
 * It used to hang: the recursive call re-initialised the environment the outer
 * call was still using, so the loop waiting for control to come back never saw
 * it. No error, no bound, no diagnostic -- the one place in this interpreter
 * that looped forever rather than raising.
 */
static void test_recursion_returns(void)
{
    TEST_REQUIRE_OK(run_program("10 DEF FACT(N#)\n"
				"20 IF N# <= 1 THEN RETURN 1\n"
				"30 RETURN N# * FACT(N# - 1)\n"
				"40 PRINT FACT(5)\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "120\n");
    harness_stop();
}

/**
 * @brief Each call gets its own arguments, which is what recursion needs.
 *
 * Distinct from the test above: a function could return the right answer for
 * `FACT` by luck if the argument happened to be re-read before being clobbered.
 * This one unwinds and uses the argument *after* the inner call has returned, so
 * a shared parameter slot gives the wrong answer rather than no answer.
 */
static void test_arguments_are_per_call(void)
{
    TEST_REQUIRE_OK(run_program("10 DEF SUMTO(N#)\n"
				"20 IF N# <= 0 THEN RETURN 0\n"
				"30 RETURN N# + SUMTO(N# - 1)\n"
				"40 PRINT SUMTO(4)\n"));
    /* 4+3+2+1 = 10, and only if each frame kept its own N#. */
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "10\n");
    harness_stop();
}

/**
 * @brief Runaway recursion is reported, not hung.
 *
 * Depth now answers to the environment pool like every other nesting, so too
 * deep is the same diagnosis `GOSUB` already gave. That is the whole change in
 * one sentence: a bound where there was none.
 */
static void test_runaway_recursion_is_diagnosed(void)
{
    TEST_REQUIRE_OK(run_program("10 DEF INF(N#)\n"
				"20 RETURN INF(N# + 1)\n"
				"30 PRINT INF(1)\n"));
    TEST_REQUIRE(strstr(HARNESS_OUTPUT, "Environment pool exhausted") != NULL,
		 "unbounded recursion should report the pool bound, got \"%s\"", HARNESS_OUTPUT);
    harness_stop();
}

/** @brief A single-expression function still works, and still nests. */
static void test_single_expression_form(void)
{
    TEST_REQUIRE_OK(run_program("10 DEF SQ(N#) = N# * N#\n"
				"20 PRINT SQ(4)\n"
				"30 PRINT SQ(SQ(2))\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "16\n16\n");
    harness_stop();
}

/**
 * @brief A structure parameter is passed by value, and a pointer one is not.
 *
 * Neither is a special rule: a parameter is bound by assignment like any other
 * variable, and assignment copies a structure and copies a pointer's reference.
 * The two halves of the feature seen from a function's side.
 */
static void test_structure_parameters(void)
{
    TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n"
				"20   W#\n"
				"30 END TYPE\n"
				"40 DIM A@ AS CRATE\n"
				"50 A@.W# = 5\n"
				"60 DEF WIDEN(B@ AS CRATE)\n"
				"70 B@.W# = 99\n"
				"80 RETURN B@.W#\n"
				"90 PRINT WIDEN(A@)\n"
				"100 PRINT A@.W#\n"));
    /* The callee saw 99; the caller still has 5, because it was a copy. */
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "99\n5\n");
    harness_stop();

    TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n"
				"20   W#\n"
				"30 END TYPE\n"
				"40 DIM A@ AS CRATE\n"
				"50 A@.W# = 5\n"
				"60 DIM Q@ AS PTR TO CRATE\n"
				"70 POINT Q@ AT A@\n"
				"80 DEF POKEIT(P@ AS PTR TO CRATE)\n"
				"90 P@->W# = 42\n"
				"100 RETURN P@->W#\n"
				"110 PRINT POKEIT(Q@)\n"
				"120 PRINT A@.W#\n"));
    /* And through a pointer the caller's record does change. */
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "42\n42\n");
    harness_stop();
}

/**
 * @brief A structure parameter must name its type, and the type is checked.
 *
 * `@` says "a structure" without saying which, so `X@` does not state a contract
 * the way `X$` does. Naming the type is what closes that, and refusing a bare
 * `X@` rather than treating it as "any structure" is what keeps the rule to one
 * -- duck typing there would put the hole straight back.
 */
static void test_structure_parameter_types_are_checked(void)
{
    static const struct { const char *tail; const char *expect; } CASES[] = {
	{ "90 DEF F(B@) = B@.W#\n100 PRINT 1\n",              "must name its type" },
	{ "90 DEF F(B@ AS CRATE) = B@.W#\n100 PRINT F(O@)\n", "cannot take a OTHERT" },
	{ "90 DEF F(B@ AS NOSUCH) = B@.W#\n100 PRINT F(A@)\n", "which is not a type" },
	{ "90 DEF F(B@ AS PTR TO CRATE) = B@->W#\n100 PRINT F(A@)\n", "expects a pointer to" },
	{ "90 DEF F(B@ AS) = 1\n100 PRINT 1\n",               "Expected a type name" }
    };
    char source[2048];
    size_t i = 0;

    for ( i = 0; i < sizeof(CASES) / sizeof(CASES[0]); i++ ) {
	snprintf(source, sizeof(source),
		 "10 TYPE CRATE\n20   W#\n30 END TYPE\n"
		 "40 TYPE OTHERT\n50   N#\n60 END TYPE\n"
		 "70 DIM A@ AS CRATE\n80 DIM O@ AS OTHERT\n%s", CASES[i].tail);
	TEST_REQUIRE_OK(run_program(source));
	TEST_REQUIRE(strstr(HARNESS_OUTPUT, CASES[i].expect) != NULL,
		     "case %zu should say \"%s\", got \"%s\"",
		     i, CASES[i].expect, HARNESS_OUTPUT);
	harness_stop();
    }
}

/**
 * @brief A call gives its parameter variables back when it returns.
 *
 * One variable leaked per call before this, so a function called two hundred
 * times exhausted the 128-slot pool and reported "Maximum runtime variables
 * reached" on a four-line program. It was there for `GOSUB` all along --
 * measured on a stashed build -- and giving each `DEF` call its own scope simply
 * made it reachable a second way.
 */
static void test_call_scopes_are_reclaimed(void)
{
    TEST_REQUIRE_OK(run_program("10 DEF DBL(N#) = N# * 2\n"
				"20 T# = 0\n"
				"30 FOR I# = 1 TO 200\n"
				"40   T# = T# + DBL(I#)\n"
				"50 NEXT I#\n"
				"60 PRINT T#\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "40200\n");
    harness_stop();

    /* The GOSUB half, which is where the leak actually started. */
    TEST_REQUIRE_OK(run_program("10 FOR I# = 1 TO 300\n"
				"20   GOSUB 100\n"
				"30 NEXT I#\n"
				"40 PRINT \"OK\"\n"
				"50 END\n"
				"100 LOCALV# = I# * 2\n"
				"110 RETURN\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "OK\n");
    harness_stop();
}

/**
 * @brief Eight thousand calls, which used to be about four thousand too many.
 *
 * The *variable* slot came back (the test above); the value slots behind the
 * parameter did not. A `DEF` cost one pool slot per call and died between the
 * four and five thousandth with "Array of 1 elements does not fit in the 0
 * remaining value slots" -- so a game calling one function per frame at thirty
 * frames a second got a little over two minutes, and the message named neither
 * the function nor the reason.
 *
 * TODO.md section 9 item 1. Both forms are here because both leaked: the
 * comparison that isolated it originally was that a `GOSUB` doing the same work
 * ran eight thousand times without complaint.
 */
static void test_calls_do_not_leak_value_slots(void)
{
    TEST_REQUIRE_OK(run_program_bounded("10 DEF ADDIT(N#)\n"
					"20   RETURN N# + 1\n"
					"30 R# = 0\n"
					"40 FOR I# = 1 TO 8000\n"
					"50   R# = ADDIT(I#)\n"
					"60 NEXT I#\n"
					"70 PRINT \"OK \" + R#\n", 1000000));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "OK 8001\n");
    harness_stop();

    TEST_REQUIRE_OK(run_program_bounded("10 DEF SQR1(X#) = X# * X#\n"
					"20 R# = 0\n"
					"30 FOR I# = 1 TO 8000\n"
					"40   R# = SQR1(I#)\n"
					"50 NEXT I#\n"
					"60 PRINT \"OK \" + R#\n", 1000000));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "OK 64000000\n");
    harness_stop();
}

/**
 * @brief A host can call a BASIC function with values it already has.
 *
 * The entry point a *verb* would use. Everything else here reaches a function
 * through an expression the parser built; this reaches one with four numbers and
 * a name, which is what a verb taking a callback would have to do and what was
 * impossible until the argument binding was split out of the call site handling.
 */
static void test_call_from_c(void)
{
    akbasic_Value args[2];
    akbasic_Value *argp[2];
    akbasic_Value *result = NULL;

    TEST_REQUIRE_OK(run_program("10 DEF ADDEM(A#, B#) = A# + B#\n"
				"20 DEF TRIPLE(N#)\n"
				"30   T# = N# * 3\n"
				"40   RETURN T#\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "");

    memset(&args[0], 0, sizeof(args[0]));
    memset(&args[1], 0, sizeof(args[1]));
    args[0].valuetype = AKBASIC_TYPE_INTEGER;
    args[0].intval = 17;
    args[1].valuetype = AKBASIC_TYPE_INTEGER;
    args[1].intval = 25;
    argp[0] = &args[0];
    argp[1] = &args[1];

    TEST_REQUIRE_OK(akbasic_runtime_call_function(&HARNESS_RUNTIME, "ADDEM", argp, 2, &result));
    TEST_REQUIRE(result != NULL, "a call should have produced a result");
    TEST_REQUIRE_INT(result->intval, 42);

    /*
     * **The multi-line form is not asserted here, and that is a finding rather
     * than an omission.** Its body is *source lines*, so the call re-enters the
     * interpreter's line loop -- and that loop only runs while the runtime is in
     * RUN mode. By the time a host can call this the program has stopped, so the
     * body does not run and the result is the caller's zeroed return slot.
     *
     * The same defect is reachable without any of this: a multi-line function
     * called at the *REPL* answers "(UNDEFINED STRING REPRESENTATION FOR 0)".
     * TODO.md section 6 item 41. So this entry point is usable today from a verb
     * during execution, which is what it was built for, and from a host only for
     * the single-expression form.
     */

    /* A name nobody defined is refused rather than crashing. */
    TEST_REQUIRE_ANY_ERROR(akbasic_runtime_call_function(&HARNESS_RUNTIME, "NOSUCH",
							 argp, 1, &result));
    harness_stop();
}

/**
 * @brief A long multi-line body called from C completes.
 *
 * The value scratch is a *per line* limit, and the call loop has to reset it
 * per line the way akbasic_runtime_step() does. It did not: the scratch
 * accumulated across the whole body, and any body past about ten real lines
 * died with "Maximum values per line reached" -- silently, from the caller's
 * point of view, because a BASIC-level error inside the loop reports through
 * the sink and comes back as a zero (issue #7's shape). Found by the galaga
 * example, whose enemy functions are all longer than ten lines.
 *
 * The set_mode(RUN) between the load and the call is the issue #8 workaround:
 * the body only runs in RUN mode, and the program has already ended.
 */
static void test_long_body_called_from_c(void)
{
    akbasic_Value arg;
    akbasic_Value *argp[1];
    akbasic_Value *result = NULL;

    TEST_REQUIRE_OK(run_program("10 DEF LONGB(N#)\n"
				"20   A# = N# + 1\n"
				"30   B# = A# + 1\n"
				"40   C# = B# + 1\n"
				"50   D# = C# + 1\n"
				"60   E# = D# + 1\n"
				"70   F# = E# + 1\n"
				"80   G# = F# + 1\n"
				"90   H# = G# + 1\n"
				"100  I# = H# + 1\n"
				"110  J# = I# + 1\n"
				"120  K# = J# + 1\n"
				"130  L# = K# + 1\n"
				"140  M# = L# + 1\n"
				"150  P# = M# + 1\n"
				"160  Q# = P# + 1\n"
				"170  R# = Q# + 1\n"
				"180  RETURN R#\n"));
    TEST_REQUIRE_OK(akbasic_runtime_set_mode(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));

    memset(&arg, 0, sizeof(arg));
    arg.valuetype = AKBASIC_TYPE_INTEGER;
    arg.intval = 1;
    argp[0] = &arg;
    TEST_REQUIRE_OK(akbasic_runtime_call_function(&HARNESS_RUNTIME, "LONGB", argp, 1, &result));
    TEST_REQUIRE(result != NULL, "a call should have produced a result");
    TEST_REQUIRE_INT(result->intval, 17);
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "");
    harness_stop();
}

/**
 * @brief A body that dies leaves the environment stack balanced.
 *
 * A runtime error inside a called body reports through the sink and ends the
 * run -- that part is unchanged, and the caller still gets the zeroed slot
 * (issue #7 tracks whether it should). What must NOT happen is what did: the
 * call's environment was never given back, so a host that absorbed script
 * errors and kept calling drained the twelve-slot pool after twelve dead
 * calls, and every later call failed with "Environment pool exhausted" -- an
 * exhaustion nothing in the script explains.
 *
 * The revival dance after each death is two calls: clear_error(), because a
 * run's first error latches and every later line is skipped while it stands,
 * and set_mode(RUN), the issue #8 workaround the boot already needed --
 * the error dropped the runtime out of RUN mode.
 */
static void test_dead_body_releases_environments(void)
{
    akbasic_Value arg;
    akbasic_Value *argp[1];
    akbasic_Value *result = NULL;
    akbasic_Environment *root = NULL;
    int i = 0;

    TEST_REQUIRE_OK(run_program("10 DEF DIE(N#)\n"
				"20   X# = NOSUCH(N#)\n"
				"30   RETURN X#\n"
				"40 DEF FINE(N#)\n"
				"50   Y# = N# * 2\n"
				"60   RETURN Y#\n"));
    TEST_REQUIRE_OK(akbasic_runtime_set_mode(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
    root = HARNESS_RUNTIME.environment;

    memset(&arg, 0, sizeof(arg));
    arg.valuetype = AKBASIC_TYPE_INTEGER;
    arg.intval = 7;
    argp[0] = &arg;

    /* Fifteen deaths: more than the pool holds, so a single leaked scope
     * fails this loop even if the first twelve limp through. */
    for ( i = 0; i < 15; i++ ) {
	TEST_REQUIRE_OK(akbasic_runtime_call_function(&HARNESS_RUNTIME, "DIE", argp, 1, &result));
	TEST_REQUIRE(HARNESS_RUNTIME.environment == root,
		     "a dead call must unwind back to the caller's environment");
	TEST_REQUIRE_OK(akbasic_runtime_clear_error(&HARNESS_RUNTIME));
	TEST_REQUIRE_OK(akbasic_runtime_set_mode(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
    }

    /* And the runtime is still whole: a healthy function runs to the right
     * answer after every one of those deaths. */
    TEST_REQUIRE_OK(akbasic_runtime_call_function(&HARNESS_RUNTIME, "FINE", argp, 1, &result));
    TEST_REQUIRE(result != NULL, "a call should have produced a result");
    TEST_REQUIRE_INT(result->intval, 14);
    harness_stop();
}

int main(void)
{
    TEST_REQUIRE_OK(akbasic_error_register());

    test_two_calls_in_one_expression();
    test_recursion_returns();
    test_arguments_are_per_call();
    test_runaway_recursion_is_diagnosed();
    test_single_expression_form();
    test_structure_parameters();
    test_structure_parameter_types_are_checked();
    test_call_scopes_are_reclaimed();
    test_calls_do_not_leak_value_slots();
    test_call_from_c();
    test_long_body_called_from_c();
    test_dead_body_releases_environments();

    return akbasic_test_failures;
}