rose-ash/lib/forth/tests/runtime.sx

;; lib/forth/tests/runtime.sx — Tests for lib/forth/runtime.sx

(define forth-test-pass 0)
(define forth-test-fail 0)
(define forth-test-fails (list))

(define
  (forth-test name got expected)
  (if
    (= got expected)
    (set! forth-test-pass (+ forth-test-pass 1))
    (begin
      (set! forth-test-fail (+ forth-test-fail 1))
      (set! forth-test-fails (append forth-test-fails (list {:got got :expected expected :name name}))))))

;; ---------------------------------------------------------------------------
;; 1. Bitwise operations
;; ---------------------------------------------------------------------------

;; AND
(forth-test "and 0b1100 0b1010" (forth-and 12 10) 8)
(forth-test "and 0xFF 0x0F" (forth-and 255 15) 15)
(forth-test "and 0 any" (forth-and 0 42) 0)

;; OR
(forth-test "or 0b1100 0b1010" (forth-or 12 10) 14)
(forth-test "or 0 x" (forth-or 0 7) 7)

;; XOR
(forth-test "xor 0b1100 0b1010" (forth-xor 12 10) 6)
(forth-test "xor x x" (forth-xor 42 42) 0)

;; INVERT
(forth-test "invert 0" (forth-invert 0) -1)
(forth-test "invert -1" (forth-invert -1) 0)
(forth-test "invert 1" (forth-invert 1) -2)

;; LSHIFT RSHIFT
(forth-test "lshift 1 3" (forth-lshift 1 3) 8)
(forth-test "lshift 3 2" (forth-lshift 3 2) 12)
(forth-test "rshift 8 3" (forth-rshift 8 3) 1)
(forth-test "rshift 16 2" (forth-rshift 16 2) 4)

;; 2* 2/
(forth-test "2* 5" (forth-2* 5) 10)
(forth-test "2/ 10" (forth-2/ 10) 5)
(forth-test "2/ 7" (forth-2/ 7) 3)

;; BIT-COUNT
(forth-test "bit-count 0" (forth-bit-count 0) 0)
(forth-test "bit-count 1" (forth-bit-count 1) 1)
(forth-test "bit-count 7" (forth-bit-count 7) 3)
(forth-test "bit-count 255" (forth-bit-count 255) 8)
(forth-test "bit-count 256" (forth-bit-count 256) 1)

;; INTEGER-LENGTH
(forth-test "integer-length 0" (forth-integer-length 0) 0)
(forth-test "integer-length 1" (forth-integer-length 1) 1)
(forth-test "integer-length 4" (forth-integer-length 4) 3)
(forth-test "integer-length 255" (forth-integer-length 255) 8)

;; WITHIN
(forth-test
  "within 5 0 10"
  (forth-within 5 0 10)
  true)
(forth-test
  "within 0 0 10"
  (forth-within 0 0 10)
  true)
(forth-test
  "within 10 0 10"
  (forth-within 10 0 10)
  false)
(forth-test
  "within -1 0 10"
  (forth-within -1 0 10)
  false)

;; Arithmetic ops
(forth-test "negate 5" (forth-negate 5) -5)
(forth-test "negate -3" (forth-negate -3) 3)
(forth-test "abs -7" (forth-abs -7) 7)
(forth-test "min 3 5" (forth-min 3 5) 3)
(forth-test "max 3 5" (forth-max 3 5) 5)
(forth-test "mod 7 3" (forth-mod 7 3) 1)
(forth-test
  "divmod 7 3"
  (forth-divmod 7 3)
  (list 1 2))
(forth-test
  "divmod 10 5"
  (forth-divmod 10 5)
  (list 0 2))

;; ---------------------------------------------------------------------------
;; 2. String buffer
;; ---------------------------------------------------------------------------

(define sb1 (forth-sb-new))
(forth-test "sb? new" (forth-sb? sb1) true)
(forth-test "sb? non-sb" (forth-sb? 42) false)
(forth-test "sb value empty" (forth-sb-value sb1) "")
(forth-test "sb length empty" (forth-sb-length sb1) 0)

(forth-sb-type! sb1 "HELLO")
(forth-test "sb type" (forth-sb-value sb1) "HELLO")
(forth-test "sb length after type" (forth-sb-length sb1) 5)

;; EMIT one char
(define sb2 (forth-sb-new))
(forth-sb-emit! sb2 (nth (string->list "A") 0))
(forth-sb-emit! sb2 (nth (string->list "B") 0))
(forth-sb-emit! sb2 (nth (string->list "C") 0))
(forth-test "sb emit chars" (forth-sb-value sb2) "ABC")

;; Emit integer
(define sb3 (forth-sb-new))
(forth-sb-type! sb3 "n=")
(forth-sb-emit-int! sb3 42)
(forth-test "sb emit-int" (forth-sb-value sb3) "n=42")

(forth-sb-clear! sb1)
(forth-test "sb clear" (forth-sb-value sb1) "")
(forth-test "sb length after clear" (forth-sb-length sb1) 0)

;; Build a word definition-style name
(define sb4 (forth-sb-new))
(forth-sb-type! sb4 ": ")
(forth-sb-type! sb4 "SQUARE")
(forth-sb-type! sb4 " DUP * ;")
(forth-test "sb word def" (forth-sb-value sb4) ": SQUARE DUP * ;")

;; ---------------------------------------------------------------------------
;; 3. Memory / Bytevectors
;; ---------------------------------------------------------------------------

(define m1 (forth-mem-new 8))
(forth-test "mem? yes" (forth-mem? m1) true)
(forth-test "mem? no" (forth-mem? 42) false)
(forth-test "mem size" (forth-mem-size m1) 8)
(forth-test "mem cfetch zero" (forth-cfetch m1 0) 0)

;; C! C@
(forth-cstore m1 0 65)
(forth-cstore m1 1 66)
(forth-test "mem cstore/cfetch 0" (forth-cfetch m1 0) 65)
(forth-test "mem cstore/cfetch 1" (forth-cfetch m1 1) 66)
(forth-cstore m1 2 256)
(forth-test
  "mem cstore wraps 256→0"
  (forth-cfetch m1 2)
  0)
(forth-cstore m1 2 257)
(forth-test
  "mem cstore wraps 257→1"
  (forth-cfetch m1 2)
  1)

;; @ ! (32-bit LE cell)
(define m2 (forth-mem-new 8))
(forth-store m2 0 305419896)
(forth-test "mem store/fetch" (forth-fetch m2 0) 305419896)
(forth-store m2 4 1)
(forth-test "mem fetch byte 4" (forth-cfetch m2 4) 1)
(forth-test "mem fetch byte 5" (forth-cfetch m2 5) 0)

;; FILL ERASE
(define m3 (forth-mem-new 4))
(forth-fill! m3 0 4 42)
(forth-test
  "mem fill"
  (forth-mem->list m3 0 4)
  (list 42 42 42 42))
(forth-erase! m3 1 2)
(forth-test
  "mem erase middle"
  (forth-mem->list m3 0 4)
  (list 42 0 0 42))

;; MOVE
(define m4 (forth-mem-new 4))
(forth-cstore m4 0 1)
(forth-cstore m4 1 2)
(forth-cstore m4 2 3)
(define m5 (forth-mem-new 4))
(forth-move! m4 0 m5 0 3)
(forth-test
  "mem move"
  (forth-mem->list m5 0 3)
  (list 1 2 3))

;; mem->list
(define m6 (forth-mem-new 3))
(forth-cstore m6 0 10)
(forth-cstore m6 1 20)
(forth-cstore m6 2 30)
(forth-test
  "mem->list"
  (forth-mem->list m6 0 3)
  (list 10 20 30))