|
| 1 | +/** |
| 2 | + * locale-smoke.ts — kd-dvph Perl default/locale startup smoke on Kandelo. |
| 3 | + * |
| 4 | + * Regression guard for the default-locale startup panic: perl 5.40 built for |
| 5 | + * the wasm32 musl target used to abort at interpreter startup when no locale |
| 6 | + * env was set, because perl-cross defaulted the target to glibc's |
| 7 | + * "cat=value;cat=value" LC_ALL notation while Kandelo's libc (musl) returns a |
| 8 | + * POSITIONAL ";"-separated composite ("C.UTF-8;C;C;C;C;C"). perl parsed the |
| 9 | + * first field "C.UTF-8" as name=value, found no '=', and panicked (exit 29). |
| 10 | + * |
| 11 | + * Each case spawns the built perl.wasm under the Node kernel host with a |
| 12 | + * controlled guest environment and asserts a clean run (exit 0 + expected |
| 13 | + * stdout). The empty-env case is the primary regression; the disparate case |
| 14 | + * exercises the exact multi-component positional path that used to panic. |
| 15 | + * |
| 16 | + * If a Perl runtime tree (PERL5LIB with POSIX.pm/XS, e.g. kd-k7zy's |
| 17 | + * perl-runtime) is provided as argv[2], an extra case round-trips |
| 18 | + * POSIX::setlocale(LC_ALL) to verify per-category parsing; otherwise that case |
| 19 | + * is skipped (baseline `make perl` ships no modules). |
| 20 | + * |
| 21 | + * Usage: |
| 22 | + * bash build.sh && bash packages/registry/perl/build-perl.sh |
| 23 | + * npx tsx packages/registry/perl/demo/locale-smoke.ts [PERL5LIB_DIR] |
| 24 | + */ |
| 25 | +import { existsSync } from "fs"; |
| 26 | +import { resolve, dirname } from "path"; |
| 27 | +import { runCentralizedProgram } from "../../../../host/test/centralized-test-helper"; |
| 28 | +import { NodePlatformIO } from "../../../../host/src/platform/node"; |
| 29 | + |
| 30 | +const scriptDir = dirname(new URL(import.meta.url).pathname); |
| 31 | +const repoRoot = resolve(scriptDir, "../../../.."); |
| 32 | + |
| 33 | +interface Case { |
| 34 | + name: string; |
| 35 | + env: string[]; |
| 36 | + argv: string[]; |
| 37 | + expect: string; |
| 38 | + optional?: boolean; |
| 39 | +} |
| 40 | + |
| 41 | +// A trivial arithmetic program that loads no modules, so it works against the |
| 42 | +// baseline `make perl` build (no staged runtime). The only thing under test is |
| 43 | +// that the interpreter reaches its body instead of panicking during the |
| 44 | +// startup locale scan. |
| 45 | +const ARITH = 'print "R=", 2 + 3, "\\n"'; |
| 46 | + |
| 47 | +function buildCases(perl5lib?: string): Case[] { |
| 48 | + const cases: Case[] = [ |
| 49 | + // PRIMARY regression: no locale env at all -> musl returns the disparate |
| 50 | + // positional composite "C.UTF-8;C;C;C;C;C"; used to panic (exit 29). |
| 51 | + { name: "unset-locale (no LC_ALL/LANG)", env: [], argv: ["perl", "-e", ARITH], expect: "R=5" }, |
| 52 | + { name: "LC_ALL=C", env: ["LC_ALL=C"], argv: ["perl", "-e", ARITH], expect: "R=5" }, |
| 53 | + { name: "LC_ALL=C.UTF-8", env: ["LC_ALL=C.UTF-8"], argv: ["perl", "-e", ARITH], expect: "R=5" }, |
| 54 | + { name: "LANG=C.UTF-8", env: ["LANG=C.UTF-8"], argv: ["perl", "-e", ARITH], expect: "R=5" }, |
| 55 | + // Browser demos default the guest env to LANG=en_US.UTF-8 (live-setup.ts, |
| 56 | + // browser-kernel-host.ts). musl maps that to a disparate composite too, so |
| 57 | + // this covers the exact env the browser host passes. |
| 58 | + { name: "LANG=en_US.UTF-8 (browser default)", env: ["LANG=en_US.UTF-8"], argv: ["perl", "-e", ARITH], expect: "R=5" }, |
| 59 | + // Explicitly disparate categories -> forces musl's multi-field positional |
| 60 | + // composite; this is the exact code path that panicked, now positionally |
| 61 | + // parsed. If the positional category map were wrong the interpreter would |
| 62 | + // mis-route or NULL-deref a category during startup. |
| 63 | + { |
| 64 | + name: "disparate (LC_CTYPE=C.UTF-8, others C)", |
| 65 | + env: ["LC_CTYPE=C.UTF-8", "LC_NUMERIC=C", "LC_TIME=C", "LC_COLLATE=C", "LC_MONETARY=C", "LC_MESSAGES=C"], |
| 66 | + argv: ["perl", "-e", ARITH], |
| 67 | + expect: "R=5", |
| 68 | + }, |
| 69 | + // Category-mapping correctness (no modules needed): perl's built-in |
| 70 | + // ${^UTF8LOCALE} is true iff the *LC_CTYPE* startup locale is UTF-8. In a |
| 71 | + // disparate composite it must reflect field 0 (CTYPE) only, so these prove |
| 72 | + // the positional map routes CTYPE to the right slot rather than merely not |
| 73 | + // panicking. If the order were wrong, CTYPE would pick up a different |
| 74 | + // field's value and these would flip. |
| 75 | + { |
| 76 | + name: "category map: CTYPE=C.UTF-8 disparate -> UTF8LOCALE=1", |
| 77 | + env: ["LC_CTYPE=C.UTF-8", "LC_NUMERIC=C", "LC_TIME=C", "LC_COLLATE=C", "LC_MONETARY=C", "LC_MESSAGES=C"], |
| 78 | + argv: ["perl", "-e", 'print "U=", (${^UTF8LOCALE} ? 1 : 0), "\\n"'], |
| 79 | + expect: "U=1", |
| 80 | + }, |
| 81 | + { |
| 82 | + name: "category map: LC_ALL=C -> UTF8LOCALE=0", |
| 83 | + env: ["LC_ALL=C"], |
| 84 | + argv: ["perl", "-e", 'print "U=", (${^UTF8LOCALE} ? 1 : 0), "\\n"'], |
| 85 | + expect: "U=0", |
| 86 | + }, |
| 87 | + ]; |
| 88 | + |
| 89 | + if (perl5lib) { |
| 90 | + // With a runtime tree, verify per-category parsing by round-tripping the |
| 91 | + // composite through POSIX::setlocale under the disparate env above. This |
| 92 | + // fails loudly if the positional order/count is wrong. |
| 93 | + const PROG = [ |
| 94 | + "use POSIX qw(setlocale LC_ALL LC_CTYPE LC_NUMERIC);", |
| 95 | + 'my $all = setlocale(LC_ALL);', |
| 96 | + 'my $ctype = setlocale(LC_CTYPE);', |
| 97 | + 'my $num = setlocale(LC_NUMERIC);', |
| 98 | + 'print "LC_ALL=$all\\nLC_CTYPE=$ctype\\nLC_NUMERIC=$num\\n";', |
| 99 | + 'print "POSIX_OK\\n" if $ctype =~ /UTF-?8/i && $num eq "C";', |
| 100 | + ].join(" "); |
| 101 | + cases.push({ |
| 102 | + name: "POSIX::setlocale round-trip (disparate)", |
| 103 | + env: [ |
| 104 | + `PERL5LIB=${perl5lib}`, |
| 105 | + "LC_CTYPE=C.UTF-8", |
| 106 | + "LC_NUMERIC=C", |
| 107 | + "LC_TIME=C", |
| 108 | + "LC_COLLATE=C", |
| 109 | + "LC_MONETARY=C", |
| 110 | + "LC_MESSAGES=C", |
| 111 | + ], |
| 112 | + argv: ["perl", "-e", PROG], |
| 113 | + expect: "POSIX_OK", |
| 114 | + optional: true, |
| 115 | + }); |
| 116 | + } |
| 117 | + return cases; |
| 118 | +} |
| 119 | + |
| 120 | +async function main() { |
| 121 | + const perlWasm = resolve(repoRoot, "packages/registry/perl/bin/perl.wasm"); |
| 122 | + const perl5lib = process.argv[2]; |
| 123 | + if (!existsSync(perlWasm)) { |
| 124 | + console.error("perl.wasm not found. Run: bash packages/registry/perl/build-perl.sh"); |
| 125 | + process.exit(1); |
| 126 | + } |
| 127 | + |
| 128 | + const passed: string[] = []; |
| 129 | + const failed: string[] = []; |
| 130 | + const skipped: string[] = []; |
| 131 | + |
| 132 | + for (const c of buildCases(perl5lib)) { |
| 133 | + let result; |
| 134 | + try { |
| 135 | + result = await runCentralizedProgram({ |
| 136 | + programPath: perlWasm, |
| 137 | + argv: c.argv, |
| 138 | + env: c.env, |
| 139 | + io: new NodePlatformIO(), |
| 140 | + timeout: 60_000, |
| 141 | + }); |
| 142 | + } catch (err) { |
| 143 | + failed.push(`${c.name}: threw ${String(err)}`); |
| 144 | + continue; |
| 145 | + } |
| 146 | + const ok = result.exitCode === 0 && result.stdout.includes(c.expect); |
| 147 | + const detail = `exit=${result.exitCode} stdout=${JSON.stringify(result.stdout.trim())}`; |
| 148 | + if (ok) { |
| 149 | + passed.push(`${c.name}: ${detail}`); |
| 150 | + } else if (c.optional && result.exitCode !== 0) { |
| 151 | + // Optional cases (need runtime modules) are skipped, not failed, when the |
| 152 | + // interpreter can't load the module — the required cases still gate. |
| 153 | + skipped.push(`${c.name}: ${detail} stderr=${JSON.stringify(result.stderr.trim())} (runtime module unavailable)`); |
| 154 | + } else { |
| 155 | + failed.push(`${c.name}: ${detail} stderr=${JSON.stringify(result.stderr.trim())}`); |
| 156 | + } |
| 157 | + } |
| 158 | + |
| 159 | + console.log("=== PASSED ==="); |
| 160 | + for (const p of passed) console.log(" " + p); |
| 161 | + if (skipped.length) { |
| 162 | + console.log("=== SKIPPED ==="); |
| 163 | + for (const s of skipped) console.log(" " + s); |
| 164 | + } |
| 165 | + if (failed.length) { |
| 166 | + console.log("=== FAILED ==="); |
| 167 | + for (const f of failed) console.log(" " + f); |
| 168 | + } |
| 169 | + |
| 170 | + const allRequiredPass = failed.length === 0; |
| 171 | + console.log(allRequiredPass ? "PERL_LOCALE_SMOKE_PASS" : "PERL_LOCALE_SMOKE_FAIL"); |
| 172 | + process.exit(allRequiredPass ? 0 : 1); |
| 173 | +} |
| 174 | + |
| 175 | +main().catch((err) => { |
| 176 | + console.error("Fatal error:", err); |
| 177 | + process.exit(1); |
| 178 | +}); |
0 commit comments