#!/usr/bin/newlisp

;; qa-bench - benchmarking all non I/O primitives
;;
;; USAGE:
;;    newlisp qa-bench
;;    newlisp qa-bench 2    # run twice as long
;;    newlisp qa-bench report # report on individual functions
;;    newlisp qa-bench report 10 # report and run 10 times long

(set-locale "en_US")

(println)
(println ">>>>> Benchmarking all non I/O primitives ... may take a while ...")

(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")
		
(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 
 cond cons constant context context? copy cos cosh 
 count cpymem crc32 crit-chi2 crit-z curry date date-value debug 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 import 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 Intel Core Duo 2 1.83 Ghz
; and pass 10 milliseconds

(set 'QA:primes '(
  (!= 2427) 
  ($ 9262) 
  (% 2876) 
  (& 10620) 
  (* 8863) 
  (+ 4845) 
  (- 10470) 
  (/ 6216) 
  (< 955) 
  (<< 10183) 
  (<= 8419) 
  (= 1012) 
  (> 1074) 
  (>= 8511) 
  (>> 10388) 
  (NaN? 2165) 
  (^ 10310) 
  (abs 6025) 
  (acos 6085) 
  (acosh 8841) 
  (add 436) 
  (address 1426) 
  (amb 5877) 
  (and 7619) 
  (append 277) 
  (apply 737) 
  (args 3576) 
  (array 215) 
  (array-list 616) 
  (array? 728) 
  (asin 2809) 
  (asinh 3709) 
  (assoc 584) 
  (atan 4349) 
  (atan2 6142) 
  (atanh 6609) 
  (atom? 4756) 
  (base64-dec 1513) 
  (base64-enc 850) 
  (bayes-query 4044) 
  (bayes-train 429) 
  (begin 
   5593) 
  (beta 4938) 
  (betai 3721) 
  (bind 2176) 
  (binomial 5346) 
  (bits 989) 
  (case 2416) 
  (catch 501) 
  (ceil 11091) 
  (char 700) 
  (chop 825) 
  (clean 212) 
  (cond 
   1233) 
  (cons 1383) 
  (constant 7006) 
  (context 7797) 
  (context? 9519) 
  (copy 2839) 
  (cos 6072) 
  (cosh 4865) 
  (count 547) 
  (cpymem 3135) 
  (crc32 626) 
  (crit-chi2 612) 
  (crit-z 1776) 
  (curry 146) 
  (date 950) 
  (date-value 8767) 
  (debug 1321) 
  (dec 2943) 
  (def-new 2271) 
  (default 210) 
  (define 891) 
  (define-macro 920) 
  (delete 379) 
  (det 2190) 
  (difference 375) 
  (div 4383) 
  (do-until 1768) 
  (do-while 373) 
  (doargs 3732) 
  (dolist 485) 
  (dostring 2030) 
  (dotimes 827) 
  (dotree 60) 
  (dump 4728) 
  (dup 857) 
  (empty? 1328) 
  (encrypt 3519) 
  (ends-with 522) 
  (env 384) 
  (erf 6566) 
  (error-event 11245) 
  (eval 2826) 
  (eval-string 1274) 
  (exists 84) 
  (exp 4581) 
  (expand 298) 
  (explode 322) 
  (factor 163) 
  (fft 3163) 
  (filter 124) 
  (find 189) 
  (find-all 202) 
  (first 425) 
  (flat 1007) 
  (float 9331) 
  (float? 14755) 
  (floor 11018) 
  (flt 11424) 
  (for 1570) 
  (for-all 161) 
  (format 43) 
  (fv 6775) 
  (gammai 5190) 
  (gammaln 5329) 
  (gcd 2771) 
  (get-char 2860) 
  (get-float 5353) 
  (get-int 303) 
  (get-long 4186) 
  (get-string 5548) 
  (global 13537) 
  (global? 9198) 
  (if 1532) 
  (if-not 14592) 
  (ifft 3135) 
  (import 14647) 
  (inc 1634) 
  (index 360) 
  (int 2274) 
  (integer? 6314) 
  (intersect 837) 
  (invert 251) 
  (irr 936) 
  (join 687) 
  (lambda? 14723) 
  (last 416) 
  (last-error 6005) 
  (legal? 1879) 
  (length 555) 
  (let 1803) 
  (letex 544) 
  (letn 2295) 
  (list 3335) 
  (list? 7057) 
  (local 3062) 
  (log 4014) 
  (lookup 2064) 
  (lower-case 3427) 
  (macro? 10949) 
  (main-args 1148) 
  (map 942) 
  (mat 148) 
  (match 277) 
  (max 5409) 
  (member 595) 
  (min 5486) 
  (mod 4539) 
  (mul 10565) 
  (multiply 480) 
  (new 107) 
  (nil? 961) 
  (normal 381) 
  (not 1575) 
  (now 4579) 
  (nper 6866) 
  (npv 5782) 
  (nth 247) 
  (null? 1387) 
  (number? 3993) 
  (or 3669) 
  (pack 161) 
  (parse 541) 
  (pmt 6818) 
  (pop 196) 
  (pop-assoc 439) 
  (pow 5780) 
  (pretty-print 6348) 
  (primitive? 14670) 
  (prob-chi2 4781) 
  (prob-z 6927) 
  (protected? 5236) 
  (push 158) 
  (pv 6710) 
  (quote 10434) 
  (quote? 12768) 
  (rand 32) 
  (random 4055) 
  (randomize 1095) 
  (read-expr 1632) 
  (ref 111) 
  (ref-all 48) 
  (regex 776) 
  (regex-comp 1631) 
  (replace 32) 
  (rest 379) 
  (reverse 1627) 
  (rotate 753) 
  (round 595) 
  (seed 784) 
  (select 703) 
  (sequence 6353) 
  (series 2259) 
  (set 5082) 
  (set-locale 5853) 
  (set-ref 442) 
  (set-ref-all 692) 
  (setf 269) 
  (setq 4570) 
  (sgn 4759) 
  (sin 5737) 
  (sinh 4466) 
  (slice 193) 
  (sort 55) 
  (source 264) 
  (sqrt 6126) 
  (starts-with 1942) 
  (string 133) 
  (string? 7660) 
  (sub 6720) 
  (swap 649) 
  (sym 3353) 
  (symbol? 4323) 
  (symbols 299) 
  (sys-error 6536) 
  (sys-info 5046) 
  (tan 5162) 
  (tanh 3869) 
  (term 7286) 
  (throw 1074) 
  (throw-error 793) 
  (time 9940) 
  (time-of-day 6417) 
  (title-case 2699) 
  (transpose 621) 
  (trim 1007) 
  (true? 2653) 
  (unify 125) 
  (unique 2210) 
  (unless 2369) 
  (unpack 2857) 
  (until 2251) 
  (upper-case 3229) 
  (uuid 3000) 
  (when 2353) 
  (while 390) 
  (write-buffer 1091) 
  (write-line 2192) 
  (xml-parse 1881) 
  (xml-type-tags 5336) 
  (zero? 3631) 
  (| 10142) 
  (~ 1336)))

;; run all test-xxx functions the number of times it would take to pass
;; 10 ms on a Core Duo 2 MacBook 1.83 Ghz
(define (qa )
    (dolist (sm primes) 
        (if (and 
              (set 'func (eval (sym (append "test-" (string (first sm))))) )
              (catch (time (apply func) (mul (last sm) multiplier) ) 'result)  
              result)
            (if report-flag
				(begin
                    (println (format "%-14s %5.1f ms" 
                             (string (first sm)) result))
                    (inc total-time result))
                (inc total-time result))
            (failed (string ">>>> " sm " threw error " result))
        )
    )	
)

;; 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)))
    (set 'n 123)
    (= (get-long (address n)) 123)
    (set 'f 1.234)
    (= (get-float (address f) 1.234))
))

(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)
    (not (catch (nth '(10 10) A)  'result))
    (not (catch (nth '(-10 -10) A) 'result))
    (= (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))

; old test broke after Mac OS X update to 10.5.2
;  (= 1 (atan (tan (atan (tan 1)))))

(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 
	(catch (+ 3 4) 'result) 
        (= result 7)
	(= (catch (+ 3 4)) 7)
        (= (catch (dotimes (x 100) (if (= x 7) (throw x)))) 7)
))

(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-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 )
  (< (abs (sub (crit-chi2 0.559506 10) 9.999991)) 1e-05))

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

(define (test-curry)
  (and
    (= (set 'f (curry + 10)) (lambda () (+ 10 ($args 0))))
    (= (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-debug )
  (= (debug (+ 3 4)) 7))

(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-title-case)
	(= (title-case "heLLo") "HeLLo")
	(= (title-case "heLLo" true) "Hello"))

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


(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 '("Win32" "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 '("Win32" "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)
  (not (catch (first '()) 'result))
)

(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"))
   (not (catch (format "%%" 1) 'result))
   (not (catch (format "%10.2lf" 123) 'result))
   (= (test-format-r '(("foo" "bar") ("foo" "baz"))) 
      "[ [ 'foo', 'bar' ], [ 'foo', 'baz' ] ]")
   ; test 64-bit formatting
   (if (= ostype "Win32") ;; Win32 
      (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-import )
  (primitive? import))

(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)
  (not (catch (last '()) 'result))
)

(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 " ")))

(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) '())
    ; 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")
	))
 
;; this can run only once than must be reloaded
;; because some replace's are in place with a constant
(define (test-replace ) 
 (and
  (not (catch (replace "a" "akakak") 'result))
  (not (catch (replace "a") 'result))
  (not (catch (replace) 'result))
  (catch (replace "a" '("x" "a" "y")) 'result)
  (= (replace "a" "ababab" "b") "bbbbbb")
  (= $0 3) 
  (= (replace 'a '(a a b a b a a a b a) 'b) '(b b b b b b b b b b))
  (= (replace 'a '(a a b a b a a a b a)) '(b b b))
  (= (replace 'a '(a)) '())
;; with regular expressions option
  (= (replace "" "abc" "x" 0) "xaxbxcx")
  (= (replace "$" "abc" "x" 0) "abcx")
  (= (replace "^" "abc" "x" 0) "xabc")
  (= (replace "\\b" "abc" "x" 0) "xabcx")
  (= (replace "(?<=[0-9])(?=(?:[0-9]{3})+(?![0-9]))" "1234567" "," 0) "1,234,567")
  (= (replace "a" "ababab" (upper-case $it) 0) "AbAbAb")
  (= $0 3) 
  (set 'str2 "abaBab")
  (= (replace "b|B" str2 "z" 0) "azazaz")
  (= $0 3)
  (replace-once "aaa")
  (= (replace "%([0-9A-F][0-9A-F])" "%41123%42456%43" (char (int (append "0x" $1))) 1) "A123B456C")
  ; replace with comparison functor
  (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 ($0 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 ($0 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))

))
 
(define (replace-once str)
  (= (replace "a" str (upper-case $it) 0x8000) "Aaa") ;; custom option replace once
)

(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 -2) 123.49000000000001)
		(= (round 123.49 3)  0)))

(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)) 9)))

(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-throw )
  (and (catch (throw (+ 3 4)) 'msg) (= msg 7)))

(define (test-time )
  (integer? (time)))

(define (test-time-of-day )
  (integer? (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 (= ostype "Win32")
		(= 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 '("Win32" "OS/2"))
        (= (format "%I64x" (~ 0xa0a0a0a0a0a0a0a0)) "5f5f5f5f5f5f5f5f")

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

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


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

(set 'report-flag (find "report" (main-args)))
(set 'multiplier (int (main-args -1) 1))

; 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)
)

;; test everything
(qa)
(println (format "%10.1f ms" total-time))
; compensate for rounding error
(inc total-time (mul 0.5 (length primes)))
(println (format ">>>>> Performance ratio:%5.2f (1.0 on Mac OSX, 1.83 GHz Core 2 Duo, newLISP v10.2.8)"
    (round (div total-time (mul 10 (length primes)) multiplier) -2)))
(dolist (msg failed-messages)
	(println msg))

;; test math functions
;; test list functions
;; test string functions
;; test control flow

(context 'MAIN)
(sys-info)
(exit)
;; eof

