ww/test/wcc/945_tuple_nary_destructure_run.c

/*
 * 945_tuple_nary_destructure_run — runtime coverage for project #83: the
 * general N-ary tuple-destructure per-element register-return. The send
 * (N_RETURN) and receive (N_MLET / N_MASSIGN) sites previously gated the
 * 3-word {ptr,len,cap} store on a str-only XOR (`e0_is_str ^ e1_is_str`),
 * which admitted EXACTLY ONE str element and was slice-BLIND: a tuple with
 * a []u8 element fell to the scalar-pair fallback and silently DROPPED
 * len+cap (only .ptr landed). The fix REPLACES the XOR with a positional
 * per-element cursor (harec create_unpack_bindings,
 * ref/harec/src/check.c:1354-1416): each element rides consecutive
 * eightbytes over [AX,DX,CX,R8]; a slice/str rides its 3-word header
 * (ref/hare/rt/ensure.ha:4-8), a scalar rides 1. SEND and RECEIVE walk the
 * SAME cursor so element->register agrees. This closes the pre-existing
 * (scalar,slice) cs!=ww divergence by construction (slice no longer rides
 * the scalar fallback) and unifies both stages on the positional layout.
 *
 * LOUD-STOP (rule 7): the register file holds only 4 eightbytes. A tuple
 * whose elements sum to > 4 (e.g. ([]u8,[]u8)/(str,str) = 3+3 = 6) CANNOT
 * be register-returned; the send site emits a COMPILE-TIME abort citing
 * the return-ABI capacity (project #10), NOT a silent miscompile. Row F
 * asserts that loud stop fires on BOTH stages: the build must FAIL *and*
 * stderr must carry the cited diagnostic (rule 7 — loud, not a silent
 * crash that an exit-code-only check would mistake for the stop).
 *
 * N_MLET vs N_MASSIGN: `let (a, s) = f()` is N_MLET (fresh bindings, slots
 * sized from each element type). `a, s = f()` with a, s PRE-DECLARED is
 * N_MASSIGN (reassignment, existing slots) — a retained ww-EXTENSION
 * beyond Hare (Hare tuple-unpack is binding-only; ww keeps the Go/rob-pike
 * multi-assign idiom). The N_MASSIGN rows pre-poison the destination slot
 * (distinct len/cap via a PROVEN 3-word let-init copy) so a dropped
 * len/cap reads the poison, never the test value — deterministic
 * fail-before. The N_MLET rows use cap!=len distinct values; a dropped
 * cap reads fresh-slot garbage, ~never the asserted pair.
 *
 * Backing storage: each []u8 element borrows a str literal's .ptr (stable
 * .rodata), so the header survives the producer's return without a
 * use-after-return. str elements return a literal with a MUTATED .cap so
 * cap!=len (a bare literal carries cap==len, hiding a dropped cap).
 *
 * Rows (cap!=len in every wide row so a dropped len OR cap is caught):
 *   A  mlet_islice   `let (a, s) = f()`, f()->(i64,[]u8). a=4,len=2,cap=5,'h'.
 *   B  massign_islice`a, s = f()` predeclared+poisoned (len=9,cap=9).
 *   C  mlet_istr     `let (a, s) = f()`, f()->(i64,str).  a=4,len=2,cap=7,'h'.
 *   D  massign_istr  `a, s = f()` predeclared+poisoned (len=4,cap=6).
 *   E  str_control   plain single-str return `let s = f()` f()->str — the
 *                    non-tuple str path (cgen.c N_RETURN node_isstr branch)
 *                    the fix leaves untouched; len=5,cap=9 regression guard.
 *   G  massign_blank_wide  `_, a = f()`, f()->([]u8,i64). The blank `_`
 *                    rides a 3-word slot so a lands on R8 (the i64), not DX
 *                    (slice.len). len=2,cap=5,i64=7 distinct (any desync !=7).
 *   F  slice_slice_recv  f()->([]u8,[]u8) returns (a,b) — 6 eightbytes >
 *                    cap; the SEND sret's it (#10 Fold A) and the
 *                    destructure RECEIVE copies all 3 words/element out
 *                    of @sretscr (#10 Fold B). len AND cap of both halves
 *                    asserted (cap!=len) so a dropped word is caught.
 *
 * Fold discriminators: A/B (slice) — the old str-only XOR was slice-blind,
 * so the slice fell to the scalar-pair fallback and dropped len/cap; B's
 * poison makes that deterministic. G (blank `_`) — cstage derived the
 * receive width from the binding type, which is null for an unstamped `_`,
 * so a wide `_` was mis-sized scalar and the cursor desynced (cstage read
 * DX, wwstage R8); deriving width from the rhs tuple type fixes + aligns
 * both stages. F (over-cap recv) — the pre-#10 code register-returned
 * ([]u8,[]u8) with only the two .ptr words (built + ran WRONG); #10 Fold A
 * loud-stopped it at the SEND, and Fold B now sret's + copies it out into
 * the bindings, so it is a working round-trip (was a BUILDERR at Fold A).
 * C/D/E are CONTROLS: the (i64,str) path was ALREADY 3-word
 * under the old XOR, and the single-str return is a separate untouched
 * branch — they confirm no regression. All 14
 * fixtures pass on both the cstage `ww` and wwstage `ww_ww` drivers with
 * byte-identical asm (smoke-verified pre-commit; the formal fail-before
 * revert-run is ken's tuple83 gate). NNN<950, self-contained (/tmp, no
 * imports), so rule-14's selfhost-sibling race does not apply (mirrors the
 * 941/942/943/944 precedent).
 */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <sys/stat.h>
#include <sys/wait.h>

static int
runwait(const char *cmd)
{
	int rc = system(cmd);
	if (rc == -1) return -1;
	if (WIFEXITED(rc)) return WEXITSTATUS(rc);
	return -1;
}

/* experr (builderr rows only): a stable substring of the loud-stop
 * diagnostic. rule 7 — the over-capacity stop must be LOUD: the build must
 * fail BECAUSE of the cited return-ABI diagnostic (project #10), not an
 * incidental/silent error. NULL skips the message check. */
struct row { const char *label; const char *src; int want; int builderr;
             const char *experr; };

static const struct row rows[] = {
	/* A — mlet_islice: `let (a, s) = f()`, f()->(i64,[]u8). Slice borrows
	 * the "hi" literal's .ptr (stable). len=2, cap=5 (distinct). */
	{ "mlet_islice",
	  "fn mk() (i64, []u8) = {\n"
	  "    let b: str = \"hi\";\n"
	  "    let p: []u8; p.ptr = b.ptr; p.len = 2; p.cap = 5;\n"
	  "    return (4i64, p);\n"
	  "};\n"
	  "export fn main() i32 = {\n"
	  "    let (a, s) = mk();\n"
	  "    if (a != 4)            { return 1; };\n"
	  "    if (s.len: i32 != 2)   { return 2; };\n"
	  "    if (s.cap: i32 != 5)   { return 3; };\n"
	  "    if (s[0] != 104u8)     { return 4; };\n"
	  "    return 0;\n"
	  "};\n",
	  0, 0, NULL },
	/* B — massign_islice: `a, s = f()` predeclared; s poisoned (len=9,
	 * cap=9) via the proven 3-word `s = q` let-init copy. A dropped
	 * len/cap leaves the poison 9; the fix lands 2 / 5. */
	{ "massign_islice",
	  "fn mk() (i64, []u8) = {\n"
	  "    let b: str = \"hi\";\n"
	  "    let p: []u8; p.ptr = b.ptr; p.len = 2; p.cap = 5;\n"
	  "    return (4i64, p);\n"
	  "};\n"
	  "export fn main() i32 = {\n"
	  "    let qb: str = \"zzzz\";\n"
	  "    let q: []u8; q.ptr = qb.ptr; q.len = 9; q.cap = 9;\n"
	  "    let a: i64 = 0i64;\n"
	  "    let s: []u8 = q;\n"
	  "    a, s = mk();\n"
	  "    if (a != 4)            { return 1; };\n"
	  "    if (s.len: i32 != 2)   { return 2; };\n"
	  "    if (s.cap: i32 != 5)   { return 3; };\n"
	  "    if (s[0] != 104u8)     { return 4; };\n"
	  "    return 0;\n"
	  "};\n",
	  0, 0, NULL },
	/* C — mlet_istr: `let (a, s) = f()`, f()->(i64,str). cap mutated to
	 * 7 so cap!=len(2). */
	{ "mlet_istr",
	  "fn mk() (i64, str) = {\n"
	  "    let p: str = \"hi\"; p.cap = 7i32;\n"
	  "    return (4i64, p);\n"
	  "};\n"
	  "export fn main() i32 = {\n"
	  "    let (a, s) = mk();\n"
	  "    if (a != 4)            { return 1; };\n"
	  "    if (s.len: i32 != 2)   { return 2; };\n"
	  "    if (s.cap: i32 != 7)   { return 3; };\n"
	  "    if (s[0] != 104u8)     { return 4; };\n"
	  "    return 0;\n"
	  "};\n",
	  0, 0, NULL },
	/* D — massign_istr: `a, s = f()` predeclared; s poisoned (len=4,
	 * cap=6) via the proven 3-word `s = q` copy. */
	{ "massign_istr",
	  "fn mk() (i64, str) = {\n"
	  "    let p: str = \"hi\"; p.cap = 7i32;\n"
	  "    return (4i64, p);\n"
	  "};\n"
	  "export fn main() i32 = {\n"
	  "    let q: str = \"qqqq\"; q.cap = 6i32;\n"
	  "    let a: i64 = 0i64;\n"
	  "    let s: str = q;\n"
	  "    a, s = mk();\n"
	  "    if (a != 4)            { return 1; };\n"
	  "    if (s.len: i32 != 2)   { return 2; };\n"
	  "    if (s.cap: i32 != 7)   { return 3; };\n"
	  "    if (s[0] != 104u8)     { return 4; };\n"
	  "    return 0;\n"
	  "};\n",
	  0, 0, NULL },
	/* E — str_control: plain single-str return, the non-tuple path the
	 * fix leaves untouched. cap mutated to 9 so cap!=len(5). */
	{ "str_control",
	  "fn mk() str = {\n"
	  "    let p: str = \"hello\"; p.cap = 9i32;\n"
	  "    return p;\n"
	  "};\n"
	  "export fn main() i32 = {\n"
	  "    let s: str = mk();\n"
	  "    if (s.len: i32 != 5)   { return 1; };\n"
	  "    if (s.cap: i32 != 9)   { return 2; };\n"
	  "    if (s[0] != 104u8)     { return 3; };\n"
	  "    return 0;\n"
	  "};\n",
	  0, 0, NULL },
	/* G — massign_blank_wide: `_, a = f()`, f()->([]u8,i64), wide-first
	 * blank. The `_` (N_IDENT, empty str) is never type-stamped by the
	 * checker, so cstage previously mis-sized it as a scalar (1 word) and
	 * the cursor desynced: a read DX (slice.len=2) instead of R8 (the
	 * i64). The fix reads element width from the rhs tuple type, so `_`
	 * consumes its 3-word slot and a lands on R8. len=2, cap=5, i64=7 all
	 * distinct so any desync misread (DX=2 / CX=5) is caught, never 7. */
	{ "massign_blank_wide",
	  "fn mk() ([]u8, i64) = {\n"
	  "    let b: str = \"hi\";\n"
	  "    let p: []u8; p.ptr = b.ptr; p.len = 2; p.cap = 5;\n"
	  "    return (p, 7i64);\n"
	  "};\n"
	  "export fn main() i32 = {\n"
	  "    let a: i64 = 0i64;\n"
	  "    _, a = mk();\n"
	  "    if (a != 7) { return 1; };\n"
	  "    return 0;\n"
	  "};\n",
	  0, 0, NULL },
	/* F — slice_slice_recv: ([]u8,[]u8) = 6 eightbytes > 4 capacity. The
	 * SEND sret's the over-cap tuple (#10 Fold A) and the destructure
	 * RECEIVE copies all 3 words per element out of the @sretscr slot
	 * (#10 Fold B) — formerly a loud-stop, now a working round-trip.
	 * Asserts BOTH len AND cap of each half (cap != len) so a dropped
	 * word — the original register-return bug — is caught at runtime. */
	{ "slice_slice_recv",
	  "fn mk() ([]u8, []u8) = {\n"
	  "    let a: []u8; a.len = 1; a.cap = 5;\n"
	  "    let b: []u8; b.len = 2; b.cap = 6;\n"
	  "    return (a, b);\n"
	  "};\n"
	  "export fn main() i32 = {\n"
	  "    let (x, y) = mk();\n"
	  "    if (x.len: i32 != 1) { return 1; };\n"
	  "    if (x.cap: i32 != 5) { return 2; };\n"
	  "    if (y.len: i32 != 2) { return 3; };\n"
	  "    if (y.cap: i32 != 6) { return 4; };\n"
	  "    return 0;\n"
	  "};\n",
	  0, 0, NULL },
};

static int
file_contains(const char *path, const char *needle)
{
	FILE *f = fopen(path, "rb");
	if (!f) return 0;
	char buf[8192];
	size_t n = fread(buf, 1, sizeof buf - 1, f);
	fclose(f);
	buf[n] = '\0';
	return strstr(buf, needle) != NULL;
}

/* Returns 0 on pass, nonzero on fail. For builderr rows the build must
 * FAIL and (if experr is set) the diagnostic must carry the loud-stop
 * message; for normal rows the build must succeed and the binary's exit
 * must equal r->want. */
static int
run_driver(const char *driver, const struct row *r, int i)
{
	char src[96], tmpdir[96], errf[96], cmd[1024];
	snprintf(src, sizeof src, "/tmp/tuplenary_%d_%d.ww", getpid(), i);
	snprintf(tmpdir, sizeof tmpdir, "/tmp/tuplenary_%d_d_%d", getpid(), i);
	snprintf(errf, sizeof errf, "/tmp/tuplenary_%d_e_%d", getpid(), i);

	FILE *f = fopen(src, "wb");
	if (!f) return -1;
	fputs(r->src, f);
	fclose(f);

	mkdir(tmpdir, 0755);
	snprintf(cmd, sizeof cmd, "cd %s && %s build %s >/dev/null 2>%s",
	    tmpdir, driver, src, errf);
	int brc = runwait(cmd);

	if (r->builderr) {
		int ok = (brc != 0)
		    && (r->experr == NULL || file_contains(errf, r->experr));
		if (!ok)
			fprintf(stderr,
			    "row[%s]: %s expected loud-stop builderr (brc=%d)\n",
			    r->label, driver, brc);
		unlink(src); unlink(errf); rmdir(tmpdir);
		return ok ? 0 : 1;
	}

	if (brc != 0) {
		fprintf(stderr, "row[%s]: build via %s failed\n",
		    r->label, driver);
		unlink(src); unlink(errf); rmdir(tmpdir);
		return -1;
	}

	const char *base = strrchr(src, '/');
	base = base ? base + 1 : src;
	char outbin[160];
	snprintf(outbin, sizeof outbin, "%s/%s", tmpdir, base);
	char *dot = strrchr(outbin, '.');
	if (dot && strcmp(dot, ".ww") == 0) *dot = '\0';
	int got = runwait(outbin);

	unlink(src); unlink(outbin); unlink(errf); rmdir(tmpdir);
	return (got == r->want) ? 0 : (got ? got : 1);
}

int
main(void)
{
	const char *bin = getenv("BIN");
	if (!bin) bin = "out/bin";
	char absbin[512];
	if (bin[0] != '/') {
		char cwd[256];
		if (getcwd(cwd, sizeof cwd) == NULL) return 1;
		snprintf(absbin, sizeof absbin, "%s/%s", cwd, bin);
		bin = absbin;
	}

	char cdrv[640];
	snprintf(cdrv, sizeof cdrv, "%s/ww", bin);
	char wdrv[640];
	snprintf(wdrv, sizeof wdrv, "%s/ww_ww", bin);

	struct { const char *name; const char *path; int gated_on_existence; }
	drivers[] = {
		{ "cstage",  cdrv, 0 },
		{ "wwstage", wdrv, 1 },
		{ NULL, NULL, 0 },
	};

	int n = (int)(sizeof rows / sizeof rows[0]);
	int total = 0, fail = 0;
	for (int d = 0; drivers[d].name; d++) {
		if (drivers[d].gated_on_existence
		    && access(drivers[d].path, X_OK) != 0) {
			fprintf(stderr,
			    "tuple_nary_destructure_run: skip %s (no %s)\n",
			    drivers[d].name, drivers[d].path);
			continue;
		}
		for (int i = 0; i < n; i++) {
			int rc = run_driver(drivers[d].path, &rows[i], i);
			total++;
			if (rc != 0) {
				fprintf(stderr,
				    "tuple_nary_destructure_run[%s][%s]: rc=%d\n",
				    drivers[d].name, rows[i].label, rc);
				fail++;
			}
		}
	}

	if (fail) {
		fprintf(stderr, "tuple_nary_destructure_run: %d/%d fixtures failed\n",
		    fail, total);
		return 1;
	}
	printf("tuple_nary_destructure_run: %d/%d ok\n", total, total);
	return 0;
}