New Rust driver for Forth tests

.github/workflows/deploy.yml

@@ -8,9 +8,6 @@ on:
     branches:
       - '*'
 
-env:
-  UV_NO_EDITABLE: 1
-
 jobs:
   build:
     runs-on: ubuntu-latest
@@ -25,12 +22,9 @@ jobs:
           version: 4.0.15
           actions-cache-folder: 'emsdk-cache'
       - uses: astral-sh/setup-uv@v6
-        with:
-          python-version: '3.13'
-      - run: uv sync
       - run: |
           cd assets
-          make
+          make --jobs=4
       - uses: actions/upload-pages-artifact@v3
         with:
           path: assets

.github/workflows/pythonpackage.yml

@@ -23,12 +23,8 @@ jobs:
       - uses: astral-sh/ruff-action@v3
         with:
           version: "latest"
-      - uses: qoomon/actions--parallel-steps@v1
-        with:
-          steps: |
-            - run: uvx ruff check
-            - run: uvx ty check
-            - run: uvx pyright
+      - run: uvx ruff check
+      - run: uvx ty check
       - run: uv run pytest
         env:
           pytest_github_report: true

assets/Makefile

@@ -21,7 +21,7 @@ jonesforth.wasm : ../forth/wasm/jonesforth.wast main.js worker.js
 	npx -y --package wabt wat2wasm --enable-tail-call --debug-names -o $@ $<
 
 lib%.a : %.zig
-	uv run --with ziglang -m ziglang build-lib $(ZFLAGS) -Mroot=$< -lc --name $(basename $(<F)) -static -rdynamic
+	uv run --no-project --with ziglang -m ziglang build-lib $(ZFLAGS) -Mroot=$< -lc --name $(basename $(<F)) -static -rdynamic
 
 lib6th.a : 6th.zig
 

conftest.py

@@ -1,3 +1,7 @@
+import os
+import re
+import subprocess
+
 import pytest  # pyright: ignore[reportMissingImports]
 
 
@@ -17,22 +21,33 @@
     "notebooks/nbody.py",
 ]
 
-def pytest_addoption(parser: pytest.Parser) -> None:
-    parser.addoption(
-        "--target",
-        choices=[
-            "", "4th", "4th.gcov", "4th.32", "4th.ll", "5th.ll", "zig-out/bin/6th"
-        ],
-        default="",
-        help="Pick a target to test",
-    )
-
 
 def pytest_generate_tests(metafunc: pytest.Metafunc) -> None:
-    if "target" in metafunc.fixturenames:
-        target = metafunc.config.getoption("target")
+    scenarios: str | None = getattr(metafunc.cls, "scenarios", None)
+    if scenarios:
+        target = {
+            "test_4th": "4th",
+            "test_5th": "5th.ll",
+        }[metafunc.function.__name__]
+        scenarios = scenarios.format(
+            argv0=f"./{target}",
+            uid=os.getuid(),
+        )
+        subprocess.run(["make", target], cwd="forth", check=True)
+        cp = subprocess.run(
+            [f"./{target}"],
+            cwd="forth/",
+            env={"SHELL": "/bin/bash"},
+            capture_output=True,
+            check=True,
+            input=scenarios,
+            text=True,
+        )
+        subprocess.run(["rm", target], cwd="forth", check=True)
         metafunc.parametrize(
-            "target",
-            [target] if target else ["4th", "5th.ll", "zig-out/bin/6th"],
-            scope="module"
+            ["actual", "expected"],
+            zip(
+                cp.stdout.splitlines(),
+                re.findall(r"(?<=\\ )(.+)$", scenarios, re.M),
+            ),
         )

forth/5th.c

@@ -11,7 +11,7 @@
 #include <stdarg.h>
 
 /* https://github.com/emscripten-core/emscripten/issues/6708 */
-enum SYS {SYS_exit, SYS_open, SYS_close, SYS_read, SYS_write, SYS_creat, SYS_brk, SYS_getppid};
+enum SYS {SYS_exit, SYS_open, SYS_close, SYS_read, SYS_write, SYS_creat, SYS_brk};
 #endif
 
 #define NEXT __attribute__((musttail)) return ip->word->code(env, sp, rsp, ip + 1, ip->word)
@@ -634,6 +634,11 @@ DEFCODE(SYSCALL2, 0, "SYSCALL1", SYSCALL1)
         case SYS_brk:
             sp[1] = sp[1] ? (intptr_t)sbrk((intptr_t)sbrk(0) + sp[1]) : (intptr_t)sbrk(sp[1]);
             break;
+#ifndef EMSCRIPTEN
+        case SYS_setuid:
+            sp[1] = setuid(sp[1]);
+            break;
+#endif            
     }
     ++sp;
     NEXT;
@@ -643,8 +648,8 @@ DEFCODE(SYSCALL1, 0, "SYSCALL0", SYSCALL0)
 #ifndef EMSCRIPTEN
     switch (sp[0])
     {
-        case SYS_getppid:
-            sp[0] = getppid();
+        case SYS_getuid:
+            sp[0] = getuid();
             break;
     }
 #endif

forth/Cargo.toml

@@ -0,0 +1,7 @@
+[package]
+name = "harness"
+version = "0.1.0"
+edition = "2024"
+
+[dependencies]
+rstest = "0.26.1"

forth/src/main.rs

@@ -0,0 +1,162 @@
+const PREAMBLE: &str = r#": / /MOD SWAP DROP ;
+: '\n' 10 ;
+: BL 32 ;
+: CR '\n' EMIT ;
+: SPACE BL EMIT ;
+: NEGATE 0 SWAP - ;
+: TRUE  1 ;
+: FALSE 0 ;
+: NOT   0= ;
+: LITERAL IMMEDIATE ' LIT , , ;
+: ':' [ CHAR : ] LITERAL ;
+: ';' [ CHAR ; ] LITERAL ;
+: '"' [ CHAR " ] LITERAL ;
+: 'A' [ CHAR A ] LITERAL ;
+: '0' [ CHAR 0 ] LITERAL ;
+: '-' [ CHAR - ] LITERAL ;
+: [COMPILE] IMMEDIATE WORD FIND >CFA , ;
+: RECURSE   IMMEDIATE LATEST @ >CFA , ;
+: IF        IMMEDIATE ' 0BRANCH , HERE @ 0 , ;
+: THEN      IMMEDIATE DUP HERE @ SWAP - SWAP ! ;
+: ELSE      IMMEDIATE ' BRANCH , HERE @ 0 , SWAP DUP HERE @ SWAP - SWAP ! ;
+: BEGIN     IMMEDIATE HERE @ ;
+: AGAIN     IMMEDIATE ' BRANCH , HERE @ - , ;
+: WHILE     IMMEDIATE ' 0BRANCH , HERE @ 0 , ;
+: REPEAT    IMMEDIATE ' BRANCH , SWAP HERE @ - , DUP HERE @ SWAP - SWAP ! ;
+: NIP SWAP DROP ;
+: PICK 1+ 8 * DSP@ + @ ;
+: SPACES BEGIN DUP 0> WHILE SPACE 1- REPEAT DROP ;
+: U. BASE @ /MOD ?DUP IF RECURSE THEN DUP 10 < IF '0' ELSE 10 - 'A' THEN + EMIT ;
+: .S DSP@ BEGIN DUP S0 @ < WHILE DUP @ U. 8+ SPACE REPEAT DROP ;
+: UWIDTH BASE @ / ?DUP IF RECURSE 1+ ELSE 1 THEN ;
+: U.R SWAP DUP UWIDTH ROT SWAP - SPACES U. ;
+: .R SWAP DUP 0< IF NEGATE 1 SWAP ROT 1- ELSE 0 SWAP ROT THEN SWAP DUP
+  UWIDTH ROT SWAP - SPACES SWAP IF '-' EMIT THEN U. ;
+: . 0 .R SPACE ;
+: U. U. SPACE ;
+: WITHIN -ROT OVER <= IF > IF TRUE ELSE FALSE THEN ELSE 2DROP FALSE THEN ;
+: ALIGNED 7 + -8 AND ;
+: ALIGN HERE @ ALIGNED HERE ! ;
+: C, HERE @ C! 1 HERE +! ;
+: S" IMMEDIATE STATE @ IF
+  ' LITSTRING , HERE @ 0 , BEGIN KEY DUP '"' <> WHILE
+  C, REPEAT DROP DUP HERE @ SWAP - 8- SWAP ! ALIGN ELSE
+  HERE @ BEGIN KEY DUP '"' <> WHILE OVER C! 1+ REPEAT DROP HERE @ - HERE @ SWAP THEN ;
+: ." IMMEDIATE STATE @ IF [COMPILE] S" ' TELL , ELSE BEGIN KEY DUP '"' = IF
+  DROP EXIT THEN EMIT AGAIN THEN ;
+: CELLS 8 * ;
+: ID. 8+ DUP C@ F_LENMASK AND BEGIN DUP 0> WHILE SWAP 1+ DUP C@ EMIT SWAP 1- REPEAT
+  2DROP ;
+: ?IMMEDIATE 8+ C@ F_IMMED AND ;
+: CASE    IMMEDIATE 0 ;
+: OF      IMMEDIATE ' OVER , ' = , [COMPILE] IF ' DROP , ;
+: ENDOF   IMMEDIATE [COMPILE] ELSE ;
+: ENDCASE IMMEDIATE ' DROP , BEGIN ?DUP WHILE [COMPILE] THEN REPEAT ;
+: CFA> LATEST @ BEGIN ?DUP WHILE 2DUP >CFA = IF NIP EXIT THEN @ REPEAT DROP 0 ;
+: SEE WORD FIND HERE @ LATEST @ BEGIN 2 PICK OVER <> WHILE NIP DUP @ REPEAT DROP SWAP
+  ':' EMIT SPACE DUP ID. SPACE DUP ?IMMEDIATE IF ." IMMEDIATE " THEN >DFA
+  BEGIN 2DUP > WHILE DUP @
+      CASE
+          ' LIT OF 8+ DUP @ . ENDOF
+          ' LITSTRING OF [ CHAR S ] LITERAL EMIT '"' EMIT SPACE 8+ DUP @ SWAP 8+
+            SWAP 2DUP TELL '"' EMIT SPACE + ALIGNED 8- ENDOF
+          ' 0BRANCH OF ." 0BRANCH ( " 8+ DUP @ . ." ) " ENDOF
+          '  BRANCH OF  ." BRANCH ( " 8+ DUP @ . ." ) " ENDOF
+          ' ' OF [ CHAR ' ] LITERAL EMIT SPACE 8+ DUP CFA> ID. SPACE ENDOF
+          ' EXIT OF 2DUP 8+ <> IF ." EXIT " THEN ENDOF
+          DUP CFA> ID. SPACE
+      ENDCASE
+      8+
+  REPEAT
+ ';' EMIT CR 2DROP ;
+: ['] IMMEDIATE ' LIT , ;
+: EXCEPTION-MARKER RDROP 0 ;
+: CATCH DSP@ 8+ >R ' EXCEPTION-MARKER 8+ >R EXECUTE ;
+: THROW ?DUP IF RSP@ BEGIN DUP R0 8- < WHILE DUP @ ' EXCEPTION-MARKER 8+ = IF
+  8+ RSP! DUP DUP DUP R> 8- SWAP OVER ! DSP! EXIT THEN 8+ REPEAT
+  DROP CASE 0 1- OF ." ABORTED" CR ENDOF ." UNCAUGHT THROW " DUP . CR ENDCASE QUIT THEN
+  ;
+: Z" IMMEDIATE STATE @ IF
+  ' LITSTRING , HERE @ 0 , BEGIN KEY DUP '"' <> WHILE
+  HERE @ C! 1 HERE +! REPEAT 0 HERE @ C! 1 HERE +! DROP DUP
+  HERE @ SWAP - 8- SWAP ! ALIGN ' DROP , ELSE
+  HERE @ BEGIN KEY DUP '"' <> WHILE OVER C! 1+ REPEAT DROP 0 SWAP C! HERE @ THEN ;
+: STRLEN DUP BEGIN DUP C@ 0<> WHILE 1+ REPEAT SWAP - ;
+: ARGC (ARGC) @ ;
+: ARGV 1+ CELLS (ARGC) + @ DUP STRLEN ;
+: ENVIRON ARGC 2 + CELLS (ARGC) + ;
+"#;
+
+#[cfg(test)]
+mod tests {
+    use std::process::{Command, Stdio};
+    use std::io::Write;
+    use rstest::rstest;
+    use super::PREAMBLE;
+
+    #[rstest]
+    #[case("", "65 EMIT", "A")]
+    #[case("", "777 65 EMIT", "A")]
+    #[case("", "32 DUP + 1+ EMIT", "A")]
+    #[case("", "16 DUP 2DUP + + + 1+ EMIT", "A")]
+    #[case("", "8 DUP * 1+ EMIT", "A")]
+    #[case("", "CHAR A EMIT", "A")]
+    #[case("", ": SLOW WORD FIND >CFA EXECUTE ; 65 SLOW EMIT", "A")]
+    #[case("", "3480240455236671827 DSP@ 8 TELL", "SYSCALL0")]
+    #[case("", "3480240455236671827 DSP@ HERE @ 8 CMOVE HERE @ 8 TELL", "SYSCALL0")]
+    #[case("", "13622 DSP@ 2 NUMBER DROP EMIT", "A")]
+    #[case("", "64 >R RSP@ 1 TELL RDROP", "@")]
+    #[case("", "64 DSP@ RSP@ SWAP C@C! RSP@ 1 TELL", "@")]
+    #[case("", "64 >R 1 RSP@ +! RSP@ 1 TELL", "A")]
+    #[case("", r#"
+: <BUILDS WORD CREATE DODOES , 0 , ;
+: DOES> R> LATEST @ >DFA ! ;
+: CONST <BUILDS , DOES> @ ;
+
+65 CONST FOO
+FOO EMIT
+"#, "A")]
+    #[case(PREAMBLE, "VERSION .", "47 ")]
+    #[case(PREAMBLE, "CR", "\n")]
+    #[case(PREAMBLE, "LATEST @ ID.", "ENVIRON")]
+    #[case(PREAMBLE, "0 1 > . 1 0 > .", "0 -1 ")]
+    #[case(PREAMBLE, "0 1 >= . 0 0 >= .", "0 -1 ")]
+    #[case(PREAMBLE, "0 0<> . 1 0<> .", "0 -1 ")]
+    #[case(PREAMBLE, "1 0<= . 0 0<= .", "0 -1 ")]
+    #[case(PREAMBLE, "-1 0>= . 0 0>= .", "0 -1 ")]
+    #[case(PREAMBLE, "0 0 OR . 0 -1 OR .", "0 -1 ")]
+    #[case(PREAMBLE, "-1 -1 XOR . 0 -1 XOR .", "0 -1 ")]
+    #[case(PREAMBLE, "-1 INVERT . 0 INVERT .", "0 -1 ")]
+    #[case(PREAMBLE, "3 4 5 .S", "5 4 3 ")]
+    #[case(PREAMBLE, "1 2 3 4 2SWAP .S", "2 1 4 3 ")]
+    #[case(PREAMBLE, "F_IMMED F_HIDDEN .S", "32 128 ")]
+    #[case(PREAMBLE, ": CFA@ WORD FIND >CFA @ ; CFA@ >DFA DOCOL = .", "-1 ")]
+    #[case(PREAMBLE, "3 4 5 WITHIN .", "0 ")]
+    #[case(PREAMBLE, r#"S" test" SWAP 1 SYS_WRITE SYSCALL3"#, "test")]
+    #[case(PREAMBLE, "SEE >DFA", ": >DFA >CFA 8+ EXIT ;\n")]
+    #[case(PREAMBLE, "SEE HIDE", ": HIDE WORD FIND HIDDEN ;\n")]
+    #[case(PREAMBLE, "SEE QUIT", ": QUIT R0 RSP! INTERPRET BRANCH ( -16 ) ;\n")]
+    fn test_wait_with_output(
+        #[case] preamble: &str,
+        #[case] input: &str,
+        #[case] expected: &str,
+        #[values("./4th", "./5th.ll")] program: &str,
+    ) {
+        let mut child = Command::new(program)
+            .stdin(Stdio::piped())
+            .stdout(Stdio::piped())
+            .stderr(Stdio::null())
+            .spawn()
+            .expect("Failed to spawn command");
+
+        child.stdin.take()
+            .unwrap()
+            .write_all(format!("{} {}\n", preamble, input).as_bytes())
+            .expect("Failed to write to stdin");
+
+        let output = child.wait_with_output().expect("Failed to read stdout");
+
+        assert!(output.status.success(), "Command failed with status: {:?}", output.status);
+        assert_eq!(output.stdout, expected.as_bytes(), "Mismatch for: {}", input);
+    }
+}