commit 51f2496aa8075ec8e66f9eaa14e18420991fbfaf parent cd42b163a2272e058d1b41ca6a13e28d12e7d4aa Author: Ryan Sepassi <rsepassi@gmail.com> Date: Mon, 27 Apr 2026 12:27:38 -0700 tests/scheme1: prelude tests, do/case/if tests, 3-digit prefix Diffstat:
208 files changed, 352 insertions(+), 8 deletions(-)
diff --git a/tests/scheme1/00-exit.expected-exit b/tests/scheme1/000-exit.expected-exit diff --git a/tests/scheme1/00-exit.scm b/tests/scheme1/000-exit.scm diff --git a/tests/scheme1/01-if.expected-exit b/tests/scheme1/001-if.expected-exit diff --git a/tests/scheme1/01-if.scm b/tests/scheme1/001-if.scm diff --git a/tests/scheme1/02-if-false.expected-exit b/tests/scheme1/002-if-false.expected-exit diff --git a/tests/scheme1/02-if-false.scm b/tests/scheme1/002-if-false.scm diff --git a/tests/scheme1/03-lambda-call.expected-exit b/tests/scheme1/003-lambda-call.expected-exit diff --git a/tests/scheme1/03-lambda-call.scm b/tests/scheme1/003-lambda-call.scm diff --git a/tests/scheme1/04-lambda-multi.expected-exit b/tests/scheme1/004-lambda-multi.expected-exit diff --git a/tests/scheme1/04-lambda-multi.scm b/tests/scheme1/004-lambda-multi.scm diff --git a/tests/scheme1/05-lambda-capture.expected-exit b/tests/scheme1/005-lambda-capture.expected-exit diff --git a/tests/scheme1/05-lambda-capture.scm b/tests/scheme1/005-lambda-capture.scm diff --git a/tests/scheme1/06-comment.expected-exit b/tests/scheme1/006-comment.expected-exit diff --git a/tests/scheme1/06-comment.scm b/tests/scheme1/006-comment.scm diff --git a/tests/scheme1/07-hex.expected-exit b/tests/scheme1/007-hex.expected-exit diff --git a/tests/scheme1/07-hex.scm b/tests/scheme1/007-hex.scm diff --git a/tests/scheme1/08-quote.expected-exit b/tests/scheme1/008-quote.expected-exit diff --git a/tests/scheme1/08-quote.scm b/tests/scheme1/008-quote.scm diff --git a/tests/scheme1/09-define-value.expected-exit b/tests/scheme1/009-define-value.expected-exit diff --git a/tests/scheme1/09-define-value.scm b/tests/scheme1/009-define-value.scm diff --git a/tests/scheme1/10-define-fn.expected-exit b/tests/scheme1/010-define-fn.expected-exit diff --git a/tests/scheme1/10-define-fn.scm b/tests/scheme1/010-define-fn.scm diff --git a/tests/scheme1/11-define-mutual.expected-exit b/tests/scheme1/011-define-mutual.expected-exit diff --git a/tests/scheme1/11-define-mutual.scm b/tests/scheme1/011-define-mutual.scm diff --git a/tests/scheme1/12-variadic-rest.expected-exit b/tests/scheme1/012-variadic-rest.expected-exit diff --git a/tests/scheme1/12-variadic-rest.scm b/tests/scheme1/012-variadic-rest.scm diff --git a/tests/scheme1/13-define-variadic.expected-exit b/tests/scheme1/013-define-variadic.expected-exit diff --git a/tests/scheme1/13-define-variadic.scm b/tests/scheme1/013-define-variadic.scm diff --git a/tests/scheme1/14-empty-rest.expected-exit b/tests/scheme1/014-empty-rest.expected-exit diff --git a/tests/scheme1/14-empty-rest.scm b/tests/scheme1/014-empty-rest.scm diff --git a/tests/scheme1/15-dot-symbol.expected-exit b/tests/scheme1/015-dot-symbol.expected-exit diff --git a/tests/scheme1/15-dot-symbol.scm b/tests/scheme1/015-dot-symbol.scm diff --git a/tests/scheme1/16-cond.expected-exit b/tests/scheme1/016-cond.expected-exit diff --git a/tests/scheme1/16-cond.scm b/tests/scheme1/016-cond.scm diff --git a/tests/scheme1/17-cond-else.expected-exit b/tests/scheme1/017-cond-else.expected-exit diff --git a/tests/scheme1/17-cond-else.scm b/tests/scheme1/017-cond-else.scm diff --git a/tests/scheme1/18-let.expected-exit b/tests/scheme1/018-let.expected-exit diff --git a/tests/scheme1/18-let.scm b/tests/scheme1/018-let.scm diff --git a/tests/scheme1/19-letstar.expected-exit b/tests/scheme1/019-letstar.expected-exit diff --git a/tests/scheme1/19-letstar.scm b/tests/scheme1/019-letstar.scm diff --git a/tests/scheme1/20-letrec.expected-exit b/tests/scheme1/020-letrec.expected-exit diff --git a/tests/scheme1/20-letrec.scm b/tests/scheme1/020-letrec.scm diff --git a/tests/scheme1/21-letrec-recursion.expected-exit b/tests/scheme1/021-letrec-recursion.expected-exit diff --git a/tests/scheme1/21-letrec-recursion.scm b/tests/scheme1/021-letrec-recursion.scm diff --git a/tests/scheme1/22-named-let.expected-exit b/tests/scheme1/022-named-let.expected-exit diff --git a/tests/scheme1/22-named-let.scm b/tests/scheme1/022-named-let.scm diff --git a/tests/scheme1/23-cons-car-cdr.expected-exit b/tests/scheme1/023-cons-car-cdr.expected-exit diff --git a/tests/scheme1/23-cons-car-cdr.scm b/tests/scheme1/023-cons-car-cdr.scm diff --git a/tests/scheme1/24-arith.expected-exit b/tests/scheme1/024-arith.expected-exit diff --git a/tests/scheme1/24-arith.scm b/tests/scheme1/024-arith.scm diff --git a/tests/scheme1/25-comparisons.expected-exit b/tests/scheme1/025-comparisons.expected-exit diff --git a/tests/scheme1/25-comparisons.scm b/tests/scheme1/025-comparisons.scm diff --git a/tests/scheme1/26-bitwise.expected-exit b/tests/scheme1/026-bitwise.expected-exit diff --git a/tests/scheme1/26-bitwise.scm b/tests/scheme1/026-bitwise.scm diff --git a/tests/scheme1/27-apply.expected-exit b/tests/scheme1/027-apply.expected-exit diff --git a/tests/scheme1/27-apply.scm b/tests/scheme1/027-apply.scm diff --git a/tests/scheme1/28-list-recursion.expected-exit b/tests/scheme1/028-list-recursion.expected-exit diff --git a/tests/scheme1/28-list-recursion.scm b/tests/scheme1/028-list-recursion.scm diff --git a/tests/scheme1/29-make-bv.expected-exit b/tests/scheme1/029-make-bv.expected-exit diff --git a/tests/scheme1/29-make-bv.scm b/tests/scheme1/029-make-bv.scm diff --git a/tests/scheme1/30-bv-set-ref.expected-exit b/tests/scheme1/030-bv-set-ref.expected-exit diff --git a/tests/scheme1/30-bv-set-ref.scm b/tests/scheme1/030-bv-set-ref.scm diff --git a/tests/scheme1/31-bv-fill.expected-exit b/tests/scheme1/031-bv-fill.expected-exit diff --git a/tests/scheme1/31-bv-fill.scm b/tests/scheme1/031-bv-fill.scm diff --git a/tests/scheme1/32-bv-copy.expected-exit b/tests/scheme1/032-bv-copy.expected-exit diff --git a/tests/scheme1/32-bv-copy.scm b/tests/scheme1/032-bv-copy.scm diff --git a/tests/scheme1/33-bv-copy-bang.expected-exit b/tests/scheme1/033-bv-copy-bang.expected-exit diff --git a/tests/scheme1/33-bv-copy-bang.scm b/tests/scheme1/033-bv-copy-bang.scm diff --git a/tests/scheme1/35-record-basic.expected-exit b/tests/scheme1/035-record-basic.expected-exit diff --git a/tests/scheme1/35-record-basic.scm b/tests/scheme1/035-record-basic.scm diff --git a/tests/scheme1/36-record-mutator.expected-exit b/tests/scheme1/036-record-mutator.expected-exit diff --git a/tests/scheme1/36-record-mutator.scm b/tests/scheme1/036-record-mutator.scm diff --git a/tests/scheme1/37-record-predicate.expected-exit b/tests/scheme1/037-record-predicate.expected-exit diff --git a/tests/scheme1/37-record-predicate.scm b/tests/scheme1/037-record-predicate.scm diff --git a/tests/scheme1/38-record-internal-prims.expected b/tests/scheme1/038-record-internal-prims.expected diff --git a/tests/scheme1/38-record-internal-prims.expected-exit b/tests/scheme1/038-record-internal-prims.expected-exit diff --git a/tests/scheme1/38-record-internal-prims.scm b/tests/scheme1/038-record-internal-prims.scm diff --git a/tests/scheme1/39-eof.expected-exit b/tests/scheme1/039-eof.expected-exit diff --git a/tests/scheme1/39-eof.scm b/tests/scheme1/039-eof.scm diff --git a/tests/scheme1/39-record-typename-unbound.expected b/tests/scheme1/039-record-typename-unbound.expected diff --git a/tests/scheme1/39-record-typename-unbound.expected-exit b/tests/scheme1/039-record-typename-unbound.expected-exit diff --git a/tests/scheme1/39-record-typename-unbound.scm b/tests/scheme1/039-record-typename-unbound.scm diff --git a/tests/scheme1/40-argv.expected-exit b/tests/scheme1/040-argv.expected-exit diff --git a/tests/scheme1/40-argv.scm b/tests/scheme1/040-argv.scm diff --git a/tests/scheme1/41-fileio.expected-exit b/tests/scheme1/041-fileio.expected-exit diff --git a/tests/scheme1/41-fileio.scm b/tests/scheme1/041-fileio.scm diff --git a/tests/scheme1/43-prelude.expected-exit b/tests/scheme1/043-prelude.expected-exit diff --git a/tests/scheme1/43-prelude.scm b/tests/scheme1/043-prelude.scm diff --git a/tests/scheme1/45-shell-spawn.expected-exit b/tests/scheme1/045-shell-spawn.expected-exit diff --git a/tests/scheme1/45-shell-spawn.scm b/tests/scheme1/045-shell-spawn.scm diff --git a/tests/scheme1/46-and.expected-exit b/tests/scheme1/046-and.expected-exit diff --git a/tests/scheme1/46-and.scm b/tests/scheme1/046-and.scm diff --git a/tests/scheme1/47-or.expected-exit b/tests/scheme1/047-or.expected-exit diff --git a/tests/scheme1/47-or.scm b/tests/scheme1/047-or.scm diff --git a/tests/scheme1/48-display-write.expected b/tests/scheme1/048-display-write.expected diff --git a/tests/scheme1/48-display-write.expected-exit b/tests/scheme1/048-display-write.expected-exit diff --git a/tests/scheme1/48-display-write.scm b/tests/scheme1/048-display-write.scm diff --git a/tests/scheme1/49-format.expected b/tests/scheme1/049-format.expected diff --git a/tests/scheme1/49-format.expected-exit b/tests/scheme1/049-format.expected-exit diff --git a/tests/scheme1/49-format.scm b/tests/scheme1/049-format.scm diff --git a/tests/scheme1/50-error.expected b/tests/scheme1/050-error.expected diff --git a/tests/scheme1/50-error.expected-exit b/tests/scheme1/050-error.expected-exit diff --git a/tests/scheme1/50-error.scm b/tests/scheme1/050-error.scm diff --git a/tests/scheme1/51-shell-signal.expected-exit b/tests/scheme1/051-shell-signal.expected-exit diff --git a/tests/scheme1/51-shell-signal.scm b/tests/scheme1/051-shell-signal.scm diff --git a/tests/scheme1/52-string-literal.expected-exit b/tests/scheme1/052-string-literal.expected-exit diff --git a/tests/scheme1/52-string-literal.scm b/tests/scheme1/052-string-literal.scm diff --git a/tests/scheme1/53-string-escapes.expected-exit b/tests/scheme1/053-string-escapes.expected-exit diff --git a/tests/scheme1/53-string-escapes.scm b/tests/scheme1/053-string-escapes.scm diff --git a/tests/scheme1/54-char-literal.expected-exit b/tests/scheme1/054-char-literal.expected-exit diff --git a/tests/scheme1/54-char-literal.scm b/tests/scheme1/054-char-literal.scm diff --git a/tests/scheme1/55-char-named.expected-exit b/tests/scheme1/055-char-named.expected-exit diff --git a/tests/scheme1/55-char-named.scm b/tests/scheme1/055-char-named.scm diff --git a/tests/scheme1/56-shell-fileio.expected-exit b/tests/scheme1/056-shell-fileio.expected-exit diff --git a/tests/scheme1/56-shell-fileio.scm b/tests/scheme1/056-shell-fileio.scm diff --git a/tests/scheme1/57-bytevector-eq.expected-exit b/tests/scheme1/057-bytevector-eq.expected-exit diff --git a/tests/scheme1/57-bytevector-eq.scm b/tests/scheme1/057-bytevector-eq.scm diff --git a/tests/scheme1/58-equal.expected-exit b/tests/scheme1/058-equal.expected-exit diff --git a/tests/scheme1/58-equal.scm b/tests/scheme1/058-equal.scm diff --git a/tests/scheme1/59-record-equal.expected-exit b/tests/scheme1/059-record-equal.expected-exit diff --git a/tests/scheme1/59-record-equal.scm b/tests/scheme1/059-record-equal.scm diff --git a/tests/scheme1/59-stringq.expected-exit b/tests/scheme1/059-stringq.expected-exit diff --git a/tests/scheme1/59-stringq.scm b/tests/scheme1/059-stringq.scm diff --git a/tests/scheme1/60-set-pair-bang.expected-exit b/tests/scheme1/060-set-pair-bang.expected-exit diff --git a/tests/scheme1/60-set-pair-bang.scm b/tests/scheme1/060-set-pair-bang.scm diff --git a/tests/scheme1/61-length.expected-exit b/tests/scheme1/061-length.expected-exit diff --git a/tests/scheme1/61-length.scm b/tests/scheme1/061-length.scm diff --git a/tests/scheme1/62-list-ref.expected-exit b/tests/scheme1/062-list-ref.expected-exit diff --git a/tests/scheme1/62-list-ref.scm b/tests/scheme1/062-list-ref.scm diff --git a/tests/scheme1/63-file-output-roundtrip.scm b/tests/scheme1/063-file-output-roundtrip.scm diff --git a/tests/scheme1/64-file-append.scm b/tests/scheme1/064-file-append.scm diff --git a/tests/scheme1/65-string-symbol.expected-exit b/tests/scheme1/065-string-symbol.expected-exit diff --git a/tests/scheme1/65-string-symbol.scm b/tests/scheme1/065-string-symbol.scm diff --git a/tests/scheme1/66-bytevector-append.expected-exit b/tests/scheme1/066-bytevector-append.expected-exit diff --git a/tests/scheme1/66-bytevector-append.scm b/tests/scheme1/066-bytevector-append.scm diff --git a/tests/scheme1/67-read-line.scm b/tests/scheme1/067-read-line.scm diff --git a/tests/scheme1/68-read-bytes-multi.scm b/tests/scheme1/068-read-bytes-multi.scm diff --git a/tests/scheme1/69-open-input-missing.scm b/tests/scheme1/069-open-input-missing.scm diff --git a/tests/scheme1/70-type-predicates.expected-exit b/tests/scheme1/070-type-predicates.expected-exit diff --git a/tests/scheme1/70-type-predicates.scm b/tests/scheme1/070-type-predicates.scm diff --git a/tests/scheme1/71-quot-rem-mod.expected-exit b/tests/scheme1/071-quot-rem-mod.expected-exit diff --git a/tests/scheme1/71-quot-rem-mod.scm b/tests/scheme1/071-quot-rem-mod.scm diff --git a/tests/scheme1/72-min-max-abs.expected-exit b/tests/scheme1/072-min-max-abs.expected-exit diff --git a/tests/scheme1/72-min-max-abs.scm b/tests/scheme1/072-min-max-abs.scm diff --git a/tests/scheme1/73-bit-xor-not.expected-exit b/tests/scheme1/073-bit-xor-not.expected-exit diff --git a/tests/scheme1/73-bit-xor-not.scm b/tests/scheme1/073-bit-xor-not.scm diff --git a/tests/scheme1/74-num-str-conv.expected-exit b/tests/scheme1/074-num-str-conv.expected-exit diff --git a/tests/scheme1/74-num-str-conv.scm b/tests/scheme1/074-num-str-conv.scm diff --git a/tests/scheme1/75-signed-int.scm b/tests/scheme1/075-signed-int.scm diff --git a/tests/scheme1/76-bad-int-trailing.expected b/tests/scheme1/076-bad-int-trailing.expected diff --git a/tests/scheme1/76-bad-int-trailing.expected-exit b/tests/scheme1/076-bad-int-trailing.expected-exit diff --git a/tests/scheme1/76-bad-int-trailing.scm b/tests/scheme1/076-bad-int-trailing.scm diff --git a/tests/scheme1/77-bad-ident-char.expected b/tests/scheme1/077-bad-ident-char.expected diff --git a/tests/scheme1/77-bad-ident-char.expected-exit b/tests/scheme1/077-bad-ident-char.expected-exit diff --git a/tests/scheme1/77-bad-ident-char.scm b/tests/scheme1/077-bad-ident-char.scm diff --git a/tests/scheme1/78-symbolq.scm b/tests/scheme1/078-symbolq.scm diff --git a/tests/scheme1/79-bv-num-aliases.scm b/tests/scheme1/079-bv-num-aliases.scm diff --git a/tests/scheme1/80-u8-literal.scm b/tests/scheme1/080-u8-literal.scm diff --git a/tests/scheme1/81-set-bang.expected-exit b/tests/scheme1/081-set-bang.expected-exit diff --git a/tests/scheme1/81-set-bang.scm b/tests/scheme1/081-set-bang.scm diff --git a/tests/scheme1/82-cond-arrow.expected-exit b/tests/scheme1/082-cond-arrow.expected-exit diff --git a/tests/scheme1/82-cond-arrow.scm b/tests/scheme1/082-cond-arrow.scm diff --git a/tests/scheme1/83-write-line.scm b/tests/scheme1/083-write-line.scm diff --git a/tests/scheme1/85-internal-define-error.expected b/tests/scheme1/085-internal-define-error.expected diff --git a/tests/scheme1/85-internal-define-error.expected-exit b/tests/scheme1/085-internal-define-error.expected-exit diff --git a/tests/scheme1/85-internal-define-error.scm b/tests/scheme1/085-internal-define-error.scm diff --git a/tests/scheme1/86-pmatch-basic.expected-exit b/tests/scheme1/086-pmatch-basic.expected-exit diff --git a/tests/scheme1/86-pmatch-basic.scm b/tests/scheme1/086-pmatch-basic.scm diff --git a/tests/scheme1/87-pmatch-binders.expected-exit b/tests/scheme1/087-pmatch-binders.expected-exit diff --git a/tests/scheme1/87-pmatch-binders.scm b/tests/scheme1/087-pmatch-binders.scm diff --git a/tests/scheme1/88-pmatch-literals.expected-exit b/tests/scheme1/088-pmatch-literals.expected-exit diff --git a/tests/scheme1/88-pmatch-literals.scm b/tests/scheme1/088-pmatch-literals.scm diff --git a/tests/scheme1/89-pmatch-guards.expected-exit b/tests/scheme1/089-pmatch-guards.expected-exit diff --git a/tests/scheme1/89-pmatch-guards.scm b/tests/scheme1/089-pmatch-guards.scm diff --git a/tests/scheme1/90-pmatch-no-match.expected b/tests/scheme1/090-pmatch-no-match.expected diff --git a/tests/scheme1/90-pmatch-no-match.expected-exit b/tests/scheme1/090-pmatch-no-match.expected-exit diff --git a/tests/scheme1/90-pmatch-no-match.scm b/tests/scheme1/090-pmatch-no-match.scm diff --git a/tests/scheme1/91-pmatch-bad-unquote.expected b/tests/scheme1/091-pmatch-bad-unquote.expected diff --git a/tests/scheme1/91-pmatch-bad-unquote.expected-exit b/tests/scheme1/091-pmatch-bad-unquote.expected-exit diff --git a/tests/scheme1/91-pmatch-bad-unquote.scm b/tests/scheme1/091-pmatch-bad-unquote.scm diff --git a/tests/scheme1/92-pmatch-compiler-dispatch.expected-exit b/tests/scheme1/092-pmatch-compiler-dispatch.expected-exit diff --git a/tests/scheme1/92-pmatch-compiler-dispatch.scm b/tests/scheme1/092-pmatch-compiler-dispatch.scm diff --git a/tests/scheme1/93-heap-mark-rewind.expected-exit b/tests/scheme1/093-heap-mark-rewind.expected-exit diff --git a/tests/scheme1/93-heap-mark-rewind.scm b/tests/scheme1/093-heap-mark-rewind.scm diff --git a/tests/scheme1/94-when.expected-exit b/tests/scheme1/094-when.expected-exit diff --git a/tests/scheme1/94-when.scm b/tests/scheme1/094-when.scm diff --git a/tests/scheme1/95-unless.expected-exit b/tests/scheme1/095-unless.expected-exit diff --git a/tests/scheme1/95-unless.scm b/tests/scheme1/095-unless.scm diff --git a/tests/scheme1/96-case.expected-exit b/tests/scheme1/096-case.expected-exit diff --git a/tests/scheme1/96-case.scm b/tests/scheme1/096-case.scm diff --git a/tests/scheme1/97-pmatch-record.expected-exit b/tests/scheme1/097-pmatch-record.expected-exit diff --git a/tests/scheme1/97-pmatch-record.scm b/tests/scheme1/097-pmatch-record.scm diff --git a/tests/scheme1/14-empty-rest.expected-exit b/tests/scheme1/100-char-procs.expected-exit diff --git a/tests/scheme1/100-char-procs.scm b/tests/scheme1/100-char-procs.scm @@ -0,0 +1,56 @@ +; char?, char->integer, integer->char, digit-value, char predicates, +; case maps, and the variadic char comparisons. + +;; --- char? is a fixnum 0..255 range check -------------------------- +(if (char? #\A) 0 (sys-exit 1)) +(if (char? 0) 0 (sys-exit 2)) +(if (char? 255) 0 (sys-exit 3)) +(if (not (char? -1)) 0 (sys-exit 4)) +(if (not (char? 256)) 0 (sys-exit 5)) +(if (not (char? 'sym)) 0 (sys-exit 6)) + +;; --- char->integer / integer->char are the identity --------------- +(if (= 65 (char->integer #\A)) 0 (sys-exit 7)) +(if (= #\A (integer->char 65)) 0 (sys-exit 8)) +(if (eq? #\A 65) 0 (sys-exit 9)) + +;; --- digit-value -------------------------------------------------- +(if (= 0 (digit-value #\0)) 0 (sys-exit 10)) +(if (= 9 (digit-value #\9)) 0 (sys-exit 11)) +(if (eq? #f (digit-value #\A)) 0 (sys-exit 12)) + +;; --- char predicates ---------------------------------------------- +(if (char-alphabetic? #\Z) 0 (sys-exit 13)) +(if (char-alphabetic? #\a) 0 (sys-exit 14)) +(if (not (char-alphabetic? #\5)) 0 (sys-exit 15)) +(if (char-numeric? #\7) 0 (sys-exit 16)) +(if (not (char-numeric? #\A)) 0 (sys-exit 17)) +(if (char-whitespace? #\space) 0 (sys-exit 18)) +(if (char-whitespace? #\tab) 0 (sys-exit 19)) +(if (char-whitespace? #\newline) 0 (sys-exit 20)) +(if (not (char-whitespace? #\A)) 0 (sys-exit 21)) +(if (char-upper-case? #\K) 0 (sys-exit 22)) +(if (not (char-upper-case? #\k)) 0 (sys-exit 23)) +(if (char-lower-case? #\k) 0 (sys-exit 24)) +(if (not (char-lower-case? #\K)) 0 (sys-exit 25)) + +;; --- case maps (ASCII; non-letters unchanged) -------------------- +(if (eq? #\A (char-upcase #\a)) 0 (sys-exit 26)) +(if (eq? #\A (char-upcase #\A)) 0 (sys-exit 27)) +(if (eq? #\7 (char-upcase #\7)) 0 (sys-exit 28)) +(if (eq? #\a (char-downcase #\A)) 0 (sys-exit 29)) +(if (eq? #\a (char-downcase #\a)) 0 (sys-exit 30)) +(if (eq? #\a (char-foldcase #\A)) 0 (sys-exit 31)) + +;; --- variadic char comparisons ----------------------------------- +(if (char=? #\a #\a) 0 (sys-exit 32)) +(if (char=? #\a #\a #\a #\a) 0 (sys-exit 33)) +(if (not (char=? #\a #\a #\b)) 0 (sys-exit 34)) +(if (char<? #\a #\b) 0 (sys-exit 35)) +(if (char<? #\a #\b #\c) 0 (sys-exit 36)) +(if (not (char<? #\a #\b #\b)) 0 (sys-exit 37)) +(if (char>? #\c #\b #\a) 0 (sys-exit 38)) +(if (char<=? #\a #\b #\b #\c) 0 (sys-exit 39)) +(if (char>=? #\c #\c #\b #\a) 0 (sys-exit 40)) + +(sys-exit 41) diff --git a/tests/scheme1/101-string-procs.expected-exit b/tests/scheme1/101-string-procs.expected-exit @@ -0,0 +1 @@ +35 diff --git a/tests/scheme1/101-string-procs.scm b/tests/scheme1/101-string-procs.scm @@ -0,0 +1,74 @@ +; make-string, string, string-ref, string-set!, substring, string-append, +; string-copy, string-copy!, string-fill!, string->list, list->string. + +;; --- make-string --------------------------------------------------- +(define ms (make-string 4 #\x)) +(if (= 4 (string-length ms)) 0 (sys-exit 1)) +(if (eq? #\x (string-ref ms 0)) 0 (sys-exit 2)) +(if (eq? #\x (string-ref ms 3)) 0 (sys-exit 3)) +;; default fill is #\space (32) +(define ms2 (make-string 3)) +(if (eq? #\space (string-ref ms2 0)) 0 (sys-exit 4)) + +;; --- string (variadic) -------------------------------------------- +(define s1 (string #\a #\b #\c)) +(if (= 3 (string-length s1)) 0 (sys-exit 5)) +(if (eq? #\b (string-ref s1 1)) 0 (sys-exit 6)) +(if (= 0 (string-length (string))) 0 (sys-exit 7)) ; empty string + +;; --- string-ref / string-set! ------------------------------------- +(define m (make-string 5 #\.)) +(string-set! m 2 #\X) +(if (eq? #\X (string-ref m 2)) 0 (sys-exit 8)) +(if (eq? #\. (string-ref m 0)) 0 (sys-exit 9)) +(if (eq? #\. (string-ref m 4)) 0 (sys-exit 10)) + +;; --- substring ----------------------------------------------------- +(define sub (substring "abcdef" 1 4)) +(if (= 3 (string-length sub)) 0 (sys-exit 11)) +(if (eq? #\b (string-ref sub 0)) 0 (sys-exit 12)) +(if (eq? #\d (string-ref sub 2)) 0 (sys-exit 13)) +;; full-range substring +(if (string=? "abcdef" (substring "abcdef" 0 6)) 0 (sys-exit 14)) + +;; --- string-append ------------------------------------------------ +(define a (string-append "foo" "bar" "baz")) +(if (= 9 (string-length a)) 0 (sys-exit 15)) +(if (eq? #\f (string-ref a 0)) 0 (sys-exit 16)) +(if (eq? #\z (string-ref a 8)) 0 (sys-exit 17)) +(if (= 0 (string-length (string-append))) 0 (sys-exit 18)) + +;; --- string-copy -------------------------------------------------- +(define c (string-copy "hello")) +(if (= 5 (string-length c)) 0 (sys-exit 19)) +(if (eq? #\h (string-ref c 0)) 0 (sys-exit 20)) +;; with start / end +(define c2 (string-copy "hello" 1 4)) +(if (= 3 (string-length c2)) 0 (sys-exit 21)) +(if (eq? #\e (string-ref c2 0)) 0 (sys-exit 22)) +(if (eq? #\l (string-ref c2 2)) 0 (sys-exit 23)) + +;; --- string-copy! ------------------------------------------------- +(define dst (make-string 6 #\.)) +(string-copy! dst 1 "abc") +(if (eq? #\. (string-ref dst 0)) 0 (sys-exit 24)) +(if (eq? #\a (string-ref dst 1)) 0 (sys-exit 25)) +(if (eq? #\c (string-ref dst 3)) 0 (sys-exit 26)) +(if (eq? #\. (string-ref dst 5)) 0 (sys-exit 27)) + +;; --- string-fill! ------------------------------------------------- +(define f (make-string 4 #\.)) +(string-fill! f #\Q) +(if (eq? #\Q (string-ref f 0)) 0 (sys-exit 28)) +(if (eq? #\Q (string-ref f 3)) 0 (sys-exit 29)) + +;; --- string->list / list->string ---------------------------------- +(if (equal? (list #\a #\b #\c) (string->list "abc")) 0 (sys-exit 30)) +(if (= 3 (length (string->list "abc"))) 0 (sys-exit 31)) + +(define rt (list->string (list #\h #\i))) +(if (= 2 (string-length rt)) 0 (sys-exit 32)) +(if (eq? #\h (string-ref rt 0)) 0 (sys-exit 33)) +(if (eq? #\i (string-ref rt 1)) 0 (sys-exit 34)) + +(sys-exit 35) diff --git a/tests/scheme1/102-string-cmp-case.expected-exit b/tests/scheme1/102-string-cmp-case.expected-exit @@ -0,0 +1 @@ +25 diff --git a/tests/scheme1/102-string-cmp-case.scm b/tests/scheme1/102-string-cmp-case.scm @@ -0,0 +1,44 @@ +; Variadic string comparisons (= < > <= >=), the -ci variants, +; case maps, plus string-map and string-for-each. + +;; --- string=? ----------------------------------------------------- +(if (string=? "foo" "foo") 0 (sys-exit 1)) +(if (not (string=? "foo" "Foo")) 0 (sys-exit 2)) +(if (not (string=? "foo" "bar")) 0 (sys-exit 3)) +(if (string=? "ab" "ab" "ab") 0 (sys-exit 4)) +(if (not (string=? "ab" "ab" "ba")) 0 (sys-exit 5)) + +;; --- string<? / >? / <=? / >=? ----------------------------------- +(if (string<? "abc" "abd") 0 (sys-exit 6)) +(if (string<? "abc" "abcd") 0 (sys-exit 7)) ; shorter < its prefix +(if (string<? "a" "b" "c") 0 (sys-exit 8)) +(if (not (string<? "a" "b" "b")) 0 (sys-exit 9)) +(if (string>? "z" "y" "x") 0 (sys-exit 10)) +(if (string<=? "a" "a" "b") 0 (sys-exit 11)) +(if (string>=? "z" "z" "a") 0 (sys-exit 12)) + +;; --- string-ci variants (ASCII case fold) ------------------------ +(if (string-ci=? "FOO" "foo") 0 (sys-exit 13)) +(if (string-ci=? "Foo" "fOO") 0 (sys-exit 14)) +(if (not (string-ci=? "foo" "bar")) 0 (sys-exit 15)) +(if (string-ci<? "Apple" "BANANA") 0 (sys-exit 16)) +(if (string-ci>? "Banana" "apple") 0 (sys-exit 17)) + +;; --- case maps --------------------------------------------------- +(if (string=? "ABC" (string-upcase "abc")) 0 (sys-exit 18)) +(if (string=? "ABC" (string-upcase "ABC")) 0 (sys-exit 19)) +(if (string=? "abc" (string-downcase "ABC")) 0 (sys-exit 20)) +(if (string=? "abc" (string-foldcase "ABC")) 0 (sys-exit 21)) +;; non-letters unchanged +(if (string=? "AB1!" (string-upcase "ab1!")) 0 (sys-exit 22)) + +;; --- string-map applies f and returns a fresh string ------------- +(if (string=? "HELLO" (string-map char-upcase "Hello")) 0 (sys-exit 23)) + +;; --- string-for-each accumulates side effects -------------------- +(define total 0) +(string-for-each (lambda (c) (set! total (+ total c))) "abc") +;; 97 + 98 + 99 = 294 +(if (= 294 total) 0 (sys-exit 24)) + +(sys-exit 25) diff --git a/tests/scheme1/103-bv-system.expected-exit b/tests/scheme1/103-bv-system.expected-exit @@ -0,0 +1 @@ +9 diff --git a/tests/scheme1/103-bv-system.scm b/tests/scheme1/103-bv-system.scm @@ -0,0 +1,25 @@ +; bytevector variadic constructor, command-line, file-exists? + +;; --- bytevector constructor ---------------------------------------- +(define bv (bytevector 10 20 30 40)) +(if (= 4 (bytevector-length bv)) 0 (sys-exit 1)) +(if (= 10 (bytevector-u8-ref bv 0)) 0 (sys-exit 2)) +(if (= 40 (bytevector-u8-ref bv 3)) 0 (sys-exit 3)) +;; empty bv +(define ebv (bytevector)) +(if (= 0 (bytevector-length ebv)) 0 (sys-exit 4)) + +;; --- command-line returns a non-empty list ------------------------- +(define cl (command-line)) +(if (pair? cl) 0 (sys-exit 5)) + +;; --- file-exists? -------------------------------------------------- +;; Round-trip through the shell to avoid depending on the test +;; harness's cwd or any committed file path. +(define rc (run "/bin/sh" "-c" "echo > /tmp/scheme1-fe.txt")) +(if (and (car rc) (zero? (cdr rc))) 0 (sys-exit 6)) + +(if (file-exists? "/tmp/scheme1-fe.txt") 0 (sys-exit 7)) +(if (not (file-exists? "/tmp/scheme1-no-such-xyz.txt")) 0 (sys-exit 8)) + +(sys-exit 9) diff --git a/tests/scheme1/00-exit.expected-exit b/tests/scheme1/104-single-arm-if.expected-exit diff --git a/tests/scheme1/104-single-arm-if.scm b/tests/scheme1/104-single-arm-if.scm @@ -0,0 +1,24 @@ +; (if test then) -- single-arm if. When test is non-#f, evaluates and +; returns then. When test is #f, returns UNSPEC instead of segfaulting +; off the missing else slot. + +;; --- Truthy: returns then ------------------------------------------------ +(if (= 9 (if #t 9)) 0 (sys-exit 1)) +(if (= 9 (if 0 9)) 0 (sys-exit 2)) +(if (= 9 (if '() 9)) 0 (sys-exit 3)) + +;; --- Falsy: returns UNSPEC (singleton, eq? to other UNSPECs) ------------ +(if (eq? (if #f 9) (if #f 7)) 0 (sys-exit 4)) +(if (not (eq? (if #f 9) #t)) 0 (sys-exit 5)) +(if (not (eq? (if #f 9) #f)) 0 (sys-exit 6)) +(if (not (eq? (if #f 9) '())) 0 (sys-exit 7)) +(if (not (eq? (if #f 9) 0)) 0 (sys-exit 8)) + +;; --- Side effects: then runs only on truthy ------------------------------ +(define counter 0) +(if #f (set! counter 100)) +(if (= counter 0) 0 (sys-exit 9)) +(if #t (set! counter 5)) +(if (= counter 5) 0 (sys-exit 10)) + +(sys-exit 42) diff --git a/tests/scheme1/00-exit.expected-exit b/tests/scheme1/105-do.expected-exit diff --git a/tests/scheme1/105-do.scm b/tests/scheme1/105-do.scm @@ -0,0 +1,53 @@ +; (do ((var init step) ...) (test result ...) body ...) +; Iteration. Each iteration: evaluate test; if truthy run result forms +; and return last (UNSPEC if none); else run body for side effects, then +; evaluate every step in the current env, rebind, loop. A binding form +; (var init) -- with no step -- carries var unchanged. + +;; --- Sum 1..10 via step -------------------------------------------------- +(define s + (do ((i 1 (+ i 1)) + (acc 0 (+ acc i))) + ((> i 10) acc))) +(if (= s 55) 0 (sys-exit 1)) + +;; --- Test truthy on first eval: result evaluated, body never runs ------- +(define touched 0) +(do ((i 0 (+ i 1))) + ((= i 0) 'done) + (set! touched 99)) +(if (= touched 0) 0 (sys-exit 2)) + +;; --- No result expressions: returns UNSPEC ------------------------------- +(if (eq? (do ((i 0 (+ i 1))) ((= i 0))) (do () (#t))) 0 (sys-exit 3)) + +;; --- Multiple result expressions: last is the value ---------------------- +(define n + (do ((i 0 (+ i 1))) + ((= i 3) 'a 'b 7))) +(if (= n 7) 0 (sys-exit 4)) + +;; --- Body runs in env that sees current iteration's bindings ------------- +(define collected '()) +(do ((i 0 (+ i 1))) + ((= i 3)) + (set! collected (cons i collected))) +(if (equal? collected '(2 1 0)) 0 (sys-exit 5)) + +;; --- Step omitted: variable keeps its value ------------------------------ +(define hits 0) +(do ((i 0 (+ i 1)) + (cap 5)) + ((= i cap)) + (set! hits (+ hits 1))) +(if (= hits 5) 0 (sys-exit 6)) + +;; --- Steps evaluated in pre-update env (parallel update) ---------------- +(define swap + (do ((a 1 b) + (b 2 a) + (n 0 (+ n 1))) + ((= n 3) (cons a b)))) +(if (equal? swap (cons 2 1)) 0 (sys-exit 7)) + +(sys-exit 42) diff --git a/tests/scheme1/00-exit.expected-exit b/tests/scheme1/106-case-lambda.expected-exit diff --git a/tests/scheme1/106-case-lambda.scm b/tests/scheme1/106-case-lambda.scm @@ -0,0 +1,47 @@ +; (case-lambda (formals body...) ...) -- pick the first clause whose +; formals match the call's arity. Formals follow the same shape as +; lambda: (a b), (), (a b . rest), or rest-symbol. + +;; --- Plain arity dispatch ----------------------------------------------- +(define f (case-lambda + (() 100) + ((x) (+ x 1)) + ((x y) (* x y)))) +(if (= 100 (f)) 0 (sys-exit 1)) +(if (= 4 (f 3)) 0 (sys-exit 2)) +(if (= 12 (f 3 4)) 0 (sys-exit 3)) + +;; --- First matching clause wins ------------------------------------------ +(define g (case-lambda + ((x) 'first) + ((x) 'second))) +(if (eq? 'first (g 7)) 0 (sys-exit 4)) + +;; --- Rest argument clause: variadic match -------------------------------- +(define h (case-lambda + (() 'none) + ((x) (list 'one x)) + (xs (cons 'many xs)))) +(if (eq? 'none (h)) 0 (sys-exit 5)) +(if (equal? (h 9) (list 'one 9)) 0 (sys-exit 6)) +(if (equal? (h 1 2 3) (cons 'many (list 1 2 3))) 0 (sys-exit 7)) + +;; --- Improper formals: (a . rest) ---------------------------------------- +(define k (case-lambda + ((a) 'lone) + ((a . rest) (cons a rest)))) +(if (eq? 'lone (k 5)) 0 (sys-exit 8)) +(if (equal? (k 1 2 3) (list 1 2 3)) 0 (sys-exit 9)) + +;; --- Closes over the enclosing environment ------------------------------- +(define base 10) +(define add (case-lambda + ((x) (+ base x)) + ((x y) (+ base x y)))) +(if (= 11 (add 1)) 0 (sys-exit 10)) +(if (= 13 (add 1 2)) 0 (sys-exit 11)) + +;; --- Higher-order: case-lambda result is a procedure -------------------- +(if (procedure? f) 0 (sys-exit 12)) + +(sys-exit 42) diff --git a/tests/scheme1/20-letrec.expected-exit b/tests/scheme1/20-letrec.expected-exit @@ -1 +1 @@ -120 +4 diff --git a/tests/scheme1/20-letrec.scm b/tests/scheme1/20-letrec.scm @@ -1,7 +1,25 @@ -; letrec: a local helper that calls itself. The closure must see its own -; binding via the captured env. Real recursion -- factorial walks the -; stack down to the base case and back, so a one-step bug would not -; produce 120. -(sys-exit (letrec ((fact (lambda (n) - (if (= n 0) 1 (* n (fact (- n 1))))))) - (fact 5))) ; 5! = 120 +; letrec / letrec*: local recursive bindings. letrec* is an alias of +; letrec in scheme1 (eval_letrec already evaluates inits left-to-right); +; the R7RS guarantee letrec* adds — later inits may reference earlier +; ones — is exercised below. + +;; --- letrec: classic recursive factorial --------------------------- +(if (= 120 (letrec ((fact (lambda (n) + (if (= n 0) 1 (* n (fact (- n 1))))))) + (fact 5))) + 0 (sys-exit 1)) + +;; --- letrec* accepts the same shape and value --------------------- +(if (= 120 (letrec* ((fact (lambda (n) + (if (= n 0) 1 (* n (fact (- n 1))))))) + (fact 5))) + 0 (sys-exit 2)) + +;; --- letrec*: later inits reference earlier ones ------------------- +;; y depends on x; z depends on both. + is 2-arg in scheme1, so each +;; init uses pairwise sums. +(if (= 6 (letrec* ((x 1) (y (+ x 2)) (z (+ y x))) + (+ z 2))) + 0 (sys-exit 3)) + +(sys-exit 4)