Lines Matching defs:eval
73 (defun compare-eval (test expect form
78 (setq result (eval form))
103 (defun error-eval (form &aux result (error t))
105 (setq result (eval form))
126 (defun eq-eval (expect form)
127 (compare-eval #'eq expect form))
129 (defun eql-eval (expect form)
130 (compare-eval #'eql expect form))
132 (defun equal-eval (expect form)
133 (compare-eval #'equal expect form))
135 (defun equalp-eval (expect form)
136 (compare-eval #'equalp expect form))
156 (eq-eval t '(let* ((a #\a) (b a)) (eq a b)))
159 (eq-eval t '(eq #1=1 #1#))
174 (equal-eval '(1 5/6 #p"test" #\#) '(setq a '(1 5/6 #p"test" #\#)))
199 (equal-eval '(1 2 3/5 #\a) '(setq a '(1 2 3/5 #\a)))
257 (eql-eval 1 '(setq temp1 1 temp2 1 temp3 1))
258 (eql-eval 2 '(and (incf temp1) (incf temp2) (incf temp3)))
259 (eq-eval t '(and (eql 2 temp1) (eql 2 temp2) (eql 2 temp3)))
260 (eql-eval 1 '(decf temp3))
261 (eq-eval nil '(and (decf temp1) (decf temp2) (eq temp3 'nil) (decf temp3)))
262 (eq-eval t '(and (eql temp1 temp2) (eql temp2 temp3)))
263 (eq-eval t '(and))
264 (equal-eval '(1 2 3) '(multiple-value-list (and (values 'a) (values 1 2 3))))
265 (equal-eval nil '(and (values) t))
292 (eq-eval nil '(block empty))
293 (eql-eval 2 '(let ((x 1))
295 (eql-eval 2 '(block twin (block twin (return-from twin 1)) 2))
302 (eql-eval 1 '(setq x 1))
306 (eq-eval nil '(let ((x 1)) (boundp 'x)))
312 (equal-eval '(1 2 3 4 5 6 7 8 9) 'x)
313 (eq-eval nil '(nbutlast x 9))
315 (equal-eval '(1) 'x)
371 (eql-eval t '(let ((a 1)) (case a ((4 5 6) nil) ((3 2 1) t) (otherwise :error))))
372 (eql-eval t '(let ((a 1)) (case a ((3 2) nil) (1 t) (t :error))))
373 (error-eval '(let ((a 1)) (case a (2 :error) (t nil) (otherwise t))))
374 (error-eval '(let ((a 1)) (case a (2 :error) (otherwise t) (t nil))))
377 (eql-eval 3 '(catch 'dummy-tag 1 2 (throw 'dummy-tag 3) 4))
378 (eql-eval 4 '(catch 'dummy-tag 1 2 3 4))
379 (eq-eval 'throw-back '(defun throw-back (tag) (throw tag t)))
380 (eq-eval t '(catch 'dummy-tag (throw-back 'dummy-tag) 2))
558 (eql-eval 2 '(let ((a 1)) (cond ((= a 2) 1) ((= a 1) 2) ((= a 0) 1) (t nil))))
559 (eql-eval nil '(let ((a 1)) (cond ((= a 2) 1) (t nil) ((= a 1) 2) ((= a 0) 1))))
588 (equal-eval '(1 (2 3)) '(setq x '(1 (2 3))))
589 (equal-eval x '(setq y (copy-list x)))
594 (equal-eval '(1 (2 3) 4) '(setq a '(1 (2 3) 4) b (copy-list a)))
595 (eq-eval t '(eq (cadr a) (cadr b)))
596 (eq-eval t '(eq (car a) (car b)))
598 (eq-eval nil '(eq (cadr a) (cadr b)))
599 (eq-eval t '(eq (car a) (car b)))
607 (eq-eval t '(eq (cadadr a) (cadadr as-list)))
608 (eq-eval t '(eq (cadadr a) (cadadr as-alist)))
609 (eq-eval nil '(eq (cadadr a) (cadadr as-tree)))
613 (eql-eval 1 '(decf n))
614 (eql-eval 1 'n)
616 (eql-eval -2147483649 '(decf n))
617 (eql-eval -2147483649 'n)
619 (eql-eval -0.5d0 '(decf n 0.5d0))
620 (eql-eval -0.5d0 'n)
622 (eql-eval 1/2 '(decf n 1/2))
623 (eql-eval 1/2 'n)
628 (eq-eval t '(eq a b))
630 (equal-eval '(1 3 5 9) 'a)
633 (eq-eval t '(eq a b))
635 (eq-eval t '(eq a b))
637 (eq-eval t '(eq a b))
639 (eq-eval t '(eq a b))
641 (equal-eval '(1 2 1 3 5) 'a)
643 (equal-eval '(1 2 1 3 4 5) 'a)
645 (equal-eval '(1 2 4 1 3 5) 'a)
652 (eq-eval t '(eq a b))
654 (equal-eval '(1 2 :test 7 8) 'a)
689 (eq-eval 'test '(defun test ()))
693 (eq-eval 'test '(defmacro test (x) x))
700 (eq-eval t '(eq (car x) (cadr x)))
713 (equal-eval '(nil nil)
715 (equal-eval '(nil nil)
718 (equal-eval test '(read-from-string "(never-before-used nil)"))
719 (equal-eval '(never-before-used :internal)
721 (equal-eval '(never-before-used :internal)
723 (equal-eval '(nil nil)
725 (equal-eval '(car :inherited)
727 (equal-eval '(car :external)
731 (equal-eval '(nil :inherited)
733 (equal-eval '(nil :external)
738 (equal-eval (read-from-string "(just-testing::nil :internal)") 'test)
739 (eq-eval t '(export 'just-testing::nil 'just-testing))
740 (equal-eval '(just-testing:nil :external)
743 #+xedit (equal-eval '(nil nil)
747 (equal-eval '(:nil :external)
787 (eq-eval '*john* '(defvar *john* (make-person "John" "Dow")))
788 (eq-eval '*sally* '(defvar *sally* (make-person "Sally" "Jones")))
789 (equal-eval "John" '(get *john* 'first-name))
790 (equal-eval "Jones" '(get *sally* 'last-name))
797 (equal-eval "Dow-Jones" '(marry *john* *sally* "Dow-Jones"))
798 (equal-eval "Dow-Jones" '(get *john* 'last-name))
799 (equal-eval "Sally" '(get (get *john* 'wife) 'first-name))
800 (equal-eval `(wife ,*sally* last-name "Dow-Jones" first-name "John")
802 (eq-eval 'age
805 (eq-eval 'thirty-something '(age *john*))
806 (eql-eval 20 '(age *john* 20))
807 (eql-eval 25 '(setf (age *john*) 25))
808 (eql-eval 25 '(age *john*))
809 (eql-eval 25 '(age *john* 20))
819 (eq-eval nil '(if nil t))
820 (eq-eval nil '(if t nil t))
821 (eq-eval nil '(if nil t nil))
822 (eq-eval nil '(if nil t (if nil (if nil t) nil)))
826 (eql-eval 2 '(incf n))
827 (eql-eval 2 'n)
829 (eql-eval 2147483648 '(incf n))
830 (eql-eval 2147483648 'n)
832 (eql-eval 0.5d0 '(incf n 0.5d0))
833 (eql-eval 0.5d0 'n)
835 (eql-eval 3/2 '(incf n 1/2))
836 (eql-eval 3/2 'n)
846 (equal-eval '(1 1 4 b c) 'list1)
881 (eql-eval 2 '(setq a 1 b 2))
882 (eql-eval 2 '(let ((a 2)) a))
883 (eql-eval 1 'a)
884 (eql-eval 1 '(let ((a 3) (b a)) b))
885 (eql-eval 2 'b)
889 (eql-eval 2 '(let* ((a 2)) a))
890 (eql-eval 1 'a)
891 (eql-eval 3 '(let* ((a 3) (b a)) b))
892 (eql-eval 2 'b)
968 (equal-eval '(nil nil) '(multiple-value-list (find-symbol temp-string)))
971 (eq-eval 1 '(setf (symbol-value 'a) 1))
973 (eql-eval 1 'a)
985 (equal-eval '(1 a x 2 b y 3 c z) 'dummy)
1010 (equal-eval '((4) (3 4) (2 3 4) (1 2 3 4)) 'dummy)
1036 (equal-eval '(11 9) '(multiple-value-bind (f r) (floor 130 11) (list f r)))
1039 (equal-eval '(1 / 2 3 / / 2 0.5)
1041 (eql-eval 10 '(multiple-value-call #'+ (floor 5 3) (floor 19 4)))
1044 (equal-eval '(-1 1) '(multiple-value-list (floor -3 4)))
1045 (eql-eval nil '(multiple-value-list (values)))
1046 (equal-eval '(nil) '(multiple-value-list (values nil)))
1050 (equal-eval temp
1058 (eql-eval 1 '(multiple-value-setq (quotient remainder) (truncate 3.5d0 2)))
1059 (eql-eval 1 quotient)
1060 (eql-eval 1.5d0 'remainder)
1061 (eql-eval 1 '(multiple-value-setq (a b c) (values 1 2)))
1062 (eql-eval 1 'a)
1063 (eql-eval 2 'b)
1064 (eq-eval nil 'c)
1065 (eql-eval 4 '(multiple-value-setq (a b) (values 4 5 6)))
1066 (eql-eval 4 'a)
1067 (eql-eval 5 'b)
1069 (eql-eval nil '(multiple-value-setq (a) (values)))
1070 (eql-eval nil 'a)
1077 (equal-eval '(a b c d e f) 'x)
1081 (equal-eval '(k l m)
1086 (equal-eval '(a b c d e f g h i j k l m) 'foo)
1087 (equal-eval (nthcdr 5 foo) 'bar)
1088 (equal-eval (nthcdr 10 foo) 'baz)
1092 (equal-eval '(a b c d e f g h i j k l m) '(setq foo (nconc nil foo bar nil baz)))
1093 (equal-eval '(a b c d e f g h i j k l m) 'foo)
1094 (equal-eval (nthcdr 5 foo) 'bar)
1095 (equal-eval (nthcdr 10 foo) 'baz)
1116 (equal-eval 'a '(nth-value 0 (values 'a 'b)))
1117 (equal-eval 'b '(nth-value 1 (values 'a 'b)))
1118 (eq-eval nil '(nth-value 2 (values 'a 'b)))
1119 (equal-eval '(3332987528 3332987528 t)
1140 (eq-eval nil '(or))
1142 (eql-eval 10 '(or temp0 temp1 (setq temp2 37)))
1143 (eql-eval 20 'temp2)
1144 (eql-eval 11 '(or (incf temp1) (incf temp2) (incf temp3)))
1145 (eql-eval 11 'temp1)
1146 (eql-eval 20 temp2)
1147 (eql-eval 30 'temp3)
1148 (eql-eval 11 '(or (values) temp1))
1149 (eql-eval 11 '(or (values temp1 temp2) temp3))
1150 (equal-eval '(11 20) '(multiple-value-list (or temp0 (values temp1 temp2))))
1151 (equal-eval '(20 30)
1173 (equal-eval '(1 2 3) 'keys)
1174 (equal-eval '("one" "two" "three") 'data)
1175 (equal-eval '((4 . "four")) 'alist)
1182 (eq-eval 'a '(pop stack))
1183 (eq-eval (cdr test) 'stack)
1185 (eq-eval 1 '(pop (car llst)))
1186 (eq-eval (cdr test) '(car llst))
1187 (error-eval '(pop 1))
1188 (error-eval '(pop nil))
1191 (eq-eval 1 '(pop stack))
1192 (error-eval '(pop stack))
1195 (eql-eval 1 '(pop stack))
1196 (eql-eval 1 '(pop stack))
1197 (eql-eval 1 '(pop (cdr stack)))
1207 (eq-eval nil '(prog () :error))
1208 (eq-eval 'ok
1218 (eq-eval '/= '(prog ((a 2) (b a)) (return (if (= a b) '= '/=))))
1222 (eq-eval nil '(prog* () :error))
1223 (eq-eval 'ok
1234 (eq-eval '= '(prog* ((a 2) (b a)) (return (if (= a b) '= '/=))))
1238 (eql-eval 1 '(prog1 temp (incf temp) (eql-eval 2 'temp) temp))
1239 (eql-eval 2 'temp)
1240 (eql-eval 2 '(prog1 temp (setq temp nil) (eql-eval nil 'temp) temp))
1241 (eq-eval nil 'temp)
1242 (eql-eval 1 '(prog1 (values 1 2 3) 4))
1244 (eq-eval 'a '(prog1 (car temp) (setf (car temp) 'alpha)))
1245 (equal-eval '(alpha b c) 'temp)
1246 (equal-eval '(1)
1251 (eql-eval 3 '(prog2 (incf temp) (incf temp) (incf temp)))
1252 (eql-eval 4 'temp)
1253 (eql-eval 2 '(prog2 1 (values 2 3 4) 5))
1254 (equal-eval '(3)
1258 (eq-eval nil '(progn))
1259 (eql-eval 3 '(progn 1 2 3))
1260 (equal-eval '(1 2 3) '(multiple-value-list (progn (values 1 2 3))))
1262 (eq-eval 'here '(if a (progn (setq a nil) 'here) (progn (setq a t) 'there)))
1263 (eq-eval nil 'a)
1268 (eql-eval 2 '(progv '(*x*) '(2) *x*))
1269 (eql-eval 1 '*x*)
1270 (equal-eval '(3 4)
1274 (equal-eval '(4 4)
1276 (equal-eval '(4 4)
1283 (equal-eval '(1) '(push 1 (car llst)))
1284 (equal-eval '((1)) 'llst)
1285 (equal-eval '(1 1) '(push 1 (car llst)))
1286 (equal-eval '((1 1)) 'llst)
1288 (equal-eval '(5 B C) '(push 5 (cadr x)))
1289 (equal-eval '(a (5 b c) d) 'x)
1293 (equal-eval '(5 b c) '(pushnew 5 (cadr x)))
1294 (equal-eval '(a (5 b c) d) 'x)
1295 (equal-eval '(5 b c) '(pushnew 'b (cadr x)))
1296 (equal-eval '(a (5 b c) d) 'x)
1298 (equal-eval '((2) (1) (1 2) (1 2 3)) '(pushnew '(2) lst))
1299 (equal-eval '((1) (2) (1) (1 2) (1 2 3)) '(pushnew '(1) lst))
1300 (equal-eval '((1) (2) (1) (1 2) (1 2 3)) '(pushnew '(1) lst :test 'equal))
1301 (equal-eval '((1) (2) (1) (1 2) (1 2 3)) '(pushnew '(1) lst :key #'car))
1321 (equal-eval "010123456" 'lst)
1324 (equal-eval '(2) '(rest '(1 2)))
1325 (eql-eval 2 '(rest '(1 . 2)))
1326 (eq-eval nil '(rest '(1)))
1328 (equal-eval "two" '(setf (rest *cons*) "two"))
1329 (equal-eval '(1 . "two") '*cons*)
1332 (eq-eval nil '(block nil (return) 1))
1333 (eql-eval 1 '(block nil (return 1) 2))
1334 (equal-eval '(1 2) '(multiple-value-list (block nil (return (values 1 2)) 3)))
1335 (eql-eval 1 '(block nil (block alpha (return 1) 2)))
1336 (eql-eval 2 '(block alpha (block nil (return 1)) 2))
1337 (eql-eval 1 '(block nil (block nil (return 1) 2)))
1340 (eq-eval nil '(block alpha (return-from alpha) 1))
1341 (eql-eval 1 '(block alpha (return-from alpha 1) 2))
1342 (equal-eval '(1 2)
1344 (eql-eval 2
1346 (eq-eval 'temp '(defun temp (x) (if x (return-from temp ''dummy)) 44))
1347 (eql-eval 44 '(temp nil))
1348 (eq-eval 'dummy (temp t))
1349 (eql-eval 2 (block nil (unwind-protect (return-from nil 1) (return-from nil 2))))
1350 (error-eval '(funcall (block nil #'(lambda () (return-from nil)))))
1355 (eq-eval test 'str)
1356 (equal-eval "cba" '(setq test (nreverse str)))
1357 (equal-eval "cba" 'test)
1359 (equal-eval '(3 2 1) '(setq test (nreverse l)))
1360 (equal-eval '(3 2 1) 'test)
1363 (eql-eval '*some-list*
1365 (equal-eval '(one two three . four) '*some-list*)
1367 (equal-eval '(uno two three . four) '*some-list*)
1369 (equal-eval '(uno two three iv) '*some-list*)
1384 (eql-eval 1 '(setf (symbol-value 'n) 1))
1387 (eql-eval 4
1393 (eql-eval 44 'n)
1395 (eql-eval 80
1401 (eql-eval 2 '*n*)
1402 (eq-eval '*even-count* '(defvar *even-count* 0))
1403 (eq-eval '*odd-count* '(defvar *odd-count* 0))
1404 (eql-eval 'tally-list
1409 (eq-eval nil '(tally-list '(1 9 4 3 2 7)))
1410 (eql-eval 6 '*even-count*)
1411 (eql-eval 20 '*odd-count*)
1423 (equal-eval '(("c" . "a") ("e" . "b") ("d" . "a")) 'lst2)
1442 (equal-eval '(1 x 3) '(setf (car x) 'x (cadr y) (car x) (cdr x) y))
1443 (equal-eval '(x 1 x 3) 'x)
1444 (equal-eval '(1 x 3) 'y)
1446 (eq-eval nil '(psetf (car x) 'x (cadr y) (car x) (cdr x) y))
1447 (equal-eval '(x 1 a 3) 'x)
1448 (equal-eval '(1 a 3) 'y)
1449 (error-eval '(setf x))
1450 (error-eval '(psetf x))
1453 (eql-eval 3 '(setq a 1 b 2 c 3))
1454 (eql-eval 1 'a)
1455 (eql-eval 2 'b)
1456 (eql-eval 3 'c)
1457 (eql-eval 7 '(setq a (1+ b) b (1+ a) c (+ a b)))
1458 (eql-eval 3 'a)
1459 (eql-eval 4 'b)
1460 (eql-eval 7 'c)
1461 (eq-eval nil '(psetq a 1 b 2 c 3))
1462 (eql-eval 1 'a)
1463 (eql-eval 2 'b)
1464 (eql-eval 3 'c)
1465 (equal-eval '(2 1)
1467 (error-eval '(setq x))
1468 (error-eval '(setq x 1 y))
1502 (equalp-eval
1575 (equal-eval "0123AbcD890a" 'str)
1616 (equal-eval "abc" '(setf (subseq str 4) "abc"))
1617 (equal-eval "0123ab" 'str)
1618 (equal-eval "A" '(setf (subseq str 0 2) "A"))
1619 (equal-eval "A123ab" 'str)
1633 (eql-eval 1 '(svref v 0))
1634 (eql-eval 'sirens '(svref v 2))
1635 (eql-eval 'newcomer '(setf (svref v 1) 'newcomer))
1636 (equalp-eval #(1 newcomer sirens) 'v)
1651 (eq-eval t '(export (find-symbol "SAMPLE1" "PK1") "PK1"))
1653 (equal-eval '(pk1:sample1 :inherited)
1663 (eq-eval t '(import s3 'pk2))
1664 (eq-eval t '(unintern s3 'pk1)) ;; XXX unintern not yet implemented
1670 (eq-eval () '(symbol-plist sym))
1671 (eq-eval 'val1 '(setf (get sym 'prop1) 'val1))
1672 (equal-eval '(prop1 val1) '(symbol-plist sym))
1673 (eq-eval 'val2 '(setf (get sym 'prop2) 'val2))
1674 (equal-eval '(prop2 val2 prop1 val1) '(symbol-plist sym))
1676 (eq-eval sym-plist '(setf (symbol-plist sym) sym-plist))
1677 (eq-eval sym-plist '(symbol-plist sym))
1680 (eql-eval 1 '(setf (symbol-value 'a) 1))
1681 (eql-eval 1 '(symbol-value 'a))
1683 (eql-eval 1 '(let ((a 2)) (symbol-value 'a)))
1684 (eql-eval 1 '(let ((a 2)) (setq a 3) (symbol-value 'a)))
1691 (eql-eval 2 '(let ((a 2)) (symbol-value 'a)))
1692 (eql-eval 1 'a)
1693 (eql-eval 3 '(let ((a 2)) (setq a 3) (symbol-value 'a)))
1694 (eql-eval 1 'a)
1697 (eql-eval 2 '(let ((a 2)) (setf (symbol-value 'a) 3) a))
1698 (eql-eval 3 'a)
1699 (eql-eval 3 '(symbol-value 'a))
1702 (equal-eval '(5 4)
1712 (eql-eval 3 'a)
1714 (eq-eval :any-keyword '(symbol-value :any-keyword))
1716 (eq-eval nil '(symbol-value 'nil))
1717 (eq-eval nil '(symbol-value '()))
1730 (eq-eval () '(symbol-plist test))
1731 (eq-eval t '(setf (get test 'constant) t))
1732 (eql-eval 3.14 '(setf (get test 'approximation) 3.14))
1733 (eql-eval 'noticeable '(setf (get test 'error-range) 'noticeable))
1734 (equal-eval '(error-range noticeable approximation 3.14 constant t)
1736 (eq-eval nil '(setf (get test 'approximation) nil))
1737 (equal-eval '(error-range noticeable approximation nil constant t)
1739 (eq-eval nil (get test 'approximation))
1741 (eq-eval nil '(get test 'approximation))
1742 (equal-eval '(error-range noticeable constant t) '(symbol-plist test))
1744 (equal-eval '(error-range noticeable constant t) '(symbol-plist test))
1746 (eql-eval 3 '(setf (get test 'approximation) 3))
1747 (equal-eval '(approximation 3 constant t) '(symbol-plist test))
1750 (equal-eval '(3 9)
1756 (eql-eval 2 '(catch nil (unwind-protect (throw nil 1) (throw nil 2))))
1759 (eql-eval 2
1764 (eq-eval :outer-catch
1771 (equal-eval "The inner catch returns :SECOND-THROW." 'string)
1794 (eq-eval 'hello '(when t 'hello))
1795 (eq-eval nil '(unless t 'hello))
1796 (eq-eval nil (when nil 'hello))
1797 (eq-eval 'hello '(unless nil 'hello))
1798 (eq-eval nil (when t))
1799 (eql-eval nil '(unless nil))
1801 (equal-eval '(3 2 1) '(when t (push 1 test) (push 2 test) (push 3 test)))
1802 (equal-eval '(3 2 1) 'test)
1804 (eq-eval nil '(unless t (push 1 test) (push 2 test) (push 3 test)))
1805 (eq-eval nil 'test)
1806 (eq-eval nil '(when nil (push 1 test) (push 2 test) (push 3 test)))
1807 (eq-eval nil 'test)
1808 (equal-eval '(3 2 1) '(unless nil (push 1 test) (push 2 test) (push 3 test)))
1809 (equal-eval '(3 2 1) 'test)
1810 (equal-eval '((4) nil (5) nil 6 (6) 7 (7))
1826 (eql-eval 2 '(catch 'abort (dummy-function 1)))
1827 (eql-eval 2 'state)
1828 (eq-eval 'not-a-number '(catch 'abort (dummy-function 'trash)))
1829 (eq-eval 'running 'state)
1830 (eq-eval 'not-a-number
1833 (eq-eval 'aborted 'state)
1834 (eql-eval 2 '(block nil (unwind-protect (return 1) (return 2))))
1836 (eql-eval 2
1841 (eql-eval 2 '(catch nil (unwind-protect (throw nil 1) (throw nil 2))))
1843 (eql-eval 2
1845 (eq-eval ':outer-catch
1853 (equal-eval "The inner catch returns :SECOND-THROW." 'string)
1854 (eql-eval 10
1860 (eql-eval 4
1866 (eql-eval 4
1872 (eql-eval 5
1885 (eq-eval () '(multiple-value-list (values)))
1886 (equal-eval '(1) '(multiple-value-list (values 1)))
1887 (equal-eval '(1 2) '(multiple-value-list (values 1 2)))
1888 (equal-eval '(1 2 3) '(multiple-value-list (values 1 2 3)))
1889 (equal-eval '(1 4 5) '(multiple-value-list (values (values 1 2 3) 4 5)))
1892 (eq-eval nil '(multiple-value-list (values-list nil)))
1893 (equal-eval '(1) '(multiple-value-list (values-list '(1))))
1894 (equal-eval '(1 2) '(multiple-value-list (values-list '(1 2))))
1895 (equal-eval '(1 2 3) '(multiple-value-list (values-list '(1 2 3))))