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, bounded so a hang fails rather than waits. */
static akerr_ErrorContext AKERR_NOIGNORE *run_program(const char *source)
{
    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, 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 function reaches a structure through the caller's scope.
 *
 * **Not through a parameter**: `DEF F(B@ AS CRATE)` is not implemented, and a
 * bare `DEF F(B@)` is refused because `@` alone does not say *which* type. So
 * the way a function works with a record today is by name, which the dynamic
 * scoping already allows -- a call's environment has the caller's as its parent.
 *
 * Pinned rather than left implicit, because it is the only route there is and a
 * reader would otherwise reasonably assume the parameter form works.
 */
static void test_structures_reached_through_scope(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 SCALED(N#) = A@.W# * N#\n"
				"70 PRINT SCALED(3)\n"));
    TEST_REQUIRE_STR(HARNESS_OUTPUT, "15\n");
    harness_stop();

    /* And a structure parameter is refused rather than silently misbehaving. */
    TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n"
				"20   W#\n"
				"30 END TYPE\n"
				"40 DEF WID(B@) = B@.W#\n"
				"50 PRINT 1\n"));
    TEST_REQUIRE(strstr(HARNESS_OUTPUT, "ERROR") != NULL,
		 "a structure parameter should be refused for now, got \"%s\"", HARNESS_OUTPUT);
    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_structures_reached_through_scope();

    return akbasic_test_failures;
}