Give each DEF call its own environment, so recursion returns
The function's environment was owned by the funcdef and re-initialised on every
call, which made a function not re-entrant and cost two silent defects:
DEF DBL(N#) = N# * 2
PRINT DBL(10) + DBL(1) was 4, should be 22
The result was a pointer into the funcdef's own environment, so the second call
overwrote the first before the operator saw it -- both operands became the last
call's answer. Two *different* functions in one expression were fine, which is
most of why it was invisible.
DEF FACT(N#)
IF N# <= 1 THEN RETURN 1
RETURN N# * FACT(N# - 1)
PRINT FACT(5) never returned
The recursive call re-initialised the environment the outer call was still
using, so the loop waiting for control to come back could not see it. No error,
no bound, no diagnostic -- the one place in this interpreter that looped forever
rather than raising.
A call takes an environment from the pool now, exactly as GOSUB does. The result
is copied into a caller-scope scratch before that environment goes back, because
handing back a pointer into the callee is what made two calls collide and would
now be a pointer into a released slot as well. RETURN parks its result on the
*parent* rather than on the environment it is about to release, so nothing reads
a freed slot to find it.
Recursion depth answers to AKBASIC_MAX_ENVIRONMENTS like every other nesting, so
too deep is "Environment pool exhausted" -- a diagnosis where there was none.
akbasic_FunctionDef.environment goes with it, as dead state.
One thing this exposed but did not cause, measured against a stashed build and
recorded rather than fixed: a statement containing a failed multi-line DEF call
still completes and prints a junk value. It is visible more often now only
because runaway recursion reaches it where it used to hang.
tests/language/functions/recursion.bas deliberately does not pin that answer.
Chapter 16 loses its "walk a list with a loop, not a recursive DEF" caveat and
gains the one that is still true: a function cannot take a structure parameter
yet, so it reaches a record by name.
Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -300,6 +300,7 @@ set(AKBASIC_TESTS
|
|||||||
struct_types
|
struct_types
|
||||||
trap_verbs
|
trap_verbs
|
||||||
symtab
|
symtab
|
||||||
|
user_functions
|
||||||
value_arithmetic
|
value_arithmetic
|
||||||
value_bitwise
|
value_bitwise
|
||||||
value_compare
|
value_compare
|
||||||
|
|||||||
58
TODO.md
58
TODO.md
@@ -1573,6 +1573,34 @@ the reference's semantics reproduced faithfully; the third is the port's own.
|
|||||||
listings read it there. Same known-failing test as item 19; the fix is a scoping decision
|
listings read it there. Same known-failing test as item 19; the fix is a scoping decision
|
||||||
about where a loop counter is created, not an ordering one.
|
about where a loop counter is created, not an ordering one.
|
||||||
|
|
||||||
|
### Found while fixing the DEF recursion hang
|
||||||
|
|
||||||
|
25. **A statement containing a failed multi-line `DEF` call still completes, and prints a
|
||||||
|
junk value.** The call's error is reported and the run stops, but the *enclosing*
|
||||||
|
statement carries on with whatever `*dest` was left holding:
|
||||||
|
|
||||||
|
```
|
||||||
|
10 DEF BAD(N#)
|
||||||
|
20 RETURN N# / 0
|
||||||
|
30 PRINT 99
|
||||||
|
40 PRINT BAD(1)
|
||||||
|
```
|
||||||
|
|
||||||
|
prints `99`, the division-by-zero line, and then
|
||||||
|
`(UNDEFINED STRING REPRESENTATION FOR 0)`.
|
||||||
|
|
||||||
|
**Pre-existing, and measured as such**: identical before and after the re-entrancy
|
||||||
|
fix, on a build stashed back to compare. It is visible more often now only because
|
||||||
|
runaway recursion reaches it where it used to hang instead.
|
||||||
|
|
||||||
|
The cause is that `akbasic_runtime_process_line_run()` swallows a script's error by
|
||||||
|
design -- goal 3 -- so the loop inside `akbasic_runtime_user_function()` sees the run
|
||||||
|
end normally and hands back a value nobody should use. The fix is for the multi-line
|
||||||
|
path to notice the run did not return through `RETURN` and refuse rather than produce
|
||||||
|
a value; it is not done here because it is a decision about what a failed call
|
||||||
|
*evaluates to*, and `tests/language/functions/recursion.bas` deliberately does not
|
||||||
|
pin the current answer.
|
||||||
|
|
||||||
### Found while building structures
|
### Found while building structures
|
||||||
|
|
||||||
23. ~~**A host could not run one script twice.**~~ **Fixed.**
|
23. ~~**A host could not run one script twice.**~~ **Fixed.**
|
||||||
@@ -1591,6 +1619,30 @@ the reference's semantics reproduced faithfully; the third is the port's own.
|
|||||||
index a field already recorded keeps pointing at the same type.
|
index a field already recorded keeps pointing at the same type.
|
||||||
`tests/hoststruct.c` pins it.
|
`tests/hoststruct.c` pins it.
|
||||||
|
|
||||||
|
26. ~~**A `DEF` call was not re-entrant, which cost a wrong answer and a hang.**~~
|
||||||
|
**Fixed.** The function's environment was owned by the funcdef and re-initialised on
|
||||||
|
every call, so a second call trampled the first:
|
||||||
|
|
||||||
|
- **Two calls in one expression aliased one slot.** `DBL(10) + DBL(1)` was 4 rather
|
||||||
|
than 22 -- both operands became the last call's answer, because the result was a
|
||||||
|
pointer into the funcdef's own environment. Two *different* functions were fine,
|
||||||
|
which is most of why it was invisible. Same severity class as §6 item 12, and the
|
||||||
|
same shape: a silent wrong answer from a two-line program.
|
||||||
|
- **Recursion never came back.** The recursive call re-initialised the environment the
|
||||||
|
outer call was still using, so the loop waiting for control could not see it return.
|
||||||
|
No error, no bound, no diagnostic -- the one place in this interpreter that looped
|
||||||
|
forever instead of raising.
|
||||||
|
|
||||||
|
A call takes an environment from the pool now, exactly as `GOSUB` does, and the result
|
||||||
|
is copied into a caller-scope scratch before that environment goes back. `RETURN`
|
||||||
|
parks its result on the *parent* rather than on the environment about to be released,
|
||||||
|
so nothing reads a freed slot. Recursion depth answers to `AKBASIC_MAX_ENVIRONMENTS`
|
||||||
|
like every other nesting, so too deep is `Environment pool exhausted` -- a diagnosis
|
||||||
|
where there was none.
|
||||||
|
|
||||||
|
`akbasic_FunctionDef.environment` is gone with it, as dead state.
|
||||||
|
`tests/user_functions.c` and `tests/language/functions/recursion.bas`.
|
||||||
|
|
||||||
### Found while auditing `akbasic_value_clone()` for the structures work
|
### Found while auditing `akbasic_value_clone()` for the structures work
|
||||||
|
|
||||||
22. ~~**The numeric operators' `else` was a catch-all, not a float branch.**~~ **Fixed.**
|
22. ~~**The numeric operators' `else` was a catch-all, not a float branch.**~~ **Fixed.**
|
||||||
@@ -1712,12 +1764,12 @@ requirement; exactly one case has diverged on purpose since, and
|
|||||||
|
|
||||||
| Gate | Result |
|
| Gate | Result |
|
||||||
|---|---|
|
|---|---|
|
||||||
| `ctest` | 104/104 — 41 reference golden cases, 20 local ones, 39 unit tests, 3 embedding examples, and `docs_examples` |
|
| `ctest` | 106/106 — 41 reference golden cases, 20 local ones, 39 unit tests, 3 embedding examples, and `docs_examples` |
|
||||||
| `ctest` with `-DAKBASIC_WITH_AKGL=ON` | 104/104 on a machine with a display; 103 passed + 1 skipped headless. The same set minus the three `no_device` cases the SDL driver contradicts, plus `akgl_backends`, `akgl_frontend`, `docs_screenshots` and `akgl_typing` — the last of which is the skip, and the `akgl_build` CI job is where it skips |
|
| `ctest` with `-DAKBASIC_WITH_AKGL=ON` | 106/106 on a machine with a display; 105 passed + 1 skipped headless. The same set minus the three `no_device` cases the SDL driver contradicts, plus `akgl_backends`, `akgl_frontend`, `docs_screenshots` and `akgl_typing` — the last of which is the skip, and the `akgl_build` CI job is where it skips |
|
||||||
| `docs_examples` | Every fenced block in `README.md`, `MAINTENANCE.md` and `docs/` executed and byte-compared: 49 programs, 9 transcripts, 57 output comparisons, 2 excerpts, 2 shell blocks and 8 figures in the default build; 65 programs and 56 output comparisons in the AKGL one. The C-snippet count reads 0 when the harness is run by hand without `--cflags-file`; CTest passes it. `MAINTENANCE.md` documents the fence-tag convention |
|
| `docs_examples` | Every fenced block in `README.md`, `MAINTENANCE.md` and `docs/` executed and byte-compared: 49 programs, 9 transcripts, 57 output comparisons, 2 excerpts, 2 shell blocks and 8 figures in the default build; 65 programs and 56 output comparisons in the AKGL one. The C-snippet count reads 0 when the harness is run by hand without `--cflags-file`; CTest passes it. `MAINTENANCE.md` documents the fence-tag convention |
|
||||||
| `docs_screenshots` | 8/8 figures re-rendered and byte-identical to the checked-in PNGs. AKGL build only — rendering a picture needs the SDL half |
|
| `docs_screenshots` | 8/8 figures re-rendered and byte-identical to the checked-in PNGs. AKGL build only — rendering a picture needs the SDL half |
|
||||||
| Golden corpus | 41/41 byte-exact from `tests/reference/` — **and 41/41 again through the SDL binary**, which is most of what proves the frontend changes no output |
|
| Golden corpus | 41/41 byte-exact from `tests/reference/` — **and 41/41 again through the SDL binary**, which is most of what proves the frontend changes no output |
|
||||||
| ASan + UBSan | 104/104 |
|
| ASan + UBSan | 106/106 |
|
||||||
| Line coverage | 94.8% (6648/7013) — above the 90% gate |
|
| Line coverage | 94.8% (6648/7013) — above the 90% gate |
|
||||||
| Function coverage | 98.4% (441/448) |
|
| Function coverage | 98.4% (441/448) |
|
||||||
| Warnings | none under `-Wall -Wextra` |
|
| Warnings | none under `-Wall -Wextra` |
|
||||||
|
|||||||
@@ -186,9 +186,11 @@ Note line 130: assigning one *pointer* to another copies the reference, not the
|
|||||||
That is the one place assignment does not deep-copy, and it is why pointers are declared
|
That is the one place assignment does not deep-copy, and it is why pointers are declared
|
||||||
separately rather than being a mode a structure can be in.
|
separately rather than being a mode a structure can be in.
|
||||||
|
|
||||||
**Walk a list with a loop, not with a recursive `DEF`.** A recursive multi-line `DEF`
|
A recursive `DEF` works too, and is bounded by the scope pool at 32 deep — the same
|
||||||
does not return in this interpreter; it is a known defect recorded in `TODO.md`, and it
|
bound `GOSUB` has. What a function cannot yet do is take a structure *parameter*:
|
||||||
is not specific to structures.
|
`DEF F(B@ AS NODE)` is not implemented, and a bare `DEF F(B@)` is refused because `@`
|
||||||
|
alone does not say which type. Until it is, a function reaches a record by name, which
|
||||||
|
the scoping already allows — a call can see the caller's variables.
|
||||||
|
|
||||||
`PRINT` follows pointers, so a cycle would not come back — it stops after four levels and
|
`PRINT` follows pointers, so a cycle would not come back — it stops after four levels and
|
||||||
prints `(...)`.
|
prints `(...)`.
|
||||||
|
|||||||
@@ -91,7 +91,12 @@ typedef struct
|
|||||||
akbasic_ASTLeaf *arglist;
|
akbasic_ASTLeaf *arglist;
|
||||||
akbasic_ASTLeaf *expression;
|
akbasic_ASTLeaf *expression;
|
||||||
int64_t lineno;
|
int64_t lineno;
|
||||||
akbasic_Environment *environment;
|
/*
|
||||||
|
* There is deliberately no environment here. It used to be owned by the
|
||||||
|
* funcdef and reset on every call, which made a function not re-entrant --
|
||||||
|
* two calls in one expression shared one slot, and recursion never came
|
||||||
|
* back. A call takes one from the pool now, exactly as GOSUB does.
|
||||||
|
*/
|
||||||
/* Deep copies of the arglist and expression need storage that outlives the line. */
|
/* Deep copies of the arglist and expression need storage that outlives the line. */
|
||||||
akbasic_ASTLeaf leafstorage[AKBASIC_MAX_LEAVES * 2];
|
akbasic_ASTLeaf leafstorage[AKBASIC_MAX_LEAVES * 2];
|
||||||
akbasic_LeafPool leafpool;
|
akbasic_LeafPool leafpool;
|
||||||
|
|||||||
@@ -767,55 +767,85 @@ akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_
|
|||||||
akbasic_ASTLeaf *argptr = NULL;
|
akbasic_ASTLeaf *argptr = NULL;
|
||||||
akbasic_Value *argvalue = NULL;
|
akbasic_Value *argvalue = NULL;
|
||||||
akbasic_Value *unused = NULL;
|
akbasic_Value *unused = NULL;
|
||||||
|
akbasic_Value *result = NULL;
|
||||||
|
akbasic_Value *out = NULL;
|
||||||
|
akbasic_Environment *callenv = NULL;
|
||||||
void *fnptr = NULL;
|
void *fnptr = NULL;
|
||||||
|
|
||||||
PASS(errctx, akbasic_environment_get_function(obj->environment, expr->identifier, &fnptr));
|
PASS(errctx, akbasic_environment_get_function(obj->environment, expr->identifier, &fnptr));
|
||||||
fndef = (akbasic_FunctionDef *)fnptr;
|
fndef = (akbasic_FunctionDef *)fnptr;
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* The function's environment is owned by the funcdef, not by the pool free
|
* **One environment per call, from the pool -- exactly as GOSUB does.**
|
||||||
* list: it is reset on every call and outlives any single one. The reference
|
*
|
||||||
* holds it by value inside BasicFunctionDef for the same reason.
|
* It used to be owned by the funcdef and reset on every call, which made a
|
||||||
|
* function not re-entrant and cost two silent defects:
|
||||||
|
*
|
||||||
|
* - Calling one twice in a single expression aliased one storage slot, so
|
||||||
|
* the second call overwrote the first result before the operator saw it.
|
||||||
|
* `DBL(10) + DBL(1)` was 4 rather than 22, and two different functions
|
||||||
|
* in one expression were fine, which is what made it so hard to see.
|
||||||
|
* - Recursion did not terminate. The recursive call re-initialised the
|
||||||
|
* environment the outer call was still using, so the loop below could
|
||||||
|
* never see control come back. No error, no bound, no diagnostic -- the
|
||||||
|
* one place in this interpreter that hung instead of raising.
|
||||||
|
*
|
||||||
|
* Taking it from the pool fixes both, and makes recursion depth answer to
|
||||||
|
* AKBASIC_MAX_ENVIRONMENTS like every other nesting: too deep is now
|
||||||
|
* "Environment pool exhausted", which is a diagnosis rather than a hang.
|
||||||
*/
|
*/
|
||||||
if ( fndef->environment == NULL ) {
|
PASS(errctx, akbasic_runtime_new_environment(obj));
|
||||||
PASS(errctx, akbasic_runtime_new_environment(obj));
|
callenv = obj->environment;
|
||||||
fndef->environment = obj->environment;
|
obj->environment = targetenv;
|
||||||
obj->environment = targetenv;
|
|
||||||
}
|
|
||||||
PASS(errctx, akbasic_environment_init(fndef->environment, obj, obj->environment));
|
|
||||||
|
|
||||||
/* Bind arguments into the function's scope before entering it. */
|
/*
|
||||||
|
* Bind arguments into the call's scope, evaluating each one in the caller's.
|
||||||
|
* Passing is by value: assignment is what copies, so a structure argument
|
||||||
|
* deep-copies and a pointer argument copies its reference.
|
||||||
|
*/
|
||||||
leafptr = (expr->right != NULL ? expr->right->right : NULL);
|
leafptr = (expr->right != NULL ? expr->right->right : NULL);
|
||||||
argptr = (fndef->arglist != NULL ? fndef->arglist->right : NULL);
|
argptr = (fndef->arglist != NULL ? fndef->arglist->right : NULL);
|
||||||
while ( leafptr != NULL && argptr != NULL ) {
|
while ( leafptr != NULL && argptr != NULL ) {
|
||||||
akbasic_Environment *callerenv = obj->environment;
|
|
||||||
PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue));
|
PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue));
|
||||||
obj->environment = fndef->environment;
|
obj->environment = callenv;
|
||||||
PASS(errctx, akbasic_environment_assign(fndef->environment, argptr, argvalue, &unused));
|
PASS(errctx, akbasic_environment_assign(callenv, argptr, argvalue, &unused));
|
||||||
obj->environment = callerenv;
|
obj->environment = targetenv;
|
||||||
leafptr = leafptr->next;
|
leafptr = leafptr->next;
|
||||||
argptr = argptr->next;
|
argptr = argptr->next;
|
||||||
}
|
}
|
||||||
|
|
||||||
obj->environment = fndef->environment;
|
obj->environment = callenv;
|
||||||
|
|
||||||
if ( fndef->expression != NULL ) {
|
if ( fndef->expression != NULL ) {
|
||||||
PASS(errctx, akbasic_runtime_evaluate(obj, fndef->expression, dest));
|
PASS(errctx, akbasic_runtime_evaluate(obj, fndef->expression, &result));
|
||||||
obj->environment = obj->environment->parent;
|
/*
|
||||||
|
* Copied into the *caller's* scratch before the call's environment goes
|
||||||
|
* back to the pool. Handing back a pointer into the callee is what made
|
||||||
|
* two calls in one expression collide, and it would now be a pointer
|
||||||
|
* into a released slot as well.
|
||||||
|
*/
|
||||||
|
PASS(errctx, akbasic_runtime_prev_environment(obj));
|
||||||
|
PASS(errctx, akbasic_environment_new_value(targetenv, &out));
|
||||||
|
PASS(errctx, akbasic_value_clone(result, out));
|
||||||
|
*dest = out;
|
||||||
SUCCEED_RETURN(errctx);
|
SUCCEED_RETURN(errctx);
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* A multi-line subroutine. Hand control to its environment and let the
|
* A multi-line subroutine. Hand control to its environment and let the
|
||||||
* caller's step loop run it until RETURN pops back out. The result is the
|
* caller's step loop run it until RETURN pops back out. RETURN parks its
|
||||||
* value RETURN parked in the child environment.
|
* result on the *parent* -- this environment -- precisely so it outlives the
|
||||||
|
* pop, and it is copied into a fresh scratch here for the same reason the
|
||||||
|
* single-expression form does.
|
||||||
*/
|
*/
|
||||||
obj->environment->gosubReturnLine = obj->environment->lineno + 1;
|
callenv->gosubReturnLine = callenv->lineno + 1;
|
||||||
obj->environment->nextline = fndef->lineno;
|
callenv->nextline = fndef->lineno;
|
||||||
while ( obj->environment != targetenv && obj->mode == AKBASIC_MODE_RUN ) {
|
while ( obj->environment != targetenv && obj->mode == AKBASIC_MODE_RUN ) {
|
||||||
PASS(errctx, akbasic_runtime_process_line_run(obj));
|
PASS(errctx, akbasic_runtime_process_line_run(obj));
|
||||||
}
|
}
|
||||||
*dest = &fndef->environment->returnValue;
|
PASS(errctx, akbasic_environment_new_value(targetenv, &out));
|
||||||
|
PASS(errctx, akbasic_value_clone(&targetenv->returnValue, out));
|
||||||
|
*dest = out;
|
||||||
SUCCEED_RETURN(errctx);
|
SUCCEED_RETURN(errctx);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -171,7 +171,16 @@ akerr_ErrorContext *akbasic_cmd_return(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
|
|||||||
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
|
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
|
||||||
"RETURN from an orphaned environment");
|
"RETURN from an orphaned environment");
|
||||||
obj->environment->parent->nextline = obj->environment->gosubReturnLine;
|
obj->environment->parent->nextline = obj->environment->gosubReturnLine;
|
||||||
PASS(errctx, akbasic_value_clone(result, &obj->environment->returnValue));
|
/*
|
||||||
|
* Parked on the *parent*, not on this environment.
|
||||||
|
*
|
||||||
|
* This one is about to be popped and released, so a caller reading a result
|
||||||
|
* out of it would be reading a pool slot that is free again -- safe only for
|
||||||
|
* as long as nothing else acquires one, which is not a property worth
|
||||||
|
* relying on. The parent is the caller, which is exactly who wants it, and
|
||||||
|
* it is still there afterwards.
|
||||||
|
*/
|
||||||
|
PASS(errctx, akbasic_value_clone(result, &obj->environment->parent->returnValue));
|
||||||
/*
|
/*
|
||||||
* Leaving an interrupt handler re-arms interrupts. Compared by identity
|
* Leaving an interrupt handler re-arms interrupts. Compared by identity
|
||||||
* rather than by a depth counter so that a GOSUB the handler itself makes
|
* rather than by a depth counter so that a GOSUB the handler itself makes
|
||||||
|
|||||||
@@ -49,7 +49,6 @@ static akerr_ErrorContext AKERR_NOIGNORE *clear_variables(akbasic_Runtime *obj)
|
|||||||
}
|
}
|
||||||
for ( i = 0; i < AKBASIC_MAX_FUNCTIONS; i++ ) {
|
for ( i = 0; i < AKBASIC_MAX_FUNCTIONS; i++ ) {
|
||||||
obj->functions[i].used = false;
|
obj->functions[i].used = false;
|
||||||
obj->functions[i].environment = NULL;
|
|
||||||
}
|
}
|
||||||
PASS(errctx, akbasic_valuepool_init(&obj->valuepool));
|
PASS(errctx, akbasic_valuepool_init(&obj->valuepool));
|
||||||
|
|
||||||
|
|||||||
23
tests/language/functions/recursion.bas
Normal file
23
tests/language/functions/recursion.bas
Normal file
@@ -0,0 +1,23 @@
|
|||||||
|
10 REM A DEF call takes its environment from the pool, one per call, exactly as
|
||||||
|
20 REM GOSUB does. It used to be owned by the funcdef and reset on every call,
|
||||||
|
30 REM which cost two silent defects: two calls in one expression shared a slot,
|
||||||
|
40 REM and recursion never came back at all.
|
||||||
|
50 DEF FACT(N#)
|
||||||
|
60 IF N# <= 1 THEN RETURN 1
|
||||||
|
70 RETURN N# * FACT(N# - 1)
|
||||||
|
80 PRINT FACT(5)
|
||||||
|
90 REM Each frame keeps its own argument, which is what makes the unwind work.
|
||||||
|
100 DEF SUMTO(N#)
|
||||||
|
110 IF N# <= 0 THEN RETURN 0
|
||||||
|
120 RETURN N# + SUMTO(N# - 1)
|
||||||
|
130 PRINT SUMTO(4)
|
||||||
|
140 REM And two calls to one function in one expression no longer collide.
|
||||||
|
150 DEF DBL(N#) = N# * 2
|
||||||
|
160 PRINT DBL(10) + DBL(1)
|
||||||
|
170 PRINT DBL(1) + DBL(10) + DBL(100)
|
||||||
|
180 REM Depth answers to the environment pool now, so runaway recursion reports
|
||||||
|
190 REM "Environment pool exhausted" rather than hanging. It is not exercised here
|
||||||
|
200 REM because the statement containing a failed call still prints a junk value
|
||||||
|
210 REM afterwards -- a separate, pre-existing defect recorded in TODO.md, and one
|
||||||
|
220 REM this golden file would pin if it went in. tests/user_functions.c asserts
|
||||||
|
230 REM the message instead.
|
||||||
4
tests/language/functions/recursion.txt
Normal file
4
tests/language/functions/recursion.txt
Normal file
@@ -0,0 +1,4 @@
|
|||||||
|
120
|
||||||
|
10
|
||||||
|
22
|
||||||
|
222
|
||||||
176
tests/user_functions.c
Normal file
176
tests/user_functions.c
Normal file
@@ -0,0 +1,176 @@
|
|||||||
|
/**
|
||||||
|
* @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;
|
||||||
|
}
|
||||||
Reference in New Issue
Block a user