cl-runtime: add lib/common-lisp/runtime.sx + test.sh (68/68 pass)
Type predicates, arithmetic, chars (inline α/digit/case), format, gensym, values, sets, radix, list utilities. cl-empty? guards all list traversal against () vs nil in sx_server. Load spec/stdlib.sx in test.sh to expose format. Fix lib/r7rs.sx number->string to use (= (len r) 0) not (nil? r). Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
306
lib/common-lisp/runtime.sx
Normal file
306
lib/common-lisp/runtime.sx
Normal file
@@ -0,0 +1,306 @@
|
||||
;; lib/common-lisp/runtime.sx — CL built-ins using SX spec primitives
|
||||
;;
|
||||
;; Provides CL-specific wrappers and helpers. Deliberately thin: wherever
|
||||
;; an SX spec primitive already does the job, we alias it rather than
|
||||
;; reinventing it.
|
||||
;;
|
||||
;; Primitives used from spec:
|
||||
;; char/char->integer/integer->char/char-upcase/char-downcase
|
||||
;; format (Phase 21 — must be loaded before this file)
|
||||
;; gensym (Phase 12)
|
||||
;; rational/rational? (Phase 16)
|
||||
;; make-set/set-member?/set-union/etc (Phase 18)
|
||||
;; open-input-string/read-char/etc (Phase 14)
|
||||
;; modulo/remainder/quotient/gcd/lcm/expt (Phase 2 / Phase 15)
|
||||
;; number->string with radix (Phase 15)
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 1. Type predicates
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define (cl-null? x) (= x nil))
|
||||
(define (cl-consp? x) (and (list? x) (not (cl-empty? x))))
|
||||
(define (cl-listp? x) (or (cl-empty? x) (list? x)))
|
||||
(define (cl-atom? x) (not (cl-consp? x)))
|
||||
|
||||
(define
|
||||
(cl-numberp? x)
|
||||
(let ((t (type-of x))) (or (= t "number") (= t "rational"))))
|
||||
|
||||
(define cl-integerp? integer?)
|
||||
(define cl-floatp? float?)
|
||||
(define cl-rationalp? rational?)
|
||||
|
||||
(define (cl-realp? x) (or (integer? x) (float? x) (rational? x)))
|
||||
|
||||
(define cl-characterp? char?)
|
||||
(define cl-stringp? (fn (x) (= (type-of x) "string")))
|
||||
(define cl-symbolp? (fn (x) (= (type-of x) "symbol")))
|
||||
(define cl-keywordp? (fn (x) (= (type-of x) "keyword")))
|
||||
|
||||
(define
|
||||
(cl-functionp? x)
|
||||
(let
|
||||
((t (type-of x)))
|
||||
(or
|
||||
(= t "function")
|
||||
(= t "lambda")
|
||||
(= t "native-fn")
|
||||
(= t "component"))))
|
||||
|
||||
(define cl-vectorp? vector?)
|
||||
(define cl-arrayp? vector?)
|
||||
|
||||
;; sx_server: (rest (list x)) returns () not nil — cl-empty? handles both
|
||||
(define
|
||||
(cl-empty? x)
|
||||
(or (nil? x) (and (list? x) (= (len x) 0))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 2. Arithmetic — thin aliases to spec primitives
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define cl-mod modulo)
|
||||
(define cl-rem remainder)
|
||||
(define cl-gcd gcd)
|
||||
(define cl-lcm lcm)
|
||||
(define cl-expt expt)
|
||||
(define cl-floor floor)
|
||||
(define cl-ceiling ceil)
|
||||
(define cl-truncate truncate)
|
||||
(define cl-round round)
|
||||
(define cl-abs (fn (x) (if (< x 0) (- 0 x) x)))
|
||||
(define cl-min (fn (a b) (if (< a b) a b)))
|
||||
(define cl-max (fn (a b) (if (> a b) a b)))
|
||||
(define cl-quotient quotient)
|
||||
|
||||
(define
|
||||
(cl-signum x)
|
||||
(cond
|
||||
((> x 0) 1)
|
||||
((< x 0) -1)
|
||||
(else 0)))
|
||||
|
||||
(define (cl-evenp? n) (= (modulo n 2) 0))
|
||||
(define (cl-oddp? n) (= (modulo n 2) 1))
|
||||
(define (cl-zerop? n) (= n 0))
|
||||
(define (cl-plusp? n) (> n 0))
|
||||
(define (cl-minusp? n) (< n 0))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 3. Character functions — alias spec char primitives + CL name mapping
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define cl-char->integer char->integer)
|
||||
(define cl-integer->char integer->char)
|
||||
(define cl-char-upcase char-upcase)
|
||||
(define cl-char-downcase char-downcase)
|
||||
(define cl-char-code char->integer)
|
||||
(define cl-code-char integer->char)
|
||||
|
||||
(define cl-char=? char=?)
|
||||
(define cl-char<? char<?)
|
||||
(define cl-char>? char>?)
|
||||
(define cl-char<=? char<=?)
|
||||
(define cl-char>=? char>=?)
|
||||
(define cl-char-ci=? char-ci=?)
|
||||
(define cl-char-ci<? char-ci<?)
|
||||
(define cl-char-ci>? char-ci>?)
|
||||
|
||||
;; Inline predicates — char-alphabetic?/char-numeric? unreliable in sx_server
|
||||
(define
|
||||
(cl-alpha-char-p c)
|
||||
(let
|
||||
((n (char->integer c)))
|
||||
(or
|
||||
(and (>= n 65) (<= n 90))
|
||||
(and (>= n 97) (<= n 122)))))
|
||||
|
||||
(define
|
||||
(cl-digit-char-p c)
|
||||
(let ((n (char->integer c))) (and (>= n 48) (<= n 57))))
|
||||
|
||||
(define
|
||||
(cl-alphanumericp c)
|
||||
(let
|
||||
((n (char->integer c)))
|
||||
(or
|
||||
(and (>= n 48) (<= n 57))
|
||||
(and (>= n 65) (<= n 90))
|
||||
(and (>= n 97) (<= n 122)))))
|
||||
|
||||
(define
|
||||
(cl-upper-case-p c)
|
||||
(let ((n (char->integer c))) (and (>= n 65) (<= n 90))))
|
||||
|
||||
(define
|
||||
(cl-lower-case-p c)
|
||||
(let ((n (char->integer c))) (and (>= n 97) (<= n 122))))
|
||||
|
||||
;; Named character constants
|
||||
(define cl-char-space (integer->char 32))
|
||||
(define cl-char-newline (integer->char 10))
|
||||
(define cl-char-tab (integer->char 9))
|
||||
(define cl-char-backspace (integer->char 8))
|
||||
(define cl-char-return (integer->char 13))
|
||||
(define cl-char-null (integer->char 0))
|
||||
(define cl-char-escape (integer->char 27))
|
||||
(define cl-char-delete (integer->char 127))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 4. String + IO — use spec format and ports
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; CL format: (cl-format nil "~a ~a" x y) — nil destination means return string
|
||||
(define
|
||||
(cl-format dest template &rest args)
|
||||
(let ((s (apply format (cons template args)))) (if (= dest nil) s s)))
|
||||
|
||||
(define cl-write-to-string write-to-string)
|
||||
(define cl-princ-to-string display-to-string)
|
||||
|
||||
;; CL read-from-string: parse value from a string using SX port
|
||||
(define
|
||||
(cl-read-from-string s)
|
||||
(let ((p (open-input-string s))) (read p)))
|
||||
|
||||
;; String stream (output)
|
||||
(define cl-make-string-output-stream open-output-string)
|
||||
(define cl-get-output-stream-string get-output-string)
|
||||
|
||||
;; String stream (input)
|
||||
(define cl-make-string-input-stream open-input-string)
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 5. Gensym
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define cl-gensym gensym)
|
||||
(define cl-gentemp gensym)
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 6. Multiple values (CL: values / nth-value)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define (cl-values &rest args) {:_values true :_list args})
|
||||
|
||||
(define
|
||||
(cl-call-with-values producer consumer)
|
||||
(let
|
||||
((mv (producer)))
|
||||
(if
|
||||
(and (dict? mv) (get mv :_values))
|
||||
(apply consumer (get mv :_list))
|
||||
(consumer mv))))
|
||||
|
||||
(define
|
||||
(cl-nth-value n mv)
|
||||
(cond
|
||||
((and (dict? mv) (get mv :_values))
|
||||
(let
|
||||
((lst (get mv :_list)))
|
||||
(if (>= n (len lst)) nil (nth lst n))))
|
||||
((= n 0) mv)
|
||||
(else nil)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 7. Sets (CL: adjoin / member / union / intersection / set-difference)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define cl-make-set make-set)
|
||||
(define cl-set? set?)
|
||||
(define cl-set-add set-add!)
|
||||
(define cl-set-memberp set-member?)
|
||||
(define cl-set-remove set-remove!)
|
||||
(define cl-set-union set-union)
|
||||
(define cl-set-intersect set-intersection)
|
||||
(define cl-set-difference set-difference)
|
||||
(define cl-list->set list->set)
|
||||
(define cl-set->list set->list)
|
||||
|
||||
;; CL: (member item list) — returns tail starting at item, or nil
|
||||
(define
|
||||
(cl-member item lst)
|
||||
(cond
|
||||
((cl-empty? lst) nil)
|
||||
((equal? item (first lst)) lst)
|
||||
(else (cl-member item (rest lst)))))
|
||||
|
||||
;; CL: (adjoin item list) — cons only if not already present
|
||||
(define (cl-adjoin item lst) (if (cl-member item lst) lst (cons item lst)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 8. Radix formatting (CL: (write-to-string n :base radix))
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define (cl-integer-to-string n radix) (number->string n radix))
|
||||
|
||||
(define (cl-string-to-integer s radix) (string->number s radix))
|
||||
|
||||
;; CL ~R directive helpers
|
||||
(define (cl-format-binary n) (number->string n 2))
|
||||
(define (cl-format-octal n) (number->string n 8))
|
||||
(define (cl-format-hex n) (number->string n 16))
|
||||
(define (cl-format-decimal n) (number->string n 10))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 9. List utilities — cl-empty? guards against () from rest
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
(cl-last lst)
|
||||
(cond
|
||||
((cl-empty? lst) nil)
|
||||
((cl-empty? (rest lst)) lst)
|
||||
(else (cl-last (rest lst)))))
|
||||
|
||||
(define
|
||||
(cl-butlast lst)
|
||||
(if
|
||||
(or (cl-empty? lst) (cl-empty? (rest lst)))
|
||||
nil
|
||||
(cons (first lst) (cl-butlast (rest lst)))))
|
||||
|
||||
(define
|
||||
(cl-nthcdr n lst)
|
||||
(if (= n 0) lst (cl-nthcdr (- n 1) (rest lst))))
|
||||
|
||||
(define (cl-nth n lst) (first (cl-nthcdr n lst)))
|
||||
|
||||
(define (cl-list-length lst) (len lst))
|
||||
|
||||
(define
|
||||
(cl-copy-list lst)
|
||||
(if (cl-empty? lst) nil (cons (first lst) (cl-copy-list (rest lst)))))
|
||||
|
||||
(define
|
||||
(cl-flatten lst)
|
||||
(cond
|
||||
((cl-empty? lst) nil)
|
||||
((list? (first lst))
|
||||
(append (cl-flatten (first lst)) (cl-flatten (rest lst))))
|
||||
(else (cons (first lst) (cl-flatten (rest lst))))))
|
||||
|
||||
;; CL: (assoc key alist) — returns matching pair or nil
|
||||
(define
|
||||
(cl-assoc key alist)
|
||||
(cond
|
||||
((cl-empty? alist) nil)
|
||||
((equal? key (first (first alist))) (first alist))
|
||||
(else (cl-assoc key (rest alist)))))
|
||||
|
||||
;; CL: (rassoc val alist) — reverse assoc (match on second element)
|
||||
(define
|
||||
(cl-rassoc val alist)
|
||||
(cond
|
||||
((cl-empty? alist) nil)
|
||||
((equal? val (first (rest (first alist)))) (first alist))
|
||||
(else (cl-rassoc val (rest alist)))))
|
||||
|
||||
;; CL: (getf plist key) — property list lookup
|
||||
(define
|
||||
(cl-getf plist key)
|
||||
(cond
|
||||
((or (cl-empty? plist) (cl-empty? (rest plist))) nil)
|
||||
((equal? (first plist) key) (first (rest plist)))
|
||||
(else (cl-getf (rest (rest plist)) key))))
|
||||
302
lib/common-lisp/test.sh
Executable file
302
lib/common-lisp/test.sh
Executable file
@@ -0,0 +1,302 @@
|
||||
#!/usr/bin/env bash
|
||||
# lib/common-lisp/test.sh — quick smoke-test the CL runtime layer.
|
||||
# Uses sx_server.exe epoch protocol (same as lib/lua/test.sh).
|
||||
#
|
||||
# Usage:
|
||||
# bash lib/common-lisp/test.sh
|
||||
# bash lib/common-lisp/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:-}"
|
||||
PASS=0; FAIL=0; ERRORS=""
|
||||
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
||||
|
||||
cat > "$TMPFILE" << 'EPOCHS'
|
||||
(epoch 1)
|
||||
(load "spec/stdlib.sx")
|
||||
(load "lib/common-lisp/runtime.sx")
|
||||
|
||||
;; --- Type predicates ---
|
||||
(epoch 10)
|
||||
(eval "(cl-null? nil)")
|
||||
(epoch 11)
|
||||
(eval "(cl-null? false)")
|
||||
(epoch 12)
|
||||
(eval "(cl-consp? (list 1 2))")
|
||||
(epoch 13)
|
||||
(eval "(cl-consp? nil)")
|
||||
(epoch 14)
|
||||
(eval "(cl-listp? nil)")
|
||||
(epoch 15)
|
||||
(eval "(cl-listp? (list 1))")
|
||||
(epoch 16)
|
||||
(eval "(cl-atom? nil)")
|
||||
(epoch 17)
|
||||
(eval "(cl-atom? (list 1))")
|
||||
(epoch 18)
|
||||
(eval "(cl-integerp? 42)")
|
||||
(epoch 19)
|
||||
(eval "(cl-floatp? 3.14)")
|
||||
(epoch 20)
|
||||
(eval "(cl-characterp? (integer->char 65))")
|
||||
(epoch 21)
|
||||
(eval "(cl-stringp? \"hello\")")
|
||||
|
||||
;; --- Arithmetic ---
|
||||
(epoch 30)
|
||||
(eval "(cl-mod 10 3)")
|
||||
(epoch 31)
|
||||
(eval "(cl-rem 10 3)")
|
||||
(epoch 32)
|
||||
(eval "(cl-quotient 10 3)")
|
||||
(epoch 33)
|
||||
(eval "(cl-gcd 12 8)")
|
||||
(epoch 34)
|
||||
(eval "(cl-lcm 4 6)")
|
||||
(epoch 35)
|
||||
(eval "(cl-abs -5)")
|
||||
(epoch 36)
|
||||
(eval "(cl-abs 5)")
|
||||
(epoch 37)
|
||||
(eval "(cl-min 2 7)")
|
||||
(epoch 38)
|
||||
(eval "(cl-max 2 7)")
|
||||
(epoch 39)
|
||||
(eval "(cl-evenp? 4)")
|
||||
(epoch 40)
|
||||
(eval "(cl-evenp? 3)")
|
||||
(epoch 41)
|
||||
(eval "(cl-oddp? 7)")
|
||||
(epoch 42)
|
||||
(eval "(cl-zerop? 0)")
|
||||
(epoch 43)
|
||||
(eval "(cl-plusp? 1)")
|
||||
(epoch 44)
|
||||
(eval "(cl-minusp? -1)")
|
||||
(epoch 45)
|
||||
(eval "(cl-signum 42)")
|
||||
(epoch 46)
|
||||
(eval "(cl-signum -7)")
|
||||
(epoch 47)
|
||||
(eval "(cl-signum 0)")
|
||||
|
||||
;; --- Characters ---
|
||||
(epoch 50)
|
||||
(eval "(cl-char-code (integer->char 65))")
|
||||
(epoch 51)
|
||||
(eval "(char? (cl-code-char 65))")
|
||||
(epoch 52)
|
||||
(eval "(cl-char=? (integer->char 65) (integer->char 65))")
|
||||
(epoch 53)
|
||||
(eval "(cl-char<? (integer->char 65) (integer->char 90))")
|
||||
(epoch 54)
|
||||
(eval "(cl-char-code cl-char-space)")
|
||||
(epoch 55)
|
||||
(eval "(cl-char-code cl-char-newline)")
|
||||
(epoch 56)
|
||||
(eval "(cl-alpha-char-p (integer->char 65))")
|
||||
(epoch 57)
|
||||
(eval "(cl-digit-char-p (integer->char 48))")
|
||||
|
||||
;; --- Format ---
|
||||
(epoch 60)
|
||||
(eval "(cl-format nil \"hello\")")
|
||||
(epoch 61)
|
||||
(eval "(cl-format nil \"~a\" \"world\")")
|
||||
(epoch 62)
|
||||
(eval "(cl-format nil \"~d\" 42)")
|
||||
(epoch 63)
|
||||
(eval "(cl-format nil \"~x\" 255)")
|
||||
(epoch 64)
|
||||
(eval "(cl-format nil \"x=~d y=~d\" 3 4)")
|
||||
|
||||
;; --- Gensym ---
|
||||
(epoch 70)
|
||||
(eval "(= (type-of (cl-gensym)) \"symbol\")")
|
||||
(epoch 71)
|
||||
(eval "(not (= (cl-gensym) (cl-gensym)))")
|
||||
|
||||
;; --- Sets ---
|
||||
(epoch 80)
|
||||
(eval "(cl-set? (cl-make-set))")
|
||||
(epoch 81)
|
||||
(eval "(let ((s (cl-make-set))) (do (cl-set-add s 1) (cl-set-memberp s 1)))")
|
||||
(epoch 82)
|
||||
(eval "(cl-set-memberp (cl-make-set) 42)")
|
||||
(epoch 83)
|
||||
(eval "(cl-set-memberp (cl-list->set (list 1 2 3)) 2)")
|
||||
|
||||
;; --- Lists ---
|
||||
(epoch 90)
|
||||
(eval "(cl-nth 0 (list 1 2 3))")
|
||||
(epoch 91)
|
||||
(eval "(cl-nth 2 (list 1 2 3))")
|
||||
(epoch 92)
|
||||
(eval "(cl-last (list 1 2 3))")
|
||||
(epoch 93)
|
||||
(eval "(cl-butlast (list 1 2 3))")
|
||||
(epoch 94)
|
||||
(eval "(cl-nthcdr 1 (list 1 2 3))")
|
||||
(epoch 95)
|
||||
(eval "(cl-assoc \"b\" (list (list \"a\" 1) (list \"b\" 2)))")
|
||||
(epoch 96)
|
||||
(eval "(cl-assoc \"z\" (list (list \"a\" 1)))")
|
||||
(epoch 97)
|
||||
(eval "(cl-getf (list \"x\" 42 \"y\" 99) \"x\")")
|
||||
(epoch 98)
|
||||
(eval "(cl-adjoin 0 (list 1 2))")
|
||||
(epoch 99)
|
||||
(eval "(cl-adjoin 1 (list 1 2))")
|
||||
(epoch 100)
|
||||
(eval "(cl-member 2 (list 1 2 3))")
|
||||
(epoch 101)
|
||||
(eval "(cl-member 9 (list 1 2 3))")
|
||||
(epoch 102)
|
||||
(eval "(cl-flatten (list 1 (list 2 3) 4))")
|
||||
|
||||
;; --- Radix ---
|
||||
(epoch 110)
|
||||
(eval "(cl-format-binary 10)")
|
||||
(epoch 111)
|
||||
(eval "(cl-format-octal 15)")
|
||||
(epoch 112)
|
||||
(eval "(cl-format-hex 255)")
|
||||
(epoch 113)
|
||||
(eval "(cl-format-decimal 42)")
|
||||
(epoch 114)
|
||||
(eval "(cl-integer-to-string 31 16)")
|
||||
(epoch 115)
|
||||
(eval "(cl-string-to-integer \"1f\" 16)")
|
||||
|
||||
EPOCHS
|
||||
|
||||
OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||
|
||||
check() {
|
||||
local epoch="$1" desc="$2" expected="$3"
|
||||
local actual
|
||||
# ok-len format: value appears on the line AFTER "(ok-len N length)"
|
||||
actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
|
||||
# strip any leading "(ok-len ...)" if grep -A1 returned it instead
|
||||
if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
|
||||
if [ -z "$actual" ]; then
|
||||
actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
|
||||
fi
|
||||
if [ -z "$actual" ]; then
|
||||
actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
|
||||
fi
|
||||
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
|
||||
|
||||
if echo "$actual" | grep -qF -- "$expected"; then
|
||||
PASS=$((PASS+1))
|
||||
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
|
||||
else
|
||||
FAIL=$((FAIL+1))
|
||||
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
|
||||
"
|
||||
fi
|
||||
}
|
||||
|
||||
# Type predicates
|
||||
check 10 "cl-null? nil" "true"
|
||||
check 11 "cl-null? false" "false"
|
||||
check 12 "cl-consp? pair" "true"
|
||||
check 13 "cl-consp? nil" "false"
|
||||
check 14 "cl-listp? nil" "true"
|
||||
check 15 "cl-listp? list" "true"
|
||||
check 16 "cl-atom? nil" "true"
|
||||
check 17 "cl-atom? pair" "false"
|
||||
check 18 "cl-integerp?" "true"
|
||||
check 19 "cl-floatp?" "true"
|
||||
check 20 "cl-characterp?" "true"
|
||||
check 21 "cl-stringp?" "true"
|
||||
|
||||
# Arithmetic
|
||||
check 30 "cl-mod 10 3" "1"
|
||||
check 31 "cl-rem 10 3" "1"
|
||||
check 32 "cl-quotient 10 3" "3"
|
||||
check 33 "cl-gcd 12 8" "4"
|
||||
check 34 "cl-lcm 4 6" "12"
|
||||
check 35 "cl-abs -5" "5"
|
||||
check 36 "cl-abs 5" "5"
|
||||
check 37 "cl-min 2 7" "2"
|
||||
check 38 "cl-max 2 7" "7"
|
||||
check 39 "cl-evenp? 4" "true"
|
||||
check 40 "cl-evenp? 3" "false"
|
||||
check 41 "cl-oddp? 7" "true"
|
||||
check 42 "cl-zerop? 0" "true"
|
||||
check 43 "cl-plusp? 1" "true"
|
||||
check 44 "cl-minusp? -1" "true"
|
||||
check 45 "cl-signum pos" "1"
|
||||
check 46 "cl-signum neg" "-1"
|
||||
check 47 "cl-signum zero" "0"
|
||||
|
||||
# Characters
|
||||
check 50 "cl-char-code" "65"
|
||||
check 51 "code-char returns char" "true"
|
||||
check 52 "cl-char=?" "true"
|
||||
check 53 "cl-char<?" "true"
|
||||
check 54 "cl-char-space code" "32"
|
||||
check 55 "cl-char-newline code" "10"
|
||||
check 56 "cl-alpha-char-p A" "true"
|
||||
check 57 "cl-digit-char-p 0" "true"
|
||||
|
||||
# Format
|
||||
check 60 "cl-format plain" '"hello"'
|
||||
check 61 "cl-format ~a" '"world"'
|
||||
check 62 "cl-format ~d" '"42"'
|
||||
check 63 "cl-format ~x" '"ff"'
|
||||
check 64 "cl-format multi" '"x=3 y=4"'
|
||||
|
||||
# Gensym
|
||||
check 70 "gensym returns symbol" "true"
|
||||
check 71 "gensyms are unique" "true"
|
||||
|
||||
# Sets
|
||||
check 80 "make-set is set?" "true"
|
||||
check 81 "set-add + member" "true"
|
||||
check 82 "member in empty" "false"
|
||||
check 83 "list->set member" "true"
|
||||
|
||||
# Lists
|
||||
check 90 "cl-nth 0" "1"
|
||||
check 91 "cl-nth 2" "3"
|
||||
check 92 "cl-last" "(3)"
|
||||
check 93 "cl-butlast" "(1 2)"
|
||||
check 94 "cl-nthcdr 1" "(2 3)"
|
||||
check 95 "cl-assoc hit" '("b" 2)'
|
||||
check 96 "cl-assoc miss" "nil"
|
||||
check 97 "cl-getf hit" "42"
|
||||
check 98 "cl-adjoin new" "(0 1 2)"
|
||||
check 99 "cl-adjoin dup" "(1 2)"
|
||||
check 100 "cl-member hit" "(2 3)"
|
||||
check 101 "cl-member miss" "nil"
|
||||
check 102 "cl-flatten" "(1 2 3 4)"
|
||||
|
||||
# Radix
|
||||
check 110 "cl-format-binary 10" '"1010"'
|
||||
check 111 "cl-format-octal 15" '"17"'
|
||||
check 112 "cl-format-hex 255" '"ff"'
|
||||
check 113 "cl-format-decimal 42" '"42"'
|
||||
check 114 "n->s base 16" '"1f"'
|
||||
check 115 "s->n base 16" "31"
|
||||
|
||||
TOTAL=$((PASS+FAIL))
|
||||
if [ $FAIL -eq 0 ]; then
|
||||
echo "ok $PASS/$TOTAL lib/common-lisp tests passed"
|
||||
else
|
||||
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
|
||||
echo "$ERRORS"
|
||||
fi
|
||||
[ $FAIL -eq 0 ]
|
||||
Reference in New Issue
Block a user