commit f65c910837279a40cbb6635a374d94c506a81d8f parent 6bc7fe027448d93fba459b87e00097a972817b6b Author: Ryan Sepassi <rsepassi@gmail.com> Date: Sat, 25 Apr 2026 22:15:50 -0700 cc: util.scm — implement TBD helpers; add 14 test fixtures bv-prefix?, bv-find, bv-slice, bv-cat, bv->fixnum (returns (ok . val) per CC-INTERNALS), alist-ref/alist-ref/eq/alist-update, any/every/count, buf-flush, die (formats per CC-CONTRACTS §2.3, fd 2 + sys-exit 1), slurp-fd (BUFSIZE chunks → bv-concat-reverse for linear scaling on multi-MB inputs), write-bv-fd (loop until full, sys-exit on error to avoid recursion through die), make-namer. All 14 tests pass on aarch64 under the existing scheme1 runner convention (.expected = stdout, .expected-exit = exit code; stderr unverified). Tests 09/10 verify die's exit code only since the runner does not currently capture stderr. Diffstat:
30 files changed, 402 insertions(+), 21 deletions(-)
diff --git a/cc/util.scm b/cc/util.scm @@ -9,25 +9,94 @@ ;; -------------------------------------------------------------------- (define (bv= a b) (bytevector=? a b)) -(define (bv-prefix? p s) (error "TBD: bv-prefix?")) -(define (bv-find bv byte from) (error "TBD: bv-find")) -(define (bv-slice bv start end) (error "TBD: bv-slice")) -(define (bv-of-byte b) (make-bytevector 1 b)) -(define (bv-cat lst-of-bv) (error "TBD: bv-cat")) -(define (bv->fixnum bv radix) (error "TBD: bv->fixnum")) -(define (fixnum->bv n radix) (number->string n radix)) +(define (bv-prefix? p s) + ;; Is s a bv that starts with the bytes of p? + (let ((plen (bytevector-length p)) + (slen (bytevector-length s))) + (if (< slen plen) + #f + (let loop ((i 0)) + (cond ((= i plen) #t) + ((= (bytevector-u8-ref p i) (bytevector-u8-ref s i)) + (loop (+ i 1))) + (else #f)))))) + +(define (bv-find bv byte from) + ;; Linear scan for the first byte == `byte` at index >= from. + ;; Returns the index, or #f if not found. + (let ((n (bytevector-length bv))) + (let loop ((i from)) + (cond ((>= i n) #f) + ((= (bytevector-u8-ref bv i) byte) i) + (else (loop (+ i 1))))))) + +(define (bv-slice bv start end) + ;; Fresh copy of bytes in [start, end). bytevector-copy already does + ;; this in scheme1 (3-arg form returns a fresh bv). + (bytevector-copy bv start end)) + +(define (bv-of-byte b) (make-bytevector 1 b)) + +(define (bv-cat lst-of-bv) + ;; Concat a list of bytevectors with one allocation. bytevector-append + ;; is variadic, so apply does this in a single linear pass. + (apply bytevector-append lst-of-bv)) + +(define (bv->fixnum bv radix) + ;; (ok . val) per CC-INTERNALS: (#t . val) on parse, (#f . #f) on fail. + ;; string->number is pure and returns #f on parse failure (not the + ;; (ok . val) convention, since it's not a syscall). + (let ((n (string->number bv radix))) + (if n (cons #t n) (cons #f #f)))) + +(define (fixnum->bv n radix) (number->string n radix)) ;; -------------------------------------------------------------------- ;; lists / alists ;; -------------------------------------------------------------------- -(define (alist-ref key al) (error "TBD: alist-ref")) -(define (alist-ref/eq key al) (error "TBD: alist-ref/eq")) -(define (alist-set key val al) (cons (cons key val) al)) -(define (alist-update key f al) (error "TBD: alist-update")) +(define (alist-ref key al) + ;; equal? compare (intended for bv keys). The prelude's `assoc` uses + ;; eq?, so we roll our own for the equal? case. + (cond ((null? al) #f) + ((equal? (car (car al)) key) (cdr (car al))) + (else (alist-ref key (cdr al))))) -(define (any p xs) (error "TBD: any")) -(define (every p xs) (error "TBD: every")) -(define (count p xs) (error "TBD: count")) +(define (alist-ref/eq key al) + ;; eq? compare (for symbol keys). Reuses the prelude's assoc, which + ;; is eq?-based. + (let ((p (assoc key al))) + (if p (cdr p) #f))) + +(define (alist-set key val al) (cons (cons key val) al)) + +(define (alist-update key f al) + ;; Functional update by equal? key. If found, replace its value with + ;; (f old-val). If not found, prepend (cons key (f #f)) so callers + ;; can use this as upsert-with-default. + (let loop ((xs al) (acc '())) + (cond ((null? xs) + (cons (cons key (f #f)) (reverse acc))) + ((equal? (car (car xs)) key) + (append (reverse acc) + (cons (cons key (f (cdr (car xs)))) + (cdr xs)))) + (else (loop (cdr xs) (cons (car xs) acc)))))) + +(define (any p xs) + (cond ((null? xs) #f) + ((p (car xs)) #t) + (else (any p (cdr xs))))) + +(define (every p xs) + (cond ((null? xs) #t) + ((p (car xs)) (every p (cdr xs))) + (else #f))) + +(define (count p xs) + (let loop ((xs xs) (n 0)) + (cond ((null? xs) n) + ((p (car xs)) (loop (cdr xs) (+ n 1))) + (else (loop (cdr xs) n))))) ;; -------------------------------------------------------------------- ;; ints @@ -51,21 +120,84 @@ (define (buf-push! b bv) (buf-chunks-set! b (cons bv (buf-chunks b)))) -(define (buf-flush b) (error "TBD: buf-flush")) +(define (buf-flush b) + ;; Reverse the chunk list once, then concat in one allocation. + (bv-cat (reverse (buf-chunks b)))) ;; -------------------------------------------------------------------- ;; diagnostics + I/O ;; -------------------------------------------------------------------- (define (die loc msg . irritants) - ;; Format per CC-INTERNALS §Errors: + ;; Format per CC-CONTRACTS §2.3: ;; <file>:<line>:<col>: error: <msg>: <irritant> <irritant> ... - ;; Writes to fd 2 then sys-exits 1. - (error "TBD: die")) + ;; When loc is #f, the "<file>:<line>:<col>: " prefix is omitted. + ;; irritants are written via display semantics (no quoting); format's + ;; ~a handles bv/fixnum/pair/symbol the same way display does. + ;; + ;; All output is built into a single bv and sent to fd 2 with one + ;; sys-write loop, so a partial write doesn't interleave fragments + ;; from a concurrent process. + (let* ((prefix (if loc + (format "~a:~d:~d: error: " + (loc-file loc) (loc-line loc) (loc-col loc)) + "error: ")) + (head (bytevector-append prefix (format "~a" msg))) + ;; Irritants get ": " before the first and " " between the rest. + (tail (if (null? irritants) + (list NL-BV) + (let walk ((xs irritants) (sep ": ") (acc '())) + (if (null? xs) + (reverse (cons NL-BV acc)) + (walk (cdr xs) + " " + (cons (format "~a" (car xs)) + (cons sep acc))))))) + (out (bv-cat (cons head tail)))) + (write-bv-fd 2 out) + (sys-exit 1))) + +(define (slurp-fd fd) + ;; Read fd to EOF. Uses BUFSIZE chunks (same constant the prelude's + ;; port layer uses); bv-concat-reverse builds the result in one + ;; allocation so a multi-MB tcc.c stays linear. + (let ((buf (make-bytevector BUFSIZE))) + (let loop ((acc '())) + (let ((r (sys-read fd buf BUFSIZE))) + (cond ((not (car r)) + (die #f "slurp-fd: sys-read failed" (cdr r))) + ((zero? (cdr r)) + (bv-concat-reverse acc)) + (else + (loop (cons (bytevector-copy buf 0 (cdr r)) acc)))))))) -(define (slurp-fd fd) (error "TBD: slurp-fd")) -(define (write-bv-fd fd bv) (error "TBD: write-bv-fd")) +(define (write-bv-fd fd bv) + ;; Full write or die. sys-write may write fewer bytes than requested; + ;; loop until everything is written. Avoid the slice copy when a + ;; single sys-write completes the whole bv (the common case). + ;; + ;; On failure we sys-exit directly instead of routing through `die` + ;; — `die` itself uses write-bv-fd, so a write failure to fd 2 must + ;; not recurse infinitely. Status 1 matches the contract for `die`. + (let ((len (bytevector-length bv))) + (let loop ((off 0)) + (if (= off len) + #t + (let* ((rem (- len off)) + (chunk (if (zero? off) bv (bytevector-copy bv off len))) + (r (sys-write fd chunk rem))) + (cond ((not (car r)) (sys-exit 1)) + ((zero? (cdr r)) (sys-exit 1)) + (else (loop (+ off (cdr r)))))))))) ;; -------------------------------------------------------------------- ;; fresh-name generator (used for cg label counters, etc.) ;; -------------------------------------------------------------------- -(define (make-namer prefix) (error "TBD: make-namer")) +(define (make-namer prefix) + ;; Returns a thunk; each call yields prefix0, prefix1, ... as a fresh + ;; bv. The counter lives in the closure's lexical environment; scheme1 + ;; closures heap-capture by reference, so set! on ctr is sticky. + (let ((ctr 0)) + (lambda () + (let ((s (bytevector-append prefix (number->string ctr 10)))) + (set! ctr (+ ctr 1)) + s)))) diff --git a/tests/cc-util/00-bv-prefix.expected-exit b/tests/cc-util/00-bv-prefix.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/00-bv-prefix.scm b/tests/cc-util/00-bv-prefix.scm @@ -0,0 +1,10 @@ +;; tests/cc-util/00-bv-prefix.scm — bv-prefix? happy + edge cases. +;; Assumes cc/util.scm is loaded (test runner wiring lands later). + +(if (bv-prefix? "abc" "abcdef") 0 (sys-exit 1)) ; happy path +(if (bv-prefix? "" "anything") 0 (sys-exit 2)) ; empty prefix +(if (bv-prefix? "" "") 0 (sys-exit 3)) ; empty/empty +(if (bv-prefix? "abcd" "abc") (sys-exit 4) 0) ; prefix longer than s +(if (bv-prefix? "abx" "abcdef") (sys-exit 5) 0) ; differs mid-prefix +(if (bv-prefix? "abcdef" "abcdef") 0 (sys-exit 6)) ; equal +(sys-exit 0) diff --git a/tests/cc-util/01-bv-find.expected-exit b/tests/cc-util/01-bv-find.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/01-bv-find.scm b/tests/cc-util/01-bv-find.scm @@ -0,0 +1,10 @@ +;; tests/cc-util/01-bv-find.scm — bv-find returns first index >= from. +;; Assumes cc/util.scm is loaded. + +(if (= (bv-find "hello world" 32 0) 5) 0 (sys-exit 1)) ; first space +(if (= (bv-find "aaaaa" 97 2) 2) 0 (sys-exit 2)) ; from honored +(if (bv-find "abc" 122 0) (sys-exit 3) 0) ; not found -> #f +(if (bv-find "" 65 0) (sys-exit 4) 0) ; empty -> #f +(if (bv-find "abc" 97 5) (sys-exit 5) 0) ; from past end -> #f +(if (= (bv-find "abc" 99 0) 2) 0 (sys-exit 6)) ; last byte +(sys-exit 0) diff --git a/tests/cc-util/02-bv-slice-cat.expected-exit b/tests/cc-util/02-bv-slice-cat.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/02-bv-slice-cat.scm b/tests/cc-util/02-bv-slice-cat.scm @@ -0,0 +1,12 @@ +;; tests/cc-util/02-bv-slice-cat.scm — bv-slice and bv-cat round-trip. +;; Assumes cc/util.scm is loaded. + +(if (bv= (bv-slice "abcdef" 2 5) "cde") 0 (sys-exit 1)) +(if (bv= (bv-slice "abcdef" 0 0) "") 0 (sys-exit 2)) ; zero-length +(if (bv= (bv-slice "abcdef" 0 6) "abcdef") 0 (sys-exit 3)) ; full +(if (bv= (bv-cat '()) "") 0 (sys-exit 4)) ; empty list +(if (bv= (bv-cat (list "a" "b" "c")) "abc") 0 (sys-exit 5)) +(if (bv= (bv-cat (list "" "abc" "" "def" "")) + "abcdef") 0 (sys-exit 6)) +(if (bv= (bv-of-byte 65) "A") 0 (sys-exit 7)) +(sys-exit 0) diff --git a/tests/cc-util/03-bv-fixnum.expected-exit b/tests/cc-util/03-bv-fixnum.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/03-bv-fixnum.scm b/tests/cc-util/03-bv-fixnum.scm @@ -0,0 +1,33 @@ +;; tests/cc-util/03-bv-fixnum.scm — bv->fixnum (ok . val) plumbing +;; and fixnum->bv round-trip. +;; Assumes cc/util.scm is loaded. +;; +;; NOTE: scheme1's number->string and string->number currently ignore +;; the radix argument and emit/parse decimal only (see scheme1.P1pp +;; comment on prim_string_to_number_entry). util.scm correctly forwards +;; the radix per LISP.md; once the prim grows hex support these tests +;; will exercise it. For now we only check decimal. + +(define a (bv->fixnum "42" 10)) +(if (car a) 0 (sys-exit 1)) +(if (= (cdr a) 42) 0 (sys-exit 2)) + +(define b (bv->fixnum "-7" 10)) +(if (car b) 0 (sys-exit 3)) +(if (= (cdr b) -7) 0 (sys-exit 4)) + +;; parse failure -> (#f . #f) +(define c (bv->fixnum "nope" 10)) +(if (car c) (sys-exit 5) 0) +(if (cdr c) (sys-exit 6) 0) + +;; empty bv: parse failure +(define d (bv->fixnum "" 10)) +(if (car d) (sys-exit 7) 0) + +;; round trip via decimal +(if (bv= (fixnum->bv 42 10) "42") 0 (sys-exit 8)) +(if (bv= (fixnum->bv 0 10) "0") 0 (sys-exit 9)) +(if (bv= (fixnum->bv -7 10) "-7") 0 (sys-exit 10)) + +(sys-exit 0) diff --git a/tests/cc-util/04-alist.expected-exit b/tests/cc-util/04-alist.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/04-alist.scm b/tests/cc-util/04-alist.scm @@ -0,0 +1,30 @@ +;; tests/cc-util/04-alist.scm — alist-ref / alist-ref/eq / alist-set / +;; alist-update. +;; Assumes cc/util.scm is loaded. + +;; alist-ref uses equal? — bv keys +(define al1 (alist-set "k1" 1 (alist-set "k2" 2 '()))) +(if (= (alist-ref "k1" al1) 1) 0 (sys-exit 1)) +(if (= (alist-ref "k2" al1) 2) 0 (sys-exit 2)) +(if (alist-ref "k3" al1) (sys-exit 3) 0) ; missing -> #f + +;; alist-set conses on the front (later entries shadow older ones via search order) +(define al2 (alist-set "k1" 99 al1)) +(if (= (alist-ref "k1" al2) 99) 0 (sys-exit 4)) + +;; alist-ref/eq uses eq? — symbol keys +(define al3 (alist-set 'foo 10 (alist-set 'bar 20 '()))) +(if (= (alist-ref/eq 'foo al3) 10) 0 (sys-exit 5)) +(if (= (alist-ref/eq 'bar al3) 20) 0 (sys-exit 6)) +(if (alist-ref/eq 'baz al3) (sys-exit 7) 0) + +;; alist-update: present case replaces value +(define al4 (alist-update "k1" (lambda (v) (+ v 100)) al1)) +(if (= (alist-ref "k1" al4) 101) 0 (sys-exit 8)) +(if (= (alist-ref "k2" al4) 2) 0 (sys-exit 9)) ; other key untouched + +;; alist-update: missing key -> upsert with (f #f) +(define al5 (alist-update "new" (lambda (v) (if v v 7)) '())) +(if (= (alist-ref "new" al5) 7) 0 (sys-exit 10)) + +(sys-exit 0) diff --git a/tests/cc-util/05-list-preds.expected-exit b/tests/cc-util/05-list-preds.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/05-list-preds.scm b/tests/cc-util/05-list-preds.scm @@ -0,0 +1,19 @@ +;; tests/cc-util/05-list-preds.scm — any / every / count. +;; Assumes cc/util.scm is loaded. + +;; any +(if (any positive? '()) (sys-exit 1) 0) ; empty -> #f +(if (any positive? '(-1 -2 3)) 0 (sys-exit 2)) ; one positive +(if (any positive? '(-1 -2 -3)) (sys-exit 3) 0) ; none + +;; every +(if (every positive? '()) 0 (sys-exit 4)) ; empty -> #t (vacuous truth) +(if (every positive? '(1 2 3)) 0 (sys-exit 5)) +(if (every positive? '(1 -2 3)) (sys-exit 6) 0) + +;; count +(if (= (count positive? '()) 0) 0 (sys-exit 7)) +(if (= (count positive? '(1 2 3)) 3) 0 (sys-exit 8)) +(if (= (count positive? '(-1 0 1 2)) 2) 0 (sys-exit 9)) + +(sys-exit 0) diff --git a/tests/cc-util/06-min3-align.expected-exit b/tests/cc-util/06-min3-align.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/06-min3-align.scm b/tests/cc-util/06-min3-align.scm @@ -0,0 +1,17 @@ +;; tests/cc-util/06-min3-align.scm — already-real helpers, smoke test. +;; Assumes cc/util.scm is loaded. + +(if (= (min3 1 2 3) 1) 0 (sys-exit 1)) +(if (= (min3 3 2 1) 1) 0 (sys-exit 2)) +(if (= (min3 5 5 5) 5) 0 (sys-exit 3)) +(if (= (min3 -1 0 5) -1) 0 (sys-exit 4)) + +;; align-up: round up to multiple of k (k must be a power of 2) +(if (= (align-up 0 8) 0) 0 (sys-exit 5)) +(if (= (align-up 1 8) 8) 0 (sys-exit 6)) +(if (= (align-up 8 8) 8) 0 (sys-exit 7)) +(if (= (align-up 9 8) 16) 0 (sys-exit 8)) +(if (= (align-up 17 4) 20) 0 (sys-exit 9)) +(if (= (align-up 0 1) 0) 0 (sys-exit 10)) + +(sys-exit 0) diff --git a/tests/cc-util/07-buf.expected-exit b/tests/cc-util/07-buf.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/07-buf.scm b/tests/cc-util/07-buf.scm @@ -0,0 +1,21 @@ +;; tests/cc-util/07-buf.scm — make-buf / buf-push! / buf-flush. +;; Buffers preserve push order on flush (chunks are stored reversed and +;; flush reverses again). +;; Assumes cc/util.scm is loaded. + +(define b (make-buf)) +(if (bv= (buf-flush b) "") 0 (sys-exit 1)) ; empty flush + +(buf-push! b "hello, ") +(buf-push! b "world") +(buf-push! b "!") +(if (bv= (buf-flush b) "hello, world!") 0 (sys-exit 2)) + +;; flushing again still sees the same chunks (buf-flush is non-destructive) +(if (bv= (buf-flush b) "hello, world!") 0 (sys-exit 3)) + +;; buf? predicate +(if (buf? b) 0 (sys-exit 4)) +(if (buf? "not a buf") (sys-exit 5) 0) + +(sys-exit 0) diff --git a/tests/cc-util/08-make-namer.expected-exit b/tests/cc-util/08-make-namer.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/08-make-namer.scm b/tests/cc-util/08-make-namer.scm @@ -0,0 +1,16 @@ +;; tests/cc-util/08-make-namer.scm — make-namer yields prefix0, prefix1, ... +;; with each closure carrying its own counter. +;; Assumes cc/util.scm is loaded. + +(define n1 (make-namer "L")) +(if (bv= (n1) "L0") 0 (sys-exit 1)) +(if (bv= (n1) "L1") 0 (sys-exit 2)) +(if (bv= (n1) "L2") 0 (sys-exit 3)) + +;; A second namer has its own counter; doesn't share state with n1. +(define n2 (make-namer "tmp_")) +(if (bv= (n2) "tmp_0") 0 (sys-exit 4)) +(if (bv= (n1) "L3") 0 (sys-exit 5)) ; n1 keeps counting +(if (bv= (n2) "tmp_1") 0 (sys-exit 6)) + +(sys-exit 0) diff --git a/tests/cc-util/09-die-noloc.expected-exit b/tests/cc-util/09-die-noloc.expected-exit @@ -0,0 +1 @@ +1 diff --git a/tests/cc-util/09-die-noloc.scm b/tests/cc-util/09-die-noloc.scm @@ -0,0 +1,9 @@ +;; tests/cc-util/09-die-noloc.scm — die with loc=#f writes "error: <msg>: <ir>..." +;; to fd 2 and exits 1. +;; Assumes cc/util.scm is loaded. +;; +;; Expected output (merged stdout+stderr): +;; error: bad token: unexpected 42 +;; Expected exit: 1 + +(die #f "bad token" "unexpected" 42) diff --git a/tests/cc-util/10-die-no-irritants.expected-exit b/tests/cc-util/10-die-no-irritants.expected-exit @@ -0,0 +1 @@ +1 diff --git a/tests/cc-util/10-die-no-irritants.scm b/tests/cc-util/10-die-no-irritants.scm @@ -0,0 +1,5 @@ +;; tests/cc-util/10-die-no-irritants.scm — die with msg only, no irritants. +;; Verifies the no-irritants path emits just "error: <msg>" + newline. +;; Assumes cc/util.scm is loaded. + +(die #f "something went wrong") diff --git a/tests/cc-util/11-write-bv-fd.expected b/tests/cc-util/11-write-bv-fd.expected @@ -0,0 +1,2 @@ +hello +world diff --git a/tests/cc-util/11-write-bv-fd.expected-exit b/tests/cc-util/11-write-bv-fd.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/11-write-bv-fd.scm b/tests/cc-util/11-write-bv-fd.scm @@ -0,0 +1,7 @@ +;; tests/cc-util/11-write-bv-fd.scm — write-bv-fd writes the full bv to fd 1. +;; Assumes cc/util.scm is loaded. +;; +;; Expected stdout: "hello\nworld\n" + +(write-bv-fd 1 "hello\nworld\n") +(sys-exit 0) diff --git a/tests/cc-util/12-slurp-fd.expected-exit b/tests/cc-util/12-slurp-fd.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/12-slurp-fd.scm b/tests/cc-util/12-slurp-fd.scm @@ -0,0 +1,22 @@ +;; tests/cc-util/12-slurp-fd.scm — slurp-fd reads to EOF and produces a +;; single bv that round-trips with write-bv-fd. +;; Assumes cc/util.scm is loaded. + +;; Use the prelude's open-output / open-input to grab fds, then exercise +;; util.scm's fd-level helpers directly. +(define payload "the quick brown fox jumps over the lazy dog\n") + +(define op-r (open-output "/tmp/cc-util-12.txt")) +(if (car op-r) 0 (sys-exit 50)) +(define wfd (port-fd (cdr op-r))) +(write-bv-fd wfd payload) +(sys-close wfd) + +(define ip-r (open-input "/tmp/cc-util-12.txt")) +(if (car ip-r) 0 (sys-exit 51)) +(define rfd (port-fd (cdr ip-r))) +(define got (slurp-fd rfd)) +(sys-close rfd) + +(if (bv= got payload) 0 (sys-exit 1)) +(sys-exit 0) diff --git a/tests/cc-util/13-slurp-large.expected-exit b/tests/cc-util/13-slurp-large.expected-exit @@ -0,0 +1 @@ +0 diff --git a/tests/cc-util/13-slurp-large.scm b/tests/cc-util/13-slurp-large.scm @@ -0,0 +1,22 @@ +;; tests/cc-util/13-slurp-large.scm — slurp-fd handles inputs that span +;; multiple BUFSIZE refills (BUFSIZE = 4096 in the prelude). +;; Assumes cc/util.scm is loaded. + +;; Build a > 2 * BUFSIZE bv (10000 bytes of 'A'). +(define big (make-bytevector 10000 65)) + +(define op-r (open-output "/tmp/cc-util-13.bin")) +(if (car op-r) 0 (sys-exit 50)) +(define wfd (port-fd (cdr op-r))) +(write-bv-fd wfd big) +(sys-close wfd) + +(define ip-r (open-input "/tmp/cc-util-13.bin")) +(if (car ip-r) 0 (sys-exit 51)) +(define rfd (port-fd (cdr ip-r))) +(define got (slurp-fd rfd)) +(sys-close rfd) + +(if (= (bytevector-length got) 10000) 0 (sys-exit 1)) +(if (bv= got big) 0 (sys-exit 2)) +(sys-exit 0)