;-*- Syntax:COMMON-LISP -*-
;------------------------------------------------------------------------ ;
; Copyright (c) Richard C. Waters, 1988 ;
;------------------------------------------------------------------------ ;
; This is a file of test cases to test OSS. Just load it and run the
;function (DO-TESTS). It prompts you for the name of a scratch file
;to use when testing. It then prints out identifying numbers of tests
;as it performs one test after another. When all of the tests have
;been run a summary line is printed saying how many tests failed.
; Whenever a test fails for any reason, an error is signalled. To continue
;testing call the function (MORE) either within the break, or at top
;level after aborting the execution of a test. (The latter is useful
;if a test leads to an infinite loop.) When all of the tests have
;been completed, the variable TESTS-FAILED contains a list of the
;numbers of the tests that failed. (You can look at the tests
;themselves by evaluating (NTH N TEST-LIST) for any test number.)
; After running the tests and fixing problems which arise you may wish
;to run some or all of the tests again. Calling (DO-TESTS) runs all
;of the tests again. Calling (DO-FAILED-TESTS) runs just the tests
;which failed the first time. (The variable TESTS-FAILED is updated
;to reflect the new state of affairs in either case.) Calling
;(DO-TEST n) runs just the test with the given number. (In some
;lisps, if you run the tests more than once without rstarting the
;lisp, you can get some warnings about redefining functions called
;FOOn. These do not indicate any problem.)
;THINGS TO DO BY HAND: Look at what Esymbols does in detail.
(use-package "OSS")
(proclaim '(special form test-list tests-failed))
(defvar in-tester nil)
(defvar tests nil)
(defvar test-file nil)
(defun do-tests ()
(format T "~% Running the suit of ~S test cases~%" (length test-list))
(setq tests (do ((i (1- (length test-list)) (1- i))
(r nil (cons i r)))
((minusp i) r))
tests-failed nil)
(do-many-tests))
(defun do-failed-tests ()
(format T "~% Running the ~S failed tests~%" (length tests-failed))
(setq tests tests-failed tests-failed nil)
(do-many-tests))
(defun do-many-tests ()
(loop (when (null tests)
(setq tests-failed (nreverse tests-failed))
(if (zerop (length tests-failed))
(format T "~2% OSS passed all tests.")
(format T "~2% OSS failed ~A tests." (length tests-failed)))
(return (values)))
(format T " ~A" (car tests))
(do-test (pop tests))))
(defun more ()
(if in-tester (throw 'in-tester nil) (do-many-tests)))
(defun do-test (n)
(when (null test-file)
(format T "~%Type a pathname of a scratch disk file ending in <newline>: ")
(setq test-file (read-line)))
(catch 'in-tester
(let* ((info (nth n test-list))
(*break-on-warnings* T)
(tester (if (symbolp (car info)) (pop info) 'test-ordinary))
(value (cadr info))
(pop-if-no-failure nil)
(in-tester T))
(setq form (car info))
(when (not (member n tests-failed))
(push n tests-failed)
(setq pop-if-no-failure T))
(let ((result (funcall tester (oss::iterative-copy-tree form))))
(when (not (equal result value))
(format t "~%form: ~S~% desired value ~S~% actual value ~S~%"
form value result)
(pprint *last-oss-loop*)
(error "failed test"))
(when pop-if-no-failure
(pop tests-failed)))))) ;doesn't happen when abort out of test error
;This is useful for special test cases, and rerunning the last test case.
(defmacro r (&optional (f nil))
(if f (setq form f))
(setq f (oss::iterative-copy-tree form))
(gensym 1)
(setq f (macroexpand f))
(pprint f)
(cond ((Y-or-N-p "continue") f)))
;Helper funtions for tests.
(defun test-ordinary (form)
(funcall (compile nil `(lambda () ,form))))
(defun test-def (form)
(eval (car form))
(compile (cadar form))
(test-ordinary (cadr form)))
(defun test-warn (form)
(let (v (*break-on-warnings* nil))
(setq *last-oss-error* nil)
(with-output-to-string (*error-output*) (setq v (test-ordinary form)))
(list v (car *last-oss-error*))))
(defun test-tut (form)
(unwind-protect
(progn (oss-tutorial-mode T) (test-ordinary form))
(oss-tutorial-mode nil)))
(defmacro dummy-mac (stuff) `(car ,stuff))
(defun decls (arg) (declare (ignore arg)) (decls0 *last-oss-loop*))
(defun decls0 (tree)
(cond ((not (consp tree)) nil)
((eq (car tree) 'declare) tree)
(T (do ((l tree (cdr l))) ((not (consp l)) nil)
(let ((x (decls0 (car l))))
(if x (return x)))))))
;the first few pages of tests attempt to test each of the different
;series operations in the series function library.
(setq test-list '(
((Rlist (Eoss 'a 'b 'c)) (a b c))
((Rlist (Eoss 'a 'b 'c :R)) (a b c))
((Rlist (list (Eoss 'a0 :R 'a1 'b1) (Elist '(z a b c))))
((a0 z) (a1 a) (b1 b) (a1 c)))
((Rlist (list (Eoss :R 'a1 'b1) (Elist '(a b c))))
((a1 a) (b1 b) (a1 c)))
((Rlist (list (Eoss :R 'a1) (Elist '(a b c)))) ((a1 a) (a1 b) (a1 c)))
((Rlist (Eoss)) ())
((Rlist (list (Eup) (Elist '(a b c)))) ((0 a) (1 b) (2 c)))
((Rlist (list (Eup 4 :by 3) (Elist '(a b c)))) ((4 a) (7 b) (10 c)))
((Rlist (Eup 0 :to 3)) (0 1 2 3))
((Rlist (Eup 0 :below 3)) (0 1 2))
((Rlist (Eup 0 :length 3)) (0 1 2))
((Rlist (Eup 2 :to 3)) (2 3))
((Rlist (Eup 2 :below 3)) (2))
((Rlist (Eup 2 :length 3)) (2 3 4))
((Rlist (Eup 4 :to 3)) ())
((Rlist (Eup 4 :below 3)) ())
((Rlist (Eup 4 :length 3)) (4 5 6))
((Rlist (Eup :to 3 :by 2)) (0 2))
((Rlist (Eup :to 4 :by 2)) (0 2 4))
((Rlist (Eup :below 3 :by 2)) (0 2))
((Rlist (Eup :below 4 :by 2)) (0 2))
((Rlist (Eup :length 3 :by 2)) (0 2 4))
((Rlist (round (* 10. (Eup 1.5 :by .2 :below 2.0)))) (15 17 19))
((Rlist (list (Edown) (Elist '(a b c)))) ((0 a) (-1 b) (-2 c)))
((Rlist (list (Edown 4 :by 3) (Elist '(a b c)))) ((4 a) (1 b) (-2 c)))
((Rlist (Edown 0 :to -3)) (0 -1 -2 -3))
((Rlist (Edown 0 :above -3)) (0 -1 -2))
((Rlist (Edown 0 :length 3)) (0 -1 -2))
((Rlist (Edown 4 :to 3)) (4 3))
((Rlist (Edown 4 :above 3)) (4))
((Rlist (Edown 4 :length 3)) (4 3 2))
((Rlist (Edown :to -3 :by 2)) (0 -2))
((Rlist (Edown :to -4 :by 2)) (0 -2 -4))
((Rlist (Edown :above -3 :by 2)) (0 -2))
((Rlist (Edown :above -4 :by 2)) (0 -2))
((Rlist (Edown :length 3 :by 2)) (0 -2 -4))
((Rlist (Esublists '(a b c))) ((a b c) (b c) (c)))
((Rlist (Esublists '(a b . c) #'atom)) ((a b . c) (b . c)))
((Rlist (Esublists ())) ())
((Rlist (Elist '(a b c))) (a b c))
((Rlist (Elist '(a b . c) #'atom)) (a b))
((Rlist (Elist ())) ())
((letS ((x '(a b c)))
(alterS (Elist x) (Eup))
x) (0 1 2))
((Rlist (Ealist '((1 . a) () (2) (1 . c)))) (1 2))
((Rlist (Ealist ())) ())
((letS (((key value) (Ealist '((1 . a) () (2) (1 . c)))))
(Rlist (list key value))) ((1 a) (2 nil)))
((let ((alist '((a . 1) (b . 2))))
(letS (((key val) (Ealist alist)))
(alterS key (list key))
(alterS val (list val)))
alist) (((a) . (1)) ((b) . (2))))
((Rlist (Eplist '(P1 1 P2 2 P1 3 P3 4))) (P1 P2 P3))
((Rlist (Eplist ())) ())
((letS (((key value) (Eplist '(P1 1 P2 2 P1 3))))
(Rlist (list key value))) ((P1 1) (P2 2)))
((let ((plist '(a 1 b 2)))
(letS (((key val) (Eplist plist)))
(alterS key (list key))
(alterS val (list val)))
plist) ((a) (1) (b) (2)))
((Rlist (Etree '(1 (2 3) 4))) ((1 (2 3) 4) 1 (2 3) 2 3 4))
((Rlist (Etree '(1 (2 3) 4) #'atom)) ((1 (2 3) 4) 1 (2 3) 2 3 4))
((Rlist (Etree '(1 (2 3) 4) #'(lambda (n) (not (and (consp n) (cddr n))))))
((1 (2 3) 4) 1 (2 3) 4))
((Rlist (Etree nil)) (nil))
((let ((tree '((3) 4)))
(letS ((leaf (Efringe tree)))
(if (evenp leaf) (alterS leaf (- leaf))))
tree) ((3) -4))
((Rlist (Efringe '((1 2 ((3 . 4) 4) (5) () (((6)))))))
(1 2 3 4 5 nil 6))
((Rlist (Efringe '(1 2 ((3 . 4) 4) (5) () (((6))))
#'(lambda (n) (not (and (consp n) (cdr n))))))
(1 2 3 4 (5) nil (((6)))))
((Rlist (Efringe ())) (nil))
((letS ((z '(a b (3 . e) d)))
(letS* ((x (Efringe z)))
(alterS x (list x)))
z) ((a) (b) ((3) . e) (d)))
((Rlist (Evector '#(1 2 3))) (1 2 3))
((Rlist (Evector '#())) ())
((Rlist (Evector '#(1 2 3) (Eup 1 :to 2))) (2 3))
((Rlist (Evector '#(1 2 3) (Eoss 2 0 1 9 0))) (3 1 2))
((letS ((v "FOOBAR"))
(alterS (Evector v (Eoss 2 3 4)) #\-)
v) "FO---R")
((letS ((v "FOOBAR"))
(alterS (Evector v) #\-)
v) "------")
((Rlist (Esequence '#(1 2 3))) (1 2 3))
((Rlist (Esequence '#(1 2 3) (Eup 1 :to 2))) (2 3))
((Rlist (Esequence '#(1 2 3) (Eoss 2 0 1 9 0))) (3 1 2))
((letS ((v "FOOBAR"))
(alterS (Esequence v (Eoss 2 3 4)) #\-)
v) "FO---R")
((Rlist (Esequence '(1 2 3))) (1 2 3))
((Rlist (Esequence '(1 2 3) (Eup 1 :to 2))) (2 3))
((Rlist (Esequence '(1 2 3) (Eoss 2 0 1 9 0))) (3 1 2))
((letS ((y '(F O O B A R)))
(alterS (Esequence y (Eoss 2 3 4)) '-)
y) (F O - - - R))
((letS (((key val) (Ehash (let ((x (make-hash-table)))
(setf (gethash 'color x) 'brown)
(setf (gethash 'name x) 'fred)
x))))
(sort (Rlist (cons key val))
#'(lambda (x y)
(string-lessp (string (car x)) (string (car y))))))
((color . brown) (name . fred)))
((progn (Rfirst (Esymbols)) nil) nil) ;grotesquely weak tests
((progn (Rfirst (Esymbols (find-package "OSS"))) nil) nil)
((Rlist (car (EnumerateF '(a b c) #'cdr #'null))) (a b c))
((Rlist (list (Elist '(a b c)) (car (EnumerateF '(1 2) #'cdr))))
((a 1) (b 2) (c nil)))
((Rlist (car (Enumerate-inclusiveF '(a b c) #'cdr #'null)))
(a b c nil))
((Rlist (car (Enumerate-inclusiveF () #'cdr #'null))) (nil))
((Rlist (Tprevious (Elist '(a b c)))) (nil a b))
((Rlist (Tprevious (Elist '(a b c)) 'fill 2)) (fill fill a))
((Rlist (Tprevious (Elist '(a b c)) 0)) (0 a b))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)))) (nil 3 nil nil nil))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :after 2)) (nil 3 nil 4 nil))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :after 0)) (nil nil nil nil nil))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :after 2 :pre 'a)) (A A A A 5))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :after 2 :pre 'a :post 'b))
(A A A A B))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :after 2 :post 'b)) (nil 3 nil 4 B))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :before 2)) (nil 3 nil nil nil))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :before 0)) (nil nil nil nil nil))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :before 2 :pre 'a)) (A A A 4 5))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :before 2 :pre 'a :post 'b))
(A A A B B))
((Rlist (Tlatch (Elist '(nil 3 nil 4 5)) :before 2 :post 'b)) (nil 3 nil B B))
((Rlist (Tuntil (Eoss nil nil T nil T) (Eoss 1 2 3))) (1 2))
((Rlist (Tuntil (Eoss) (Eoss 1 2 3))) ())
((letS ((x (Eoss 1 2 3 nil nil)))
(Rlist (Tuntil (Tprevious (null x)) x)))
(1 2 3 nil))
((Rlist (TuntilF #'null (Eoss 1 2 3 nil nil))) (1 2 3))
((letS ((fn #'null))
(Rlist (TuntilF fn (Eoss 1 2 3 nil nil)))) (1 2 3))
((let ((v '(1 -2 3)))
(letS ((x (TuntilF #'minusp (Elist v))))
(alterS x (- x)))
v) (-1 -2 3))
((let ((c 1))
(Rlist (cons (Elist '(a b c)) (TmapF #'(lambda () (incf c))))))
((a . 2) (b . 3) (c . 4)))
((letS* ((tt '((1 2) (3 4)))
(e (Elist tt)))
(Rlist (TmapF #'(lambda (e f) (list (Rbag (Elist e)) e)) e e)))
(((2 1) (1 2)) ((4 3) (3 4))))
((lets ((e (Elist '((1 2) (3 4)))))
(Rlist (TmapF #'(lambda (e) (Rsum (Elist e))) e))) (3 7))
((Rlist (TmapF #'dummy-mac (Elist '((1) (2))))) (1 2))
((Rlist (TscanF 0 #'+ (Elist '(1 2 3)))) (1 3 6))
((Rlist (TscanF 0 #'- (Elist '(1 2 3)))) (-1 -3 -6))
((Rlist (TscanF #'+ (Elist '(1 2 3)))) (1 3 6))
((Rlist (TscanF #'- (Elist '(1 2 3)))) (1 -1 -4))
((letS (((x y) (Tcotruncate (Eoss 1 2 3) (Eoss 4 5))))
(list (Rsum x) (Rsum y))) (3 9))
((letS (((x y) (Tcotruncate (Eoss) (Eoss 4 5))))
(list (Rsum x) (Rsum y))) (0 0))
((letS (((x) (Tcotruncate (Eoss 4 5))))
(list (Rsum x))) (9))
((letS (((x y) (Tcotruncate (Eoss 1 2 3) (Eoss 4 5))))
(list (Rsum (+ x y)) (Rsum y))) (12 9))
((Rlist (Tremove-duplicates (Eoss 1 2 1 2 3))) (1 2 3))
((Rlist (Tremove-duplicates (Elist '((1 a) (1 b) (2 c) (1 d) (3 e) (2 f)))
#'(lambda (x y) (eql (car x) (car y)))))
((1 a) (2 c) (3 e)))
((Rlist (Tchunk 0 (Elist '(a b c)))) ((a) (b) (c)))
((Rlist (Tchunk 1 (Elist '(a b c)))) ((a) (b) (c)))
((Rlist (Tchunk 2 (Elist '(a b c)))) ((a b)))
((Rlist (Tchunk 3 (Elist '(a b c)))) ((a b c)))
((Rlist (Tchunk 4 (Elist '(a b c)))) ())
((Rlist (Twindow 1 (Elist '(a b c)))) ((a) (b) (c)))
((Rlist (Twindow 2 (Elist '(a b c)))) ((a b) (b c)))
((Rlist (Twindow 4 (Elist '(a b c)))) ())
((Rlist (Tconcatenate (Elist '(a b c)) (Elist '(1 2 3))))
(a b c 1 2 3))
((Rlist (Tconcatenate (Eoss) (Elist '(a b c)) (Eoss) (Elist '(a b c))))
(a b c a b c))
((LetS ((x (Eoss 1 2)) (y (Eoss 3 4)))
(Rlist (Tconcatenate x y))) (1 2 3 4))
((Rlist (TconcatenateF #'Elist (Elist '((1 2) (3) () (4 5)))))
(1 2 3 4 5))
((Rlist (TconcatenateF #'Elist (Elist ()))) ())
((lets (((p v) (TconcatenateF #'Eplist (Elist '((a 1) (b 2 c 3))))))
(Rlist (list p v))) ((a 1) (b 2) (c 3)))
((Rlist (Tsubseries (Elist '(a b c)) 1 2)) (b))
((Rlist (Tsubseries (Elist '(a b c)) 1)) (b c))
((let ((v '(1 -2 3)))
(letS ((x (Tsubseries (Elist v) 1)))
(alterS x (- x)))
v) (1 2 -3))
((Rlist (Tpositions (Elist '(a nil 3 nil T nil)))) (0 2 4))
((Rlist (Tpositions (Elist '(nil 3 T nil)))) (1 2))
((Rlist (Tpositions (Elist '(nil nil)))) ())
((Rlist (Tsubseries (Tmask (Elist '())) 0 6)) (nil nil nil nil nil nil))
((Rlist (Tsubseries (Tmask (Elist '(0 2 4))) 0 6)) (T nil T nil T nil))
((Rlist (Tmerge (Eoss 1 3 7 9) (Eoss 4 5 8) #'<)) (1 3 4 5 7 8 9))
((Rlist (Tmerge (Eoss 4 5 8) (Eoss 1 3 7 9) #'<)) (1 3 4 5 7 8 9))
((letS (((lp a) (Tlastp (Elist '(a b c d)))))
(list (Rlist lp) (Rlist a))) ((nil nil nil T) (a b c d)))
((letS (((lp a) (Tlastp (Elist '(a)))))
(list (Rlist lp) (Rlist a))) ((T) (a)))
((letS (((lp a) (Tlastp (Elist nil))))
(list (Rlist lp) (Rlist a))) (nil nil))
((Rlist (Tselect (Eoss t t nil nil t) (Elist '(1 2 nil nil -4))))
(1 2 -4))
((Rlist (Tselect (Elist '(1 2 nil nil -4)))) (1 2 -4))
((letS ((x (Elist '(1 -1 2 -2))))
(Rlist (Tselect (plusp x) x))) (1 2))
((letS ((x (Elist '(1 -1 2 -2))))
(Rlist (if (plusp x) x))) (1 nil 2 nil))
((letS ((x (Elist '(1 -1 2 -2))))
(Rlist (if (plusp x) x (- x)))) (1 1 2 2))
((letS ((x (Elist '(0 1 -1 2 -2))))
(Rlist (list (Tselect (plusp x) x) (Eup)))) ((1 0) (2 1)))
((letS ((x (Elist '(0 1 -1 2 -2)))
(tag (Eup)))
(Rlist (list (Tselect (plusp x) x) tag))) ((1 0) (2 1)))
((Rlist (TselectF #'minusp (Elist '(1 2 -2 3 -4)))) (-2 -4))
((letS ((fn #'minusp))
(Rlist (TselectF fn (Elist '(1 2 -2 3 -4))))) (-2 -4))
((let ((v '(1 -2 3)))
(letS ((x (TselectF #'minusp (Elist v))))
(alterS x (- x)))
v) (1 2 3))
((Rlist (Texpand (Eoss nil T nil T nil) (Elist '(a b c))))
(nil a nil b nil))
((Rlist (Texpand (Eoss nil T nil T) (Elist '(a b c)) T)) (T a T b))
((letS* ((x (Elist '(1 -1 2 -2)))
((y+ y-) (Tsplit x (Eoss :R t nil t nil))))
(list (Rlist x) (Rlist y+) (Rlist y-)))
((1 -1 2 -2) (1 2) (-1 -2)))
((letS* ((x (Elist '(1 0 -1 2 0 -2)))
((y+ y- y0) (Tsplit x (Eoss :R t nil nil t nil nil)
(Eoss :R nil nil t nil nil t))))
(list (Rlist y+) (Rlist y-) (Rlist y0) (Rlist x)))
((1 2) (-1 -2) (0 0) (1 0 -1 2 0 -2)))
((letS* ((x (Elist '(1 -1 2 -2)))
((y+ y-) (TsplitF x #'plusp)))
(list (Rlist x) (Rlist y+) (Rlist y-)))
((1 -1 2 -2) (1 2) (-1 -2)))
((letS* ((x (Elist '(1 -1 2 -2)))
(y+ (TsplitF x #'plusp)))
(Rlist (+ y+ y+)))
(2 4))
((letS* ((x (Elist '(1 -1 2 -2)))
(y+ (TsplitF x #'plusp)))
(list (Rlist y+) (Rsum y+)))
((1 2) 3))
((letS* ((x (Elist '(1 -1 2 -2)))
(y+ (TsplitF x #'plusp)))
(Rlist (Tconcatenate y+ (Eoss 5 6))))
(1 2 5 6))
((letS* ((x (Elist '(1 0 -1 2 0 -2)))
((y+ y- y0) (TsplitF x #'plusp #'minusp)))
(list (Rlist y+) (Rlist y-) (Rlist y0) (Rlist x)))
((1 2) (-1 -2) (0 0) (1 0 -1 2 0 -2)))
((letS* ((x (Elist '(1 (nil) (3))))
((y+ y- y0) (TsplitF x #'numberp #'car)))
(list (Rlist y+) (Rlist y-) (Rlist y0)))
((1) ((3)) ((nil))))
((Rlist (Elist '(a b c))) (a b c))
((Rbag (Elist '(a b c))) (c b a))
((Rbag (Tremove-duplicates (Elist '(a (a) a (a) b a)) #'equal)) (b (a) a))
((list (Rappend (Eoss '(a b c) '(a b c))) '(a b c))
((a b c a b c) (a b c)))
((Rappend (Eoss)) ())
((letS ((a (list 1 2)) (b '(3 4)))
(Rappend (Eoss a b))
a) (1 2))
((Rnconc (Elist '(() (a b) () (c d) (e) ()))) (a b c d e))
((Rnconc (Eoss)) ())
((letS ((a (list 1 2)) (b '(3 4)))
(Rnconc (Eoss a b))
a) (1 2 3 4))
((Ralist (Elist '(d e d)) (Elist '(a b c))) ((d . a) (e . b) (d . c)))
((Ralist (Elist '(d e d)) (Elist '())) ())
((Rplist (Elist '(d e d)) (Elist '(a b c))) (d a e b d c))
((Rplist (Elist '(d e d)) (Elist '())) ())
((let ((h (Rhash (Elist '(color name)) (Elist '(brown fred)))))
(letS (((key val) (Ehash h)))
(sort (Rlist (cons key val))
#'(lambda (x y)
(string-lessp (string (car x)) (string (car y)))))))
((color . brown) (name . fred)))
#-:GCLISP((concatenate 'list (Rvector (Elist '(a b c)))) (a b c))
#-:GCLISP((concatenate 'list (Rvector (Eoss))) ())
#-:GCLISP((Rvector (Eoss #\B #\A #\R) :element-type 'string-char) "BAR")
((concatenate 'list (Rvector (Elist '(a b c)) :size 3)) (a b c))
((concatenate 'list
(Rvector (Elist '(a b c)) :size 4 :initial-element 0)) (a b c 0))
((progn (if (probe-file test-file) (delete-file test-file))
(Rfile test-file (Elist '(a b c)))
(Rlist (Efile test-file))) (a b c))
((Rfirst-late (Elist '(a b c))) a)
((Rfirst-late (Eoss)) nil)
((Rfirst-late (Eoss) 'fill) fill)
((Rlast (Elist '(a b c))) c)
((Rlast (Eoss)) nil)
((Rlast (Eoss) 'fill) fill)
((Rnth-late 1 (Elist '(a b c))) b)
((Rnth-late 1 (Eoss)) nil)
((Rnth-late 1 (Eoss) 'fill) fill)
((Rlength (Elist '(a b c))) 3)
((Rlength (Eoss)) 0)
((Rlength (Tselect (plusp (Eoss 1 -1 2 -2)))) 2)
((Rsum (Elist '(1 2 3))) 6)
((Rsum (Elist nil)) 0)
((Rmin (Elist '(1 2 3))) 1)
((Rmin (Elist nil)) nil)
((Rmax (Elist '(1 2 3))) 3)
((Rmax (Elist nil)) nil)
((Rand-late (Eoss 1 2)) 2)
((Rand-late (Eoss)) T)
((Ror-late (Eoss 1 2)) 1)
((Ror-late (Eoss nil)) nil)
((Ror-late (Eoss)) nil)
((ReduceF 0 #'+ (Elist '(1 2 3))) 6)
((ReduceF 0 #'- (Eoss 1 2 3)) -6)
((ReduceF 0 #'+ (Elist nil)) 0)
((ReduceF T #'+ (Elist nil)) T)
((Rfirst (Elist '(a b c))) a)
((Rfirst (Eoss)) nil)
((Rfirst (Eoss) 'T) T)
((Rfirst (car (Elist '((T) (nil) 4)))) T)
((Rfirst (Tpositions (plusp (Eoss -3 1 -1 3 -2)))) 1)
((Rfirst (Tselect (Eoss nil t nil) (Eoss 0 1 -1 3 -2))) 1)
((Rnth 1 (Elist '(a b c))) b)
((Rnth 1 (Eoss)) nil)
((Rnth 1 (Eoss) 'T) T)
((Rnth 1 (car (Elist '((T) (nil) 4)))) nil)
((Rand (Eoss 1 2)) 2)
((Rand (car (Elist '((T) (nil) 4)))) nil)
((Rand (Eoss)) T)
((Ror (Eoss nil)) nil)
((Ror (car (Elist '((T) (nil) 4)))) T)
((Ror (Eoss)) nil)
;this contains tests of the various special forms supported.
((lets* ((x (Elist '(a b c)))
(xx (list x)))
(Rlist (list x xx))) ((a (a)) (b (b)) (c (c))))
((lets* ((x (Elist '(a b c)))
(x (list x)))
(Rlist x)) ((a) (b) (c)))
((let ((x 9))
(lets ((x (Elist '(a b c)))
(xx (list x)))
(Rlist (list x xx)))) ((a (9)) (b (9)) (c (9))))
((lets () (Rlist (Elist '(a b c)))) (a b c))
((lets* ((e 3)
(f (Elist '(a b c)))
(g (Rlist f))
(h (Rlist (Elist '(a b c)))))
(list e g h)) (3 (a b c) (a b c)))
((letS ((x (Rlist (Elist '(1 2 3)))))
(list x)
x) (1 2 3))
((not (null (member '(type integer x)
(decls (letS ((x (Elist '(1 2 3))))
(declare (type integer x))
(Rsum x))) :test #'equal))) T)
((letS ()) nil)
((letS (((key value) (Ealist '((a . 1) (b . 2)))))
(Rlist (list key value))) ((a 1) (b 2)))
((letS ((key (Ealist '((a . 1) (b . 2)))))
(Rlist key)) (a b))
((let ((x 4))
(letS ((x (Elist '(1 2 3))))
(Rlist (TmapF #'(lambda (y) (+ x y)) x)))) (5 6 7))
((prognS) nil)
((prognS (Elist '(a b c)) (prognS)) nil)
((prognS (Elist '(a b c)) (funcallS #'(lambdaS ()))) nil)
((multiple-value-list (prognS (TmapF #'sqrt (Elist '(1 2))))) nil)
((Ralist (Elist '(a b)) (* 2 3)) ((a . 6) (b . 6)))
((let ((x 1))
(Ralist (Elist '(a b)) (setq x (1+ x)))) ((a . 2) (b . 2)))
((Rsum (car (Elist '((1) (2))))) 3)
((Rsum (* 2 (Elist '(1 2)))) 6)
((let ((x 1))
(Rlist (list (Elist '(a b)) (setq x (1+ x))))) ((a 2) (b 3)))
((let ((x 1))
(Rlist (list (Elist '(a b)) (Eoss :R (setq x (1+ x)))))) ((a 2) (b 2)))
((Rlist (if (plusp (Elist '(10 -11 12))) (Eup))) (0 nil 2))
((Rlist (Tselect (plusp (Elist '(10 -11 12))) (Eup))) (0 2))
((letS ((z (Elist '(1 2))))
(Rlist (list z (mapS 2)))) ((1 2) (2 2)))
((letS ((z (Elist '(1 2))))
(Rlist (list z (mapS)))) ((1 nil) (2 nil)))
((letS ((z (Elist '(1 2))))
(Rlist (mapS (1+ z)))) (2 3))
((letS ((z (Elist '(1 2))))
(Rlist (mapS (do ((x 1 (1+ x)) (sum 0 (+ sum x))) ((> x z) sum)))))
(1 3))
((letS ((z (Elist '((1 2) (3 4)))))
(Rlist (mapS (Rlist (Elist z))))) ((1 2) (3 4)))
((funcalls #'Rlist (Elist '(a b c))) (a b c))
((Rlist (funcalls #'list (Elist '(a b c)))) ((a) (b) (c)))
((letS ((fn #'list))
(Rlist (funcalls fn (Elist '(a b c))))) ((a) (b) (c)))
((funcalls #'(lambdaS (x) (declare (type oss x)) (Rlist x))
(Elist '(a b c)))
(a b c))
(test-def ((defunS foo (list) "doc" (car (Elist list)))
(list #+lispm(documentation 'foo 'function)
(Rlist (foo '((a) (b) (c))))))
(#+lispm"doc" (a b c)))
(test-def ((defunS foo1 (list &optional (plus 1))
(+ (Elist list) plus))
(list (Rlist (foo1 '(1 2 3) 3))
(Rlist (foo1 '(1 2 3)))))
((4 5 6) (2 3 4)))
(test-def ((defunS foo2 (list &optional (plus 1 p?))
(list (Elist list) p?))
(list (Rlist (foo2 '(1 2 3) 3))
(Rlist (foo2 '(1 2 3)))))
(((1 T) (2 T) (3 T)) ((1 nil) (2 nil) (3 nil))))
(test-def ((defunS foo3 (list &key (plus 1))
(+ (Elist list) plus))
(list (Rlist (foo3 '(1 2 3) :plus 3))
(Rlist (foo3 '(1 2 3)))))
((4 5 6) (2 3 4)))
(test-def ((defunS foo4 (list &key (plus #'1+))
(funcall plus (Elist list)))
(list (Rlist (foo4 '(1 2 3) :plus #'1-))
(Rlist (foo4 '(1 2 3)))))
((0 1 2) (2 3 4)))
(test-def ((defunS foo5 (list &key (k 'list))
(list (Elist list) k))
(list (Rlist (foo5 '(1 2 3) :k 'a))
(Rlist (foo5 '(1 2 3)))))
(((1 a) (2 a) (3 a)) ((1 list) (2 list) (3 list))))
((multiple-value-list
(lets ((x (Elist '(a b)))) (valS (Rlist x) (Rbag x))))
((a b) (b a)))
((Rlist (funcallS #'(lambdaS (pairs)
(letS ((p (Elist pairs)))
(valS (car p) (cdr p))))
'((a . 1)(b . 2)))) (a b))
((letS (((x y) (funcallS #'(lambdaS (pairs)
(letS ((p (Elist pairs)))
(valS (car p) (cdr p))))
'((a . 1)(b . 2)))))
(list (Rlist x) (Rlist y))) ((a b) (1 2)))
((letS (((nil y) (funcallS #'(lambdaS (pairs)
(letS ((p (Elist pairs)))
(valS (car p) (cdr p))))
'((a . 1)(b . 2))))) (Rlist y)) (1 2))
((letS (((a b) (pass-valS 2 (intern (string (Elist '(x y)))))))
(Rlist (list a b))) ((x :internal) (y :internal)))
((letS (((a b) (intern (string (Elist '(x y))))))
(Rlist (list a b))) ((x :internal) (y :internal)))
((let ((v '(1 -2 3)))
(letS ((x (TselectF #'minusp (Elist v))))
(alterS x (- x)))
v) (1 2 3))
((letS ((x '(a b c)))
(alterS (Elist x) (Eup))
x) (0 1 2))
((letS ((x '((a) (b) (c))))
(setf (car (Elist x)) (Eup))
x) ((0) (1) (2)))
((lets ((e (Elist (list 1 2)))) (alters e (1+ e)) (rlist e)) (1 2))
((let ((*print-case* :upcase))
(with-output-to-string (f)
(Rbag (Elist (showS '(a b c) " ~S" f)))
f)) " (A B C)")
((let ((*print-case* :upcase))
(with-output-to-string (f)
(Rbag (showS (Elist '(a b c)) " ~S" f))
f)) " A B C")
((let ((*print-case* :upcase))
(with-output-to-string (f)
(showS (Rbag (Elist '(a b c))) " ~S" f)
f)) " (C B A)")
((Rlist (funcallS #'(lambda-primitiveS (x) (y) (y)
(declare (type oss x y) (type integer y))
(setq y (car x)))
(Elist '((1) (2))))) (1 2))
((funcallS #'(lambda-primitiveS (numbers) (number) (number)
(declare (type oss numbers))
(prologS (setq number 0))
(setq number (+ number numbers)))
(Elist '(1 2))) 3)
((funcallS #'(lambda-primitiveS (items) (list) (list)
(declare (type oss items))
(prologS (setq list nil))
(setq list (cons items list))
(epilogS (setq list (nreverse list))))
(Elist '(1 2))) (1 2))
((Rlist (funcallS #'(lambda-primitiveS (list) (items) (state items)
(declare (type oss items))
(prologS (setq state list))
(if (null state) (terminateS))
(setq items (car state))
(setq state (cdr state)))
'(1 2))) (1 2))
((Rlist (funcallS #'(lambda-primitiveS (Nitems1 Nitems2) (items) (items done)
(declare (type oss Nitems1 Nitems2 items))
(prologS (setq done nil))
(if done (go D))
(next-inS Nitems1 (setq done T) (go D))
(setq items Nitems1)
(go F)
D (next-inS Nitems2)
(setq items Nitems2)
F)
(Elist '(1 2)) (Elist '(3 4)))) (1 2 3 4))
((letS (((x+ x-) (funcallS #'(lambda-primitiveS (items pred)
(Nitems1 Nitems2) (Nitems1 Nitems2)
(declare (type oss items Nitems1 Nitems2))
(if (not (funcall pred items)) (go D))
(setq Nitems1 items)
(next-outS Nitems1)
(go F)
D (setq Nitems2 items)
(next-outS Nitems2)
F)
(Elist '(1 -2 3 -4))
#'plusp)))
(list (Rsum x+) (Rsum x-))) (4 -6))
(test-def ((defmacro Rcount (items)
(let ((counter (gensym)))
`(funcallS #'(lambda-primitiveS (items)
(result) (result)
(declare (type oss items))
(wrapS #'(lambda (body)
(list 'let '((,counter 0))
body)))
(incf ,counter)
(epilogS (setq result ,counter)))
,items)))
(Rcount (Elist '(1 2 3)))) 3)
((let ((l (list 1 2)))
(letS ((e (funcallS #'(lambda-primitiveS (list) (items) (state parent items)
(declare (type oss items))
(prologS (setq state list))
(if (null state) (terminateS))
(setq parent state)
(setq items (car state))
(setq state (cdr state))
(alterableS items (car parent)))
l)))
(alterS e (1+ e))
l)) (2 3))
((lets ((e (Elist '(1 -2 3))))
(Rlist (funcallS #'(lambda-primitiveS (Nitems) (Nitems) ()
(declare (type oss Nitems) (type number Nitems))
L (next-inS Nitems)
(if (not (plusp Nitems)) (go L)))
e))) (1 3))
((not
(null
(member '(type number e)
(decls
(lets ((e (Elist '(1 -2 3))))
(Rlist (funcallS #'(lambda-primitiveS (Nitems) (Nitems) ()
(declare (type oss Nitems)
(type number Nitems))
L (next-inS Nitems)
(if (not (plusp Nitems)) (go L)))
e))))
:test #'equal))) T)
((letS ((x (Eoss 1 2 3))
(y (Eoss 4 5)))
(list (Rsum x) (Rsum y))) (6 9))
((list (Rsum (Eoss 1 2 3)) (Rsum (Eoss 4 5))) (6 9))
;the following uses lambdaS to test all kinds of wierd combinations
;mg1
((funcalls #'(lambdaS (x) (lets ((z (list x))) (list z))) 4) ((4)))
((funcalls #'(lambdaS (x) (declare (type oss x)) (nreverse (Rbag x)))
(Elist '(a b c)))
(a b c))
((funcalls #'(lambdaS (x) (declare (type oss x)) (Rlist (list x)))
(Elist '(a b c)))
((a) (b) (c)))
;mg2
((funcalls #'(lambdaS (x y) (declare (type oss x y))
(list (Rlist x) (Rlist (Tselect (plusp y) y))))
(Elist '(a b c)) (Elist '(1 -2 3)))
((a b c) (1 3)))
((funcalls #'(lambdaS (x y) (declare (type oss x y))
(list (Rlist (Tselect (plusp y) y)) (Rlist x)))
(Elist '(a b c)) (Elist '(1 -2 3)))
((1 3) (a b c)))
;mg3
((Rlist (funcallS #'(lambdaS (x y z) (declare (type oss x y z))
(Tconcatenate (Tmerge x y #'<) z))
(Eoss 1 2 4) (Eoss 1 3 3) (Eoss 0)))
(1 1 2 3 3 4 0))
((letS (((a b) (Eplist '(k1 2 k2 4))))
(list (Rlist b)
(Rlist (Texpand (Eoss :R nil nil T nil T nil nil nil T)
a nil))))
((2 4) (nil nil k1 nil k2 nil nil nil)))
((Rlist (funcallS #'(lambdaS (x)
(letS (((a b) (Eplist x)))
(Texpand (Eoss nil nil T nil T nil nil nil T)
a nil)
b))
'(k1 2 k2 4)))
(2 4))
((Rlist (funcallS #'(lambdaS (x) (declare (type oss x))
(Tconcatenate (list x) (Eoss 5 6)))
(Elist '(1 2 3))))
((1) (2) (3) 5 6))
((Rlist (funcallS #'(lambdaS (x) (declare (type oss x))
(Tconcatenate (Tselect (plusp x) x)
(Eoss 5 6)))
(Elist '(1 -2 3))))
(1 3 5 6))
((Rlist (funcalls #'(lambdaS (x) (declare (type oss x))
(TselectF #'evenp (TsplitF x #'plusp)))
(Elist '(1 2 -2 3 4))))
(2 4))
((Rlist (funcalls #'(lambdaS (x) (declare (type oss x))
(List (TsplitF x #'plusp)))
(Elist '(1 2 -2 3 4))))
((1) (2) (3) (4)))
;mg4
((letS (((a b) (Eplist '(k1 1 k2 -2))))
(list (Rlist a) (Rlist (Tselectf #'plusp b))))
((k1 k2) (1)))
((Rlist (funcallS #'(lambdaS (x)
(letS (((a b) (Eplist x)))
(Rlist (Tselectf #'plusp b)) a))
'(k1 1 k2 -2)))
(k1 k2))
((let (z)
(list (Rlist (funcallS #'(lambdaS (x)
(letS (((a b) (Eplist x)))
(setq z (Rbag (Tselectf #'plusp b))) (list a)))
'(k1 1 k2 -2)))
z))
(((k1) (k2)) (1)))
;mg5
((LetS (((A B)
(funcalls #'(lambdaS (x y) (declare (type oss x))
(valS (Tselect (plusp x) x) (Elist y)))
(Elist '(1 -2 3)) '(a b c))))
(list (Rlist a) (Rlist b)))
((1 3) (a b)))
;these are weird tests checking for particular bugs in old versions
((let ((x (list 1 2 3)))
(prognS (list (setf (car (Esublists x)) (Elist '(a b c d))))) x)
(a b c)) ;don't want to have any complaints from setf here.
((let ((x (list 1 2 3)))
(prognS (setf (car (Esublists x)) (Elist '(a b c d)))) x)
(a b c)) ;don't want to have any complaints from setf here.
((Rfirst (TselectF #'(lambda (x) (and (car x) (cdr x)))
(Elist '((a) (nil . b) (a . b) (c))))) (a . b))
((letS ((l (car '((1 2 3 4)))))
(Rlist (list (Elist l) (Elist l)))) ((1 1) (2 2) (3 3) (4 4)))
((let ((x nil))
(TmapF #'(lambda (e) (push e x)) (Elist '(1 2))) x) (2 1))
((let ((oss::*renames* '((x . 2) (y . 3))) oss::*env*)
(oss::m-&-r '(prog (x) (list x y)))) (prog (x) (list x 3)))
((let ((oss::*renames* '((x . 2) (y . 3))) oss::*env*)
(oss::m-&-r '(prog a (x) (list x y)))) (prog a (x) (list x 3)))
((let ((oss::*renames* '((x . 2) (y . 3))) oss::*env*)
(oss::m-&-r '(prog* (x) (list x y)))) (prog* (x) (list x 3)))
((let ((oss::*renames* '((x . 2) (y . 3))) oss::*env*)
(oss::m-&-r '(prog* a (x) (list x y)))) (prog* a (x) (list x 3)))
((let ((oss::*renames* '((x . 2) (y . 3))) oss::*env*)
(oss::m-&-r '(multiple-value-bind (x) (list x y) (list x y))))
(multiple-value-bind (x) (list 2 3) (list x 3)))
((letS ((x (Elist '(2 -1 0 1 -2))))
(list (Rsum (Tselectf #'plusp x)) (Rsum (Tselectf #'minusp x)))) (3 -3))
((letS ((x (Elist '(2 -1 0 1 -2))))
(list (Rsum (Tselectf #'plusp x)) (Rsum (Tselect (minusp x) x)))) (3 -3))
((letS ((x (TsplitF (Elist '(2 -1 a 0 b 1 -2)) #'numberp)))
(list (Rsum x) (Rsum (Tselectf #'minusp x)))) (0 -3))
((letS ((x (TsplitF (Elist '(2 -1 a 0 b 1 -2)) #'numberp)))
(list (Rsum x) (Rbag (Tselectf #'plusp x)))) (0 (1 2)))
((letS ((x (TsplitF (Elist '(2 -1 a 0 b 1 -2)) #'numberp)))
(list (Rsum x) (Rbag (Tselectf #'plusp x)) (Rmax (Tselectf #'plusp x))))
(0 (1 2) 2))
((letS ((x (TsplitF (Elist '(2 -1 a 0 b 1 -2)) #'numberp)))
(list (Rsum (Tselectf #'plusp x)) (Rsum (Tselectf #'minusp x)))) (3 -3))
((letS ((x (TsplitF (Elist '(2 -1 a 0 b 1 -2)) #'numberp)))
(list (Rsum (Tselectf #'plusp x)) (Rsum (Tselect (minusp x) x)))) (3 -3))
((letS ((x (TsplitF (Elist '(2 -1 a 0 b 1 -2)) #'numberp)))
(list (Rsum (Tselectf #'plusp x)) (Rbag (Tselectf #'plusp x)))) (3 (1 2)))
((letS ((x (TsplitF (Elist '(2 -1 a 0 b 1 -2)) #'numberp)))
(list (Rsum (Tselectf #'plusp x)) (Rbag (Tselectf #'plusp x))
(Rmax (Tselectf #'plusp x))))
(3 (1 2) 2))
((lets* ((e1 (Elist '(1 -2 -4 3))) (e2 (Elist '(1 -2 -4 3))) (e3 (Elist '(1 -2 -4 3)))
(w1 (TsplitF e2 #'plusp)) ((nil x2) (TsplitF e3 #'plusp)))
(list (Rlist (list e1 w1)) (Rlist (list w1 x2))))
(((1 1) (-2 3)) ((1 -2) (3 -4))))
((let ((v '(1 -2 3)))
(letS* ((e (Elist v))
(x (TuntilF #'minusp e)))
(alterS x (- x)))
v) (-1 -2 3))
((Rlist (Tsubseries (Tmask (Tpositions (Eoss t nil t nil))) 0 5))
(t nil t nil nil))
((oss::nsubst-inline nil 1 '(3 1 2)) (3 2))
((Let ((X '(1 2 3)))
(macrolet ((bab (z) `(list ,z)))
(rlist (bab (elist x))))) ((1) (2) (3)))
;the following test error checking.
(test-warn (Rlist (Eup 0 :to 5 :below 6)) (1.1 1.1))
(test-warn (Rlist (Edown 0 :to 5 :length 6)) (1.2 1.2))
(test-warn (Rlist (Tlatch (Elist '(1 2)) :after 2 :before 3))
(1.3 1.3))
(test-warn (TconcatenateF #'car (Elist x)) (2 2))
(test-warn (TconcatenateF #'Efile (Elist x)) (2 2))
(test-warn (TconcatenateF #'Tpositions (Elist x)) (2 2))
(test-warn (defunS ff (a &rest b) (car a)) (3 3))
(test-warn (defunS ff (a &allow-other-keys b) (car a)) (3 3))
(test-warn (alterS (Eup :to 4) 5) (4 4))
(test-warn (alterS (car (Elist x)) 5) (4 4))
(test-warn (alterS (Tpositions (Elist x)) 5) (4 4))
(test-warn (funcalls #'(lambdaS ((A)) nil) 2) (5 5))
(test-warn (funcalls #'(lambdaS (T) nil) 2) (5 5))
(test-warn (funcalls #'(lambdaS (nil) nil) 2) (5 5))
(test-warn (funcalls #'(lambdaS (3) nil) 2) (5 5))
(test-warn (funcalls #'(lambdaS (&aux a) nil) 2) (5 5))
(test-warn (lambdaS (arg) arg) (6 6))
(test-warn (funcallS (lambdaS (arg) arg) (Elist x)) (6 6))
(test-warn (funcallS #'(lambdaS (a) (car a))) (7 7))
(test-warn (funcallS #'(lambdaS (a) (car a)) x y) (7 7))
(test-warn (letS (((a b) (Elist x))) x) (8 8))
(test-warn (letS (a) a) (9 9))
(test-warn (letS ((a)) a) (9 9))
(test-warn (letS (((a b))) a) (9 9))
(test-warn (letS ((t 3)) a) (9 9))
(test-warn (letS ((((a)) 3)) a) (9 9))
(test-warn (letS (((t b) 3)) a) (9 9))
(test-warn (letS ((2 nil)) nil) (9 9))
(test-warn (letS ((a nil nil)) nil) (9 9))
(test-warn (letS ((a (Elist '(1 2)))) (declare (type oss a)) (Rlist a))
((1 2) 10))
(test-warn (letS ((e (Elist '(1 2 3)))) (Rlist (Elist '(1 2))))
((1 2) 11))
(test-warn
(lets ((a nil) (z (Elist x)) (b (Rlist (elist x)))) (setq a nil))
(12 12))
(test-warn
(lets ((a nil) (z (Elist x)) (b (Rlist (elist x)))) (setq z nil))
(12 12))
(test-warn
(lets ((a nil) (z (Elist x)) (b (Rlist (elist x)))) (setq b nil))
(12 12))
(test-warn (prognS (let ((z 2)) (Rlist (Elist '(a b z))))) ((a b z) 13))
(test-warn (Elist (Elist x)) (14 14))
(test-warn (letS ((e (Elist x)))
(Elist e)) (14 14))
(test-warn (block bar
(letS ((x (Eoss :R -1 2 3)))
(if (plusp x) (return-from bar x)))) (2 15))
(test-warn (compiler-let ((*permit-non-terminating-oss-expressions* T))
(block bar
(letS ((x (Eoss :R -1 2 3)))
(if (plusp x) (return-from bar x))))) (2 nil))
(test-warn (letS* ((e (Elist '(1 2)))
(w (Rlist e)))
(Rlist (cons e w))) (((1 1 2) (2 1 2)) 16))
(test-warn (letS* ((e (Elist '((1) (2))))
(w (Rlist e)))
(Rlist (cons (car e) w))) (((1 (1) (2)) (2 (1) (2))) 16))
(test-warn (letS* ((e (Elist '(1 2)))
(w (Rlist e))
(x (Rsum e)))
(list (Rlist (list e x))
(Rlist (list* e w))))
((((1 3) (2 3)) ((1 1 2) (2 1 2))) 16))
(test-warn (lets* ((e (Elist '(1 -2 -4 3)))
(w (TselectF #'plusp e)))
(Rlist (list e w))) (((1 1) (-2 3)) 17.1))
(test-warn (lets* ((e (Elist '(1 -2 -4 3)))
(w (TselectF #'plusp e)))
(Rlist (list e e w))) (((1 1 1) (-2 -2 3)) 17.1))
(test-warn (lets* ((e (Elist '(1 2))))
(Rlist (Tconcatenate e e))) ((1 2 1 2) 17.1))
(test-warn (lets* ((e (Elist '(1 2))))
(Rlist (list e (Tconcatenate e e)))) (((1 1) (2 2)) 17.1))
(test-warn (lets* ((e (Elist '(1 -2 -3 4))))
(Rlist (list e (Tconcatenate (TselectF #'plusp e)
(TselectF #'minusp e)))))
(((1 1) (-2 4) (-3 -2) (4 -3)) 17.1))
(test-warn (lets* ((e (Elist '(1 -2 -3 4)))
((w x) (TsplitF e #'plusp)))
(Rlist (list e (Tconcatenate w x))))
(((1 1) (-2 4) (-3 -2) (4 -3)) 17.1))
(test-warn (lets* ((e (Elist '(1 -2 3)))
(w (TsplitF e #'plusp)))
(Rlist (list e w))) (((1 1) (-2 3)) 17.2))
(test-warn (lets* ((e (Elist '(1 -2 3)))
(w (TsplitF e #'plusp)))
(Rlist (list e e w))) (((1 1 1) (-2 -2 3)) 17.2))
(test-warn (lets* ((e (Elist '(1 -2 -4 3)))
((w x) (TsplitF e #'plusp)))
(Rlist (list w x))) (((1 -2) (3 -4)) 17.2))
(test-warn (letS ((x (Elist '(1 2 3)))
(y (Elist '(4 5))))
(list (Rsum (+ x y)) (Rsum y)))
((12 9) 18))
(test-warn (letS ((x (Elist '(1 2 3)))
(y (Elist '(4 5))))
(list (Rsum (+ x y)) (Rsum y) (Rsum y)))
((12 9 9) 18))
(test-warn (lets* ((e (Elist '(1 -2 -4 3)))
((w x) (TsplitF e #'plusp)))
(list (Rlist (list e w))
(Rlist (list w x))))
((((1 1) (-2 3)) ((1 -2) (3 -4))) 18))
(test-warn (defunS gack (e)
(declare (type oss e))
(Elist (Rlist e))) (19 19))
(test-warn (prognS (flet ((a (b) (car b))) (a (elist x)))) (20 20))
(test-warn (lambda-primitiveS (arg) () () arg) (21 21))
(test-warn (funcallS (lambda-primitiveS (arg) () () arg) (Elist x))
(21 21))
(test-warn (prologS) (22.1 22.1))
(test-warn (progns (prologS (setq f 1)) (Rlist (Elist x))) (22.1 22.1))
(test-warn (epilogS) (22.2 22.2))
(test-warn (next-inS x) (22.3 22.3))
(test-warn (next-outS x) (22.4 22.4))
(test-warn (wrapS #'foo) (22.5 22.5))
(test-warn (alterableS x (car y)) (22.6 22.6))
(test-warn (funcallS #'(lambda-primitiveS ((a)) (b) (b) nil) 2)
(23.1 23.1))
(test-warn (funcallS #'(lambda-primitiveS (a) (c) (b) nil) 2)
(23.2 23.2))
(test-warn (funcallS #'(lambda-primitiveS (a) (3) (b) nil) 2)
(23.2 23.2))
(test-warn (funcallS #'(lambda-primitiveS (a) (b) (t) nil) 2)
(23.3 23.3))
(test-warn (funcallS #'(lambda-primitiveS (a) (b) (a) nil) 2)
(23.3 23.3))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(next-inS b)) 2) (24 24))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(next-inS a)) 2) (24 24))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(declare (type oss a))
(next-inS a) (next-inS a)) 2) (24 24))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(next-outS b)) 2) (25 25))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(next-outS a)) 2) (25 25))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(declare (type oss a))
(next-outS a) (next-outS a)) 2) (25 25))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(declare (type oss a))
(next-outS a (go f))) 2) (25 25))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(wrapS foo)) 2) (26 26))
(test-warn (funcallS #'(lambda-primitiveS (a) (a) ()
(alterableS b (car b))) 2) (27 27))
(test-warn (funcallS #'(lambda-primitiveS (c) (a) (a)
(alterableS a (car c))) 2) (27 27))
(test-warn (funcallS #'(lambda-primitiveS (c) (a) (a)
(alterableS a (car a) 3)) 2) (27 27))
;the following test tutorial mode
(test-tut (eval (read-from-string "(Rsum [1 2 3])")) 6)
(test-tut (not (null (string-equal (let ((*print-case* :downcase))
(with-output-to-string (f)
(prin1 (Elist '(a b c)) f)))
"[a b c]"))) T)
(test-tut (not (null (string-equal (let ((*print-case* :downcase))
(with-output-to-string (f)
(prin1 (Eup) f)))
"[0 1 2 3 4 5 6 7 8 9 10 ...]")))
T)
) test-failed nil)
;------------------------------------------------------------------------ ;
; Copyright (c) Richard C. Waters, 1988 ;
;------------------------------------------------------------------------ ;