#!/usr/bin/env newlisp

;
; qa-bench - benchmarks most non-I/O functions
;

; USAGE
; =====
; from the newlisp-x.x.x/ directory:
;
; Run all benchmakrs and output one number comparing to the
; calibaration platform:
;       ./newlisp /qa-specific-tests/qa-bench
;
; Calibrate for a specific platform:
;       ./newlisp /qa-specific-tests/qa-bench calibrate
; ... this generates a file primes.lsp in the current directory
; the contents replaces the (set 'QA:primes ...) statement in qa-bench
; replacement happens manually using an editor
;
; Report inividual results for each primitive tested:
;       ./newlisp /qa-specific-tests/qa-bench report
; ... on the calibration platform is will output apprxomately 10 ms
; for each function.

(unless xml-parse
    (println ">>>>> qa-bench needs needs XML support compiled")
    (exit)
)

(set-locale "C")


(context 'Lex)  ; predeclare/create context for bayes-train
(context MAIN)

; setup some stuff used later
(global 'global-myvar)
(set 'global-myvar 123)
(set '$0 "abcdefg")
       
(delete (sym "double")) ;; avoid error when running Emscripten intro before

(define (double:double x) (+ x x))

(define (test-default-functor)
    (and
        (= (map double '(1 2 3 4 5)) '(2 4 6 8 10))
        (= (map 'double '(1 2 3 4 5)) '(2 4 6 8 10))
        (set 'dflt:dflt '(a b c d e f g))
        (= (map dflt '(1 2 6)) '(b c g))
        (set 'i 0 'j -1 'k 6)
        (= (dflt i) 'a)
        (= (dflt k) 'g)
        (= (dflt j) 'g)
        (set 'ctx dflt)
        (= (default ctx) dflt:dflt)
        (= (default dflt) dflt:dflt)
        (sort (default ctx) >)
        (= (default dflt) '(g f e d c b a))
))
        
(context 'QA)

(set 'failed-messages '())

(define (failed msg)
  (push msg failed-messages))

(define (myappend x y)
  (cond 
   ((= '() x) y) 
   (true (cons (first x) (myappend (rest x) y)))))


(set 'primitives '(
 != $ % & * + - / < << <= = > >= >> NaN? ^ abs acos acosh 
 add address amb and append apply args array array-list array? asin asinh 
 assoc atan atan2 atanh atom? base64-dec base64-enc bayes-query bayes-train begin 
 beta betai bind binomial bits case catch ceil char chop clean collect
 cond cons constant context context? copy cos cosh 
 count cpymem crc32 crit-chi2 crit-z curry date date-value dec 
 def-new default define define-macro delete det 
 difference div do-until do-while doargs dolist dostring dotimes 
 dotree dump dup empty? encrypt ends-with env erf error-event eval eval-string 
 exists exp expand explode factor fft filter find find-all 
 first flat float float? floor flt for for-all format fv gammai gammaln gcd 
 get-char get-float get-int get-long get-string global global? if if-not 
 ifft inc index int integer? intersect invert irr join lambda? last 
 last-error legal? length let letex letn list list? local log lookup lower-case 
 macro? main-args map mat match max member min mod mul multiply 
 new nil? normal not now nper npv nth null? number? or pack parse 
 pmt pop pop-assoc pow pretty-print primitive? prob-chi2 
 prob-z protected? push pv quote quote? rand random 
 randomize read-expr ref ref-all regex regex-comp replace rest 
 reverse rotate round seed select sequence series set 
 set-locale set-ref set-ref-all setf setq sgn sin sinh 
 slice sort source sqrt starts-with string string? sub swap sym symbol? symbols 
 sys-error sys-info tan tanh term throw throw-error time time-of-day title-case 
 transpose trim true? unify unique unless unpack 
 until upper-case uuid when while write-buffer 
 write-line xml-parse xml-type-tags zero? | ~))

; number of times to run a test-xxxx function 
; on 2.3 GHz Intel Core i5 Mac Mini OX X 10.91
; and pass 1000 milliseconds

(set 'QA:primes '(
  (!= 5658) 
  ($ 24597) 
  (% 10231) 
  (& 33049) 
  (* 28119) 
  (+ 15827) 
  (- 33262) 
  (/ 21301) 
  (< 3076) 
  (<< 33749) 
  (<= 28658) 
  (= 2834) 
  (> 2824) 
  (>= 28624) 
  (>> 33684) 
  (NaN? 7313) 
  (^ 34421) 
  (abs 21288) 
  (acos 21191) 
  (acosh 28306) 
  (add 1185) 
  (address 5696) 
  (amb 19766) 
  (and 24425) 
  (append 756) 
  (apply 2279) 
  (args 9188) 
  (array 1387) 
  (array-list 1993) 
  (array? 2271) 
  (asin 7980) 
  (asinh 9204) 
  (assoc 2027) 
  (atan 14606) 
  (atan2 22063) 
  (atanh 21181) 
  (atom? 15481) 
  (base64-dec 2787) 
  (base64-enc 1707) 
  (bayes-query 14510) 
  (bayes-train 1604) 
  (begin 
   19205) 
  (beta 17323) 
  (betai 14527) 
  (bind 6211) 
  (binomial 17391) 
  (bits 2688) 
  (case 7069) 
  (catch 2363) 
  (ceil 34878) 
  (char 1640) 
  (chop 2053) 
  (clean 2981) 
  (collect 7518) 
  (cond 
   4828) 
  (cons 5846) 
  (constant 24160) 
  (context 22132) 
  (context? 33114) 
  (copy 11132) 
  (cos 21913) 
  (cosh 16938) 
  (count 1324) 
  (cpymem 7855) 
  (crc32 21335) 
  (crit-chi2 430) 
  (crit-z 4361) 
  (curry 1138) 
  (date 1439) 
  (date-value 27137) 
  (dec 8270) 
  (def-new 6521) 
  (default 877) 
  (define 3357) 
  (define-macro 3363) 
  (delete 269) 
  (det 5392) 
  (difference 1058) 
  (div 15700) 
  (do-until 5461) 
  (do-while 1019) 
  (doargs 11888) 
  (dolist 1469) 
  (dostring 5945) 
  (dotimes 2615) 
  (dotree 138) 
  (dump 10765) 
  (dup 2287) 
  (empty? 4284) 
  (encrypt 6777) 
  (ends-with 1038) 
  (env 782) 
  (erf 21385) 
  (error-event 36602) 
  (eval 9514) 
  (eval-string 3228) 
  (exists 984) 
  (exp 16541) 
  (expand 1149) 
  (explode 923) 
  (factor 413) 
  (fft 9372) 
  (filter 1598) 
  (find 499) 
  (find-all 586) 
  (first 2452) 
  (flat 4723) 
  (float 23719) 
  (float? 50412) 
  (floor 35995) 
  (flt 36479) 
  (for 5257) 
  (for-all 1978) 
  (format 114) 
  (fv 20796) 
  (gammai 18415) 
  (gammaln 18580) 
  (gcd 8921) 
  (get-char 7318) 
  (get-float 11986) 
  (get-int 817) 
  (get-long 10887) 
  (get-string 11818) 
  (global 44476) 
  (global? 30221) 
  (if 5613) 
  (if-not 45278) 
  (ifft 9198) 
  (inc 5305) 
  (index 3675) 
  (int 7913) 
  (integer? 21338) 
  (intersect 2198) 
  (invert 522) 
  (irr 1980) 
  (join 1411) 
  (lambda? 48649) 
  (last 2378) 
  (last-error 15602) 
  (legal? 4669) 
  (length 1238) 
  (let 5902) 
  (letex 2171) 
  (letn 8631) 
  (list 12063) 
  (list? 25437) 
  (local 10706) 
  (log 13667) 
  (lookup 6739) 
  (lower-case 6438) 
  (macro? 34727) 
  (main-args 2945) 
  (map 3759) 
  (mat 297) 
  (match 1069) 
  (max 17336) 
  (member 1320) 
  (min 17209) 
  (mod 14654) 
  (mul 33368) 
  (multiply 1076) 
  (new 220) 
  (nil? 3058) 
  (normal 907) 
  (not 5432) 
  (now 9624) 
  (nper 21972) 
  (npv 17001) 
  (nth 754) 
  (null? 4327) 
  (number? 13023) 
  (or 10287) 
  (pack 377) 
  (parse 1053) 
  (pmt 20836) 
  (pop 534) 
  (pop-assoc 1699) 
  (pow 19912) 
  (pretty-print 9626) 
  (primitive? 50885) 
  (prob-chi2 17291) 
  (prob-z 24014) 
  (protected? 17923) 
  (push 422) 
  (pv 19713) 
  (quote 36067) 
  (quote? 43134) 
  (rand 104) 
  (random 13774) 
  (randomize 2819) 
  (read-expr 4689) 
  (ref 343) 
  (ref-all 153) 
  (regex 1634) 
  (regex-comp 3744) 
  (replace 140) 
  (rest 1025) 
  (reverse 4936) 
  (rotate 2183) 
  (round 2075) 
  (seed 2682) 
  (select 1737) 
  (sequence 21485) 
  (series 7910) 
  (set 16925) 
  (set-locale 16540) 
  (set-ref 1619) 
  (set-ref-all 2603) 
  (setf 895) 
  (setq 14431) 
  (sgn 16779) 
  (sin 19283) 
  (sinh 15753) 
  (slice 506) 
  (sort 254) 
  (source 636) 
  (sqrt 21767) 
  (starts-with 3969) 
  (string 224) 
  (string? 21999) 
  (sub 23454) 
  (swap 1951) 
  (sym 9170) 
  (symbol? 10098) 
  (symbols 666) 
  (sys-error 29036) 
  (sys-info 15251) 
  (tan 16612) 
  (tanh 14236) 
  (term 17963) 
  (throw 4018) 
  (throw-error 1741) 
  (time 27169) 
  (time-of-day 14815) 
  (title-case 4338) 
  (transpose 1826) 
  (trim 1900) 
  (true? 8315) 
  (unify 297) 
  (unique 6232) 
  (unless 8488) 
  (unpack 6149) 
  (until 6973) 
  (upper-case 6446) 
  (uuid 7491) 
  (when 8297) 
  (while 1061) 
  (write-buffer 2476) 
  (write-line 4520) 
  (xml-parse 3955) 
  (xml-type-tags 11269) 
  (zero? 14075) 
  (| 34705) 
  (~ 2771)))

;; run each test function once and collect errors
(define (qa)
    (dolist (sm primes)
        (set 'func (eval (sym (append "test-" (string (first sm))))))
        (unless (apply func) (push (sm 0) errors))
    )
)

;; run all test-xxx functions the number of times it would take to pass
;; 10 ms on the calibration platform
(define (bench (total-time 0))
    (dolist (sm primes)
        (when (and 
              (set 'func (eval (sym (append "test-" (string (first sm))))))
              (set 'result (time (apply func) (mul (last sm) multiplier))))
            (inc total-time result))
        (when report-flag 
            (println (format "%-14s %5.1f ms" (string (first sm)) result)))
    )   
    total-time
)


;; calibrate - find out how many times to run a test-xxxx function to pass
;; ms milliseconds time (default is one second)

(define (calibrate (ms 1000))
    (set 'primes '())
    (dolist (sm primitives)
        (set 'func (eval (sym (append "test-" (string sm)))) )
        (set 'N 0)
        (set 'start-time (time-of-day))
        (while (< (- (time-of-day) start-time) ms)
            (dotimes (n 100) (apply func))
            (inc N 1))
        (push (list sm N) primes -1)
        (println sm " -> " N)
    )
    (save "primes.lsp" 'primes)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; test-functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (test-$) (= ($ 0) $0))

(define (test-!= )
  (and (not (!= -9223372036854775808 (& -9223372036854775808 -1))) (!= "abc" "ABC") 
   (!= "a" "¿") 
   (!= 1.000000001 1) 
   (!= "¿" "a")))

(define (test-% )
  (and
    (= (% 10 3) 1)
    (= (% 5) 5))
    (= (% 4.3 2) 0)
    (= (% 4.3 2.2) 0)
    (= (% 3.9 2) 1)
)

(define (test-& )
  (= -9223372036854775808 (& -9223372036854775808 -1)))

(define (test-* )
  (= (* (* 123456789 123456789)) 15241578750190521))

(define (test-+ )
  (= (+ 999999999999999999 1) 1000000000000000000)
  (= (+ 9223372036854775807 -9223372036854775808) -1)
  (= (+ -9223372036854775808 -1) 9223372036854775807)) ; wraps around

(define (test-- )
  (= (- 100000000 1) 99999999))

(define (test-/ )
  (= (/ 15241578750190521 123456789) 123456789)
  (= (/ -10 5) -2))

(define (test-< )
  (and 
   (< -9223372036854775808 9223372036854775807)
   (< "abcdefg" "abcdefgh")
   (< 1 1.000000001) 
   (< 1 "a") 
   (< "a" 'a)
   (< '(a b) '(b c) '(c d))
   (not (< '(a b) '(b d) '(b c)))
   (< '(((a b))) '(((b c))))
   (< '(a (b c)) '(a (b d)) '(a (b (d))))
   (< -1)
   (< -1.23)
   (not (< "1"))
   (not (< '()))
))

(define (test-<< )
  (= (<< 1 63) -9223372036854775808))

(define (test-<= )
  (and (<= -9223372036854775808 -9223372036854775808) (<= 1 1.00000001)))

(define (test-= )
  (and 
    (= 1.23456789 1.23456789) 
    (= 123456789 123456789) 
    (= '(1 2 3 (4 5) (a b ("CDEFG" "HIJK") 'u 'v 'w)) 
    '(1 2 3 (4 5) (a b ("CDEFG" "HIJK") 'u 'v 'w))) 
    (= "¿¿¿¿¿¿¿¿¿¿¿" "¿¿¿¿¿¿¿¿¿¿¿")
    (= '())
    (= 0)
    (= "")
    (not (= 1))
    (not (= "abc"))
    (not (= '(1 2 3)))
))

(define (test-> )
  (and (> 9223372036854775807 -9223372036854775808) (> "abcdefgh" "abcdefg") (> 1.000000001 
    1) 
   (> "a" 1) 
   (> "z" "aaaaa")
   (> "aaa" "a")
   (> 'a "a") 
   (> '(a) 'a)
   (> 1)
   (> 1.23)
   (> "abc")
   (> '(1 2 3))
   (not (> ""))
   (not (> '()))   
))

(define (test->= )
  (and (>= 1 0) (>= 1.00000001 1)))

(define (test->> )
  (= (>> 1073741824 30) 1))

(define (test-NaN? )
  (and (NaN? (sqrt -1))
       (set 'NaN (sqrt -1)) 
       (= 1 (+ 1 NaN)) 
       (= 0 (* 2 NaN)) 
       (NaN? (add 1 (sqrt -1))) 
       (NaN? (abs (sqrt -1)))
       (NaN? (div 0 0))
))

(define (test-^ )
  (= (^ 1431655765 -1431655766) -1))

(define (test-abs )
  (and (= (abs -1) 1) (= (abs -9.9) 9.9)))

(define (test-acos )
  (= 0 (acos (cos (acos (cos 0))))))

(define (test-acosh)
    (= (cosh (acosh 1)) 1))

(define (test-add , l)
  (dotimes (x 100) 
   (push x l))
  (= 4950 (apply add l)))

(define (test-address s)
  (and
    (set 's "foo")
    (= (address s) (last (dump s)))
    (set 'D:D "foo")
    (= (address D) (last (dump D:D)))
))

(define (test-amb)
    (set 'x (amb 1 2))
    (or (= x 1) (= x 2)))

(define (test-and )
  (and (and true true true) (not (and true true nil))))

(define (test-append )
  (and
    (= '(1 2 3 4) (append '(1 2) '(3 4)))
    (= '(1 2 3 4 5) (append '(1 2) '(3) '(4 5)))
    (= '(1 2 3 4) (append '(1 2) '(3 4) '()))
    (= '(1 2 3 4 5) (append '(1 2) '(3 4) '() '(5)))
    (= '(1 2 3 4 5) (append '() '(1 2) '(3 4) '() '(5)))
    (= '() (append '()) (append '() '()) (append))
    (= "abcdefg" (append "" "a" "bcd" "" "ef" "g" ""))
    (= "" (append ""))
    (set 'A (array 3 2 (sequence 1 6)))
    (set 'B (array 2 2 (sequence 7 10)))
    (= (array 5 2 (sequence 1 10)) (append A B))
    (lambda? (append '(lambda)))
    ; default functor
    (set 'D:D '(a b c))
    (= '(a b c a b c a b c) (append D D D))
))


(define (test-apply )
  (and (= (apply + '(1 2)) 3) 
       (= (apply append '("a" "b" "c")) "abc")
       (= (apply (fn (x y) (+ x y)) '(3 4)) 7)
       (= (apply list '(a b c d e f) 2) '(((((a b) c) d) e) f))
))


(define-macro (do-args p)
  (= (args) '(2 "3 4" 5 (x y)))
  (= (args 3 -1) 'y))   

(define (test-args )
  (do-args 1 2 "3 4" 5 (x y)))

(define (test-array) 
  (and
    (= (array-list (array 3 2 (sequence 1 6))) '((1 2) (3 4) (5 6)))
    (set 'A (array 3 2 (sequence 1 6)))
    (= (array-list (nth 0 A)) '(1 2))
    (= (nth '(0 0) A) 1)
    (= (nth '(2 1) A) 6)
    (= (nth '(-1 -1) A) 6)
    (= (nth 0 A) (array 2 '(1 2)))
    (= (array-list (nth 0 A)) '(1 2))
    (< (nth 0 A) (nth 1 A))
    (> (nth 2 A) (nth 1 A))
    (setf (A 1 0) 1)
    (= (nth '(1 0) A) 1)
    (setf (A 1 1) 1)
    (= (array-list A) '((1 2) (1 1) (5 6)))
    (< (nth 1 A) (nth 0 A))
))


(define (test-array-list)
    (and 
        (set 'a (array 3 4 (sequence 1 12)))
        (array? a) 
        (list? (array-list a))
        ; default functor
        (set 'D:D (array 3 4 (sequence 1 12)))
        (array? D:D)
        (list? (array-list D))
        (= (array-list D) '((1 2 3 4) (5 6 7 8) (9 10 11 12)))
))

(define (test-array?) (test-array-list))

(define (test-asin )
  (= (round (asin (sin (asin (sin 1)))) -9) 1))

(define (test-asinh)
  (= (round (sinh (asinh 1)) -12) 1))

(define (test-assoc)
 (and
    (set 'L '((a 1) (b (c (d 2) (e 3) (e 4))) ("a" 5) ((a) 6))) 
    (= (assoc 'a L) '(a 1)) 
    (= (assoc 'b L) '(b (c (d 2) (e 3) (e 4))))
    (= (assoc "a" L) '("a" 5))
    (= (assoc '((a)) L) '((a) 6))

    (= (assoc '(b c) L) '(c (d 2) (e 3) (e 4)))
    (= (assoc '(b c d) L) '(d 2))
    (= (assoc '(b c e) L) '(e 3))
    ; default functor
    (set 'D:D '((a 1) (b (c (d 2) (e 3) (e 4))) ("a" 5) ((a) 6)))   
    (= (assoc 'a D) '(a 1))
))


(define (test-atan )
    (< (sub 1 (atan (tan (atan (tan 1))))) 1e-15))

(define (test-atanh)
    (< (sub (tanh (atanh 0.5)) 0.5) 0.0000000001))

(define (test-atan2 )
  (= (div (acos 0) (atan 1 1)) 2))

(define (test-atom? )
  (and (atom? 1) (atom? 1.23) (atom? "hello") (atom? 'x) (atom? nil) (atom? true)))

(define (test-base64-enc)
  (and
    (= "" (base64-dec (base64-enc "")))
    (= "1" (base64-dec (base64-enc "1")))
    (= "12" (base64-dec (base64-enc "12")))
    (= "123" (base64-dec (base64-enc "123")))
    (= "1234" (base64-dec (base64-enc "1234")))
))

(define (test-base64-dec)
  (test-base64-enc))

;; context Lex was previously created

(define (test-bayes-train)
  (and
    (test-bayes-query)
    (= (bayes-train '(F F F B B) '(F B B B B) 'Lex) '(5 5))
    (> 0.001 (apply add (map sub (bayes-query '(F) Lex) '(0.75 0.25))))
    (> 0.001 (apply add (map sub (bayes-query '(F) Lex true) '(0.75 0.25))))
    (> 0.001 (apply add (map sub (bayes-query '(F F) Lex) '(0.8251777681 0.1748222319))))
    (> 0.001 (apply add (map sub (bayes-query '(F F) Lex true) '(0.9 0.1))))
  )
)

(define (test-bayes-query) 
    (set 'Lex:F '(0 0))
    (set 'Lex:B '(0 0))
    (set 'Lex:total '(0 0))
    true)

(define (test-begin )
  (begin 
   (set 'x 0) 
   (inc x) 
   (inc x) 
   (= x 2)))

(define (test-beta )
  (< (abs (sub (beta 1 2) 0.5)) 1e-05))

(define (test-betai )
  (< (abs (sub (betai 0.5 5 10) 0.910217)) 1e-05))

(define (test-bind)
    (bind '((a 1) (b "hello") (c (3 4))))
    (and
        (= a 1)
        (= b "hello")
        (= c '(3 4))
        (= 7 (bind '((a (+ 3 4))) true))
    )
)

(define (test-binomial )
  (< (sub (binomial 2 1 0.5) 0.5) 1e-09))

(define (test-bits)
  (and
    (= (int (bits 0x7fffffffffffffff) 0 2) 0x7fffffffffffffff)
    (= (int (bits 0x8000000000000000) 0 2) 0x8000000000000000)
    (= 64 (length (bits 0x8000000000000000)))
    (= (bits 0) "0")
    (= (bits 1234) "10011010010")
    (= (bits 1234 true) '(nil true nil nil true nil true true nil nil true))
))

(define (check-case x)
  (case x 
   (1 "one") 
   (2 "two") 
   (3 "three")))

(define (test-case )
  (and (= (check-case 1) "one") (= (check-case 2) "two") (= (check-case 
     9) nil)))

(define (test-catch)
    (and (not (catch (invalid-func) 'result))
         (starts-with result "ERR: invalid function in function catch")
))

(define (test-ceil )
  (= 2 (ceil 1.5)))

(define (test-change-dir )
  (make-dir "adir")
  (change-dir "adir")
  (change-dir "..")
  (remove-dir "adir"))

(define (test-char )
  (and 
    (= (format "%c" (char "a" 0)) "a") 
    (= (char "A") 65) (= (char 65) "A")
    (= (map char (sequence 65 67)) '("A" "B" "C"))
    (= (char 0) "\000")
    (set 'D:D "ABCDEFG")
    (= (char D 0) 65)
    (= (char D -1) 71)
))

(define (test-chop )
  (and 
    (= (chop "newlisp") "newlis")
    (= (chop "newlisp" 4) "new")
    (= (chop "abc" 5) "")
    (= (chop "abc" -5) "")
    (= (chop '(a b (c d) e)) '(a b (c d)))
    (= (chop '(a b (c d) e) 2) '(a b))
    (set 'D:D "newlisp")
    (= (chop D) "newlis")
    (= (chop D 4) "new")
))

(define (test-clean ) 
  (and
    (= (clean integer? '(1 1.1 2 2.2 3 3.3)) '(1.1 2.2 3.3))
    (= (clean true? '(a nil b nil c nil)) '(nil nil nil))))

(define (test-collect)
    (= (let (x 0) (collect (if (<= (inc x) 5) x))) '(1 2 3 4 5))
)

(define (test-crc32)
    (= (crc32 "abcdefghijklmnopqrstuvwxyz") 1277644989))

(define (test-select-collect )
  (and
    (set 'l '(0 1 2 3 4 5 6 7 8 9))
    (= (select l '()) '())
    (= (select l 0 9 9 0 1 8 8 1) '(0 9 9 0 1 8 8 1)) 
    (= (select "2001-09-20" 5 6 8 9 0 1 2 3) "09202001") 
    (set 'a 0 'b 1 'c 2)
    (= (select '(w x y z) a b c) '(w x y))
    (= (select '(w x y z) (inc a) (inc b) (inc c)) '(x y z))
))

(define (check-cond x)
  (cond 
   ((= x 1) 1) 
   ((= x 2) 2) 
   ((= x 3) 3)))

(define (test-cond )
  (and 
      (= (check-cond 1) 1)
      (= (check-cond 2) 2)
      (not (check-cond 99)) 
      (= (cond ((+ 3 4))) 7)
      (= (cond (nil 1) ('())) '())
      (= (cond (nil 1) (nil)) nil)
      (= (cond (nil 1) (true nil)) nil)
      (= (cond ('())) '())
      (= (cond (nil 1) ('() 2)) '())
))

(define (test-cons )
  (= (myappend '(1 2 3) '(4 5 6)) '(1 2 3 4 5 6))
)

(define (test-constant )
  (constant 'cs 123)
  (= cs 123)
  (protected? 'cs))


(define (test-context )
  (and (context 'TEST) (context 'QA)))

(define (test-context? )
  (and (context? MAIN) (context? QA)))

(define (test-copy)
 (and
    (set 'aList '(a b c))
    (= (replace 'b (copy aList)) '(a c))
    (= aList '(a b c))
))

(define (test-cos )
  (= 1 (cos (acos (cos (acos 1))))))

(define (test-cosh)
    (= (cosh 1) (div (add (exp 1) (exp -1)) 2)))

(define (test-count )
  (and (= (count '(1 2) '(2 1 2 1)) '(2 2)) 
       (= (count '(a b) '(a a b c a b b)) '(3 3))
       (= (count '(a b c) '()) '(0 0 0))
       (set 'L '(a b c d e f))
       (= (count L L) '(1 1 1 1 1 1))
  )
)

(define (test-cpymem)  
  (set 'from "12345")
  (set 'to "     ")
  (cpymem (address from) (address to) 5)
  (= from to))

(define (test-crit-chi2)
  (and
    (< (abs (sub (crit-chi2 (prob-chi2 4.605 2) 2) 4.605)) 0.001)
    (< (abs (sub (crit-chi2 (prob-chi2 51.805 40) 40) 51.805)) 0.001)
    (< (abs (sub (crit-chi2 (prob-chi2 9.210 2) 2) 9.210)) 0.001)
    (< (abs (sub (crit-chi2 (prob-chi2 63.691 40) 40) 63.691)) 0.001)
))

(define (test-crit-z )
  (< (abs (sub (crit-z 0.999) 3.090232)) 1e-05))

(define (test-curry)
  (and
    (= (set 'f (curry + 10)) (lambda ($x) (+ 10 $x)))
    (= (filter (curry match '(a *)) '((a 10) (b 5) (a 3) (c 8) (a 9)))
       '((a 10) (a 3) (a 9)))
    (= (clean (curry match '(a *)) '((a 10) (b 5) (a 3) (c 8) (a 9)))
       '((b 5) (c 8)))
    (= (map (curry list 'x) (sequence 1 5))
       '((x 1) (x 2) (x 3) (x 4) (x 5)))
))

(define (test-date )
  (= (date) (date (date-value)) (date (apply date-value (now)))))

(define (test-date-value )
  (= 0 (date-value 1970 1 1 0 0 0)))

(define (test-dec , x)
    (test-inc))

(define (test-define , foo)
  (and 
    (lambda? (define (foo (x 1) (y 2)) (list x y)))
    (= (foo) '(1 2))
    (= (foo 3) '(3 2))
    (= (foo 3 4) '(3 4))
    (define (foo (x 10) (y (div x 2))) (list x y))
    (= (foo) '(10 5))
    (= (foo 20) '(20 10))
    (= (foo 3 4) '(3 4))
))

(define (test-def-new)
  (and
    (set 'fooctx:x 123)
    (new fooctx)
    (= fooctx:x 123)
    (set 'barctx:bar 999)
    (def-new 'barctx:bar)
    (= bar 999)
    (def-new 'barctx:bar 'foobar)
    (= foobar 999)
    (def-new 'barctx:bar 'foofoo:foo)
    (= foofoo:foo 999)
))


(define (test-define-macro , foo)
  (and 
    (macro? (define-macro (foo (x 1) (y 2)) (list x y)))
    (= (foo) '(1 2))
    (= (foo 3) '(3 2))
    (= (foo 3 4) '(3 4))
    (define-macro (foo (x 10) (y (div x 2))) (list x y))
    (= (foo) '(10 5))
    (= (foo 20) '(20 10))
    (= (foo 3 4) '(3 4))
))

(define (test-default)
    (MAIN:test-default-functor))

(define (test-delete )
  (delete (sym "xxx")))

(define (test-delete-url )
  (= "ERR: bad formed URL" (delete-url "")))

(define (test-det) 
  (set 'A '((-1 1 1) (1 4 -5) (1 -2 0)))
  (<  (sub (det A) -1) 2e-10))

(define (test-difference )
  (and
    (= (difference '(2 5 6 0 3 0 2 5) '(1 2 3 3 2 1)) '(5 6 0))
    (= (difference '(1 5 2 3 2 2 4 5 3 4 5 1) '(3 4) true) '(1 5 2 2 2 5 5 1))
    (= (difference '(nil nil nil) '()) '(nil))
    (= (difference '(nil nil nil) '() true) '(nil nil nil))
    (set 'L '(a b c d e f))
    (= (difference L L) '())
  )
)

(define (test-div )
  (and (= 0.1 (div 100000000 1000000000)) 
       (= (div 1 3) 0.3333333333333333)
       (= (div 3) 0.3333333333333333)
))

(define (testdoargs)
    (local (lst)
        (doargs (i) (push i lst))
        lst))

(define (test-doargs)
    (= (testdoargs 3 2 1) '(1 2 3)))

(define (test-dolist , rList)
  (and 
   (dolist (x '(1 2 3 4 5 6 7 8 9)) 
    (push x rList)) 
   (= rList '(9 8 7 6 5 4 3 2 1)) 
   (dolist (x rList) 
    (pop rList))
    (dolist (x '(1 2 3 4 5 6 7 8 9) (> x 5))
      (push x rList))
   (= rList '(5 4 3 2 1))
   (= (local (l) (dolist (e '(1 2 3)) (push $idx l)) l) '(2 1 0))
   (= (dolist (x '(a b c d e f g)) x) 'g)
   ;; default functor
   (set 'D:D (sequence 1 10))
   (set 'cnt 0)
   (dolist (i D) (inc cnt i))
   (= cnt (apply add D))
))

(define (test-dostring)
    (local (r) 
        (dostring (i "newlisp" (= i 108)) (push  i r)) 
        (= r '(119 101 110))
        (= (dostring (c "newlisp") c) 112)
    )
)

(define (test-dotimes , aList)
  (dotimes (x 2) 
   (dotimes (y 2) 
    (dotimes (z 2) 
     (push z aList))))
  (and
     (= '(1 0 1 0 1 0 1 0) aList)
     (not (dotimes (x 0) x))
     (= (dotimes (x 1) x) 0)

     ; dotimes returns nil when ever executed since 8.9.7
     (not (= (dotimes (x -1) x) 0))
     (not (= (dotimes (x -1.8) x) 0))

     (= (dotimes (x 1.8) x) 0)
     (set 'cnt 0)
     (dotimes (x 10 (> x 5)) (inc cnt))
     (= cnt 6)

))
     
(define (test-dotree )
  (set 'aList '())
  (and
    (= (last (symbols MAIN)) (dotree (p MAIN) p))
    (dotree (x 'MAIN) 
        (push x aList))
    (= (length (symbols 'MAIN)) (length aList))
))

(define (test-dump )
  ( = "hello" (get-string (last (dump "hello")))))

(define (test-dump-symbol )
  (= (length (dump nil) 4)))

(define (test-dup)
  (and
    (= (dup "" 0) "")
    (= (dup "" 10) "")
    (= (dup "A" 10) "AAAAAAAAAA")
    (= (dup "AB" 5) "ABABABABAB")
    (= (dup 'x 5) '(x x x x x))
    (= (dup "l" -1) "")
    (= (dup '(1) -1) '())
    (= (dup 1 0) '())
    (= (dup 1 5) '(1 1 1 1 1))))

(define (test-empty? , aList)
  (set 'aList '(1 2 3 4 5 6 7 8 9 0))
  (while aList 
   (pop aList))
  (and 
    (empty? aList) 
    (empty? "")
    (set 'D:D (sequence 1 10))
    (while D:D (pop D))
    (empty? D)
))

(define (test-encrypt )
  (= (encrypt (encrypt "newlisp" "123") "123") "newlisp"))

(define (test-ends-with )
  (and 
    (ends-with "newlisp" "lisp") 
    (ends-with "newlisp" "LISP" 1) 
    (ends-with "abc.def.ghi" "def|ghi" 1)
    (ends-with "12345" "4|5" 1)
    (ends-with (explode "newlisp") "p")
    (set 'D:D "newlisp")
    (ends-with D "lisp") 
    (ends-with D "LISP" 1) 
))

(define (test-env)
  (and 
    (list? (env))
    (env "key" "value") 
    (= (env "key") "value")
    (env "key" "") ; remove key
    (if (= ostype "Solaris")
        (= (env "key" ""))
        (not (env "key")))
))

(define (test-erf)
   (<  (abs (sub 0.5204998778 (erf 0.5))) 0.000001))

(define (test-estack) (list? (estack)))

(define (test-throw)
    (= "Hello World"
        (catch (begin (+ 1 2 3 4 5) (throw "Hello World"))))
)

(define (test-throw-error)
    (and (not (catch (catch (throw-error "Hello")) 'result))
         (starts-with result "ERR: user error : Hello")
))

(define (test-title-case)
    (= (title-case "heLLo") "HeLLo")
    (= (title-case "heLLo" true) "Hello"))

(define (test-error-event )
  (= 'nil (error-event)))

(define (test-estack) (list? (estack)))

(define (test-eval , x y)
  (set 'x 123)
  (set 'y 'x)
  (set 'z 'y)
  (and (= 123 (eval y)) (= 123 (eval 'x)) (= 123 (eval (eval z)))))

(define (test-eval-string )
  (eval-string "(set 'x 123)")
  (eval-string "(set 'y x)")
  (= 123 (eval-string "y"))
  (set 'Foo:xyz 99999)
  (= 99999 (eval-string "xyz" 'Foo))
)

(define (sub-read-exec ) 
   (write-file "exectest" {(println "hello") (exit)})
   (and
    (set 'result (if (find ostype '("Windows" "OS/2"))
        (exec "newlisp exectest") 
        (exec "./newlisp exectest")))
    (= "hello" (last  result)) 
    (delete-file "exectest")))

(define (sub-write-exec )
  (and 
    (write-file "testexec" {(write-file "exectest" (read-line))})
    (if (find ostype '("Windows" "OS/2"))
     (exec "newlisp testexec" "HELLO") (exec "./newlisp testexec" "HELLO"))
    (= "HELLO" (read-file "exectest"))
    (delete-file "testexec")
    (delete-file "exectest")))


(define (test-exists)
  (and
    (= (exists string? '(2 3 4 6 "hello" 7)) "hello")
    (not (exists string? '(3 4 2 -7 3 0)) )
    (= (exists zero? '(3 4 2 -7 3 0)) 0)
    (= (exists < '(3 4 2 -7 3 0)) -7)
    (= (exists (fn (x) (> x 3)) '(3 4 2 -7 3 0)) 4)
    (not (exists (fn (x) (= x 10)) '(3 4 2 -7 3 0)))
))

(define (test-exp )
  (= 1 (exp (log (exp (log (exp (log 1))))))))

(define (test-expand) 
  (and
    (set 'x 2)
    (= (expand 'x 'x) 2)
    (= (expand '(a x b) 'x) '(a 2 b))
    (= (expand '(x b) 'x) '(2 b))
    (= (expand '(a x) 'x) '(a 2))
    (= (expand '(a (x) b) 'x) '(a (2) b))
    (= (expand '(a ((x)) b) 'x) '(a ((2)) b))
    (set 'a 1 'b 2 'c 3)
    (= (expand '(a b c) 'b 'a 'c ) '(1 2 3))
    ;; prolog mode with uppercase vars
    (set 'X 2)
    (= (expand '(a ((X)) b)) '(a ((2)) b))
    ;; env list as parameter
    (set 'a "a" 'B "B" 'c "c" 'd "d")
    (= (expand '(a (B (c) (d a B))) '((a 1) (B 2) (c 3) (d 4)))
       '(1 (2 (3) (4 1 2))))
    (= a "a") (= B "B") (= c "c") (= d "d")
    ;; default functor
    (set 'Le:Le '(a (B (c) (d a B))) )
    (set 'p '((a 1) (B 2) (c 3) (d 4)))
    (= (expand Le p) '(1 (2 (3) (4 1 2))))
))

(define (test-explode )
    (and    
        (= (explode "kakak" -1) '())
        (= (explode "ABC" 4) '("ABC"))
        (= (explode '(a b c d e f) -1) '())
        (= (explode "new") '("n" "e" "w"))
        (= (explode "newlisp" 3) '("new" "lis" "p"))
        (= (explode "newlisp" 3 true) '("new" "lis"))
        (= (explode "newlisp" 7 true) '("newlisp"))
        (= (explode "newlisp" 8 true) '())
        (= (explode '(a b c d e)) '((a) (b) (c) (d) (e)))
        (= (explode '(a b c d e) 2) '((a b) (c d) (e)))
        (= (explode '(n e w l i s p)) '((n) (e) (w) (l) (i) (s) (p)))
        (= (explode '(n e w l i s p) 3) '((n e w) (l i s) (p)))
        (= (explode '(n e w l i s p) 7 true) '((n e w l i s p)))
        (= (explode '(n e w l i s p) 8 true) '())
        (set 'D:D '(a b c d e f g))
        (= (explode D 2) '((a b) (c d) (e f) (g)))
))

(define (test-factor)
    (= (factor 123456789) '(3 3 3607 3803)))

(define (test-fft )
  (= '((1 2) (3 4)) (ifft (fft '((1 2) (3 4))))))

(define (test-filter )
  (and
    (= (filter integer? '(1 1.1 2 2.2 3 3.3)) '(1 2 3))
    (= (filter true? '(a nil b nil c nil)) '(a b c))
    ; default functor
    (set 'D:D '(2 4 2 7 5 3 8))
    (= (filter (curry < 5) D) '(7 8))
))

(define (test-find )
  (and 
    (= 3 (find '(3 4) '(0 1 2 (3 4) 5 6 7 8)))
    (= nil (find 9 '(1 2 3))) 
    (= 2 (find "W" "newlisp" 1))
    (= $0 "w")
    (= (find "newlisp" '("Perl" "Python" "newLISP") 1) 2)
    ; use a comparison functor
    (= (find '(1 2) '((1 4) 5 6 (1 2) (8 9))) 3)
    (= (find 3 '(8 4 3  7 2 6) >)  4)
    (= (find 5 '((l 3) (k 5) (a 10) (z 22)) (fn (x y) (= x (last y)))) 1)
    (= (find '(a ?) '((l 3) (k 5) (a 10) (z 22)) match) 2)
    (= (find '(X X) '((a b) (c d) (e e) (f g)) unify) 2)
    (define (has-it-as-last x y) (= x (last y)))
    (= (find 22 '((l 3) (k 5) (a 10) (z 22)) has-it-as-last) 3)
    (= (find "newlisp" '("Perl" "Python" "newLISP") (fn (x y) (regex x y 1))) 2)
    ; default functor
    (set 'D:D '(0 1 2 (3 4) 5 6 7 8))
    (= 3 (find '(3 4) D))
    (set 'D:D "newlisp")
    (= 2 (find "W" D 1))
))


(define (test-find-all)
  (and
    (= (find-all {\d+} "asdf2kjh44hgfhgf890") '("2" "44" "890"))
    (= (find-all {(new)(lisp)} "newLISPisNEWLISP" (append $2 $1) 1) '("LISPnew" "LISPNEW"))
    (set 'D:D "asdf2kjh44hgfhgf890")
    (= (find-all {\d+} D) '("2" "44" "890"))
    (set 'D:D "newLISPisNEWLISP")
    (= (find-all {(new)(lisp)} D (append $2 $1) 1) '("LISPnew" "LISPNEW"))
))

(define (test-first )
  (= 1 (first '(1 2 3 4)))
  (= "n" (first "ewLISP"))
  (= (array 2 '(1 2)) (first (array 3 2 (sequence 1 6))))
  ;; default functor
  (set 'D:D '(a b c d e f g))
  (= (first D) 'a)
  (set 'D:D (array 7 '(a b c d e f g)))
  (= (first D) 'a)
)

(define (test-flat )
  (set 'lst '(a (b (c d))))
  (= (map (fn (x) (ref x lst)) (flat lst)) '((0) (1 0) (1 1 0) (1 1 1))))

(define (test-float )
  (float? (float "1.234")))

(define (test-flt)
    (= (flt 1.23) 1067282596))

(define (test-float? )
  (float? 1.234))

(define (test-floor )
  (= 1 (floor 1.5)))

(define (test-for , x lst1 lst2)
  (set 'lst1 '())
  (set 'lst2 '())
  (for (x 10 0 3) 
   (push x lst1))
  (for (x 10 0 3 (< x 7))
   (push x lst2))
  (and
   (= lst1 '(1 4 7 10))
   (= lst2 '(7 10)) )
)

(define (test-for-all)
  (and
    (for-all number? '(2 3 4 6 7)) 
    (not (for-all number? '(2 3 4 6 "hello" 7)) )
    (for-all (fn (x) (= x 10)) '(10 10 10 10 10))
))

(define (test-format )
  (and
   (= (format "%d" 1.23) "1") 
   (= (format "%5.2f" 10) "10.00") 
   (= (format "%c %s %d %g" 65 "hello" 123 1.23) "A hello 123 1.23")
   (= (format "%5.2s" "hello") "   he")
   ; args passed in a list
   (= (format "%d" '(1.23)) "1")  
   (= (format "%5.2f" '(10)) "10.00")  
   (= (format "%c %s %d %g" '(65 "hello" 123 1.23)) "A hello 123 1.23")
   (= (format "%5.2s" '("hello")) "   he")
   (set 'data '((1 "a001" "g") (2 "a101" "c") (3 "c220" "g")))
   (set 'result (map (fn (x) (format "%3.2f %5s %2s" (nth 0 x) (nth 1 x) (nth 2 x))) data))
   (set 'result (map (fn (x) (format "%3.2f %5s %2s" (x 0) (x 1) (x 2))) data))
   (= result '("1.00  a001  g" "2.00  a101  c" "3.00  c220  g"))
   (= (test-format-r '(("foo" "bar") ("foo" "baz"))) 
      "[ [ 'foo', 'bar' ], [ 'foo', 'baz' ] ]")
   ; test 64-bit formatting
   (if (find ostype '("Windows")) ;; Windows
      (begin
        (and
         (= (format "%I64d" 0x7fffffffffffffff) "9223372036854775807")
         (= (format "%I64x" 0x7fffffffffffffff) "7fffffffffffffff")
         (= (format "%I64u" 0x7fffffffffffffff) "9223372036854775807")
         (= (format "%I64d" 0x8000000000000000) "-9223372036854775808")
         (= (format "%I64x" 0x8000000000000000) "8000000000000000")
         (= (format "%I64u" 0x8000000000000000) "9223372036854775808")
         (= (format "%I64d" 0xFFFFFFFFFFFFFFFF) "-1")
         (= (format "%I64x" 0xFFFFFFFFFFFFFFFF) "ffffffffffffffff")
         (= (format "%I64u" 0xFFFFFFFFFFFFFFFF) "18446744073709551615"))
      )
      (begin ;; UNIX like OS 
        (if (= ostype "Tru64Unix") ;TRU64
          (begin
            (and
              (= (format "%d" 0x7fffffff) "2147483647")
              (= (format "%d" 0xffffffff) "-1")
              (= (format "%u" 0xffffffff) "4294967295")
              (= (format "%i" 0x7fffffff) "2147483647")

              ; truncate
              (= (format "%d" 0x7fffffffffffffff) "-1")
              (= (format "%u" 0x7fffffffffffffff) "4294967295")
              (= (format "%x" 0x7fffffffffffffff) "ffffffff") 
              (= (format "%X" 0x7fffffffffffffff) "FFFFFFFF") 

              (= (format "%ld" 0x7fffffffffffffff) "9223372036854775807")
              (= (format "%lu" 0xffffffffffffffff) "18446744073709551615")
              (= (format "%li" 0x7fffffffffffffff) "9223372036854775807")
              (= (format "%lx" 0x7fffffffffffffff) "7fffffffffffffff")
              (= (format "%ld" 0x8000000000000000) "-9223372036854775808")
              (= (format "%lx" 0x8000000000000000) "8000000000000000")
              (= (format "%lu" 0x8000000000000000) "9223372036854775808")
              (= (format "%ld" 0xFFFFFFFFFFFFFFFF) "-1")
              (= (format "%lx" 0xFFFFFFFFFFFFFFFF) "ffffffffffffffff")
              (= (format "%lu" 0xFFFFFFFFFFFFFFFF) "18446744073709551615"))
          )
          (begin
            (and
              (= (format "%d" 0x7fffffff) "2147483647")
              (= (format "%d" 0xffffffff) "-1")
              (= (format "%u" 0xffffffff) "4294967295")

              ; truncate
              (= (format "%d" 0x7fffffffffffffff) "-1")
              (= (format "%u" 0x7fffffffffffffff) "4294967295")
              (= (format "%x" 0x7fffffffffffffff) "ffffffff") 
              (= (format "%X" 0x7fffffffffffffff) "FFFFFFFF") 

              (= (format "%lld" 0x7fffffffffffffff) "9223372036854775807")
              (= (format "%llx" 0x7fffffffffffffff) "7fffffffffffffff")
              (= (format "%llu" 0x7fffffffffffffff) "9223372036854775807")
              (= (format "%lld" 0x8000000000000000) "-9223372036854775808")
              (= (format "%llx" 0x8000000000000000) "8000000000000000")
              (= (format "%llu" 0x8000000000000000) "9223372036854775808")
              (= (format "%lld" 0xFFFFFFFFFFFFFFFF) "-1")
              (= (format "%llx" 0xFFFFFFFFFFFFFFFF) "ffffffffffffffff")
              (= (format "%llu" 0xFFFFFFFFFFFFFFFF) "18446744073709551615"))
          )
      )
))))

(define (test-format-r obj , s) 
  (cond 
   ((string? obj)   (format "'%s'" obj)) 
   ((list? obj) (format "[ %s ]" (join (map test-format-r obj) ", ")))
)) 

(define (test-fv )
  (< (sub (fv 0.1 10 1000 0 0) -15937.4246) 1e-05))

(define (test-gammai )
  (< (abs (sub (gammai 4 5) 0.734974)) 1e-05))

(define (test-gammaln )
  (< (abs (sub 120 (exp (gammaln 6)))) 1e-05))

(define (test-gcd)
 (and
  (= (gcd 0) 0)
  (= (gcd 1) 1)
  (= (gcd 12 36) 12)
  (= (gcd 12 36 6) 6)
  (= (gcd 12 36 6 3) 3)
))

(define (test-get-char )
 (and
  (= 65 (get-char (address "A")) (get-char "ABC"))
  (set 'D:D "ABC")
  (= 65 (get-char D))
))

(define (test-get-float )
  (= 1.234 (get-float (pack "lf" 1.234))))

(define (test-get-int )
  (and
    (= 123456789 (get-int (pack "ld" 123456789)))
    (set 'adr (pack "ldld" 0xaabbccdd 0xccddeeff))
    (= (format "%x" (get-int adr)) "aabbccdd")
    (= (format "%x" (get-int (address adr))) "aabbccdd")
    (= (format "%x" (get-int (+ (address adr) 0))) "aabbccdd")
    (= (format "%x" (get-int (+ (address adr) 4))) "ccddeeff")

    (set 'adr (pack "> ldld" 0xaabbccdd 0xccddeeff))
    (= adr "\170\187\204\221\204\221\238\255")
    (set 'adr (pack "< ldld" 0xaabbccdd 0xccddeeff))
    (= adr "\221\204\187\170\255\238\221\204")
    (set 'buff (pack "lulululululululu" 1 2 3 4))
    (apply and (map (fn (i) (= (+ i 1) (get-int (+ (* i 4) (address buff))))) '(0 1 2 3))) 
))


(define (test-get-long)
    (set 'adr (pack "Ld" -1))
    (= -1 (get-long adr)))

(define (test-get-string )
  (= "hello" (get-string (address "hello"))))

(define (test-global)
    (= global-myvar 123))

(define (test-global?)
    (and
        (global? 'global-myvar)
        (global? 'println)
))

(define (test-if )
  (and 
   (if true true) 
   (if nil nil true) 
   (if 'nil nil true) 
   (if '() nil true)
   (= (if '()) '())
   (= (if nil 1 '() 2) '())
   (= (if nil '() '()) '())
   (= (if true '() '()) '())
   (= (if nil 1 nil 2 nil 3 true 4 3) 4)
   (= (if nil 1 nil 2 nil 3 nil 4 3) 3)
   ))

(define (test-if-not )
  (if-not nil 
   true nil))

(define (test-ifft )
  (= '((1 2) (3 4)) (ifft (fft '((1 2) (3 4))))))

(define (test-inc , x)
  (and
    (= (inc x) 1)
    (= (inc x) 2)
    (set 'l '(1 2 3 4))
    (= (inc (l 1)) 3)
    (= (dec (nth 0 l) 2) -1)
    (= (dec (last l) 0.1) 3.9)
    (= (inc (+ 3 4)) 8)
    (= l '(-1 3 3 3.9))
))

(define (test-index )
  (= '(1 3) (index (lambda (x) (> x 3)) '(1 5 2 6 2 0))))

(define (test-integer )
  (and 
    (integer? (int "12345"))
    (= (int " 12345") 12345)
    (= (int "9223372036854775807")  9223372036854775807)
    (= (int "-9223372036854775808") -9223372036854775808)
    (= (int 0.0) 0)
    (= (int 1e30)  9223372036854775807)
    (= (int -1e30) -9223372036854775808)
    (= (int 0x8000000000000000) (int "0x8000000000000000"))
    (set 'D:D 12345)
    (= (int D) 12345)
))

(define (test-int) (test-integer))

(define (test-integer? )
  (and
    (integer? 12345)
    (integer? 9223372036854775807)
    (integer? -9223372036854775808)
    (integer? 0x7FFFFFFFFFFFFFFF)
    (integer? 0xFFFFFFFFFFFFFFFF)
))

(define (test-intersect )
  (and
    (= (intersect '(3 0 2 4 1) '(1 4 2 5)) '(2 4 1))
    (set 'L '(a b c d e f))
    (= (intersect L L) L)
  )
)

(define (test-invert )
  (set 'A '((-1 1 1) (1 4 -5) (1 -2 0)))
  (set 'I (multiply A (invert A)))
  (set 'J (multiply (array 3 3 (flat A)) (invert (array 3 3 (flat A)))))
  (and (< (sub 1 (nth 0 (nth 0 I))) 1e-06)
       (< (sub 1 (nth 1 (nth 1 I))) 1e-06) 
       (< (sub 1 (nth 2 (nth 2 I))) 1e-06)
       (= I (array-list J)) 
       (not (invert '((0 1 0) (1 0 1) (0 0 0))) )
))

(define (test-irr )
  (< (abs (sub (irr '(-1000 500 400 300 200 100)) 0.20272)) 0.0001))

(define (test-join )
  (and 
    (= "this is a sentence" (join '("this" "is" "a" "sentence") " ")) 
    (= "this_is_a_sentence" (join '("this_" "is_" "a_" "sentence")))
    (= "" (join '()))
    (= (join '("A" "B" "C") "-") "A-B-C")
    (= (join '("A" "B" "C") "-" true) "A-B-C-")
))

(define (test-lambda? )
  (lambda? qa))

(define (test-last )
  (= 'f (last '(a b c d e f)))
  (= "p" (last "newlisp"))
  (= (array 2 '(5 6)) (last (array 3 2 (sequence 1 6))))
  ;; default functor
  (set 'D:D '(a b c d e f g))
  (= (last D) 'g)
  (set 'D:D (array 7 '(a b c d e f g)))
  (= (last D) 'g)
)

(define (test-last-error)
    (= (last-error 1) '(1 "not enough memory"))
)

(define (test-legal?)
  (and
    (legal? "abc")
    (not (legal? "a b c"))
    (set 'greek (pack "cccccccccccccccccc" 206 160 206 181 206 187 206 181 206 185 206
                172 206 180 206 181 207 137))
    (legal? greek)
))


(define (test-length )
  (> (length (symbols)) 100)
  (- 7 (length "newlisp")))

(define (test-let )
  (set 'a 123)
  (set 'b 456)
  (set 'p 111)
  (set 'q 222)
  (and
     (let ((a 1) (b 2)) 
       (= (+ a b) 3))
     (= a 123) 
     (= b 456)
     (let (p 3 q 4)
       (= (+ q p) 7))
     (= p 111)
     (= q 222)
))

(define (test-letex)
  (and
    (= (letex (x '* y 3 z 4) (x y z)) 12)
    (= (letex (x 1 y 2 z 3) (quote (x y z))) '(1 2 3))
    (= (letex (x 1 y 2 z 3) '(x y z)) '(1 2 3))
    (= (letex (x 1 y 2 z 3) '('x (quote y) z)) '('1 (quote 2) 3))
    (= (letex (x 1) 'x) 1)
    (set 'x 123 'y 456)
    (= (letex (x 'y) 'x) 'y)
    (= (letex (x 'y) x) 456)
    (= (letex (x '(+ 3 4)) 'x) '(+ 3 4))
    (= (letex (x '(+ 3 4)) x) 7)
    ))

(define (test-letn)
  (set 'x 0 'y 0 'z 0)
  (and
      (= (letn ((x 1) (y (+ x 1)) (z (+ y 1))) (list x y z)) '(1 2 3))
      (= 0 x y z))
)

(define (test-list )
  (and (list? (list 1 2 3 4 5)) (= '(1) (list 1)) (= '(1 nil) (list 
     1 'nil))))

(define (test-list? )
  (and (list? '(1 2 3 4 5)) (list? '())))

(define (test-local)
    (set 'a 10 'b 20)
    (and 
        (= (local (a b) (set 'a 1 'b 2) (+ a b)) 3)
        (= a 10)
        (= b 20)))

(define (test-set-locale) 
  (list? (set-locale)))

(define (test-log )
  (and
    (= 1 (log (exp 1)))
    (= 1 (log (exp 1) (exp 1)))
  )
)

(define (test-lookup )
  (and 
    (= 3 (lookup 1 '((2 3 4) (1 2 3)))) 
    (= 2 (lookup 1 '((2 3 4) (1 2 3)) 1))
    ; default functor
    (set 'D:D '((a 1 2 3) (b 4 5 6) (c 7 8 9)))
    (= 6 (lookup 'b D -1))
))

(define (test-lower-case )
   (= "abcdefghijklmnopqrstuvwxyz" (lower-case "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))

(define (test-macro? )
  (macro? 
   (define-macro (foo-macro))))

(define (test-main-args )
  (and 
     (list? (main-args))
     (list? $main-args)
     (= $main-args (main-args))
     (= ($main-args 0) ((main-args) 0) (main-args 0))
     (= ($main-args -1) ((main-args) -1))
     (= ($main-args -1) (main-args -1))
))

(define (test-make-dir )
  (and (make-dir "foodir") (remove-dir "foodir")))

(define (test-map )
  (and (= '(11 22 33) (map + '(10 20 30) '(1 2 3))) 
       (= '(2 4 6) (map (lambda (x) (+ x x)) '(1 2 3)))
       (set 'D:D '(1 2 3 4 5))
       (= (map pow D) '(1 4 9 16 25))
))

(define (test-mat)
    (set 'A '((1 2 3) (4 5 6))) 
    (set 'B A)
    (and
        (= (mat + A B) '((2 4 6) (8 10 12)))
        (= (mat - A B) '((0 0 0) (0 0 0)))
        (= (mat * A B) '((1 4 9) (16 25 36)))
        (= (mat / A B) '((1 1 1) (1 1 1)))
        (= (mat + A 2) '((3 4 5) (6 7 8)))
        (= (mat - A 2) '((-1 0 1) (2 3 4)))
        (= (mat * A 2) '((2 4 6) (8 10 12)))
        (= (mat / A 2) '((0.5 1 1.5) (2 2.5 3)))

        (= (mat + A 5) '((6 7 8) (9 10 11)))
        (= (mat - A 2) '((-1 0 1) (2 3 4)))
        (= (mat * A 3) '((3 6 9) (12 15 18)))
        (= (mat / A 10) '((.1 .2 .3) (.4 .5 .6)))

        (set 'op +)
        (= (mat op A B) '((2 4 6) (8 10 12)))
        (set 'op '+)
        (= (mat op A B) '((2 4 6) (8 10 12)))
        ; default functor
        (set 'DA:DA A)
        (set 'DB:DB B)
        (= (mat + DA DB) '((2 4 6) (8 10 12)))
    ))

(define (test-match)
  (and 
    (= (match '(a (b ?) d e *) '(a (b c) d e f g) true)   '(a (b c) d e (f g)) )
    (= (match '(a (b ?) d e *) '(a (b c) d e f g) )  '(c (f g)) )

    (= (match '(a * b x) '(a b c d b x e f b x) true) '(a (b c d b x e f) b x) )
    (= (match '(a * b x) '(a b c d b x e f b x) ) '((b c d b x e f)) )


    (= (match '(? (?) x * ? (? e)) '(a (b) x y c (d e)) true) '(a (b) x (y) c (d e)) )
    (= (match '(? (?) x * ? (? e)) '(a (b) x y c (d e))) '(a b (y) c d) )

    (= (match '(a * b) '(a x b) true) '(a (x) b) )
    (= (match '(a * b) '(a x b)) '((x)) )


    (= (match '(a * b) '(a b) true) '(a () b) )
    (= (match '(a * b) '(a b)) '(()) )

    (= (match '( (? ?) * ) '( (x y) ) true) '((x y) ()) )
    (= (match '( (? ?) * ) '( (x y) )) '(x y ()) )
    (match '(+) '(a))
    (match '(+) '(a b))
    (not (match '(+) '()))
    ; default functors
    (set 'P:P '(a (b ?) d e *) )
    (set 'M:M '(a (b c) d e f g))
    (true? (match P M))
  ))


(define (test-max )
  (and (= 10 (max 3 6 10 8)) (= 1.2 (max 0.7 0.6 1.2))))

(define (test-member )
 (and   
  (= '(3 4) (member 3 '(1 2 3 4)))
  (= (member "LISP" "newLISP") "LISP")
  (= (member "LI" "newLISP") "LISP")
  (= (member "" "newLISP") "newLISP")
  (not (member "xyz" "newLISP"))
  (not (member "new" "this is NEWLISP" 0))
  (= (member "new" "this is NEWLISP" 1) "NEWLISP")
  ; default functor
  (set 'D:D '(1 2 3 4))
  (= '(3 4) (member 3 D))
  (set 'D:D "newLISP")
  (= "LISP" (member "LI" D))
 )  
)

(define (test-min )
  (and (= 3 (min 3 6 10 8)) (= 0.6 (min 0.7 0.6 1.2))))

(define (test-mod )
  (and (< (sub (mod 10.5 3.3) 0.6) 0.0001) (< (sub (mod 10 3) 1) 0.0001)))

(define (test-mul )
  (= 1e-09 (mul 0.0001 1e-05)))

(define (test-multiply )
  (let ((A '((1 2 3) (4 5 6))) (B '((1 2) (1 2) (1 2)))) 
    (and 
       (= '((6 12) (15 30)) (multiply A B))
       (= (array 2 2 (flat '((6 12) (15 30))))
          (multiply (array 2 3 (flat A)) (array 3 2 (flat  B))))
    )
))

(define (test-term )
  (= "term" (term 'term)))

(define (test-new) 
  (new QA 'MAIN:QA2))

(define (test-nil?) 
  (and
    ;test symbol-nil = logic-nil in order compare of count
    (= (count '(nil true) (map (curry < 3) '(1 2 4 5))) '(2 2))
    (= nil (not (nil? nil)))
    (= '(nil true) (map nil? '(a nil)))))

(define (test-null?)
    (= (map null? '(1 0 2 0.0 "hello" "" (a b c) () nil true (lambda) (fn) (lambda ())))
    '(nil true nil true nil true nil true true nil true true nil)))

(define (test-normal )
  (and (float? (normal)) (float? (normal 10 3)) (list? (normal 10 
     3 100))))

(define (test-not )
  (and (not (not (not '()))) (not (not (not (not (not nil))))) (not 
    (not (not (not true)))) 
   (= '(true true true) (map not '(nil nil nil))) 
   (= '(nil nil nil) (map not '(true true true)))))

(define (test-now )
  (= (length (now)) 11))

(define (test-nper )
  (< (sub (nper 0.1 1000 100000 0 0) -25.15885793) 1e-08))

(define (test-npv )
  (< (sub (npv 0.1 '(-10000 3000 4200 6800)) 1188.443412) 1e-06))

(define (test-nth , l)
    (and 
        (set 'l '(0 1 2))
        (= 0 (nth 0 l))
        (= 1 (nth 1 l))
        (= 2 (nth 2 l))
        (= 2 (nth -1 l))
        (= (nth 0 "lisp") "l")
        (= (nth 1 "lisp") "i")
        (= (nth 3 "lisp") "p")
        (= (nth -4 "lisp") "l")
        (= (nth 0 "") "")
        
        (set 'l '(a b (c d) (e f)))
        (= 'a (l 0))
        (= '(c d) (l 2))
        (= 'c (l 2 0))
        (= 'f (l -1 -1))
        (= 'c (l '(2 0)))
        (= 'f (l '(-1 -1)))

        (set 'myarray (array 3 2 (sequence 1 6)))
        (= (array 2 '(3 4)) (myarray 1))
        (= 6 (myarray -1 -1))

        (= (array 2 '(3 4)) (myarray '(1)))
        (= 6 (myarray '(-1 -1)))

        (= "L" ("newLISP" 3))

        (constant 'constL '((1 2 3) (a b c)))
        (set 'aref '(1 2))
        (= (constL 1 2) 'c)
        (= (nth '(1 2) constL) 'c)
        (= (nth (list (- 2 1) (+ 1 1)) constL) 'c)
        (= (nth aref constL) 'c)

        ; default functor
        (set 'D:D '(a b (c d) (e f)))
        (= 'a (D 0))
        (= '(c d) (D 2))
        (= 'c (D 2 0))
        (= 'f (D -1 -1))
        (= 'c (D '(2 0)))
        (= 'f (D '(-1 -1))) 
        (= 'a (nth 0 D))
        (= '(c d) (nth 2 D))
  ))

(define (test-number?)
    (and
        (number? 1)
        (number? 1.23)
        (not (number? 'x))
        (not (number? "abc"))
        (not (number? '(a b c)))
    )
)


(define (test-or )
  (and (or (or (= 1 2) nil nil) (or nil nil nil true)) (not (or nil 
     (= "a" "b") nil))))

(define (test-pack )
 (and
  (= (pack "c c c" 65 66 67) "ABC")
  (= (unpack "c c c" "ABC") '(65 66 67))
  (set 's (pack "c d u" 10 12345 56789))
  (= (unpack "c d u" s) '(10 12345 56789))
  (set 's (pack "s10 f" "result" 1.23))
  (= (first (unpack "s10 f" s)) "result\000\000\000\000")
  (< (- (last (unpack "s10 f" s)) 1.23) 0.00001)
  (set 's (pack "s3 lf" "result" 1.23))
  (= (first (unpack "s3 f" s)) "res")

  (= (pack "ccc" 65 66 67) "ABC")
  (= (unpack "ccc" "ABC") '(65 66 67))
  (set 's (pack "cdu" 10 12345 56789))
  (= (unpack "cdu" s) '(10 12345 56789))
  (set 's (pack "s10f" "result" 1.23))
  (= (first (unpack "s10f" s)) "result\000\000\000\000")
  (< (- (last (unpack "s10f" s)) 1.23) 0.00001)
  (set 's (pack "s3lf" "result" 1.23))
  (= (first (unpack "s3f" s)) "res")

  (= "\001\000" (pack "<d" 1))
  (= "\000\001" (pack ">d" 1))
  (= "\001\000\000\000" (pack "<ld" 1))
  (= "\000\000\000\001" (pack ">ld" 1))
  (= '(12345678) (unpack "ld" (pack "ld" 12345678)))
  (= '(12345678) (unpack "<ld" (pack "<ld" 12345678)))
  (= '(12345678) (unpack ">ld" (pack ">ld" 12345678)))
  (= (unpack "bbbbbbbb" (pack "<lf" 1.234)) '(88 57 180 200 118 190 243 63))
  (= (unpack "bbbbbbbb" (pack ">lf" 1.234)) '(63 243 190 118 200 180 57 88))
  (= (format "%20.2f" (first (unpack "lf" (pack "lf" 1234567890123456)))) " 1234567890123456.00")
))

(define (test-parse )
  (and 
    (= 3 (length (parse "hello hi there"))) 
    (= (parse "abcbdbe" "b") '("a" "c" "d" "e")) 
    (= (parse "," ",") '("" ""))  
    (= (parse "hello regular   expression 1, 2, 3" {,\s*|\s+} 0)
       '("hello" "regular" "expression" "1" "2" "3"))))


(define (test-date-parse)
    (and
        (= (date-parse "2007.1.3" "%Y.%m.%d") 1167782400)
        (= (date-parse "January 10, 07" "%B %d, %y") 1168387200)
))


(define (test-pmt ) 
  (< (sub (pmt 0.1 10 100000 0 0) -16274.53949) 1e-05))

(define (test-pop , r l)
  (set 'r '())
  (set 'l '(1 2 3 4 5 6 7 8 9 0))
  (dotimes (x 10) 
   (push (pop l) r))
  (and (= r '(0 9 8 7 6 5 4 3 2 1))
       (set 'l '(a b (c d (x) e)))
       (= 'x (pop l '(2 2 0)))
       (set 'lst '(1 2 3 (4 5)()))
       (push 'x lst -1 -1)
       (= lst '(1 2 3 (4 5) (x)))
       (push 'y lst -1 0)
       (= lst '(1 2 3 (4 5) (y x)))
       (push 'z lst -1 1)
       (= lst '(1 2 3 (4 5) (y z x)))
       (push 'p lst 4)
       (= lst '(1 2 3 (4 5) p (y z x)))
       (push 'q lst -2)
       (= lst '(1 2 3 (4 5) p q (y z x)))
       (push 'a lst 3 -3)
       (= lst '(1 2 3 (a 4 5) p q (y z x)))
       (= (pop lst 3 -3) 'a)
       (= (pop lst -2) 'q)
       (= (pop lst 4) 'p)
       (= (pop lst -1 1) 'z)
       (= (pop lst -1 0) 'y)
       (= (pop lst -1 -1) 'x)
       (= lst '(1 2 3 (4 5)()))
       ; test pop string
       (set 's "newLISP")
       (= (pop s) "n")
       (= s "ewLISP")
       (= (pop s 2) "L")
       (= s "ewISP")
       (= (pop s -1) "P")
       (= s "ewIS")
       (= (pop s -2 2) "IS")
       (= s "ew")
       (= (pop s -2 10) "ew")
       (= s "")
       (set 's "123456789")
       (= (pop s 5) "6")
       (= (pop s 5 -1) "")
       (= s "12345789")
       (set 's "123456789")
       (= (pop s 5 5) "6789")
       (set 's "x")
       (= (pop s) "x")
       (= s "")
       (= (pop s) "")
       (= (pop s) "")   
       (= s "")
        ; default functor
        (set 'D:D '(a b (c d (x) e)))
        (= 'x (pop D '(2 2 0)))
))

(define (test-pop-assoc)
    (and
        (set 'L '((a (b 1) (c (d 2)))))
        (= (pop-assoc 'a L) '(a (b 1) (c (d 2))))
        (= L '())
        (set 'L '((a (b 1) (c (d 2)))))
        ( = (pop-assoc '(a b) L) '(b 1))
        (= L '((a (c (d 2)))))
        (set 'L '((a (b 1) (c (d 2)))))
        (= (pop-assoc '(a c) L) '(c (d 2)))
        (= L '((a (b 1))))
        (set 'L '((a (b 1) (c (d 2)))))
        (= (pop-assoc (list 'a 'c 'd) L) '(d 2))
        (= L '((a (b 1) (c))))
        (= (pop-assoc '(a c) L) '(c))
        (= L '((a (b 1))))
        (= (pop-assoc '(a b) L) '(b 1))
        (= L '((a)))
        (= (pop-assoc 'a L) '(a))
        (= L '())
        ; default functor
        (set 'D:D '((a (b 1) (c (d 2)))))
        (= (pop-assoc 'a D) '(a (b 1) (c (d 2))))
        (= D:D '())
    )
)

(define (test-post-url )
  (= "ERR: bad formed URL" (post-url "" "abc" "def")))

(define (test-pow )
  (and
    (= 1024 (pow 2 10))
    (= 100 (pow 10))
))

(define (test-pretty-print)
  (= (pretty-print) '(80 " " "%1.16g")))

(define (test-primitive? )
  (primitive? primitive?))

(define (test-prob-chi2 )
  (< (abs (sub (prob-chi2 10 10) 0.440493)) 1e-05))

(define (test-prob-z )
  (< (abs (sub (prob-z 0) 0.5)) 1e-05))

(define (test-protected?)
    (and
        (protected? 'println)
        (constant 'cval 123)
        (protected? 'cval)
        (protected? 'QA))
)

(define (test-push , l)
  (dotimes (x 10) 
   (push x l x))
  (and 
       (= l '(0 1 2 3 4 5 6 7 8 9))
       (set 'l '(a b (c d () e)))
       (push 'x l '(2 2 0))
       (= (ref 'x l) '(2 2 0))
       (set 'lst '(1 2 3 (4 5)()))
       (push 'x lst -1 -1)
       (= lst '(1 2 3 (4 5) (x)))
       (push 'y lst -1 0)
       (= lst '(1 2 3 (4 5) (y x)))
       (push 'z lst -1 1)
       (= lst '(1 2 3 (4 5) (y z x)))
       (push 'p lst 4)
       (= lst '(1 2 3 (4 5) p (y z x)))
       (push 'q lst -2)
       (= lst '(1 2 3 (4 5) p q (y z x)))
       (push 'a lst 3 -3)
       (= lst '(1 2 3 (a 4 5) p q (y z x)))
       (= (pop lst 3 -3) 'a)
       (= (pop lst -2) 'q)
       (= (pop lst 4) 'p)
       (= (pop lst -1 1) 'z)
       (= (pop lst -1 0) 'y)
       (= (pop lst -1 -1) 'x)
       (= lst '(1 2 3 (4 5)()))
       (set 'lst '((1)))
       (push 2 lst -1 -1)
       (= lst '((1 2)))
       (test-push-pop)
       (test-push-optimization-bug)
       ; test string push
       (set 's "newLISP")
       (= (push "#" s) "#newLISP")
       (= (push "#" s 1) "##newLISP")
       (= (push "#" s 3) "##n#ewLISP")
       (= (push "#" s -1) "##n#ewLISP#")
       (= (push "#" s -3) "##n#ewLIS#P#")
       (= (push "xy" s) "xy##n#ewLIS#P#")
       (= (push "xy" s -1) "xy##n#ewLIS#P#xy")
       (= s "xy##n#ewLIS#P#xy")
       (set 's "")
       (= (push "" s) "")
       (set 's "newLISP")
       (= (push "" s -1) "newLISP")
       (= (push "" s) "newLISP")
       (= s "newLISP")
       (push "-" s 7)
       (= s "newLISP-")
       (push "-" s -9)
       (= s "-newLISP-")
       (set 's "newLISP")
       (= (push "-" s 8) "newLISP-")
       (= (push "-" s -10) "-newLISP-")

        ; default functor
        (set 'D:D '(a b (c d () e)))
        (push 'x D '(2 2 0))
        (= (ref 'x D) '(2 2 0))
        (set 'D:D "newLISP")
        (= (push "#" D:D) "#newLISP")
        (= D:D "#newLISP")
        
))

(define (test-push-pop)
    ; string
    (set 's "abcdefg")
    (= (pop (push "h" s -1)) "a")
    (= s "bcdefgh")
)

(define (test-push-optimization-bug) ; fixed in 8.7.1
    (set 'l nil)
    (and (push 'x l -1)
         (set 'lst l)
         (push 'y lst -1)
         (= lst '(x y))))

(define (test-put-url ) 
  (= "ERR: bad formed URL" (put-url "" "abc")))

(define (test-pv )
  (< (sub (pv 0.1 10 1000 100000 0 0) -44696.89605) 1e-05))

(define (test-quote )
  (= (quote x) 'x))

(define (test-quote? )
  (quote? ''quote?))

(define (test-rand , sum)
  (set 'sum 0)
  (dotimes (x 1000) 
   (inc sum (rand 2)))
  (and (< sum 600) (> sum 400) (list? (rand 10 100))))

(define (test-random )
  (and (float? (random)) (= (length (random 0 1 10)) 10)))

(define (test-randomize)
  (and
    (!= '(a b c d e f g) (randomize '(a b c d e f g)))
    (= (difference '(a b c d e f g) (randomize '(a b c d e f g))) '())
  )
)

(define (test-read-expr , clist) true
    (set 'code "; a statement\n(define (double x) (+ x x))\n")
    (= (read-expr code (context)) '(define (double x) (+ x x)))
)

(define (test-ref)
  (and
    (set 'pList '(a b (c d () e)))
    (push 'x pList 2 2 0)
    (= (ref 'x pList) '(2 2 0))
    (= (ref '(x) pList) '(2 2))
    (set 'v (ref '(x) pList))
    (= (pList v) '(x))
    ;(= (ref 'foo pList) '()) changed in 10.2.18
    (= (ref 'foo pList) nil)
    ; comparison functor
    (= (ref 'e '(a b (c d (e) f)) =) '(2 2 0))
    (= (ref 'e '(a b (c d (e) f)) >) '(0))
    (= (ref 'e '(a b (c d (e) f)) <) '(2))
    (= (ref 'e '(a b (c d (e) f)) (fn (x y) (or (= x y) (= y 'd)))) '(2 1))
    (define (is-it-or-d x y) (or (= x y) (= y 'd)))
    (= (ref 'e '(a b (c d (e) f)) is-it-or-d) '(2 1))
    ; comparison with match and unify
    (= (ref '(a ?) '((l 3) (a 12) (k 5) (a 10) (z 22)) match) '(1))
    (= (ref '(X X) '( ((a b) (c d)) ((e e) (f g)) ) unify) '(1 0))
    (= (ref '(X g) '( ((a b) (c d)) ((e e) (f g)) ) unify) '(1 1))
    ; default functor
    (set 'D:D '((l 3) (a 12) (k 5) (a 10) (z 22)) )
    (= (ref '(a ?) D match) '(1))
))

(define (test-ref-all) 
  (and
    (set 'L '(a b c (d a f (a h a)) (k a (m n a) (x))))
    (= (ref-all 'a L) '((0) (3 1) (3 3 0) (3 3 2) (4 1) (4 2 2)))
    (= (L '(3 1)) 'a)
    (= (map 'L (ref-all 'a L)) '(a a a a a a))
    ; with comparison functor
    (= (ref-all 'a '(1 2 3 4 5 6)) '())
    (set 'L '(a b c (d f (h l a)) (k a (m n) (x))))
    (= (ref-all 'c L =) '((2)))
    (= (ref-all 'c L >) '((0) (1) (3 2 2) (4 1)))
    (= (ref-all 'a L (fn (x y) (or (= x y) (= y 'k)))) ' ((0) (3 2 2) (4 0) (4 1)))
    (define (is-long? x y) (> (length y) 2))
    (= (ref-all nil L is-long?) '((3) (3 2) (4)))
    (define (is-it-or-d x y) (or (= x y) (= y 'd)))
    (= (ref-all 'e '(a b (c d (e) f)) is-it-or-d) '((2 1) (2 2 0)))
    (= (ref-all 'b '(a b (c d (e) f)) is-it-or-d) '((1) (2 1)))
    (= (ref-all nil '(((()))) (fn (x y) (> (length y) 0))) '((0) (0 0)))
    ; test comparison with match and unify
    (= (ref-all '(a ?) '((l 3) (a 12) (k 5) (a 10) (z 22)) match) '((1) (3)))
    (= (ref-all '(X X) '( ((a b) (c d)) ((e e) (f g)) ((z) (z))) unify) '((1 0) (2)))
    (= (ref-all '(X g) '( ((x y z) g) ((a b) (c d)) ((e e) (f g))) unify) '((0) (2 1)))
))


(define (test-regex )
  (and
   (= (regex "http://(.*):(.*)" "http://nuevatec.com:80")
      '("http://nuevatec.com:80" 0 22 "nuevatec.com" 7 12 "80" 20 2))
   (= $0 "http://nuevatec.com:80")
   (= $1 "nuevatec.com")
   (= $2 "80")
   (= (regex "b+" "AAAABBBAAAA" 1) '("BBB" 4 3))))

(define (test-regex-comp)
    (and
        (set 'pattern (regex-comp "http://(.*):(.*)"))
        (find pattern "http://nuevatec.com:80" 0x10000)
        (= $0 "http://nuevatec.com:80")
        (= $1 "nuevatec.com")
        (= $2 "80")
    ))
 
 
(define (replace-once str)
  (= (replace "a" str (upper-case $it) 0x8000) "Aaa") ;; custom option replace once
)

(define (test-replace)
    (and
        (set 'str "ababab")
        (= (replace "a" str "b") "bbbbbb")
        (set 'lst '(a a b a b a a a b a))
        (= (replace 'a lst 'b) '(b b b b b b b b b b))
        (set 'lst '(a))
        (= (replace 'a lst) '())
        (set 'str "abc")
        (= (replace "" str "x" 0) "xaxbxcx")
        (set 'str "abc")
        (= (replace "$" str "x" 0) "abcx")
        (set 'str "abc")
        (= (replace "^" str "x" 0) "xabc")
        (set 'str "abc")
        (= (replace "\\b" str "x" 0) "xabcx")
        (set 'str "1234567")
        (= (replace "(?<=[0-9])(?=(?:[0-9]{3})+(?![0-9]))" str "," 0) "1,234,567")
        (set 'str "ababab")
        (= (replace "a" str (upper-case $it) 0) "AbAbAb")
        (= $count 3)
        (set 'L '(1 4 22 5 6 89 2 3 24))
        (= (replace 10 L 10 <) '(1 4 10 5 6 10 2 3 10))
        (set 'L '(1 4 22 5 6 89 2 3 24))
        (= (replace 10 L 10 (fn (x y) (< x y))) '(1 4 10 5 6 10 2 3 10))
        (set 'AL '((john 5 6 4) (mary 3 4 7) (bob 4 2 7 9) (jane 3)))
        (= (replace '(mary *)  AL (list 'mary (apply + (rest $it))) match)
           '((john 5 6 4) (mary 14) (bob 4 2 7 9) (jane 3)))
        (set 'AL '((john 5 6 4) (mary 3 4 7) (bob 4 2 7 9) (jane 3)))
        (= (replace '(*) AL (list ($it 0) (apply + (rest $it))) match)
        '((john 15) (mary 14) (bob 22) (jane 3)))
        (set 'AL '((john 5 6 4) ("mary" 3 4 7) (bob 4 2 7 9) ("jane" 3)))
        (= (replace nil AL (cons (sym ($it 0)) (rest $it)) (fn (x y) (string? (y 0))))
        '((john 5 6 4) (mary 3 4 7) (bob 4 2 7 9) (jane 3)))
        ; default functor
        (set 'D:D '(a a b a b a a a b a) )
        (= (replace 'a D 'b) '(b b b b b b b b b b))
        (set 'D:D "abc")
        (= (replace "" D "x" 0) "xaxbxcx")
        ; regression for key cell part of list
        (setq a '(b c d))
        (= (replace (a 0) a (term (a 0))) '("b" c d))
        (replace-once "aaa")
))

(define (test-reset )
  true)

(define (test-rest , l)
  (set 'l '(a b c d e f g))
  (and  (= (cons (first l) (rest l)) l)
    (= (rest "newlisp") "ewlisp")
    ;; implicit nrest
    (= (1 l) '(b c d e f g))
    (= (10 l) '())
    (= (0 l) l)
    (= (-3 '(a b c d e f g)) '(e f g))
        (= (-3 "abcdefg") "efg")
    (= (1 '(A)) '())
    (= (1 "A") "")
    (= (array 2 2 (sequence 3 6)) (rest (array 3 2 (sequence 1 6))))
    ;; default functor
    (set 'D:D '(a b c d e f g))
    (= (rest D) '(b c d e f g))
    (set 'D:D (array 7 '(a b c d e f g)))
    (= (rest D) (array 6 '(b c d e f g)))   
))

(define (test-reverse )
  (and
    (= (reverse '(1 2 3)) '(3 2 1))
    (= (reverse "newLISP") "PSILwen")
    (set 'D:D '(1 2 3))
    (= (reverse D) '(3 2 1))
    (set 'D:D "newLISP")
    (= (reverse D) "PSILwen")
))

(define (test-rotate )
  (and
    (= '(8 9 0 1 2 3 4 5 6 7) (rotate '(0 1 2 3 4 5 6 7 8 9) 2))
    (= '() (rotate '()))
    (= (rotate '(1) -1) '(1))
    (= (rotate "") "")
    (= (rotate "x" -1) "x")
    (set 'str "abcdefg")
    (= (rotate str) "gabcdef")
    (= (rotate str 3) "defgabc")
    (= (rotate str -4) "abcdefg")
    (set 'D:D '(0 1 2 3 4 5 6 7 8 9))
    (= '(8 9 0 1 2 3 4 5 6 7) (rotate D 2))
))

(define (test-round)
    (and
        (= (round 1.25)  (round 1.25 0) 1)
        (= (round 3.89) (round 3.89 0) 4)
        (= (round 123.49 2) 100)
        (= (round 123.49 1) 120)
        (= (round 123.49 0) 123)
        (= (round 123.49 -1) 123.5)
        (= (round 123.49 -2) 123.49)
        (= (round 123.49 -3) 123.49)
        (= (round 123.49 3)  0)
        (= (round 0.05 -1) 0.1)
        (= (round 0.5) 1)
        (= (round 5 1) 10)
))

(define (test-seed )
  (seed 123)
  (set 'a (rand 10))
  (seed 123)
  (set 'b (rand 10))
  (= a b))

(define (test-select )
  (set 'l '(0 1 2 3 4 5 6 7 8 9))
  (and
    (test-select-collect)
    (= (select l '(0 9 9 0 1 8 8 1)) '(0 9 9 0 1 8 8 1))
    (= (select "2001-09-20" '(5 6 8 9 0 1 2 3)) "09202001")
    ; default functor
    (set 'D:D '(0 1 2 3 4 5 6 7 8 9))
    (= (select D '(0 9 9 0 1 8 8 1)) '(0 9 9 0 1 8 8 1))
))

(define (test-sequence )
  (= (sequence 1 10 3) '(1 4 7 10)))

(define (test-series )
  (and
    (= (series 2 2 5) '(2 4 8 16 32))
    (= (series 2 2 0) '())
    (= (series 1 2 -10) '())
    (= (series 1 1 5) '(1 1 1 1 1))
))

(define (test-set , x y z)
  (set 'x (set 'y (set 'z 123)))
  (= x 123))

(define (test-setf)
 (and
    (setf l '(a b c d e f g))
    (setf (nth 3 l) 999)
    (= l '(a b c 999 e f g))
    (set 's "abcdefg")
    (setf (s 3) (upper-case $it))
    (= s "abcDefg")
    (set 's "a-b-c-d-e-f-g")
    (setf (first (replace "-" s "")) (upper-case $it))
    (= s "Abcdefg")    
))


(define (test-setq , x y z)
  (setq x 1 y 2 z 3)
  (and (= x 1) (= y 2) (= z 3)))


(define (test-set-ref)
    (and
        (set 'L '(z a b (z) (d (c c (c)) e f c))) 
        (= (set-ref 'c L 'z) '(z a b (z) (d (z c (c)) e f c)))
        (set 'L '((a 1) (b 2) (a 3) (b 4))) 
        (= (set-ref '(a *) L '(z 99) match) '((z 99) (b 2) (a 3) (b 4)))
        (= (set-ref '(a *) L '(z 99) match) '((z 99) (b 2) (z 99) (b 4)))
        (set 'Ct:Ct '(a b c d e f g))
        (= (set-ref  'c Ct 'z) '(a b z d e f g))
        ; default functor
        (set 'D:D '(z a b (z) (d (c c (c)) e f c))) 
        (= (set-ref 'c D 'z) '(z a b (z) (d (z c (c)) e f c)))
    )
)


(define (test-set-ref-all)
    (and
        (set 'L '(z a b (c) (d (c c (c)) e f c))) 
        (= (set-ref-all 'c L 'z) '(z a b (z) (d (z z (z)) e f z)))
        (set 'L '((a 1) (b 2) (a 3) (b 4)))
        (= (set-ref-all '(a *) L '(z 99) match) '((z 99) (b 2) (z 99) (b 4)))
    )
)

(define (test-sgn)
 (and
   (= 0 (sgn 0))
   (= 1 (sgn 123))
   (= -1 (sgn -3.5))))

(define (test-sin )
  (= 1 (sin (asin (sin (asin 1))))))

(define (test-sinh)
    (< (abs (sub (tanh 1) (div (sinh 1) (cosh 1))))  0.0000000001)
)

(define (test-slice )
(and 
   (set 'str "0123456789")
   (= (slice str 0 1) "0") 
   (= (slice str 0 3) "012") 
   (= (slice str 8 2) "89") 
   (= (slice str 8 10) "89") 
   (= (slice str 20 10) "")
   (= (slice str 2 -2) "234567")
   (= (slice str 2 -5) "234")
   (= (slice str 2 -7) "2")
   (= (slice str 2 -8) "")
   (= (slice str 2 -9) "")
   (= (slice '(a b c d e f g) 3 1) '(d))
   (= (slice '(a b c d e f g) 3 0) '())
   (= (slice '(a b c d e f g) 0 0) '())
   (= (slice '(a b c d e f g) 10 10) '())
   (= (slice '(a b c d e f g) 3 2) '(d e))
   (= (slice '(a b c d e f g) 5) '(f g))
   (= (slice '(a b c d e f g) -5 2) '(c d))
   (= (slice '(a b c d e f g) -1 -2) '())
   (= (slice '(a b c d e f g) 1 -2) '(b c d e))
   (= (slice '(a b c d e f g) 4 -2) '(e))
   (= (slice '(a b c d e f g) 4 -3) '())
   (= (slice '(a b c d e f g) 4 -4) '())
   (= (slice '(a b c d e f g) -6 -3) '(b c d))
;; implicit slice
   (= (1 3 '(a b c d e f g)) '(b c d))
   (= (-4 2 '(a b c d e f g)) '(d e))
   (= (1 3 "abcdefg") "bcd")
   (= (-4 2 "abcdefg") "de")
   (= (1 -3 "abcdefg") "bcd")
   (= (1 -5 "abcdefg") "b")
   (=  (1 -7 "abcdefg") "")
   (setq x 1 y 2)
   (= (x y '(a b c d e f g)) '(b c))
   (= (x y "abcdefg") "bc")
   (= (1 -2 '(a b c d e f g)) '(b c d e))
   (= (4 -2 '(a b c d e f g)) '(e))
   (= (4 -3 '(a b c d e f g)) '())
   (= (4 -4 '(a b c d e f g)) '())
   (= (-6 -3 '(a b c d e f g)) '(b c d))

   ; default functor
   (set 'D:D "0123456789")
   (= (slice D 0 1) "0") 
   (= (slice D 0 3) "012") 
   (set 'D:D '(a b c d e f g))
   (= (slice D 3 1) '(d))
   (= (1 3 D) '(b c d))
))

(define (test-sort )
  (and
    (= '(1 2 3 4 5 6 7 8 9) (sort '(9 1 8 2 7 3 6 4 5)))
    (= '(1 2 3 4 5 6 7 8 9) (sort '(9 1 8 2 7 3 6 4 5) <))
    (= '(1 2 3 4 5 6 7 8 9) (sort '(9 1 8 2 7 3 6 4 5) (fn (x y) (< x y))))
  )
)

(define (test-source) 
  (= (replace "\r|\n" (source 'test-sin) "" 0) 
     "(define (test-sin )  (= 1 (sin (asin (sin (asin 1))))))"))

(define (test-sqrt )
  (and (= 10 (sqrt 100)) (= 1.2 (sqrt 1.44))))

(define (test-starts-with )
  (and 
    (starts-with "newlisp" "new") 
    (starts-with "newlisp" "NEW" 1)
    (set 'D:D "newlisp")
    (starts-with D "new") 
    (starts-with D "NEW" 1)
))

(define (test-string )
  (and (string? (string 12345)) (= (string 12345) "12345") (string? 
    (string 1.234)) 
   (= (string 'test-string) "test-string") 
   (string? (string test-string)) 
   (= (string "a" "b" "c") (append "a" "b" "c") "abc") 
   (= (string "a" 123 "b") "a123b")))

(define (test-string? )
  (and (string? "1234") (not (string? 1234))))

(define (test-sub )
  (= 0 (sub 0.99999999 0.99999999))
  (= -123 (sub 123)))

(define (test-swap )
  (and 
    ; new (swap <place1> <place2>) in 10.0.3
    (set 'lst '(1 2 3 4))
    (= (swap (first lst) (last lst)) 1)
    (= lst '(4 2 3 1))
    (= (swap (lst 0) (lst -1)) 4)
    (= lst '(1 2 3 4))
    (set 'A (array 2 3 (sequence 1 6)))
    (= (swap (A 0 0) (A -1 -1)) 1)
    (= A (array 2 3 (flat '((6 2 3) (4 5 1)))))
    (set 'lst '(a b c d))
    (set 'x 'z)
    (= (swap (lst 0) x) 'a)
    (= lst '(z b c d))
    (= x 'a)
  )
)

(define (test-sym)
  (and (= (sym "test-sym") 'test-sym) 
       (= (sym "test-sym" 'QA) 'test-sym)))

(define (test-symbol? )
    (and
        (symbol? (sym "test-symbol"))
        (symbol? (sym "a b"))
))

(define (test-symbols )
  (and (list? (symbols)) (> (length (symbols)) 0)))

(define (test-sys-error) (sys-error 1))

(define (test-sys-info )
   (and (list? (sys-info)) (= (length (sys-info)) 10)))

(define (test-tan )
  (> 1 (tan (atan (tan (atan 1))))))

(define (test-tanh)
    (< (abs (sub (sinh 1) (div (sub (exp 1) (exp -1)) 2))) 0.0000000001)
)


(define (test-time )
  (float? (time)))

(define (test-time-of-day )
  (float? (time-of-day)))

(define (test-trace )
  (trace nil)
  (= nil (trace)))

(define (test-trace-highlight )
  (trace-highlight "#" "#"))

(define (test-transpose )
 (and
  (= '((1) (2) (3)) (transpose '((1 2 3))))
  (= '((a b) (c d) (e f)) (transpose '((a c e) (b d f))))
  (= '((a d f) (b e g) (c nil nil)) (transpose '((a b c) (d e) (f g))))
  (= '((a c f) (b d g)) (transpose '((a b) (c d e) (f g))))
;; transpose arrays
  (set 'A (array 2 3 (sequence 1 6)))
  (= (array-list (transpose A)) '((1 4) (2 5) (3 6))) 
))

(define (test-trim )
  (and 
    (= (trim "    hello    ") "hello") 
    (= (trim "----hello----" "-") "hello")
    (= (trim "----hello====" "-" "=") "hello")
    (= (trim "000012345" "0" "") "12345")))

(define (test-true?)
 (= (map true? '(x nil  1 nil "hi" ())) '(true nil true nil true nil)))

(define (test-unique )
  (= (unique '(2 3 4 4 6 7 8 7)) '(2 3 4 6 7 8)))

(define (test-unify) 
    (and
        (= (unify 'X 123) '((X 123)))
        (= (unify '(Int Flt Str Sym Lst) '(123 4.56 "Hello" s '(a b c)))
                  '((Int 123) (Flt 4.56) (Str "Hello") (Sym s) (Lst '(a b c))))
        (= (unify 'A 'A) '())
        (= (unify '(A B "hello") '("hi" A Z)) '((A "hi") (B "hi") (Z "hello")))
        (= (unify '(A B) '(B abc)) '((A abc) (B abc)))
        (= (unify '(B A) '(abc B)) '((B abc) (A abc)))
        (= (unify '(A A C D) '(B C 1 C)) '((B 1) (A 1) (C 1) (D 1)))
        (= (unify '(D C A A) '(C 1 C B)) '((D 1) (C 1) (B 1) (A 1)))
        (= (unify '(f A) '(f (a b c))) '((A (a b c))))
        (= (unify '(A f) '((a b c) f)) '((A (a b c))))
        (= (unify '(f (g A)) '(f B)) '((B (g A))))
        (= (unify '(p X Y a) '(p Y X X)) '((Y a) (X a)))
        (= (unify '(p X Y) '(p Y X)) '((Y X)))
        (= (unify '(q (p X Y) (p Y X)) '(q Z Z)) '((Y X) (Z (p X X))))
        (= (unify '(f (g A) A) '(f B xyz)) '((B (g xyz)) (A xyz)))
        (= (unify '(A (g abc)) '(B A)) '((B (g abc)) (A (g abc))))
        ;; with additional environment list
        (= (unify '(A (B) X) '(A (A) Z) '((A 1) (Z 4)))
           '((A 1) (Z 4) (B 1) (X 4)))
))

(define (test-unless )
    (and 
        (= (unless nil (set 'x 1) (set 'y 2) (set 'z 3)) 3)
        (= x 1) (= y 2) (= z 3)
        (= (unless 123) 123)
        (= (unless true) true)
        (= (unless nil) nil)
))

(define (test-unpack )
  (= (pack "c c c" 65 66 67) "ABC")
  (= (unpack "c c c" "ABC") '(65 66 67)))

(define (test-until , x)
  (set 'x 0)
  (= 10 (until (= x 10) (inc x)) x))

(define (test-do-until , x)
  (set 'x 0)
  (and 
   (= 10 (do-until (= x 10) (inc x)) x)
   (= 11 (do-until (> x 0) (inc x)) x)
))

(define (test-upper-case )
    (= (upper-case "abcdefghijklmnopqrstuvwxyz") "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))

(define (test-uuid)
    (= 36 (length (uuid))))

(define (test-when)
    (and 
        (= (when true (set 'x 1) (set 'y 2) (set 'z 3)) 3)
        (= x 1) (= y 2) (= z 3)
        (= (when 123) 123)
        (= (when nil) nil)
        (= (when true) true)
))

(define (test-while , x)
  (and
    (set 'x 0)
    (= 100 (while (< x 100) (inc x)) x)
))

(define (test-do-while, x)
  (and
    (set 'x 0)
    (= 100 (do-while (< x 100) (inc x)) x)
    (= 101 (do-while (< x 100) (inc x)) x)
))

(define (test-write-buffer )
  (set 'str "")
  (dotimes (x 5) (write-buffer str "hello"))
  (set 'Bf:Bf "")
  (set 'S:S "hello")
  (dotimes (x 5) (write-buffer Bf S))
  (and 
    (= str "hellohellohellohellohello")
    (= Bf:Bf str)
))

(define (test-write-line ) 
  (and
    (set 'Bf:Bf "")
    (set 'S:S "hello world")
    (write-line Bf S)
    (if (find ostype '("Windows" "OS/2"))
        (= Bf:Bf "hello world\r\n")
        (= Bf:Bf "hello world\n"))
))


(define (test-xfer-event)
  (not (xfer-event)))

(define (test-xml-parse )
  (= (xml-parse "<hello att='value'></hello>") '(("ELEMENT" "hello" 
     (("att" "value")) 
     ()))))

(define (test-xml-type-tags )
  (length (xml-type-tags) 4))

(define (test-zero?)
  (= (map zero? '(1 0 1.2 0.0)) '(nil true nil true)))

(define (test-| )
  (= (| -1431655766 1431655765) -1))

(define (test-~ )
  (and
    (= (~ 0) -1)
    (if 
        (find ostype '("Windows" "OS/2"))
        (= (format "%I64x" (~ 0xa0a0a0a0a0a0a0a0)) "5f5f5f5f5f5f5f5f")

        (= ostype "True64Unix")
        (= (format "%lx" (~ 0xa0a0a0a0a0a0a0a0)) "5f5f5f5f5f5f5f5f")

        (= (format "%llx" (~ 0xa0a0a0a0a0a0a0a0)) "5f5f5f5f5f5f5f5f"))
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ENTRY POINT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; this is only run to get a calibrated 'primes' table
; after running this replace the primes table in this code
(when (find "calibrate" (main-args))
    (calibrate) 
    (exit)
)



;display-html only occurs in Emsripten compiled newLISP
(set 'Emscripten display-html)

;; for Emscripten take out throw and throw-error, they suppress output on console
(when Emscripten
    (when (set 'pos (find '(throw ?) QA:primes match) )
        (pop QA:primes pos) )
    (when (set 'pos (find '(throw-error ?) QA:primes match) )
        (pop QA:primes pos) )
)

;; test everything
(println)
(set 'report-flag nil)
(set 'errors '())
(set 'result (time (qa)))
(if errors
    (dolist (f errors) (println "->" f))
    (println (length primes) " non I/O functions performed SUCCESSFUL in " result  " ms")
)


;; benchmark
(println)
(println ">>>>> Benchmarking all non I/O primitives ... (may take a while)")
(set 'report-flag (or Emscripten (find "report" (main-args))))
(if Emscripten
    (set 'multiplier 0.2 'adjust  1.22)
    (set 'multiplier 1 'adjust  1.03)
)

(set 'total-time (bench))

(println ">>>>> total time: " total-time)
(inc total-time (mul 0.5 (length primes)))
(println (format 
">>>>> Performance ratio:%5.2f (1.0 on macOS 10.12, MacBook (Retina, 12-inch, Early 2016), newLISP v10.7.3-64-bit)"
    (round (div (div total-time adjust) (mul 10 (length primes)) multiplier) -2)))

(context 'MAIN)
(sys-info)
; don't exit when  running Emscrypten
(if (zero? (& (sys-info -1) 0x800)) (exit))
;; eof



