commit 5572d18365e4e8b17a2059a5b90feb81cc42ee27
parent 96a683eb9e0aea5e8d4d98763f66b069cfd5fff9
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 16:26:25 -0700
scheme1: rework shell + file-IO test coverage to prelude API only
Drop the raw-syscall tests and rebuild end-to-end coverage in terms of
the prelude wrappers (run/spawn/wait, open-input/output/append,
read-bytes/read-line/read-all, write-bytes/write-line, exit, argv).
Removed (raw sys-* now exercised transitively through the prelude):
- 40-sys-argv: superseded by 40-argv (already on disk, prelude (argv)).
- 42-clone-wait: raw sys-clone + sys-waitid + siginfo offset arithmetic;
non-portable. Coverage now from 45/51 via spawn + wait.
- 44-shell-run: misleading -- never called run; sys-clone + sys-wait
exit-status branch now covered by 45/56 via run.
Reworked:
- 41-fileio: now uses open-input + read-bytes + close on its own source
via (argv); no sys-openat/read/close.
- 45-shell-spawn: drop the local spawn workaround now that the prelude's
run -> spawn path is fixed; calls run "/bin/true" directly.
Added (one prelude API per file):
- 51-shell-signal: pin decode-wait-status's signal branch via
run sh -c 'kill -9 $$' -> exit 137.
- 63-file-output-roundtrip: open-output -> write-bytes -> read-all.
- 64-file-append: open-output then open-append, verify concatenation.
- 67-read-line: 3-line file -> 3 reads + EOF on 4th call.
- 68-read-bytes-multi: 5000-byte payload -> read-bytes spans BUFSIZE.
- 69-open-input-missing: pin (#f . errno) failure tuple.
- 83-write-line: pin trailing-newline append behavior.
Diffstat:
16 files changed, 137 insertions(+), 66 deletions(-)
diff --git a/tests/scheme1/40-sys-argv.expected-exit b/tests/scheme1/40-sys-argv.expected-exit
@@ -1 +0,0 @@
-2
diff --git a/tests/scheme1/40-sys-argv.scm b/tests/scheme1/40-sys-argv.scm
@@ -1,6 +0,0 @@
-; sys-argv returns a list of bytevectors. argv[0] is the program name,
-; argv[1] is this script's path. We just count the entries via a list
-; recursion and return that.
-(define (count xs)
- (if (null? xs) 0 (+ 1 (count (cdr xs)))))
-(sys-exit (count (sys-argv)))
diff --git a/tests/scheme1/41-fileio.scm b/tests/scheme1/41-fileio.scm
@@ -1,16 +1,10 @@
-; Round-trip sys-openat / sys-read / sys-close on this very file. The
-; first byte is `;` (ASCII 59) -- we exit with that, proving open and
-; read both succeeded and the data made it into a Scheme bytevector.
-(define args (sys-argv))
-(define path (car (cdr args)))
-(define r (sys-openat -100 path 0 0))
-(if (not (car r))
- (sys-exit 1)
- (let ((fd (cdr r))
- (buf (make-bytevector 1)))
- (let ((rr (sys-read fd buf 1)))
- (if (not (car rr))
- (sys-exit 2)
- (let ((b (bytevector-u8-ref buf 0)))
- (sys-close fd)
- (sys-exit b))))))
+; Round-trip the prelude port API (open-input/read-bytes/close) on this
+; very file. The first byte is `;` (ASCII 59) -- we exit with that,
+; proving open and read both succeeded and the data made it into a
+; Scheme bytevector. Path comes from (argv); no raw sys-* primitives.
+(define ip (open-input (car (cdr (argv)))))
+(if (not (car ip)) (exit 1) 0)
+(define rd (read-bytes (cdr ip) 1))
+(close (cdr ip))
+(if (not (car rd)) (exit 2) 0)
+(exit (bytevector-u8-ref (cdr rd) 0))
diff --git a/tests/scheme1/42-clone-wait.expected-exit b/tests/scheme1/42-clone-wait.expected-exit
@@ -1 +0,0 @@
-17
diff --git a/tests/scheme1/42-clone-wait.scm b/tests/scheme1/42-clone-wait.scm
@@ -1,14 +0,0 @@
-; sys-clone forks; the child exits with 17. The parent calls sys-waitid
-; (idtype=P_PID=1, id=pid, infop=128-byte buffer, options=WEXITED=4) and
-; reads the child's exit code from siginfo_t.si_status (offset 24 on
-; 64-bit Linux). Final exit reflects the child's status.
-(define r (sys-clone))
-(if (not (car r))
- (sys-exit 1)
- (if (zero? (cdr r))
- (sys-exit 17)
- (let ((info (make-bytevector 128 0)))
- (let ((wr (sys-waitid 1 (cdr r) info 4)))
- (if (car wr)
- (sys-exit (bytevector-u8-ref info 24))
- (sys-exit 2))))))
diff --git a/tests/scheme1/44-shell-run.expected-exit b/tests/scheme1/44-shell-run.expected-exit
@@ -1 +0,0 @@
-19
diff --git a/tests/scheme1/44-shell-run.scm b/tests/scheme1/44-shell-run.scm
@@ -1,11 +0,0 @@
-; Verify the shell.scm prelude's sys-wait + decode-wait-status: clone a
-; child that exits 19, and have the parent decode the wait status.
-(define r (sys-clone))
-(if (not (car r))
- (sys-exit 1)
- (if (zero? (cdr r))
- (sys-exit 19)
- (let ((wr (sys-wait (cdr r))))
- (if (car wr)
- (sys-exit (decode-wait-status (cdr wr)))
- (sys-exit 2)))))
diff --git a/tests/scheme1/45-shell-spawn.scm b/tests/scheme1/45-shell-spawn.scm
@@ -1,7 +1,8 @@
-; End-to-end shell flow: user defines spawn locally (overriding the
-; prelude's, since calling the prelude's spawn through `run` from user
-; code currently misbehaves -- see commit message). The prelude provides
-; chars->bv-equivalent helpers, `wait`, and decode-wait-status.
+; End-to-end shell flow exercising the *prelude's* spawn and run.
+; Historically this test redefined `spawn` at user level to dodge a bug
+; where `(run prog)` failed with "unbound variable" inside the prelude's
+; spawn. With the bug fixed, calling the prelude's `run` directly should
+; fork-exec /bin/true and return (#t . 0).
(define (chars->bv . cs)
(let* ((n (length cs))
(b (make-bytevector n)))
@@ -10,18 +11,8 @@
(begin (bytevector-u8-set! b i (car xs))
(loop (+ i 1) (cdr xs)))))))
-(define (spawn prog . args)
- (let ((r (sys-clone)))
- (cond
- ((not (car r)) r)
- ((zero? (cdr r))
- (sys-execve prog (cons prog args))
- (sys-exit 127))
- (else r))))
-
(define path (chars->bv 47 98 105 110 47 116 114 117 101)) ; "/bin/true"
-(define r (spawn path))
+(define r (run path))
(if (car r)
- (let ((wr (wait (cdr r))))
- (if (car wr) (sys-exit (cdr wr)) (sys-exit 88)))
+ (sys-exit (cdr r))
(sys-exit 99))
diff --git a/tests/scheme1/51-shell-signal.expected-exit b/tests/scheme1/51-shell-signal.expected-exit
@@ -0,0 +1 @@
+137
diff --git a/tests/scheme1/51-shell-signal.scm b/tests/scheme1/51-shell-signal.scm
@@ -0,0 +1,6 @@
+; Pin the signal-termination branch of decode-wait-status. Run a child
+; that SIGKILLs itself; the prelude's wait should report (#t . (+ 128 9)).
+; Together with 45/56 (exit-code branch) this covers both branches of
+; decode-wait-status without any raw sys-* poking.
+(define r (run "/bin/sh" "-c" "kill -9 $$"))
+(if (car r) (exit (cdr r)) (exit 99))
diff --git a/tests/scheme1/63-file-output-roundtrip.scm b/tests/scheme1/63-file-output-roundtrip.scm
@@ -0,0 +1,20 @@
+; open-output -> write-bytes -> close -> open-input -> read-all roundtrip.
+; Pins both halves of the prelude port API (write side + read side) and
+; the open-output/MODE_644/O_TRUNC flag combination via the public
+; surface only.
+(define path "/tmp/scheme1-output-roundtrip.txt")
+(define payload "abc\nxyz")
+
+(define op (open-output path))
+(if (not (car op)) (exit 10) 0)
+(define wr (write-bytes (cdr op) payload))
+(close (cdr op))
+(if (not (car wr)) (exit 20) 0)
+
+(define ip (open-input path))
+(if (not (car ip)) (exit 30) 0)
+(define rd (read-all (cdr ip)))
+(close (cdr ip))
+(if (not (car rd)) (exit 40) 0)
+
+(if (bytevector=? (cdr rd) payload) (exit 0) (exit 50))
diff --git a/tests/scheme1/64-file-append.scm b/tests/scheme1/64-file-append.scm
@@ -0,0 +1,22 @@
+; Pin open-output (truncating) vs open-append (preserving + appending).
+; Write "hello\n" with open-output, then "world\n" with open-append, and
+; verify the file contains the concatenation.
+(define path "/tmp/scheme1-append.txt")
+
+(define o1 (open-output path))
+(if (not (car o1)) (exit 10) 0)
+(write-bytes (cdr o1) "hello\n")
+(close (cdr o1))
+
+(define o2 (open-append path))
+(if (not (car o2)) (exit 20) 0)
+(write-bytes (cdr o2) "world\n")
+(close (cdr o2))
+
+(define ip (open-input path))
+(if (not (car ip)) (exit 30) 0)
+(define rd (read-all (cdr ip)))
+(close (cdr ip))
+(if (not (car rd)) (exit 40) 0)
+
+(if (bytevector=? (cdr rd) "hello\nworld\n") (exit 0) (exit 50))
diff --git a/tests/scheme1/67-read-line.scm b/tests/scheme1/67-read-line.scm
@@ -0,0 +1,22 @@
+; read-line splits on \n (consuming the newline). After the last line
+; a follow-up read returns (#t . eof). This indirectly exercises
+; bv-concat-reverse via the line-assembly path inside read-line.
+(define path "/tmp/scheme1-read-line.txt")
+(define op (open-output path))
+(write-bytes (cdr op) "alpha\nbeta\ngamma\n")
+(close (cdr op))
+
+(define ip (open-input path))
+(define p (cdr ip))
+(define l1 (read-line p))
+(define l2 (read-line p))
+(define l3 (read-line p))
+(define l4 (read-line p))
+(close p)
+
+(if (and (car l1) (bytevector=? (cdr l1) "alpha")
+ (car l2) (bytevector=? (cdr l2) "beta")
+ (car l3) (bytevector=? (cdr l3) "gamma")
+ (car l4) (eof-object? (cdr l4)))
+ (exit 0)
+ (exit 1))
diff --git a/tests/scheme1/68-read-bytes-multi.scm b/tests/scheme1/68-read-bytes-multi.scm
@@ -0,0 +1,22 @@
+; Force read-bytes through multiple refill! cycles. BUFSIZE is 4096, so
+; reading 5000 bytes in one read-bytes call requires 2 refills. Build
+; the payload in-process and roundtrip it through write-bytes/read-bytes
+; so the test stays self-contained (no shell or external file generators).
+(define path "/tmp/scheme1-read-bytes-multi.bin")
+(define payload (make-bytevector 5000 65)) ; 5000 'A' bytes
+
+(define op (open-output path))
+(if (not (car op)) (exit 10) 0)
+(write-bytes (cdr op) payload)
+(close (cdr op))
+
+(define ip (open-input path))
+(if (not (car ip)) (exit 20) 0)
+(define rd (read-bytes (cdr ip) 5000))
+(close (cdr ip))
+(if (not (car rd)) (exit 30) 0)
+
+(if (and (= (bytevector-length (cdr rd)) 5000)
+ (bytevector=? (cdr rd) payload))
+ (exit 0)
+ (exit 40))
diff --git a/tests/scheme1/69-open-input-missing.scm b/tests/scheme1/69-open-input-missing.scm
@@ -0,0 +1,10 @@
+; Pin the (#f . errno) failure branch of open-input. ENOENT is errno 2
+; on Linux; sys-openat returns the negated errno boxed by sys-openat
+; itself. We don't pin the specific value here -- different libcs may
+; return different signs/conventions -- but we do require:
+; - car is #f (not the success #t)
+; - cdr is an integer (a real errno-like code, not garbage)
+(define r (open-input "/this/path/should/not/exist/scheme1-test"))
+(if (and (not (car r)) (integer? (cdr r)))
+ (exit 0)
+ (exit 1))
diff --git a/tests/scheme1/83-write-line.scm b/tests/scheme1/83-write-line.scm
@@ -0,0 +1,17 @@
+; write-line writes its bytevector then a single newline byte. Pin the
+; concatenation by writing two short lines and reading the file back.
+(define path "/tmp/scheme1-write-line.txt")
+
+(define op (open-output path))
+(if (not (car op)) (exit 10) 0)
+(write-line (cdr op) "hello")
+(write-line (cdr op) "world")
+(close (cdr op))
+
+(define ip (open-input path))
+(if (not (car ip)) (exit 20) 0)
+(define rd (read-all (cdr ip)))
+(close (cdr ip))
+(if (not (car rd)) (exit 30) 0)
+
+(if (bytevector=? (cdr rd) "hello\nworld\n") (exit 0) (exit 40))
