andrew/akbasic
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add strict pointers: AS PTR TO, POINT ... AT, and the -> operator

Browse Source 
A pointer is a distinct declared kind rather than a mode a structure can be in,
which is what "strict" means here: `.` requires a structure on its left and `->`
requires a pointer, neither stands in for the other, and both refusals name the
operator the program should have used. So a reader always knows from the
spelling whether the thing on the left is their own copy or somebody else's
data.

Assignment still copies. POINT is the only way to share, so a program that never
writes it can never be surprised by aliasing -- and `P@ = A@` is refused with a
message saying to POINT it instead, rather than quietly becoming the one
assignment in the language that does not copy.

PTR TO is also the only way a TYPE may refer to itself, since by value it would
have no finite size. That is what makes a linked list possible, and
tests/language/structures/pointers.bas builds one, walks it and renders it.

Rendering follows pointers, so it needs a depth bound where copying does not:
copy stops at a pointer by construction, but two nodes pointing at each other is
easy to write and PRINT would not come back. Four levels, chosen so the bound
bites before the 256-byte render buffer does -- otherwise a cycle would stop
because it ran out of room rather than because it was told to.

Three things the work turned up, all now pinned by tests:

A freshly DIMmed record printed `(UNDEFINED STRING REPRESENTATION FOR 0)` for
every field. Slots now take the type their field declared, so it reads as zeros.

Adding POINT as a verb makes POINT unusable as a type name, and the parser
reported that as "Expected expression or literal" pointing at the line rather
than the problem. The prescan now refuses a reserved word as a type name and
says so.

Field names follow the same reserved-word rule as variable names, enforced by
the loader's own scan -- `TO@` is a bad field name for exactly the reason `TO#`
is a bad variable name. Recorded rather than worked around.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
Andrew Kesterson
2026-08-01 11:48:09 -04:00
parent 6a7c8cd920
commit 2a3f68d2c4
17 changed files with 488 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
CMakeLists.txt
View File

@@ -294,6 +294,7 @@ set(AKBASIC_TESTS
sink_tee
sprite_verbs
structure_verbs
struct_pointers
struct_types
trap_verbs
symtab

9
include/akbasic/structtype.h
View File

@@ -174,6 +174,15 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_resolve(struct akbasic_Runtime
/** @brief Evaluate a field access to the value it yields. */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_evaluate_field(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest);
/**
* @brief Give every slot of a fresh instance the type its field declared.
*
* So a record that has only been `DIM`med prints as zeros rather than as
* undefined values -- an answer instead of a puzzle. Recurses over the type
* graph, which is finite because a `TYPE` cannot contain itself by value.
*/
akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_init_slots(struct akbasic_Runtime *obj, int typeindex, akbasic_Value *base);
/** @brief Render an instance the way PRINT does, bounded by depth. */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_to_string(struct akbasic_Runtime *obj, int typeindex, akbasic_Value *base, int depth, char *dest, size_t len);

2
include/akbasic/types.h
View File

@@ -54,7 +54,7 @@
* recursion; it bounds the *rendering* of a structure, where a pointer can make
* the graph cyclic and PRINT would otherwise not come back.
*/
#define AKBASIC_MAX_STRUCT_DEPTH 8
#define AKBASIC_MAX_STRUCT_DEPTH 4
/* Commodore convention: true is -1, not 1. */
#define AKBASIC_TRUE -1

48
src/parser_commands.c
View File

@@ -568,6 +568,45 @@ akerr_ErrorContext *akbasic_parse_label(akbasic_Parser *parser, akbasic_ASTLeaf
* Making them reserved words would break any existing program with a variable
* called `AS#`, and they are only meaningful in this one position.
*/
/**
* @brief `POINT P@ AT target`.
*
* Two expressions with a word between them rather than a comma, because that is
* how it reads: the verb says what is being done and `AT` says which way round
* the two operands go. `POINT P@, A@` would read equally well in either
* direction, and getting it backwards would silently point the wrong thing.
*
* The two are chained through `.next`, the argument link, so the runtime reaches
* them with akbasic_leaf_first_argument() like any other verb's operands.
*/
akerr_ErrorContext *akbasic_parse_point(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *pointer = NULL;
akbasic_ASTLeaf *target = NULL;
akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *command = NULL;
akbasic_Token *word = NULL;
PASS(errctx, akbasic_parser_expression(parser, &pointer));
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER),
AKBASIC_ERR_SYNTAX, "Expected POINT <pointer> AT <structure>");
PASS(errctx, akbasic_parser_previous(parser, &word));
FAIL_ZERO_RETURN(errctx, (strcasecmp(word->lexeme, "AT") == 0), AKBASIC_ERR_SYNTAX,
"Expected AT after POINT <pointer>, not %s", word->lexeme);
PASS(errctx, akbasic_parser_expression(parser, &target));
pointer->next = target;
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
arglist->right = pointer;
PASS(errctx, akbasic_parser_new_leaf(parser, &command));
PASS(errctx, akbasic_leaf_new_command(command, "POINT", arglist));
*dest = command;
SUCCEED_RETURN(errctx);
}
/**
* @brief `TYPE NAME`, whose body was already read by the prescan.
*
@@ -605,7 +644,14 @@ akerr_ErrorContext *akbasic_parse_dim(akbasic_Parser *parser, akbasic_ASTLeaf **
PASS(errctx, akbasic_parser_previous(parser, &word));
if ( strcasecmp(word->lexeme, "PTR") == 0 ) {
command->literal_int = 1;
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER),
/*
* `TO` is already a verb -- FOR ... TO owns it -- so it arrives as a
* command token rather than an identifier. Matched by lexeme here for
* the same reason AS and PTR are: these three words mean something only
* in this one position, and reserving them would break any program with
* a variable called TO#.
*/
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
AKBASIC_ERR_SYNTAX, "Expected TO after PTR");
PASS(errctx, akbasic_parser_previous(parser, &word));
FAIL_ZERO_RETURN(errctx, (strcasecmp(word->lexeme, "TO") == 0), AKBASIC_ERR_SYNTAX,

8
src/runtime_commands.c
View File

@@ -317,7 +317,15 @@ static akerr_ErrorContext *dim_structure(akbasic_Runtime *obj, akbasic_ASTLeaf *
variable->values[0].valuetype = AKBASIC_TYPE_POINTER;
variable->values[0].structtype = typeindex;
variable->values[0].structbase = NULL;
SUCCEED_RETURN(errctx);
}
/*
* Give every slot the type its field declared, so a record that has just
* been DIMmed reads as zeros rather than as undefined values. A program can
* PRINT one before assigning anything, and `RECT(W#=0, H#=0)` is an answer
* where `(UNDEFINED STRING REPRESENTATION FOR 0)` is a puzzle.
*/
PASS(errctx, akbasic_struct_init_slots(obj, typeindex, variable->values));
SUCCEED_RETURN(errctx);
}

125
src/runtime_struct.c
View File

@@ -253,3 +253,128 @@ akerr_ErrorContext *akbasic_cmd_type(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- POINT --- */
/**
* @brief Find the slot a pointer *lives in*, which is not the same as its value.
*
* `POINT` writes a reference into a pointer, so it needs the storage rather than
* a copy of what is in it -- the same distinction `POKE` and `POINTER()` already
* make with `eval_clone_identifiers`. Both spellings of a pointer are accepted:
* a variable declared `AS PTR TO`, and a field declared the same way.
*/
static akerr_ErrorContext *pointer_slot(akbasic_Runtime *obj, akbasic_ASTLeaf *leaf,
akbasic_Value **slotdest, int *typedest)
{
PREPARE_ERROR(errctx);
akbasic_Variable *variable = NULL;
akbasic_StructField *field = NULL;
akbasic_Value *slot = NULL;
FAIL_ZERO_RETURN(errctx, (leaf != NULL), AKERR_NULLPOINTER, "NULL leaf in pointer_slot");
if ( leaf->leaftype == AKBASIC_LEAF_FIELD ) {
PASS(errctx, akbasic_struct_resolve(obj, leaf, &field, &slot));
FAIL_ZERO_RETURN(errctx, (field->kind == AKBASIC_FIELD_POINTER), AKBASIC_ERR_TYPE,
"%s is not a pointer; only a field declared PTR TO can be POINTed",
field->name);
*slotdest = slot;
*typedest = field->typeindex;
SUCCEED_RETURN(errctx);
}
FAIL_ZERO_RETURN(errctx, (leaf->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT),
AKBASIC_ERR_TYPE, "POINT expects a pointer on its left");
PASS(errctx, akbasic_environment_get(obj->environment, leaf->identifier, &variable));
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
"Identifier %s is undefined", leaf->identifier);
FAIL_ZERO_RETURN(errctx, (variable->ispointer), AKBASIC_ERR_TYPE,
"%s was not DIMmed AS PTR TO a type, so it cannot point at anything",
leaf->identifier);
*slotdest = &variable->values[0];
*typedest = variable->structtype;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_point(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *pointerleaf = NULL;
akbasic_ASTLeaf *targetleaf = NULL;
akbasic_Value *slot = NULL;
akbasic_Value *target = NULL;
int pointertype = -1;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in POINT");
pointerleaf = akbasic_leaf_first_argument(expr);
FAIL_ZERO_RETURN(errctx, (pointerleaf != NULL && pointerleaf->next != NULL),
AKBASIC_ERR_SYNTAX, "Expected POINT <pointer> AT <structure>");
targetleaf = pointerleaf->next;
PASS(errctx, pointer_slot(obj, pointerleaf, &slot, &pointertype));
PASS(errctx, akbasic_runtime_evaluate(obj, targetleaf, &target));
/*
* The target must be a structure, not another pointer. Pointing one pointer
* at another is spelled `Q@ = P@` -- assignment copies a reference, which is
* the one place in the language where copying does not deep-copy, and having
* two ways to write it would blur exactly the line this feature draws.
*/
FAIL_ZERO_RETURN(errctx, (target->valuetype == AKBASIC_TYPE_STRUCT), AKBASIC_ERR_TYPE,
(target->valuetype == AKBASIC_TYPE_POINTER
? "POINT ... AT takes a structure; to copy one pointer to another, assign it"
: "POINT ... AT takes a structure"));
FAIL_ZERO_RETURN(errctx, (target->structbase != NULL), AKBASIC_ERR_VALUE,
"That structure has no storage; DIM it AS a type first");
FAIL_ZERO_RETURN(errctx, (target->structtype == pointertype), AKBASIC_ERR_TYPE,
"This pointer is to %s and cannot be pointed at a %s",
obj->structtypes.types[pointertype].name,
obj->structtypes.types[target->structtype].name);
PASS(errctx, akbasic_value_zero(slot));
slot->valuetype = AKBASIC_TYPE_POINTER;
slot->structtype = target->structtype;
slot->structbase = target->structbase;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_struct_init_slots(akbasic_Runtime *obj, int typeindex, akbasic_Value *base)
{
PREPARE_ERROR(errctx);
akbasic_StructType *type = NULL;
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL && base != NULL), AKERR_NULLPOINTER,
"NULL argument in struct init_slots");
FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->structtypes.count),
AKBASIC_ERR_BOUNDS, "Structure type index %d is out of range", typeindex);
type = &obj->structtypes.types[typeindex];
for ( i = 0; i < type->fieldcount; i++ ) {
akbasic_StructField *field = &type->fields[i];
akbasic_Value *slot = base + field->offset;
switch ( field->kind ) {
case AKBASIC_FIELD_STRUCT:
/* Recurses over the type graph, which is finite: a TYPE cannot
contain itself by value, so this cannot run away. */
PASS(errctx, akbasic_struct_init_slots(obj, field->typeindex, slot));
break;
case AKBASIC_FIELD_POINTER:
PASS(errctx, akbasic_value_zero(slot));
slot->valuetype = AKBASIC_TYPE_POINTER;
slot->structtype = field->typeindex;
slot->structbase = NULL;
break;
default:
PASS(errctx, akbasic_value_zero(slot));
slot->valuetype = field->valuetype;
break;
}
}
SUCCEED_RETURN(errctx);
}

13
src/structtype.c
View File

@@ -28,6 +28,8 @@
#include <akbasic/runtime.h>
#include <akbasic/structtype.h>
#include "verbs.h"
/** @brief Step over spaces and tabs. */
static const char *skip_space(const char *cursor)
{
@@ -209,6 +211,7 @@ static akerr_ErrorContext *scan_names(akbasic_Runtime *obj)
int64_t i = 0;
int open = -1;
int existing = 0;
const akbasic_Verb *verb = NULL;
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
if ( obj->source[i].code[0] == '\0' ) {
@@ -240,6 +243,16 @@ static akerr_ErrorContext *scan_names(akbasic_Runtime *obj)
PASS(errctx, akbasic_structtype_find(table, name, &existing));
FAIL_NONZERO_RETURN(errctx, (existing >= 0), AKBASIC_ERR_VALUE,
"TYPE %s is declared twice", name);
/*
* A type name is a bare word, and so is every verb, so the two share a
* namespace whether we like it or not. Refused here with a message that
* says so -- left to the parser it comes out as "Expected expression or
* literal", pointing at the line rather than at the problem. This is the
* same check the scanner already makes for variable names.
*/
PASS(errctx, akbasic_verb_lookup(name, &verb));
FAIL_NONZERO_RETURN(errctx, (verb != NULL), AKBASIC_ERR_VALUE,
"TYPE %s: %s is a reserved word and cannot name a type", name, name);
FAIL_ZERO_RETURN(errctx, (table->count < AKBASIC_MAX_STRUCT_TYPES), AKBASIC_ERR_BOUNDS,
"More than %d TYPE declarations", AKBASIC_MAX_STRUCT_TYPES);

1
src/verbs.c
View File

@@ -120,6 +120,7 @@ static const akbasic_Verb VERBS[] = {
{ "PAINT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_paint },
{ "PEEK", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_peek },
{ "PLAY", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_play },
{ "POINT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_point, akbasic_cmd_point },
{ "POINTER", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_pointer },
{ "POINTERVAR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_pointervar },
{ "POKE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_poke, akbasic_cmd_poke },

2
src/verbs.h
View File

@@ -172,6 +172,8 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_paint(struct akbasic_Runtime *obj
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_scale(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_sshape(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Structures -- src/runtime_struct.c and src/parser_commands.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_point(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_point(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_type(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_type(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);

32
tests/language/structures/pointers.bas Normal file
View File

@@ -0,0 +1,32 @@
10 REM A strict pointer is a distinct declared kind. Assignment always copies;
20 REM POINT is the only way to share, so a program that never writes it can
30 REM never be surprised by aliasing.
40 TYPE NODE
50 COUNT#
60 TAIL@ AS PTR TO NODE
70 END TYPE
80 DIM N1@ AS NODE
90 DIM N2@ AS NODE
100 DIM N3@ AS NODE
110 N1@.COUNT# = 10
120 N2@.COUNT# = 20
130 N3@.COUNT# = 30
140 REM A TYPE may refer to itself only through PTR TO, which is what makes a
150 REM list possible at all -- by value it would have no finite size.
160 POINT N1@.TAIL@ AT N2@
170 POINT N2@.TAIL@ AT N3@
180 DIM WALK@ AS PTR TO NODE
190 POINT WALK@ AT N1@
200 PRINT WALK@->COUNT#
210 WALK@ = WALK@->TAIL@
220 PRINT WALK@->COUNT#
230 WALK@ = WALK@->TAIL@
240 PRINT WALK@->COUNT#
250 REM An unbound pointer is NOTHING, not a crash.
260 PRINT WALK@->TAIL@
270 REM Writing through a pointer changes what it points at.
280 POINT WALK@ AT N1@
290 WALK@->COUNT# = 99
300 PRINT N1@.COUNT#
310 REM And the whole list renders, following pointers as it goes.
320 PRINT N1@

6
tests/language/structures/pointers.txt Normal file
View File

@@ -0,0 +1,6 @@
10
20
30
NOTHING
99
NODE(COUNT#=99, TAIL@=NODE(COUNT#=20, TAIL@=NODE(COUNT#=30, TAIL@=NOTHING)))

6
tests/language/structures/records.bas
View File

@@ -1,12 +1,12 @@
10 REM A TYPE declares its fields; each takes its own type from its own suffix,
20 REM which is the same rule every other name in this language follows.
30 TYPE POINT
30 TYPE COORD
40 X#
50 Y#
60 END TYPE
70 TYPE SHAPE
80 NAME$
90 ORIGIN@ AS POINT
90 ORIGIN@ AS COORD
100 AREA%
110 END TYPE
120 DIM A@ AS SHAPE
@@ -22,7 +22,7 @@
220 PRINT A@
230 PRINT B@
240 REM A whole nested record copies as a unit too.
250 DIM P@ AS POINT
250 DIM P@ AS COORD
260 P@ = B@.ORIGIN@
270 PRINT P@
280 REM And a structure renders with its type name and its fields.

6
tests/language/structures/records.txt
View File

@@ -1,4 +1,4 @@
SHAPE(NAME$=CHANGED, ORIGIN@=POINT(X#=99, Y#=20), AREA%=2.500000)
SHAPE(NAME$=FIRST, ORIGIN@=POINT(X#=10, Y#=20), AREA%=2.500000)
POINT(X#=10, Y#=20)
SHAPE(NAME$=CHANGED, ORIGIN@=COORD(X#=99, Y#=20), AREA%=2.500000)
SHAPE(NAME$=FIRST, ORIGIN@=COORD(X#=10, Y#=20), AREA%=2.500000)
COORD(X#=10, Y#=20)
30

9
tests/language/structures/reserved_names.bas Normal file
View File

@@ -0,0 +1,9 @@
10 REM A type name and a field name are bare words, and so is every verb, so
20 REM they share a namespace whether we like it or not. Both are refused with
30 REM the same rule the scanner already applies to variable names -- and a type
40 REM name is refused by the prescan, which can say so plainly rather than
50 REM leaving the parser to report "Expected expression or literal".
60 TYPE POINT
70 X#
80 END TYPE
90 PRINT 1

2
tests/language/structures/reserved_names.txt Normal file
View File

@@ -0,0 +1,2 @@
? 90 : PARSE ERROR TYPE POINT: POINT is a reserved word and cannot name a type

209
tests/struct_pointers.c Normal file
View File

@@ -0,0 +1,209 @@
/**
* @file struct_pointers.c
* @brief Tests strict pointers: `PTR TO`, `POINT ... AT`, and `->`.
*
* The assertions worth having here are the *refusals*. A pointer that works is
* visible in tests/language/structures/; a pointer that should not have worked
* is not, because the failure mode of a missing check is a program that keeps
* going and gives the wrong answer later.
*
* "Strict" means the two operators do not stand in for one another: `.` needs a
* structure and `->` needs a pointer, so a reader always knows from the spelling
* whether the thing on the left is their own copy or somebody else's data.
*/
#include <string.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include <akbasic/structtype.h>
#include "harness.h"
#include "testutil.h"
/** @brief A RECT, an instance, and a pointer already aimed at it. */
static const char *PRELUDE =
"10 TYPE RECT\n"
"20 W#\n"
"30 H#\n"
"40 END TYPE\n"
"50 DIM A@ AS RECT\n"
"60 DIM P@ AS PTR TO RECT\n"
"70 A@.W# = 3\n"
"80 A@.H# = 4\n"
"90 POINT P@ AT A@\n";
/** @brief Run the prelude plus @p tail, and leave the output in HARNESS_OUTPUT. */
static akerr_ErrorContext AKERR_NOIGNORE *run_with(const char *tail)
{
PREPARE_ERROR(errctx);
char source[2048];
snprintf(source, sizeof(source), "%s%s", PRELUDE, tail);
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, 4000));
SUCCEED_RETURN(errctx);
}
/** @brief Writing through a pointer changes the thing it points at. */
static void test_pointer_writes_through(void)
{
TEST_REQUIRE_OK(run_with("100 P@->W# = 99\n110 PRINT A@.W#\n"));
TEST_REQUIRE_STR(HARNESS_OUTPUT, "99\n");
harness_stop();
}
/**
* @brief Assignment still copies, even with a pointer in the room.
*
* The property the whole design rests on: `POINT` is the only way to share, so
* a program that never writes it can never be surprised by aliasing.
*/
static void test_assignment_still_copies(void)
{
TEST_REQUIRE_OK(run_with("100 DIM B@ AS RECT\n"
"110 B@ = A@\n"
"120 P@->W# = 7\n"
"130 PRINT A@.W#\n"
"140 PRINT B@.W#\n"));
TEST_REQUIRE_STR(HARNESS_OUTPUT, "7\n3\n");
harness_stop();
}
/**
* @brief The two operators do not stand in for one another.
*
* Both messages name the other operator, because the mistake is always one of
* the two and saying which is most of the fix.
*/
static void test_wrong_operator_refused(void)
{
TEST_REQUIRE_OK(run_with("100 PRINT P@.W#\n"));
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "use -> to reach a field through a pointer") != NULL,
"'.' on a pointer should say to use ->, got \"%s\"", HARNESS_OUTPUT);
harness_stop();
TEST_REQUIRE_OK(run_with("100 PRINT A@->W#\n"));
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "use . to reach a field of a structure") != NULL,
"'->' on a structure should say to use ., got \"%s\"", HARNESS_OUTPUT);
harness_stop();
}
/** @brief A pointer that has never been POINTed is not a null dereference. */
static void test_unbound_pointer_refused(void)
{
TEST_REQUIRE_OK(run_with("100 DIM Q@ AS PTR TO RECT\n110 PRINT Q@->W#\n"));
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "not pointing at anything") != NULL,
"an unbound pointer should refuse by name, got \"%s\"", HARNESS_OUTPUT);
harness_stop();
/* And it renders as NOTHING rather than as a crash or an empty line. */
TEST_REQUIRE_OK(run_with("100 DIM Q@ AS PTR TO RECT\n110 PRINT Q@\n"));
TEST_REQUIRE_STR(HARNESS_OUTPUT, "NOTHING\n");
harness_stop();
}
/** @brief A pointer is to one type and will not be aimed at another. */
static void test_pointer_type_is_checked(void)
{
TEST_REQUIRE_OK(run_with("100 TYPE OTHER\n"
"110 N#\n"
"120 END TYPE\n"
"130 DIM O@ AS OTHER\n"
"140 POINT P@ AT O@\n"));
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "cannot be pointed at") != NULL,
"a pointer to RECT should refuse an OTHER, got \"%s\"", HARNESS_OUTPUT);
harness_stop();
}
/**
* @brief A structure cannot be assigned to a pointer, and the message says why.
*
* The two are spelled differently on purpose. Allowing `P@ = A@` to mean "point
* at" would make assignment sometimes copy and sometimes alias, which is the one
* ambiguity this design exists to avoid.
*/
static void test_structure_not_assignable_to_pointer(void)
{
TEST_REQUIRE_OK(run_with("100 P@ = A@\n"));
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "POINT it AT") != NULL,
"assigning a structure to a pointer should say to POINT it, got \"%s\"",
HARNESS_OUTPUT);
harness_stop();
}
/**
* @brief A list is built, walked and rendered -- the reason pointers exist.
*
* Walked with reassignment rather than recursion, deliberately: a recursive
* multi-line DEF does not return in this interpreter, which is recorded in
* TODO.md and is not this feature's to fix.
*/
static void test_linked_list(void)
{
TEST_REQUIRE_OK(harness_start(NULL));
TEST_REQUIRE_OK(akbasic_runtime_load(&HARNESS_RUNTIME,
"10 TYPE NODE\n"
"20 COUNT#\n"
"30 TAIL@ AS PTR TO NODE\n"
"40 END TYPE\n"
"50 DIM N1@ AS NODE\n"
"60 DIM N2@ AS NODE\n"
"70 N1@.COUNT# = 10\n"
"80 N2@.COUNT# = 20\n"
"90 POINT N1@.TAIL@ AT N2@\n"
"100 DIM WALK@ AS PTR TO NODE\n"
"110 POINT WALK@ AT N1@\n"
"120 PRINT WALK@->COUNT#\n"
"130 WALK@ = WALK@->TAIL@\n"
"140 PRINT WALK@->COUNT#\n"));
TEST_REQUIRE_OK(akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
TEST_REQUIRE_OK(akbasic_runtime_run(&HARNESS_RUNTIME, 4000));
TEST_REQUIRE_STR(HARNESS_OUTPUT, "10\n20\n");
harness_stop();
}
/**
* @brief A cycle renders to a bounded depth instead of forever.
*
* Copy cannot follow a pointer, so no *copy* can loop -- but rendering must
* follow one or a list would not be worth printing, and two nodes pointing at
* each other is easy to write by accident.
*/
static void test_cycle_renders_bounded(void)
{
TEST_REQUIRE_OK(harness_start(NULL));
TEST_REQUIRE_OK(akbasic_runtime_load(&HARNESS_RUNTIME,
"10 TYPE NODE\n"
"20 COUNT#\n"
"30 TAIL@ AS PTR TO NODE\n"
"40 END TYPE\n"
"50 DIM A@ AS NODE\n"
"60 DIM B@ AS NODE\n"
"70 POINT A@.TAIL@ AT B@\n"
"80 POINT B@.TAIL@ AT A@\n"
"90 PRINT A@\n"));
TEST_REQUIRE_OK(akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN));
TEST_REQUIRE_OK(akbasic_runtime_run(&HARNESS_RUNTIME, 4000));
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "(...)") != NULL,
"a cycle should stop at the depth bound, got \"%s\"", HARNESS_OUTPUT);
harness_stop();
}
int main(void)
{
TEST_REQUIRE_OK(akbasic_error_register());
test_pointer_writes_through();
test_assignment_still_copies();
test_wrong_operator_refused();
test_unbound_pointer_refused();
test_pointer_type_is_checked();
test_structure_not_assignable_to_pointer();
test_linked_list();
test_cycle_renders_bounded();
return akbasic_test_failures;
}

26
tests/struct_types.c
View File

@@ -76,25 +76,29 @@ static void test_nesting_flattens(void)
akbasic_StructField *field = NULL;
int index = -1;
TEST_REQUIRE_OK(declare("10 TYPE POINT\n"
TEST_REQUIRE_OK(declare("10 TYPE COORD\n"
"20 X#\n"
"30 Y#\n"
"40 END TYPE\n"
"50 TYPE LINE\n"
"60 FROM@ AS POINT\n"
"70 TO@ AS POINT\n"
"50 TYPE SEGMENT\n"
"60 SRC@ AS COORD\n"
"70 DEST@ AS COORD\n"
"80 NAME$\n"
"90 END TYPE\n"
"100 PRINT 1\n"));
TEST_REQUIRE_OK(akbasic_structtype_find(&HARNESS_RUNTIME.structtypes, "LINE", &index));
TEST_REQUIRE(index >= 0, "LINE should have been declared");
/* Two points of two slots each, plus one string: five, not three. */
TEST_REQUIRE_OK(akbasic_structtype_find(&HARNESS_RUNTIME.structtypes, "SEGMENT", &index));
TEST_REQUIRE(index >= 0, "SEGMENT should have been declared");
if ( index < 0 ) {
harness_stop();
return;
}
/* Two coordinates of two slots each, plus one string: five, not three. */
TEST_REQUIRE_INT(HARNESS_RUNTIME.structtypes.types[index].slotcount, 5);
TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "FROM@", &field));
TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "SRC@", &field));
TEST_REQUIRE_INT(field->offset, 0);
TEST_REQUIRE_INT(field->slotcount, 2);
TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "TO@", &field));
TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "DEST@", &field));
TEST_REQUIRE_INT(field->offset, 2);
TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "NAME$", &field));
TEST_REQUIRE_INT(field->offset, 4);
@@ -120,6 +124,10 @@ static void test_forward_reference(void)
"70 PRINT 1\n"));
TEST_REQUIRE_OK(akbasic_structtype_find(&HARNESS_RUNTIME.structtypes, "OUTER", &index));
TEST_REQUIRE(index >= 0, "OUTER should have been declared");
if ( index < 0 ) {
harness_stop();
return;
}
TEST_REQUIRE_INT(HARNESS_RUNTIME.structtypes.types[index].slotcount, 1);
harness_stop();
}