JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A dyn at, set-at or push that traps names the file, line and column it was written at

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 10:25:28 +07:00
parent 4d10f3c327
commit 5581bafacb
9 changed files with 231 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
TODO.org
View File

@ -1259,6 +1259,14 @@ Five words in every build rather than the spec's four, and for a stated reason:
redefinition module is built separately from its host and nothing makes the two
agree on a struct size. Give the reload path a way to carry the build flags and
this falls out.
Decision needed first: a four-word release header means release builds no longer
trap on a released region (the epoch check is what reads the fifth word), where
today every build does. Checked 2026-09-25 and not contained either way: the
reload side is already consistent (modules and their hosts are both dev builds),
but the runtime C is compiled with no dev define, so the change is a
dev-conditional =flan_vec= in flan_rt.c, its mirror in flan_dyn.c and
test/dyn_ops.c, =%vec= and the Vec's size in both emitters and the debug info,
and the Map, whose header carries the same word.
** DONE arena-destroy under a live view reads freed memory
CLOSED: [2026-09-25]
@ -1403,11 +1411,14 @@ argument passing at a call site whose register file is exactly full. The dev-sid
half is different work: the trap hook hands control to a session in-process with
the compiler, which can read the source.
** TODO trap_oom has no site
It is reached from the allocator, which has no site to be given. The range trap
already carries the location pair and every caller passes null, so giving =at=,
=set-at= and =push= a site is a call-site change rather than another round of
signature churn.
** DONE trap_oom has no site
CLOSED: [2026-09-25]
=flan_dyn_at=, =flan_dyn_set_at= and =flan_dyn_push= take the call's site as
ptr+len, like the arithmetic, and every trap they reach prints it — type, range,
a view's tag check, and push's growth failing. =trap_oom= takes a site and only
push gives one: its other callers are the collector's own allocations, which
have no line to name. A stale view's check, reached through =view_len= from the
printers as well, stays siteless.
** TODO A restart has no location
The restart frame is mirrored across both backends and the runtime, so giving

9
lib/check.ml
View File

@ -3519,7 +3519,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
let i = check ctx ~want:Types.Dyn idx in
let v = check ctx ~want:Types.Dyn v in
expect ctx loc ~want
(rt loc Types.Unit "flan_dyn_set_at" [ target; i; v ])
(rt loc Types.Unit "flan_dyn_set_at" [ target; i; v; here loc ])
else begin
let p, pty =
match target.Tast.ty with
@ -3562,7 +3562,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
List.map
(fun x ->
rt loc Types.Unit "flan_dyn_push"
[ vval; check ctx ~want:Types.Dyn x ])
[ vval; check ctx ~want:Types.Dyn x; here loc ])
items
in
mk loc Types.Dyn
@ -7473,7 +7473,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
if target.Tast.ty = Types.Dyn then
expect ctx loc ~want
(rt loc Types.Unit "flan_dyn_push"
[ target; check ctx ~want:Types.Dyn x ])
[ target; check ctx ~want:Types.Dyn x; here loc ])
else begin
let elem = vec_elem loc "push" target.Tast.ty in
let x = check ctx ~want:elem x in
@ -8264,7 +8264,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
(match idx with
| [ i ] ->
expect ctx loc ~want
(rt loc Types.Dyn "flan_dyn_at" [ target; check ctx ~want:Types.Dyn i ])
(rt loc Types.Dyn "flan_dyn_at"
[ target; check ctx ~want:Types.Dyn i; here loc ])
| _ ->
fail loc
"(at ...) over a dyn takes one index — write (at (at x i) j)")

8
lib/emit.ml
View File

@ -4230,7 +4230,7 @@ declare i64 @flan_dyn_kw(ptr, i64)
declare i64 @flan_dyn_map_get(i64, i64)
declare void @flan_dyn_map_set(i64, i64, i64)
declare i64 @flan_dyn_map_contains(i64, i64)
; The nine that trap carry the site as ptr+len, the way the bounds and
; The ones that trap carry the site as ptr+len, the way the bounds and
; arithmetic traps do: a dyn type error IS the type error in a dynamic
; program, and it used to print with no file and no line. [eq] never traps,
; so it has nowhere to put one.
@ -4245,9 +4245,9 @@ declare i64 @flan_dyn_gt(i64, i64, ptr, i64)
declare i64 @flan_dyn_ge(i64, i64, ptr, i64)
declare i64 @flan_dyn_eq(i64, i64)
declare i64 @flan_dyn_len(i64)
declare i64 @flan_dyn_at(i64, i64)
declare void @flan_dyn_set_at(i64, i64, i64)
declare void @flan_dyn_push(i64, i64)
declare i64 @flan_dyn_at(i64, i64, ptr, i64)
declare void @flan_dyn_set_at(i64, i64, i64, ptr, i64)
declare void @flan_dyn_push(i64, i64, ptr, i64)
declare void @flan_dyn_print(i64)
declare void @flan_dyn_emit_dev(i64)
declare void @flan_dyn_emit_watch(i64)

102
runtime/flan_dyn.c
View File

@ -810,9 +810,9 @@ static void say(char *buf, int64_t cap, flan_dyn v) {
*
* A NULL [loc] prints nothing at all and the sentence after it is byte for
* byte the one this file printed before: the entry points that have not been
* given a site yet (every one but the five arithmetic and four ordering ones)
* pass NULL, and so does test/dyn_ops.c, which calls the runtime directly and
* has no source position to offer. */
* given a site (everything but the arithmetic, the ordering, [at], [set-at]
* and [push]) pass NULL, and so does test/dyn_ops.c, which calls the runtime
* directly and has no source position to offer. */
static void trap_where(const uint8_t *loc, int64_t loclen) {
if (loc != NULL && loclen > 0)
fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc);
@ -845,10 +845,7 @@ static _Noreturn void trap1(const uint8_t *loc, int64_t loclen,
#define TYPE_TRAP "DynType", 7
#define ARITH_TRAP "DynArith", 8
/* No site reaches these two yet: [at], [set-at], [push] and the allocator
* paths are not among the nine entry points this pass gave a location to. The
* parameter is here so that giving them one later is a call-site change and
* not another round of signature churn. */
/* [at] and [set-at]'s, with the site their call was written at. */
static _Noreturn void trap_range(const uint8_t *loc, int64_t loclen,
const char *op, flan_dyn v, int64_t i,
int64_t len) {
@ -921,9 +918,16 @@ void flan_gc_collect(void) {
* not recoverable by anything this file can do. It takes the trap path like
* everything else, so a dev session parks on it and can be read, rather than
* the allocation quietly answering NULL and every caller below growing a null
* check for a case none of them can handle. */
static _Noreturn void trap_oom(int64_t want) {
* check for a case none of them can handle.
*
* [push] is the one caller with a site to give: its growth is the allocation
* a program's own line asked for. Every other caller is the collector's own
* bookkeeping — an object, a class table, the keyword table — and passes
* NULL, which prints no prefix. */
static _Noreturn void trap_oom(const uint8_t *loc, int64_t loclen,
int64_t want) {
fflush(stdout);
trap_where(loc, loclen);
fprintf(stderr,
"dyn heap: %lld bytes could not be allocated, with %lld live\n",
(long long)want, (long long)gc_bytes);
@ -936,7 +940,7 @@ static flan_obj *gc_alloc(uint8_t kind, int64_t extra) {
if (!gc_ready) flan_gc_init();
if (gc_bytes + need > gc_next) flan_gc_collect();
o = (flan_obj *)malloc((size_t)need);
if (o == NULL) trap_oom(need);
if (o == NULL) trap_oom(NULL, 0, need);
o->next = gc_all;
o->kind = kind;
o->mark = 0;
@ -972,7 +976,7 @@ static void mark_push(flan_obj *o) {
if (mstack_n == mstack_cap) {
int64_t cap = mstack_cap ? mstack_cap * 2 : 64;
flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m);
if (m == NULL) trap_oom(cap * (int64_t)sizeof *m);
if (m == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *m);
mstack = m;
mstack_cap = cap;
}
@ -1032,7 +1036,7 @@ static void root_add(void *base, const flan_desc *d) {
if (roots_n == roots_cap) {
int64_t cap = roots_cap ? roots_cap * 2 : 64;
flan_root *r = (flan_root *)realloc(roots, (size_t)cap * sizeof *r);
if (r == NULL) trap_oom(cap * (int64_t)sizeof *r);
if (r == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *r);
roots = r;
roots_cap = cap;
}
@ -1274,7 +1278,7 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
}
if (count > 0) {
list = (kw_entry **)malloc((size_t)count * sizeof *list);
if (list == NULL) trap_oom(count * (int64_t)sizeof *list);
if (list == NULL) trap_oom(NULL, 0, count * (int64_t)sizeof *list);
count = 0;
for (i = 0, start = 0; i <= n; i++)
if (i == n ? i > start : slots[i] == '\n') {
@ -1304,7 +1308,7 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
int64_t cap = classes_cap ? classes_cap * 2 : 8;
class_entry *t =
(class_entry *)realloc(classes, (size_t)cap * sizeof *t);
if (t == NULL) trap_oom(cap * (int64_t)sizeof *t);
if (t == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *t);
classes = t;
classes_cap = cap;
}
@ -1349,7 +1353,7 @@ static void class_sync(flan_obj *o) {
if (e == NULL || e->gen == o->gen) return;
if (e->nslots > 0) {
fresh = (flan_dyn *)malloc((size_t)e->nslots * 2 * sizeof *fresh);
if (fresh == NULL) trap_oom(e->nslots * 2 * (int64_t)sizeof *fresh);
if (fresh == NULL) trap_oom(NULL, 0, e->nslots * 2 * (int64_t)sizeof *fresh);
}
for (j = 0; j < e->nslots; j++) {
flan_dyn v = dyn_make(BOX_NIL, 0);
@ -1442,12 +1446,12 @@ flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n) {
if (kws_n == kws_cap) {
int64_t cap = kws_cap ? kws_cap * 2 : 32;
kw_entry **t = (kw_entry **)realloc(kws, (size_t)cap * sizeof *t);
if (t == NULL) trap_oom(cap * (int64_t)sizeof *t);
if (t == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *t);
kws = t;
kws_cap = cap;
}
k = (kw_entry *)malloc(sizeof(kw_entry) + (size_t)n);
if (k == NULL) trap_oom((int64_t)sizeof(kw_entry) + n);
if (k == NULL) trap_oom(NULL, 0, (int64_t)sizeof(kw_entry) + n);
k->len = n;
if (n > 0) memcpy(kw_bytes(k), p, (size_t)n);
kws[kws_n++] = k;
@ -2042,13 +2046,13 @@ static flan_dyn vecish_at(flan_obj *o, int64_t i) {
* view's element type wants, or this traps by name and never coerces or
* truncates a mismatched value into the slot. [v] is the view, for the
* sentence's container half; [x] is the value that was refused. */
static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x,
uint8_t *p) {
static void view_unbox(const uint8_t *loc, int64_t loclen, const char *op,
flan_dyn v, int32_t elem, flan_dyn x, uint8_t *p) {
switch (elem) {
case FLAN_VIEW_I64: {
int64_t n;
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT)
trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are int", v, x);
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are int", v, x);
n = dyn_int_value(x);
memcpy(p, &n, 8);
return;
@ -2056,7 +2060,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x,
case FLAN_VIEW_F64: {
double d;
if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT)
trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are float", v, x);
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x);
d = dyn_num_value(x);
memcpy(p, &d, 8);
return;
@ -2064,7 +2068,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x,
default: {
uint8_t b;
if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL)
trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are bool", v, x);
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x);
b = dyn_payload(x) ? 1 : 0;
*p = b;
return;
@ -2111,81 +2115,89 @@ flan_dyn flan_dyn_len(flan_dyn v) {
/* The index has to be an int, and that is a separate sentence from the
* container being wrong: (at v "1") and (at 3 1) are two different mistakes
* and telling somebody "these are the wrong types" names neither. */
static int64_t need_index(const char *op, flan_dyn v, flan_dyn i) {
static int64_t need_index(const uint8_t *loc, int64_t loclen, const char *op,
flan_dyn v, flan_dyn i) {
if (flan_dyn_tag(i) != FLAN_DYN_TAG_INT)
trap2(NULL, 0, TYPE_TRAP, op, "an index must be an int", v, i);
trap2(loc, loclen, TYPE_TRAP, op, "an index must be an int", v, i);
return dyn_int_value(i);
}
/* A text answers a byte, as an int. That is what [(at s i)] on a
* [(Slice u8)] does in the typed language, and a text is a run of bytes in
* both. Codepoints are utf8's job and stay there. */
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) {
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
int64_t loclen) {
int64_t k;
flan_obj *o;
if (!is_text(v) && !is_vec(v))
trap2(NULL, 0, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i);
k = need_index("at", v, i);
trap2(loc, loclen, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i);
k = need_index(loc, loclen, "at", v, i);
o = dyn_obj(v);
if (o->kind == OBJ_VIEW) {
int64_t len = view_len("at", o);
if (k < 0 || k >= len) trap_range(NULL, 0, "at", v, k, len);
if (k < 0 || k >= len) trap_range(loc, loclen, "at", v, k, len);
return view_box(o->u.view.elem,
(const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem));
}
if (k < 0 || k >= o->len) trap_range(NULL, 0, "at", v, k, o->len);
if (k < 0 || k >= o->len) trap_range(loc, loclen, "at", v, k, o->len);
if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]);
return o->u.v.items[k];
}
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) {
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
int64_t loclen) {
int64_t k;
flan_obj *o;
if (is_text(v))
trap2(NULL, 0, TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i);
trap2(loc, loclen, TYPE_TRAP, "set-at",
"a text is immutable — build another one", v, i);
if (!is_vec(v))
trap2(NULL, 0, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i);
k = need_index("set-at", v, i);
trap2(loc, loclen, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i);
k = need_index(loc, loclen, "set-at", v, i);
o = dyn_obj(v);
if (o->kind == OBJ_VIEW) {
int64_t len = view_len("set-at", o);
uint8_t *p;
if (k < 0 || k >= len) trap_range(NULL, 0, "set-at", v, k, len);
if (k < 0 || k >= len) trap_range(loc, loclen, "set-at", v, k, len);
p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem);
view_unbox("set-at", v, o->u.view.elem, x, p);
view_unbox(loc, loclen, "set-at", v, o->u.view.elem, x, p);
return;
}
if (k < 0 || k >= o->len) trap_range(NULL, 0, "set-at", v, k, o->len);
if (k < 0 || k >= o->len) trap_range(loc, loclen, "set-at", v, k, o->len);
o->u.v.items[k] = x;
}
void flan_dyn_push(flan_dyn v, flan_dyn x) {
void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen) {
flan_obj *o;
if (!is_vec(v)) {
/* The value is in the sentence rather than the vec, because the vec is the
* thing that is wrong and the value is what says which push it was. */
trap2(NULL, 0, TYPE_TRAP, "push", "only a vec is pushed to", v, x);
trap2(loc, loclen, TYPE_TRAP, "push", "only a vec is pushed to", v, x);
}
o = dyn_obj(v);
if (o->kind == OBJ_VIEW) {
uint8_t buf[8];
/* The typed Vec's own traps print a site too, and without one from the
* caller the best this can name is the operation. */
static const uint8_t push_loc[] = "(dyn push)";
const uint8_t *site = loc != NULL && loclen > 0 ? loc : push_loc;
int64_t sitelen = loc != NULL && loclen > 0 ? loclen
: (int64_t)sizeof(push_loc) - 1;
int64_t size;
if (!o->u.view.is_vec)
trap2(NULL, 0, TYPE_TRAP, "push",
trap2(loc, loclen, TYPE_TRAP, "push",
"this view is a slice or an array and cannot grow", v, x);
size = view_elem_size(o->u.view.elem);
view_unbox("push", v, o->u.view.elem, x, buf);
if (!flan_vec_push(o->u.view.base, buf, size, size, push_loc,
(int64_t)sizeof(push_loc) - 1))
trap_oom(size);
view_unbox(loc, loclen, "push", v, o->u.view.elem, x, buf);
if (!flan_vec_push(o->u.view.base, buf, size, size, site, sitelen))
trap_oom(loc, loclen, size);
return;
}
if (o->len == o->u.v.cap) {
int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8;
flan_dyn *items =
(flan_dyn *)realloc(o->u.v.items, (size_t)cap * sizeof *items);
if (items == NULL) trap_oom(cap * (int64_t)sizeof *items);
if (items == NULL) trap_oom(loc, loclen, cap * (int64_t)sizeof *items);
/* The growth is charged to the heap so the trigger sees it, and it is
* charged *here* rather than at the next collection because a vec that
* doubles a dozen times between allocations would otherwise be invisible
@ -2260,7 +2272,7 @@ void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) {
int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8;
flan_dyn *items =
(flan_dyn *)realloc(o->u.v.items, (size_t)cap * 2 * sizeof *items);
if (items == NULL) trap_oom(cap * 2 * (int64_t)sizeof *items);
if (items == NULL) trap_oom(NULL, 0, cap * 2 * (int64_t)sizeof *items);
/* Charged now for the reason push's growth is: the trigger has to see
* the block while it is growing, not after. */
gc_bytes += (cap - o->u.v.cap) * 2 * (int64_t)sizeof *items;

12
runtime/flan_dyn.h
View File

@ -166,12 +166,16 @@ flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b);
/* Bytes of a text, elements of a vec. Anything else traps. */
flan_dyn flan_dyn_len(flan_dyn v);
/* Element of a vec, or the byte of a text as an int. Out of range traps. */
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i);
/* Element of a vec, or the byte of a text as an int. Out of range traps.
* [loc] is where the call was written, printed ahead of a trap's sentence; NULL
* prints none. The same pair [flan_dyn_add] takes. */
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
int64_t loclen);
/* Vec only — a text is immutable and says so rather than being copied. */
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x);
void flan_dyn_push(flan_dyn v, flan_dyn x);
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
int64_t loclen);
void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen);
/* Map only; anything else traps by name. Keys and values are both dyn and a
* key is compared structurally, so a keyword, a text, an int, or a whole map

11
runtime/flan_dyn_stub.c
View File

@ -263,21 +263,26 @@ flan_dyn flan_dyn_len(flan_dyn v) {
return flan_dyn_from_i64(need_vec(v)->u.v.len);
}
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) {
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
int64_t loclen) {
(void)loc; (void)loclen;
cell *c = need_vec(v);
int64_t k = need_index(i);
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
return word(c->u.v.items[k]);
}
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) {
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
int64_t loclen) {
(void)loc; (void)loclen;
cell *c = need_vec(v);
int64_t k = need_index(i);
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
c->u.v.items[k] = as(x);
}
void flan_dyn_push(flan_dyn v, flan_dyn x) {
void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen) {
(void)loc; (void)loclen;
cell *c = need_vec(v);
if (c->u.v.len == c->u.v.cap) {
int64_t cap = c->u.v.cap * 2;

181
test/dyn_ops.c
View File

@ -40,10 +40,13 @@
* rather than a hand-copied list. */
#include "flan_dyn.h"
/* The nine trapping operators took a site — (loc, len) — when flan_dyn.c's
* traps learned to print a file and a line. This file calls the runtime
* directly and has no source position to offer, so it passes (NULL, 0), which
* prints the sentence exactly as it printed before. */
/* The trapping operators take a site — (loc, len) — which flan_dyn.c's traps
* print as a file and a line. This file calls the runtime directly and has no
* source position to offer, so it passes (NULL, 0), which prints the sentence
* with no prefix. */
#define FDYN_at(v, i) flan_dyn_at((v), (i), NULL, 0)
#define FDYN_set_at(v, i, x) flan_dyn_set_at((v), (i), (x), NULL, 0)
#define FDYN_push(v, x) flan_dyn_push((v), (x), NULL, 0)
#define FDYN_add(a, b) flan_dyn_add((a), (b), NULL, 0)
#define FDYN_sub(a, b) flan_dyn_sub((a), (b), NULL, 0)
#define FDYN_mul(a, b) flan_dyn_mul((a), (b), NULL, 0)
@ -244,14 +247,14 @@ static void ops(void) {
check(!truth(flan_dyn_eq(a, c)), "= text sees the last byte");
check(truth(flan_dyn_eq(a, a)), "= text against itself");
check(num(flan_dyn_len(a)) == 5, "len text");
check(num(flan_dyn_at(a, flan_dyn_from_i64(0))) == 'h', "at text");
check(num(flan_dyn_at(a, flan_dyn_from_i64(4))) == 'o', "at text last");
check(num(FDYN_at(a, flan_dyn_from_i64(0))) == 'h', "at text");
check(num(FDYN_at(a, flan_dyn_from_i64(4))) == 'o', "at text last");
{
/* Embedded NUL, because a length-prefixed text is the claim and strlen is
how that claim gets quietly broken. */
flan_dyn z = flan_dyn_from_bytes((const uint8_t *)"a\0b", 3);
check(num(flan_dyn_len(z)) == 3, "len counts past a NUL");
check(num(flan_dyn_at(z, flan_dyn_from_i64(2))) == 'b', "at past a NUL");
check(num(FDYN_at(z, flan_dyn_from_i64(2))) == 'b', "at past a NUL");
check(!truth(flan_dyn_eq(z, text("a"))), "= does not stop at a NUL");
}
{
@ -264,13 +267,13 @@ static void ops(void) {
/* Vecs. */
v = flan_dyn_vec_new();
check(num(flan_dyn_len(v)) == 0, "len of a new vec");
flan_dyn_push(v, flan_dyn_from_i64(1));
flan_dyn_push(v, flan_dyn_from_i64(2));
flan_dyn_push(v, flan_dyn_from_i64(3));
FDYN_push(v, flan_dyn_from_i64(1));
FDYN_push(v, flan_dyn_from_i64(2));
FDYN_push(v, flan_dyn_from_i64(3));
check(num(flan_dyn_len(v)) == 3, "len after three pushes");
check(num(flan_dyn_at(v, flan_dyn_from_i64(1))) == 2, "at vec");
flan_dyn_set_at(v, flan_dyn_from_i64(1), text("two"));
check(truth(flan_dyn_eq(flan_dyn_at(v, flan_dyn_from_i64(1)), text("two"))),
check(num(FDYN_at(v, flan_dyn_from_i64(1))) == 2, "at vec");
FDYN_set_at(v, flan_dyn_from_i64(1), text("two"));
check(truth(flan_dyn_eq(FDYN_at(v, flan_dyn_from_i64(1)), text("two"))),
"set-at vec");
{
/* Past the initial capacity, so the growth path runs and the elements
@ -278,10 +281,10 @@ static void ops(void) {
int i;
flan_dyn big = flan_dyn_vec_new();
flan_dyn_root_push(&big);
for (i = 0; i < 100; i++) flan_dyn_push(big, flan_dyn_from_i64(i));
for (i = 0; i < 100; i++) FDYN_push(big, flan_dyn_from_i64(i));
check(num(flan_dyn_len(big)) == 100, "len after a hundred pushes");
check(num(flan_dyn_at(big, flan_dyn_from_i64(0))) == 0, "first survived");
check(num(flan_dyn_at(big, flan_dyn_from_i64(99))) == 99, "last survived");
check(num(FDYN_at(big, flan_dyn_from_i64(0))) == 0, "first survived");
check(num(FDYN_at(big, flan_dyn_from_i64(99))) == 99, "last survived");
flan_dyn_root_pop(1);
}
@ -290,13 +293,13 @@ static void ops(void) {
flan_dyn p = flan_dyn_vec_new(), q = flan_dyn_vec_new();
flan_dyn_root_push(&p);
flan_dyn_root_push(&q);
flan_dyn_push(p, flan_dyn_from_i64(1));
flan_dyn_push(p, text("x"));
flan_dyn_push(q, flan_dyn_from_i64(1));
flan_dyn_push(q, text("x"));
FDYN_push(p, flan_dyn_from_i64(1));
FDYN_push(p, text("x"));
FDYN_push(q, flan_dyn_from_i64(1));
FDYN_push(q, text("x"));
check(p != q, "two vecs are two objects");
check(truth(flan_dyn_eq(p, q)), "= vec is element by element");
flan_dyn_push(q, flan_dyn_nil());
FDYN_push(q, flan_dyn_nil());
check(!truth(flan_dyn_eq(p, q)), "= vec sees the length");
flan_dyn_root_pop(2);
}
@ -307,8 +310,8 @@ static void ops(void) {
{
flan_dyn cyc = flan_dyn_vec_new();
flan_dyn_root_push(&cyc);
flan_dyn_push(cyc, flan_dyn_from_i64(1));
flan_dyn_push(cyc, cyc);
FDYN_push(cyc, flan_dyn_from_i64(1));
FDYN_push(cyc, cyc);
check(truth(flan_dyn_eq(cyc, cyc)), "= on a cycle answers");
show(cyc);
check(strlen(shown) > 0 && strstr(shown, "...") != NULL,
@ -335,23 +338,23 @@ static void ops(void) {
flan_dyn strs = flan_dyn_vec_new();
flan_dyn_root_push(&nums);
flan_dyn_root_push(&strs);
flan_dyn_push(nums, flan_dyn_from_i64(1));
flan_dyn_push(nums, flan_dyn_from_i64(2));
flan_dyn_push(nums, flan_dyn_from_i64(3));
FDYN_push(nums, flan_dyn_from_i64(1));
FDYN_push(nums, flan_dyn_from_i64(2));
FDYN_push(nums, flan_dyn_from_i64(3));
prints(nums, "[ 1 2 3]");
/* A text inside a structure is quoted and escaped, and bare at the top
level. That is flan_rt.c's rule and the two have to agree, because the
REPL parses the printed form back. */
flan_dyn_push(strs, text("x"));
flan_dyn_push(strs, text("a b"));
flan_dyn_push(strs, text("q\"\n"));
FDYN_push(strs, text("x"));
FDYN_push(strs, text("a b"));
FDYN_push(strs, text("q\"\n"));
prints(strs, "[ \"x\" \"a b\" \"q\\\"\\n\"]");
/* And a vec of vecs, nested twice. */
{
flan_dyn outer = flan_dyn_vec_new();
flan_dyn_root_push(&outer);
flan_dyn_push(outer, nums);
flan_dyn_push(outer, strs);
FDYN_push(outer, nums);
FDYN_push(outer, strs);
prints(outer, "[ [ 1 2 3] [ \"x\" \"a b\" \"q\\\"\\n\"]]");
flan_dyn_root_pop(1);
}
@ -430,11 +433,11 @@ static void view(void) {
flat = flan_dyn_view_flat(buf, 4, FLAN_VIEW_I64);
check(flan_dyn_tag(flat) == FLAN_DYN_TAG_VEC, "a view tags as a vec");
check(num(flan_dyn_len(flat)) == 4, "flat view len");
check(num(flan_dyn_at(flat, flan_dyn_from_i64(2))) == 30, "flat view at");
flan_dyn_set_at(flat, flan_dyn_from_i64(2), flan_dyn_from_i64(99));
check(num(FDYN_at(flat, flan_dyn_from_i64(2))) == 30, "flat view at");
FDYN_set_at(flat, flan_dyn_from_i64(2), flan_dyn_from_i64(99));
check(buf[2] == 99, "flat view write reaches the array");
buf[3] = 7;
check(num(flan_dyn_at(flat, flan_dyn_from_i64(3))) == 7,
check(num(FDYN_at(flat, flan_dyn_from_i64(3))) == 7,
"the array's own write reaches the view — it is not a copy");
prints(flat, "[ 10 20 99 7]");
@ -458,13 +461,13 @@ static void view(void) {
"two views over equal bytes are equal");
check(!truth(flan_dyn_eq(flat, other)),
"two views over different bytes are not equal");
flan_dyn_push(heap, flan_dyn_from_i64(10));
flan_dyn_push(heap, flan_dyn_from_i64(20));
flan_dyn_push(heap, flan_dyn_from_i64(99));
flan_dyn_push(heap, flan_dyn_from_i64(7));
FDYN_push(heap, flan_dyn_from_i64(10));
FDYN_push(heap, flan_dyn_from_i64(20));
FDYN_push(heap, flan_dyn_from_i64(99));
FDYN_push(heap, flan_dyn_from_i64(7));
check(truth(flan_dyn_eq(flat, heap)),
"a view and an equal heap vec are equal");
flan_dyn_set_at(heap, flan_dyn_from_i64(3), flan_dyn_from_i64(0));
FDYN_set_at(heap, flan_dyn_from_i64(3), flan_dyn_from_i64(0));
check(!truth(flan_dyn_eq(flat, heap)),
"a view and a differing heap vec are not equal");
flan_dyn_root_pop(3);
@ -480,17 +483,17 @@ static void view(void) {
check(num(flan_dyn_len(vv)) == 0, "vec view starts empty");
{
int i;
for (i = 0; i < 20; i++) flan_dyn_push(vv, flan_dyn_from_i64(i));
for (i = 0; i < 20; i++) FDYN_push(vv, flan_dyn_from_i64(i));
}
check(num(flan_dyn_len(vv)) == 20, "vec view len after growth");
check(num(flan_dyn_at(vv, flan_dyn_from_i64(0))) == 0,
check(num(FDYN_at(vv, flan_dyn_from_i64(0))) == 0,
"first element survived the growth and the move");
check(num(flan_dyn_at(vv, flan_dyn_from_i64(19))) == 19,
check(num(FDYN_at(vv, flan_dyn_from_i64(19))) == 19,
"pushed element reachable after the header's ptr moved");
/* [hv]'s own fields moved under the view's feet, by construction — the
view never captured [hv.ptr]; it captured [&hv]. */
check(hv.len == 20 && hv.cap >= 20, "the hand-built header itself grew");
flan_dyn_set_at(vv, flan_dyn_from_i64(0), flan_dyn_from_i64(-1));
FDYN_set_at(vv, flan_dyn_from_i64(0), flan_dyn_from_i64(-1));
check(((int64_t *)hv.ptr)[0] == -1, "write through the view reaches hv");
flan_vec_free(&hv, 8, 8, (const uint8_t *)"view", 4);
}
@ -502,13 +505,13 @@ static void view(void) {
double floats[2] = { 1.5, -2.0 };
flan_dyn bv = flan_dyn_view_flat(bools, 2, FLAN_VIEW_BOOL);
flan_dyn fv = flan_dyn_view_flat(floats, 2, FLAN_VIEW_F64);
check(truth(flan_dyn_at(bv, flan_dyn_from_i64(0))), "bool view at true");
check(!truth(flan_dyn_at(bv, flan_dyn_from_i64(1))), "bool view at false");
flan_dyn_set_at(bv, flan_dyn_from_i64(1), flan_dyn_from_bool(1));
check(truth(FDYN_at(bv, flan_dyn_from_i64(0))), "bool view at true");
check(!truth(FDYN_at(bv, flan_dyn_from_i64(1))), "bool view at false");
FDYN_set_at(bv, flan_dyn_from_i64(1), flan_dyn_from_bool(1));
check(bools[1] == 1, "bool view write");
check(flan_dyn_need_f64(flan_dyn_at(fv, flan_dyn_from_i64(0))) == 1.5,
check(flan_dyn_need_f64(FDYN_at(fv, flan_dyn_from_i64(0))) == 1.5,
"float view at");
flan_dyn_set_at(fv, flan_dyn_from_i64(0), flan_dyn_from_f64(3.25));
FDYN_set_at(fv, flan_dyn_from_i64(0), flan_dyn_from_f64(3.25));
check(floats[0] == 3.25, "float view write");
}
@ -524,21 +527,21 @@ static void refuse_view(const char *what) {
flan_dyn v;
if (strcmp(what, "range") == 0) {
v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64);
(void)flan_dyn_at(v, flan_dyn_from_i64(2));
(void)FDYN_at(v, flan_dyn_from_i64(2));
} else if (strcmp(what, "wrongwrite") == 0) {
v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64);
flan_dyn_set_at(v, flan_dyn_from_i64(0), text("nope"));
FDYN_set_at(v, flan_dyn_from_i64(0), text("nope"));
} else if (strcmp(what, "wrongbool") == 0) {
static uint8_t bb[1];
v = flan_dyn_view_flat(bb, 1, FLAN_VIEW_BOOL);
flan_dyn_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1));
FDYN_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1));
} else if (strcmp(what, "wrongfloat") == 0) {
static double ff[1];
v = flan_dyn_view_flat(ff, 1, FLAN_VIEW_F64);
flan_dyn_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1));
FDYN_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1));
} else if (strcmp(what, "flatpush") == 0) {
v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64);
flan_dyn_push(v, flan_dyn_from_i64(9));
FDYN_push(v, flan_dyn_from_i64(9));
} else if (strcmp(what, "stalelen") == 0) {
/* A Vec view whose allocator has moved on, asked for its length. The
* operator name is what this mode is for: the sentence is built from the
@ -624,12 +627,12 @@ static void gc(void) {
flan_gc_set_floor(64 * 1024);
flan_dyn_root_push(&keep);
keep = flan_dyn_vec_new();
for (i = 0; i < LIVE; i++) flan_dyn_push(keep, flan_dyn_nil());
for (i = 0; i < LIVE; i++) FDYN_push(keep, flan_dyn_nil());
for (i = 0; i < ROUNDS; i++) {
char buf[32];
int n = snprintf(buf, sizeof buf, "item-%lld", (long long)i);
flan_dyn_set_at(keep, flan_dyn_from_i64(i % LIVE),
FDYN_set_at(keep, flan_dyn_from_i64(i % LIVE),
flan_dyn_from_bytes((const uint8_t *)buf, n));
if (flan_gc_live_bytes() > peak) peak = flan_gc_live_bytes();
}
@ -654,7 +657,7 @@ static void gc(void) {
char buf[32];
int64_t k = ROUNDS - LIVE + i;
int n = snprintf(buf, sizeof buf, "item-%lld", (long long)k);
flan_dyn got = flan_dyn_at(keep, flan_dyn_from_i64(k % LIVE));
flan_dyn got = FDYN_at(keep, flan_dyn_from_i64(k % LIVE));
if (!flan_dyn_need_bool(
flan_dyn_eq(got, flan_dyn_from_bytes((const uint8_t *)buf, n))))
intact = 0;
@ -683,11 +686,11 @@ static void nested(void) {
cur = root;
for (i = 0; i < DEEP; i++) {
flan_dyn inner = flan_dyn_vec_new();
flan_dyn_push(cur, flan_dyn_from_i64(i));
flan_dyn_push(cur, inner);
FDYN_push(cur, flan_dyn_from_i64(i));
FDYN_push(cur, inner);
cur = inner;
}
flan_dyn_push(cur, text("bottom"));
FDYN_push(cur, text("bottom"));
/* Churn, so that collections certainly happen with the chain live, and then
one more by hand. */
@ -696,11 +699,11 @@ static void nested(void) {
cur = root;
for (i = 0; i < DEEP; i++) {
if (flan_dyn_need_i64(flan_dyn_at(cur, flan_dyn_from_i64(0))) != i) ok = 0;
cur = flan_dyn_at(cur, flan_dyn_from_i64(1));
if (flan_dyn_need_i64(FDYN_at(cur, flan_dyn_from_i64(0))) != i) ok = 0;
cur = FDYN_at(cur, flan_dyn_from_i64(1));
}
if (!flan_dyn_need_bool(
flan_dyn_eq(flan_dyn_at(cur, flan_dyn_from_i64(0)), text("bottom"))))
flan_dyn_eq(FDYN_at(cur, flan_dyn_from_i64(0)), text("bottom"))))
ok = 0;
printf("chain of %d intact: %s\n", DEEP, ok ? "yes" : "no");
flan_dyn_root_pop(1);
@ -724,26 +727,26 @@ static void sharing(void) {
holder = flan_dyn_vec_new();
shared = flan_dyn_vec_new();
flan_dyn_push(shared, text("a"));
flan_dyn_push(holder, shared);
flan_dyn_push(holder, shared);
flan_dyn_push(holder, shared);
FDYN_push(shared, text("a"));
FDYN_push(holder, shared);
FDYN_push(holder, shared);
FDYN_push(holder, shared);
/* Three slots, one object. Identity and not equality: two vecs holding the
same text are equal and are still two vecs, so a structural test would
pass against an implementation that had quietly copied. The dyn word of a
vec *is* its address, so comparing the words is comparing the objects. */
printf("three slots hold one object: %s\n",
flan_dyn_at(holder, flan_dyn_from_i64(0))
== flan_dyn_at(holder, flan_dyn_from_i64(2))
FDYN_at(holder, flan_dyn_from_i64(0))
== FDYN_at(holder, flan_dyn_from_i64(2))
? "yes" : "no");
/* And writing through one path is read through another. */
flan_dyn_set_at(flan_dyn_at(holder, flan_dyn_from_i64(0)),
FDYN_set_at(FDYN_at(holder, flan_dyn_from_i64(0)),
flan_dyn_from_i64(0), text("b"));
printf("write through one path is seen through another: %s\n",
flan_dyn_need_bool(
flan_dyn_eq(flan_dyn_at(flan_dyn_at(holder, flan_dyn_from_i64(2)),
flan_dyn_eq(FDYN_at(FDYN_at(holder, flan_dyn_from_i64(2)),
flan_dyn_from_i64(0)),
text("b")))
? "yes" : "no");
@ -759,10 +762,10 @@ static void sharing(void) {
for (i = 0; i < 5000; i++) (void)text("noise");
flan_gc_collect();
printf("shared object survives on the holder alone: %s\n",
flan_dyn_at(holder, flan_dyn_from_i64(1)) == was ? "yes" : "no");
FDYN_at(holder, flan_dyn_from_i64(1)) == was ? "yes" : "no");
printf("still reachable: %s\n",
flan_dyn_need_bool(
flan_dyn_eq(flan_dyn_at(flan_dyn_at(holder, flan_dyn_from_i64(1)),
flan_dyn_eq(FDYN_at(FDYN_at(holder, flan_dyn_from_i64(1)),
flan_dyn_from_i64(0)),
text("b")))
? "yes" : "no");
@ -839,7 +842,7 @@ static void park(void) {
config = text("hello");
flan_dyn_root_push(&frame);
frame = flan_dyn_vec_new();
for (i = 0; i < HELD; i++) flan_dyn_push(frame, text("frame"));
for (i = 0; i < HELD; i++) FDYN_push(frame, text("frame"));
flan_gc_collect();
before = flan_gc_count();
@ -914,10 +917,10 @@ static void desc(void) {
flan_dyn_root_push_desc(&row, &row_desc);
row.label = flan_dyn_vec_new();
flan_dyn_push(row.label, text("held"));
FDYN_push(row.label, text("held"));
row.inner.note = text("nested");
row.tail = flan_dyn_vec_new();
flan_dyn_push(row.tail, flan_dyn_from_i64(99));
FDYN_push(row.tail, flan_dyn_from_i64(99));
was_label = row.label;
was_note = row.inner.note;
@ -926,10 +929,10 @@ static void desc(void) {
if (row.label != was_label || row.inner.note != was_note) ok = 0;
if (!flan_dyn_need_bool(
flan_dyn_eq(flan_dyn_at(row.label, flan_dyn_from_i64(0)),
flan_dyn_eq(FDYN_at(row.label, flan_dyn_from_i64(0)),
text("held")))) ok = 0;
if (!flan_dyn_need_bool(flan_dyn_eq(row.inner.note, text("nested")))) ok = 0;
if (flan_dyn_need_i64(flan_dyn_at(row.tail, flan_dyn_from_i64(0))) != 99)
if (flan_dyn_need_i64(FDYN_at(row.tail, flan_dyn_from_i64(0))) != 99)
ok = 0;
printf("aggregate root survives collection: %s\n", ok ? "yes" : "no");
@ -949,7 +952,7 @@ static void desc(void) {
question is about. */
flan_dyn_root_push(&row.hidden);
row.hidden = flan_dyn_vec_new();
for (i = 0; i < 500; i++) flan_dyn_push(row.hidden, text("hidden"));
for (i = 0; i < 500; i++) FDYN_push(row.hidden, text("hidden"));
flan_dyn_root_pop(1);
for (i = 0; i < 200; i++) (void)text("noise");
flan_gc_collect();
@ -1002,19 +1005,19 @@ static void refuse(const char *what) {
(void)FDYN_ge(flan_dyn_from_bool(0), flan_dyn_from_bool(1));
else if (strcmp(what, "len") == 0) (void)flan_dyn_len(flan_dyn_from_i64(1));
else if (strcmp(what, "at") == 0)
(void)flan_dyn_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0));
else if (strcmp(what, "atindex") == 0) (void)flan_dyn_at(t, t);
(void)FDYN_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0));
else if (strcmp(what, "atindex") == 0) (void)FDYN_at(t, t);
else if (strcmp(what, "atrange") == 0)
(void)flan_dyn_at(t, flan_dyn_from_i64(9));
(void)FDYN_at(t, flan_dyn_from_i64(9));
else if (strcmp(what, "atnegative") == 0)
(void)flan_dyn_at(t, flan_dyn_from_i64(-1));
(void)FDYN_at(t, flan_dyn_from_i64(-1));
else if (strcmp(what, "setattext") == 0)
flan_dyn_set_at(t, flan_dyn_from_i64(0), flan_dyn_from_i64(65));
FDYN_set_at(t, flan_dyn_from_i64(0), flan_dyn_from_i64(65));
else if (strcmp(what, "setatnotvec") == 0)
flan_dyn_set_at(flan_dyn_from_i64(1), flan_dyn_from_i64(0), t);
FDYN_set_at(flan_dyn_from_i64(1), flan_dyn_from_i64(0), t);
else if (strcmp(what, "setatrange") == 0)
flan_dyn_set_at(v, flan_dyn_from_i64(0), t);
else if (strcmp(what, "push") == 0) flan_dyn_push(t, flan_dyn_from_i64(1));
FDYN_set_at(v, flan_dyn_from_i64(0), t);
else if (strcmp(what, "push") == 0) FDYN_push(t, flan_dyn_from_i64(1));
else if (strcmp(what, "needi64") == 0) (void)flan_dyn_need_i64(t);
else if (strcmp(what, "needf64") == 0)
(void)flan_dyn_need_f64(flan_dyn_from_i64(1));
@ -1208,10 +1211,10 @@ static void classes(void) {
flan_gc_set_floor(16 * 1024);
define("point", "x\ny");
keep = flan_dyn_vec_new();
for (i = 0; i < 2000; i++) flan_dyn_push(keep, a_point(i, i + 1));
for (i = 0; i < 2000; i++) FDYN_push(keep, a_point(i, i + 1));
define("point", "y\nx\ndeep");
for (i = 0; i < 2000; i++) {
flan_dyn e = flan_dyn_at(keep, flan_dyn_from_i64(i));
flan_dyn e = FDYN_at(keep, flan_dyn_from_i64(i));
/* Allocation between each migration, so a collection lands part-way
through the set and has both shapes to mark. */
flan_dyn_map_set(e, flan_dyn_kw((const uint8_t *)"deep", 4),
@ -1221,7 +1224,7 @@ static void classes(void) {
{
int ok = 1;
for (i = 0; i < 2000; i++) {
flan_dyn e = flan_dyn_at(keep, flan_dyn_from_i64(i));
flan_dyn e = FDYN_at(keep, flan_dyn_from_i64(i));
if (num(slot(e, "x")) != i || num(slot(e, "y")) != i + 1) ok = 0;
if (flan_dyn_tag(slot(e, "deep")) != FLAN_DYN_TAG_VEC) ok = 0;
if (num(flan_dyn_len(e)) != 3) ok = 0;

17
test/programs/dyn-index-site.flan Normal file
View File

@ -0,0 +1,17 @@
;;;; dyn-trap-site.flan's prefix, for the three container operations: at,
;;;; set-at and push. Each trap prints the file, line and column of the call
;;;; that failed, ahead of its sentence.
;;;;
;;;; The argument chooses which one fails, one per run, because each ends the
;;;; process. The line numbers are asserted by the test, so an edit above them
;;;; moves them.
(defn main [args [string]] i32
(let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0)
v (vec-new dyn)]
(push v 1)
(println "before")
(cond
(= which 0) (println (at v 5))
(= which 1) (set (at v 5) 2)
:else (let [n (at v 0)] (push n 3))))
0)

24
test/test_acceptance.ml
View File

@ -4807,6 +4807,30 @@ level "1"
trap_site ~opt:"-O0" ();
trap_site ~x86:true ();
(* The same prefix on at, set-at and push, which take the site as an
ordinary argument just as the arithmetic does. One run per operation,
on both backends. *)
let index_site ?x86 () =
let exe = compile ?x86 "programs/dyn-index-site.flan" in
List.iter
(fun (arg, want) ->
let code, text = run exe (Some arg) in
if code <> 134 || not (contains text want) then begin
incr failures;
Printf.printf
"FAIL dyn: a container trap says where%s\n got: %S \
(exit %d)\n wanted: %S (exit 134)\n"
(match x86 with Some true -> ", --x86" | _ -> "")
text code want
end)
[ ("0", "dyn-index-site.flan:14:28: dyn at: index 5 is out of bounds");
("1", "dyn-index-site.flan:15:19: dyn set-at: index 5 is out of bounds");
("2", "dyn-index-site.flan:16:31: dyn push: int and int") ];
(try Sys.remove exe with Sys_error _ -> ())
in
index_site ();
index_site ~x86:true ();
(* A numeric cast opening a dyn box — TODO.org, "A numeric cast opens a
dyn box". programs/dyn-cast.flan is one program because the three
behaviours are one story told in order: the same-kind casts print, the