phase-22 Smalltalk: runtime.sx numeric/char/Array/Dict/Set/Stream
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
lib/smalltalk/runtime.sx (72 forms):
- Numeric helpers: abs/max/min/gcd/lcm/quo/rem/mod/even?/odd?/floor/ceil/truncate/round.
- Character: st-char-value/from-int/is-letter?/is-digit?/uppercase?/lowercase?/
separator?/as-uppercase/as-lowercase/digit-value. SX chars via char->integer.
- Array: 1-indexed mutable arrays backed by dict {__st_array__ size "1" v1 ...};
at/at-put!/do/->list/list->array/copy-from-to.
- Dictionary: any-key hash map via list-of-pairs + linear scan;
at/at-put!/includes-key?/at-default/remove-key!/keys/values/do/do-associations.
- Set: backed by SX make-set; set-member?/add!/includes?/remove! take (set item) order.
- WriteStream/ReadStream: dict-backed buffers; printString for nil/bool/number/
string/symbol/char/list/array.
lib/smalltalk/tests/runtime.sx + lib/smalltalk/test.sh: 86/86 pass.
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
370
lib/smalltalk/runtime.sx
Normal file
370
lib/smalltalk/runtime.sx
Normal file
@@ -0,0 +1,370 @@
|
||||
;; lib/smalltalk/runtime.sx — Smalltalk primitives on SX
|
||||
;;
|
||||
;; Provides Smalltalk-idiomatic wrappers over SX built-ins.
|
||||
;; Primitives used:
|
||||
;; make-set/set-add!/set-member?/set-remove!/set->list (Phase 18)
|
||||
;; char->integer/integer->char/list->string (Phase 5)
|
||||
;; bitwise-and/or/xor/not/arithmetic-shift (Phase 7)
|
||||
;; gcd/lcm/quotient/remainder/modulo (Phase 15)
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 0. Internal list helpers (used by Array and Dictionary)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
(st-list-set-nth lst i newval)
|
||||
(letrec
|
||||
((go (fn (ps j) (if (= (len ps) 0) (list) (cons (if (= j i) newval (first ps)) (go (rest ps) (+ j 1)))))))
|
||||
(go lst 0)))
|
||||
|
||||
(define
|
||||
(st-list-remove-nth lst i)
|
||||
(letrec
|
||||
((go (fn (ps j) (if (= (len ps) 0) (list) (if (= j i) (go (rest ps) (+ j 1)) (cons (first ps) (go (rest ps) (+ j 1))))))))
|
||||
(go lst 0)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 1. Numeric helpers
|
||||
;; Thin wrappers or direct aliases for Smalltalk Number protocol.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define (st-abs x) (abs x))
|
||||
(define (st-max a b) (if (> a b) a b))
|
||||
(define (st-min a b) (if (< a b) a b))
|
||||
(define (st-gcd a b) (gcd a b))
|
||||
(define (st-lcm a b) (lcm a b))
|
||||
(define (st-quo a b) (quotient a b))
|
||||
(define (st-rem a b) (remainder a b))
|
||||
(define (st-mod a b) (modulo a b))
|
||||
(define (st-even? n) (= (remainder n 2) 0))
|
||||
(define (st-odd? n) (not (st-even? n)))
|
||||
(define (st-sqrt x) (sqrt x))
|
||||
(define (st-floor x) (floor x))
|
||||
(define (st-ceiling x) (ceil x))
|
||||
(define (st-truncated x) (truncate x))
|
||||
(define (st-rounded x) (round x))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 2. Character
|
||||
;; Smalltalk $A = char 65. Operations mirror Character class.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define (st-char-value c) (char->integer c))
|
||||
(define (st-char-from-int n) (integer->char n))
|
||||
(define (st-char? v) (= (type-of v) "char"))
|
||||
|
||||
(define
|
||||
(st-char-is-letter? c)
|
||||
(let
|
||||
((n (char->integer c)))
|
||||
(or
|
||||
(and (>= n 65) (<= n 90))
|
||||
(and (>= n 97) (<= n 122)))))
|
||||
|
||||
(define
|
||||
(st-char-is-digit? c)
|
||||
(let ((n (char->integer c))) (and (>= n 48) (<= n 57))))
|
||||
|
||||
(define
|
||||
(st-char-is-uppercase? c)
|
||||
(let ((n (char->integer c))) (and (>= n 65) (<= n 90))))
|
||||
|
||||
(define
|
||||
(st-char-is-lowercase? c)
|
||||
(let ((n (char->integer c))) (and (>= n 97) (<= n 122))))
|
||||
|
||||
(define
|
||||
(st-char-is-separator? c)
|
||||
(let
|
||||
((n (char->integer c)))
|
||||
(or
|
||||
(= n 32)
|
||||
(= n 9)
|
||||
(= n 10)
|
||||
(= n 13))))
|
||||
|
||||
(define
|
||||
(st-char-as-uppercase c)
|
||||
(let
|
||||
((n (char->integer c)))
|
||||
(if
|
||||
(and (>= n 97) (<= n 122))
|
||||
(integer->char (- n 32))
|
||||
c)))
|
||||
|
||||
(define
|
||||
(st-char-as-lowercase c)
|
||||
(let
|
||||
((n (char->integer c)))
|
||||
(if
|
||||
(and (>= n 65) (<= n 90))
|
||||
(integer->char (+ n 32))
|
||||
c)))
|
||||
|
||||
(define (st-char-digit-value c) (- (char->integer c) 48))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 3. Array (1-indexed, mutable, fixed-size)
|
||||
;; Backed as {:__st_array__ true :size N "1" v1 "2" v2 ...}
|
||||
;; Unset elements read as nil.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
(st-array-new n)
|
||||
(let
|
||||
((a (dict)))
|
||||
(dict-set! a "__st_array__" true)
|
||||
(dict-set! a "size" n)
|
||||
a))
|
||||
|
||||
(define (st-array? v) (and (dict? v) (dict-has? v "__st_array__")))
|
||||
|
||||
(define (st-array-size a) (get a "size"))
|
||||
|
||||
(define
|
||||
(st-array-at a i)
|
||||
(let ((v (get a (str i)))) (if (= v nil) nil v)))
|
||||
|
||||
(define (st-array-at-put! a i v) (dict-set! a (str i) v) a)
|
||||
|
||||
(define
|
||||
(st-array-do a fn)
|
||||
(letrec
|
||||
((go (fn (i) (when (<= i (st-array-size a)) (fn (st-array-at a i)) (go (+ i 1))))))
|
||||
(go 1)))
|
||||
|
||||
(define
|
||||
(st-array->list a)
|
||||
(letrec
|
||||
((go (fn (i acc) (if (< i 1) acc (go (- i 1) (cons (st-array-at a i) acc))))))
|
||||
(go (st-array-size a) (list))))
|
||||
|
||||
(define
|
||||
(st-list->array xs)
|
||||
(let
|
||||
((a (st-array-new (len xs))))
|
||||
(letrec
|
||||
((go (fn (ys i) (when (> (len ys) 0) (st-array-at-put! a i (first ys)) (go (rest ys) (+ i 1))))))
|
||||
(go xs 1))
|
||||
a))
|
||||
|
||||
(define
|
||||
(st-array-copy-from-to a start stop)
|
||||
(let
|
||||
((result (st-array-new (- stop start -1))))
|
||||
(letrec
|
||||
((go (fn (i j) (when (<= i stop) (st-array-at-put! result j (st-array-at a i)) (go (+ i 1) (+ j 1))))))
|
||||
(go start 1))
|
||||
result))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 4. Dictionary (hash map with any key via linear scan)
|
||||
;; {:__st_dict__ true :size N :_pairs ((key val) ...)}
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
(st-dict-new)
|
||||
(let
|
||||
((d (dict)))
|
||||
(dict-set! d "__st_dict__" true)
|
||||
(dict-set! d "size" 0)
|
||||
(dict-set! d "_pairs" (list))
|
||||
d))
|
||||
|
||||
(define (st-dict? v) (and (dict? v) (dict-has? v "__st_dict__")))
|
||||
|
||||
(define (st-dict-size d) (get d "size"))
|
||||
|
||||
(define
|
||||
(st-dict-find-idx pairs k)
|
||||
(letrec
|
||||
((go (fn (ps i) (cond ((= (len ps) 0) -1) ((= (first (first ps)) k) i) (else (go (rest ps) (+ i 1)))))))
|
||||
(go pairs 0)))
|
||||
|
||||
(define
|
||||
(st-dict-at d k)
|
||||
(letrec
|
||||
((go (fn (ps) (if (= (len ps) 0) nil (if (= (first (first ps)) k) (nth (first ps) 1) (go (rest ps)))))))
|
||||
(go (get d "_pairs"))))
|
||||
|
||||
(define
|
||||
(st-dict-at-put! d k v)
|
||||
(let
|
||||
((pairs (get d "_pairs")) (idx (st-dict-find-idx (get d "_pairs") k)))
|
||||
(if
|
||||
(= idx -1)
|
||||
(begin
|
||||
(dict-set! d "_pairs" (append pairs (list (list k v))))
|
||||
(dict-set! d "size" (+ (get d "size") 1)))
|
||||
(dict-set! d "_pairs" (st-list-set-nth pairs idx (list k v)))))
|
||||
d)
|
||||
|
||||
(define
|
||||
(st-dict-includes-key? d k)
|
||||
(not (= (st-dict-find-idx (get d "_pairs") k) -1)))
|
||||
|
||||
(define
|
||||
(st-dict-at-default d k def)
|
||||
(if (st-dict-includes-key? d k) (st-dict-at d k) def))
|
||||
|
||||
(define
|
||||
(st-dict-remove-key! d k)
|
||||
(let
|
||||
((idx (st-dict-find-idx (get d "_pairs") k)))
|
||||
(when
|
||||
(not (= idx -1))
|
||||
(dict-set! d "_pairs" (st-list-remove-nth (get d "_pairs") idx))
|
||||
(dict-set! d "size" (- (get d "size") 1))))
|
||||
d)
|
||||
|
||||
(define (st-dict-keys d) (map first (get d "_pairs")))
|
||||
(define
|
||||
(st-dict-values d)
|
||||
(map (fn (p) (nth p 1)) (get d "_pairs")))
|
||||
|
||||
(define
|
||||
(st-dict-do d fn)
|
||||
(for-each (fn (p) (fn (nth p 1))) (get d "_pairs")))
|
||||
|
||||
(define
|
||||
(st-dict-do-associations d fn)
|
||||
(for-each (fn (p) (fn (first p) (nth p 1))) (get d "_pairs")))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 5. Set (uniqueness via SX make-set)
|
||||
;; Note: set-member?/set-add!/set-remove! take (set item) order.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
(st-set-new)
|
||||
(let
|
||||
((s (dict)))
|
||||
(dict-set! s "__st_set__" true)
|
||||
(dict-set! s "size" 0)
|
||||
(dict-set! s "_set" (make-set))
|
||||
s))
|
||||
|
||||
(define (st-set? v) (and (dict? v) (dict-has? v "__st_set__")))
|
||||
|
||||
(define (st-set-size s) (get s "size"))
|
||||
|
||||
(define
|
||||
(st-set-add! s v)
|
||||
(let
|
||||
((sx (get s "_set")))
|
||||
(when
|
||||
(not (set-member? sx v))
|
||||
(set-add! sx v)
|
||||
(dict-set! s "size" (+ (get s "size") 1))))
|
||||
s)
|
||||
|
||||
(define (st-set-includes? s v) (set-member? (get s "_set") v))
|
||||
|
||||
(define
|
||||
(st-set-remove! s v)
|
||||
(let
|
||||
((sx (get s "_set")))
|
||||
(when
|
||||
(set-member? sx v)
|
||||
(set-remove! sx v)
|
||||
(dict-set! s "size" (- (get s "size") 1))))
|
||||
s)
|
||||
|
||||
(define (st-set->list s) (set->list (get s "_set")))
|
||||
|
||||
(define (st-set-do s fn) (for-each fn (st-set->list s)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 6. String / Stream utilities
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Join list of strings with separator
|
||||
(define
|
||||
(st-join-strings strs sep)
|
||||
(if
|
||||
(= (len strs) 0)
|
||||
""
|
||||
(letrec
|
||||
((go (fn (ss acc) (if (= (len ss) 0) acc (go (rest ss) (str acc sep (first ss)))))))
|
||||
(go (rest strs) (first strs)))))
|
||||
|
||||
;; printString — Smalltalk textual representation
|
||||
(define
|
||||
(st-print-string v)
|
||||
(cond
|
||||
((= v nil) "nil")
|
||||
((= v true) "true")
|
||||
((= v false) "false")
|
||||
((= (type-of v) "number") (str v))
|
||||
((= (type-of v) "string") (str "'" v "'"))
|
||||
((= (type-of v) "symbol") (str "#" (str v)))
|
||||
((= (type-of v) "char") (str "$" (list->string (list v))))
|
||||
((= (type-of v) "list")
|
||||
(str "(" (st-join-strings (map st-print-string v) " ") ")"))
|
||||
((st-array? v)
|
||||
(str
|
||||
"(#("
|
||||
(st-join-strings (map st-print-string (st-array->list v)) " ")
|
||||
"))"))
|
||||
(else (str v))))
|
||||
|
||||
;; WriteStream — accumulates strings/chars to a buffer
|
||||
(define
|
||||
(st-write-stream-new)
|
||||
(let
|
||||
((ws (dict)))
|
||||
(dict-set! ws "__st_ws__" true)
|
||||
(dict-set! ws "contents" "")
|
||||
ws))
|
||||
|
||||
(define (st-write-stream? v) (and (dict? v) (dict-has? v "__st_ws__")))
|
||||
|
||||
(define
|
||||
(st-write-stream-put-string! ws s)
|
||||
(dict-set! ws "contents" (str (get ws "contents") s))
|
||||
ws)
|
||||
|
||||
(define
|
||||
(st-write-stream-next-put! ws c)
|
||||
(st-write-stream-put-string! ws (list->string (list c))))
|
||||
|
||||
(define
|
||||
(st-write-stream-print! ws v)
|
||||
(st-write-stream-put-string! ws (st-print-string v)))
|
||||
|
||||
(define (st-write-stream-contents ws) (get ws "contents"))
|
||||
|
||||
;; ReadStream — reads characters from a string one at a time
|
||||
(define
|
||||
(st-read-stream-new s)
|
||||
(let
|
||||
((rs (dict)))
|
||||
(dict-set! rs "__st_rs__" true)
|
||||
(dict-set! rs "_chars" (string->list s))
|
||||
(dict-set! rs "pos" 0)
|
||||
rs))
|
||||
|
||||
(define (st-read-stream? v) (and (dict? v) (dict-has? v "__st_rs__")))
|
||||
|
||||
(define
|
||||
(st-read-stream-at-end? rs)
|
||||
(>= (get rs "pos") (len (get rs "_chars"))))
|
||||
|
||||
(define
|
||||
(st-read-stream-next rs)
|
||||
(if
|
||||
(st-read-stream-at-end? rs)
|
||||
nil
|
||||
(let
|
||||
((c (nth (get rs "_chars") (get rs "pos"))))
|
||||
(dict-set! rs "pos" (+ (get rs "pos") 1))
|
||||
c)))
|
||||
|
||||
(define
|
||||
(st-read-stream-peek rs)
|
||||
(if
|
||||
(st-read-stream-at-end? rs)
|
||||
nil
|
||||
(nth (get rs "_chars") (get rs "pos"))))
|
||||
|
||||
(define (st-read-stream-source rs) (list->string (get rs "_chars")))
|
||||
71
lib/smalltalk/test.sh
Executable file
71
lib/smalltalk/test.sh
Executable file
@@ -0,0 +1,71 @@
|
||||
#!/usr/bin/env bash
|
||||
# lib/smalltalk/test.sh — smoke-test the Smalltalk runtime layer.
|
||||
# Uses sx_server.exe epoch protocol.
|
||||
#
|
||||
# Usage:
|
||||
# bash lib/smalltalk/test.sh
|
||||
# bash lib/smalltalk/test.sh -v
|
||||
|
||||
set -uo pipefail
|
||||
cd "$(git rev-parse --show-toplevel)"
|
||||
|
||||
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||
fi
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
VERBOSE="${1:-}"
|
||||
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
||||
|
||||
cat > "$TMPFILE" << 'EPOCHS'
|
||||
(epoch 1)
|
||||
(load "spec/stdlib.sx")
|
||||
(load "lib/smalltalk/runtime.sx")
|
||||
(epoch 2)
|
||||
(load "lib/smalltalk/tests/runtime.sx")
|
||||
(epoch 3)
|
||||
(eval "(list st-test-pass st-test-fail)")
|
||||
EPOCHS
|
||||
|
||||
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||
|
||||
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
|
||||
if [ -z "$LINE" ]; then
|
||||
LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
|
||||
| sed -E 's/^\(ok 3 //; s/\)$//')
|
||||
fi
|
||||
if [ -z "$LINE" ]; then
|
||||
echo "ERROR: could not extract summary"
|
||||
echo "$OUTPUT" | tail -10
|
||||
exit 1
|
||||
fi
|
||||
|
||||
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
|
||||
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
|
||||
TOTAL=$((P + F))
|
||||
|
||||
if [ "$F" -eq 0 ]; then
|
||||
echo "ok $P/$TOTAL lib/smalltalk tests passed"
|
||||
else
|
||||
echo "FAIL $P/$TOTAL passed, $F failed"
|
||||
# Print failure details
|
||||
TMPFILE2=$(mktemp)
|
||||
cat > "$TMPFILE2" << 'EPOCHS2'
|
||||
(epoch 1)
|
||||
(load "spec/stdlib.sx")
|
||||
(load "lib/smalltalk/runtime.sx")
|
||||
(epoch 2)
|
||||
(load "lib/smalltalk/tests/runtime.sx")
|
||||
(epoch 3)
|
||||
(eval "(map (fn (f) (get f \"name\")) st-test-fails)")
|
||||
EPOCHS2
|
||||
FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>/dev/null | grep -E '^\(ok 3 ' || true)
|
||||
rm -f "$TMPFILE2"
|
||||
echo " Failures: $FAILS"
|
||||
fi
|
||||
|
||||
[ "$F" -eq 0 ]
|
||||
241
lib/smalltalk/tests/runtime.sx
Normal file
241
lib/smalltalk/tests/runtime.sx
Normal file
@@ -0,0 +1,241 @@
|
||||
;; lib/smalltalk/tests/runtime.sx — Tests for lib/smalltalk/runtime.sx
|
||||
;;
|
||||
;; Uses the same hk-test framework as lib/haskell/tests/runtime.sx.
|
||||
;; Load: lib/smalltalk/runtime.sx first.
|
||||
|
||||
;; --- Test framework ---
|
||||
(define st-test-pass 0)
|
||||
(define st-test-fail 0)
|
||||
(define st-test-fails (list))
|
||||
|
||||
(define
|
||||
(st-test name got expected)
|
||||
(if
|
||||
(= got expected)
|
||||
(set! st-test-pass (+ st-test-pass 1))
|
||||
(begin
|
||||
(set! st-test-fail (+ st-test-fail 1))
|
||||
(set! st-test-fails (append st-test-fails (list {:got got :expected expected :name name}))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 1. Numeric helpers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(st-test "abs -5" (st-abs -5) 5)
|
||||
(st-test "abs 3" (st-abs 3) 3)
|
||||
(st-test "max 3 7" (st-max 3 7) 7)
|
||||
(st-test "min 3 7" (st-min 3 7) 3)
|
||||
(st-test "gcd 12 8" (st-gcd 12 8) 4)
|
||||
(st-test "lcm 4 6" (st-lcm 4 6) 12)
|
||||
(st-test "quo 10 3" (st-quo 10 3) 3)
|
||||
(st-test "quo -10 3" (st-quo -10 3) -3)
|
||||
(st-test "rem 10 3" (st-rem 10 3) 1)
|
||||
(st-test "rem -10 3" (st-rem -10 3) -1)
|
||||
(st-test "mod 10 3" (st-mod 10 3) 1)
|
||||
(st-test "mod -10 3" (st-mod -10 3) 2)
|
||||
(st-test "even? 4" (st-even? 4) true)
|
||||
(st-test "even? 3" (st-even? 3) false)
|
||||
(st-test "odd? 7" (st-odd? 7) true)
|
||||
(st-test "floor 3.7" (st-floor 3.7) 3)
|
||||
(st-test "ceiling 3.2" (st-ceiling 3.2) 4)
|
||||
(st-test "truncated 3.9" (st-truncated 3.9) 3)
|
||||
(st-test "rounded 3.5" (st-rounded 3.5) 4)
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 2. Character
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(st-test
|
||||
"char-value A"
|
||||
(st-char-value (st-char-from-int 65))
|
||||
65)
|
||||
(st-test "char-from-int" (st-char? (st-char-from-int 65)) true)
|
||||
(st-test "char? true" (st-char? (integer->char 65)) true)
|
||||
(st-test "char? false" (st-char? 65) false)
|
||||
(st-test "is-letter? A" (st-char-is-letter? (integer->char 65)) true)
|
||||
(st-test
|
||||
"is-letter? 1"
|
||||
(st-char-is-letter? (integer->char 49))
|
||||
false)
|
||||
(st-test "is-digit? 5" (st-char-is-digit? (integer->char 53)) true)
|
||||
(st-test "is-digit? A" (st-char-is-digit? (integer->char 65)) false)
|
||||
(st-test
|
||||
"is-uppercase? A"
|
||||
(st-char-is-uppercase? (integer->char 65))
|
||||
true)
|
||||
(st-test
|
||||
"is-uppercase? a"
|
||||
(st-char-is-uppercase? (integer->char 97))
|
||||
false)
|
||||
(st-test
|
||||
"is-lowercase? a"
|
||||
(st-char-is-lowercase? (integer->char 97))
|
||||
true)
|
||||
(st-test
|
||||
"is-lowercase? A"
|
||||
(st-char-is-lowercase? (integer->char 65))
|
||||
false)
|
||||
(st-test
|
||||
"is-separator? sp"
|
||||
(st-char-is-separator? (integer->char 32))
|
||||
true)
|
||||
(st-test
|
||||
"is-separator? A"
|
||||
(st-char-is-separator? (integer->char 65))
|
||||
false)
|
||||
(st-test
|
||||
"as-uppercase a"
|
||||
(st-char-value (st-char-as-uppercase (integer->char 97)))
|
||||
65)
|
||||
(st-test
|
||||
"as-uppercase A"
|
||||
(st-char-value (st-char-as-uppercase (integer->char 65)))
|
||||
65)
|
||||
(st-test
|
||||
"as-lowercase A"
|
||||
(st-char-value (st-char-as-lowercase (integer->char 65)))
|
||||
97)
|
||||
(st-test
|
||||
"digit-value 5"
|
||||
(st-char-digit-value (integer->char 53))
|
||||
5)
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 3. Array
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(st-test
|
||||
"array-new size"
|
||||
(st-array-size (st-array-new 5))
|
||||
5)
|
||||
(st-test "array? yes" (st-array? (st-array-new 3)) true)
|
||||
(st-test "array? no" (st-array? 42) false)
|
||||
(st-test
|
||||
"array-at nil"
|
||||
(st-array-at (st-array-new 3) 1)
|
||||
nil)
|
||||
|
||||
(let
|
||||
((a (st-array-new 3)))
|
||||
(st-array-at-put! a 1 10)
|
||||
(st-array-at-put! a 2 20)
|
||||
(st-array-at-put! a 3 30)
|
||||
(st-test "array-at 1" (st-array-at a 1) 10)
|
||||
(st-test "array-at 2" (st-array-at a 2) 20)
|
||||
(st-test "array-at 3" (st-array-at a 3) 30))
|
||||
|
||||
(st-test
|
||||
"list->array->list"
|
||||
(st-array->list (st-list->array (list 1 2 3)))
|
||||
(list 1 2 3))
|
||||
|
||||
(let
|
||||
((a (st-list->array (list 10 20 30 40 50))))
|
||||
(st-test
|
||||
"copy-from-to"
|
||||
(st-array->list (st-array-copy-from-to a 2 4))
|
||||
(list 20 30 40)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 4. Dictionary
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(st-test "dict? yes" (st-dict? (st-dict-new)) true)
|
||||
(st-test "dict? no" (st-dict? 42) false)
|
||||
(st-test "dict empty size" (st-dict-size (st-dict-new)) 0)
|
||||
(st-test "dict at absent" (st-dict-at (st-dict-new) "k") nil)
|
||||
|
||||
(let
|
||||
((d (st-dict-new)))
|
||||
(st-dict-at-put! d "a" 1)
|
||||
(st-dict-at-put! d "b" 2)
|
||||
(st-test "dict at a" (st-dict-at d "a") 1)
|
||||
(st-test "dict at b" (st-dict-at d "b") 2)
|
||||
(st-test "dict size 2" (st-dict-size d) 2)
|
||||
(st-test "includes-key? yes" (st-dict-includes-key? d "a") true)
|
||||
(st-test "includes-key? no" (st-dict-includes-key? d "z") false)
|
||||
(st-dict-at-put! d "a" 99)
|
||||
(st-test "dict update" (st-dict-at d "a") 99)
|
||||
(st-test "size unchanged" (st-dict-size d) 2)
|
||||
(st-dict-remove-key! d "a")
|
||||
(st-test "size after remove" (st-dict-size d) 1)
|
||||
(st-test "at-default hit" (st-dict-at-default d "b" 0) 2)
|
||||
(st-test "at-default miss" (st-dict-at-default d "z" -1) -1))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 5. Set
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(st-test "set? yes" (st-set? (st-set-new)) true)
|
||||
(st-test "set? no" (st-set? 42) false)
|
||||
(st-test "set empty size" (st-set-size (st-set-new)) 0)
|
||||
|
||||
(let
|
||||
((s (st-set-new)))
|
||||
(st-set-add! s 1)
|
||||
(st-set-add! s 2)
|
||||
(st-set-add! s 1)
|
||||
(st-test "set includes 1" (st-set-includes? s 1) true)
|
||||
(st-test "set includes 2" (st-set-includes? s 2) true)
|
||||
(st-test "set not includes 3" (st-set-includes? s 3) false)
|
||||
(st-test "set dedup size" (st-set-size s) 2)
|
||||
(st-set-remove! s 1)
|
||||
(st-test "size after remove" (st-set-size s) 1)
|
||||
(st-test "removed gone" (st-set-includes? s 1) false))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 6. String / Stream
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(st-test "join-strings 3" (st-join-strings (list "a" "b" "c") "-") "a-b-c")
|
||||
(st-test "join-strings 1" (st-join-strings (list "x") ",") "x")
|
||||
(st-test "join-strings empty" (st-join-strings (list) ",") "")
|
||||
|
||||
(st-test "print nil" (st-print-string nil) "nil")
|
||||
(st-test "print true" (st-print-string true) "true")
|
||||
(st-test "print false" (st-print-string false) "false")
|
||||
(st-test "print number" (st-print-string 42) "42")
|
||||
(st-test "print string" (st-print-string "hi") "'hi'")
|
||||
(st-test "print char" (st-print-string (integer->char 65)) "$A")
|
||||
(st-test "print list" (st-print-string (list 1 2)) "(1 2)")
|
||||
|
||||
(let
|
||||
((ws (st-write-stream-new)))
|
||||
(st-write-stream-put-string! ws "hello")
|
||||
(st-write-stream-put-string! ws " world")
|
||||
(st-test
|
||||
"write-stream contents"
|
||||
(st-write-stream-contents ws)
|
||||
"hello world"))
|
||||
|
||||
(let
|
||||
((ws (st-write-stream-new)))
|
||||
(st-write-stream-next-put! ws (integer->char 72))
|
||||
(st-write-stream-next-put! ws (integer->char 105))
|
||||
(st-test "write-stream next-put!" (st-write-stream-contents ws) "Hi"))
|
||||
|
||||
(let
|
||||
((rs (st-read-stream-new "ABC")))
|
||||
(st-test
|
||||
"read-stream next A"
|
||||
(st-char-value (st-read-stream-next rs))
|
||||
65)
|
||||
(st-test
|
||||
"read-stream next B"
|
||||
(st-char-value (st-read-stream-next rs))
|
||||
66)
|
||||
(st-test
|
||||
"read-stream peek C"
|
||||
(st-char-value (st-read-stream-peek rs))
|
||||
67)
|
||||
(st-test
|
||||
"read-stream next C"
|
||||
(st-char-value (st-read-stream-next rs))
|
||||
67)
|
||||
(st-test "read-stream at-end" (st-read-stream-at-end? rs) true))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Summary (must be last form — test.sh reads this)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(list st-test-pass st-test-fail)
|
||||
Reference in New Issue
Block a user