giles
077f4a5d38
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>
242 lines
7.5 KiB
Plaintext
242 lines
7.5 KiB
Plaintext
;; 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)
|