/** * @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 #include #include #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(); } 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(); return akbasic_test_failures; }