Commit 628bce31 by pfdietz

### More order-of-argument-evaluation tests.

parent 263b709a
This diff is collapsed.
 ... ... @@ -10,133 +10,133 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; nunion (deftest nunion-1 (deftest nunion.1 (nunion nil nil) nil) (deftest nunion-2 (deftest nunion.2 (nunion-with-copy (list 'a) nil) (a)) (deftest nunion-3 (deftest nunion.3 (nunion-with-copy (list 'a) (list 'a)) (a)) (deftest nunion-4 (deftest nunion.4 (nunion-with-copy (list 1) (list 1)) (1)) (deftest nunion-5 (deftest nunion.5 (let ((x (list 'a 'b))) (nunion-with-copy (list x) (list x))) ((a b))) (deftest nunion-6 (deftest nunion.6 (let ((x '(a b c d e f)) (y '(z c y a v b))) (let ((result (nunion-with-copy x y))) (check-union x y result))) t) (deftest nunion-6-a (deftest nunion.6-a (let ((x '(a b c d e f)) (y '(z c y a v b))) (let ((result (nunion-with-copy x y :test #'eq))) (check-union x y result))) t) (deftest nunion-7 (deftest nunion.7 (let ((x '(a b c d e f)) (y '(z c y a v b))) (let ((result (nunion-with-copy x y :test #'eql))) (check-union x y result))) t) (deftest nunion-8 (deftest nunion.8 (let ((x '(a b c d e f)) (y '(z c y a v b))) (let ((result (nunion-with-copy x y :test #'equal))) (check-union x y result))) t) (deftest nunion-9 (deftest nunion.9 (let ((x '(a b c d e f)) (y '(z c y a v b))) (let ((result (nunion-with-copy x y :test-not (complement #'eql)))) (check-union x y result))) t) (deftest nunion-10 (deftest nunion.10 (let ((x '(a b c d e f)) (y '(z c y a v b))) (let ((result (nunion-with-copy x y :test-not (complement #'equal)))) (check-union x y result))) t) (deftest nunion-11 (deftest nunion.11 (let ((x '(a b c d e f)) (y '(z c y a v b))) (let ((result (nunion-with-copy x y :test-not (complement #'eq)))) (check-union x y result))) t) (deftest nunion-12 (deftest nunion.12 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy x y))) (check-union x y result))) t) (deftest nunion-13 (deftest nunion.13 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy x y :test #'equal))) (check-union x y result))) t) (deftest nunion-14 (deftest nunion.14 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy x y :test #'eql))) (check-union x y result))) t) (deftest nunion-15 (deftest nunion.15 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy x y :test-not (complement #'equal)))) (check-union x y result))) t) (deftest nunion-16 (deftest nunion.16 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy x y :test-not (complement #'eql)))) (check-union x y result))) t) (deftest nunion-17 (deftest nunion.17 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy-and-key x y #'1+))) (check-union x y result))) t) (deftest nunion-18 (deftest nunion.18 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy-and-key x y #'1+ :test #'equal))) (check-union x y result))) t) (deftest nunion-19 (deftest nunion.19 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy-and-key x y #'1+ :test #'eql))) (check-union x y result))) t) (deftest nunion-20 (deftest nunion.20 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy-and-key x y #'1+ ... ... @@ -144,7 +144,7 @@ (check-union x y result))) t) (deftest nunion-21 (deftest nunion.21 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy-and-key x y #'1+ ... ... @@ -152,14 +152,14 @@ (check-union x y result))) t) (deftest nunion-22 (deftest nunion.22 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy-and-key x y nil))) (check-union x y result))) t) (deftest nunion-23 (deftest nunion.23 (let ((x '(1 2 3 4 5 6 7)) (y '(10 19 5 3 17 1001 2))) (let ((result (nunion-with-copy-and-key x y '1+))) ... ... @@ -168,11 +168,11 @@ ;; Do large numbers of random nunions (deftest nunion-24 (deftest nunion.24 (do-random-nunions 100 100 200) nil) (deftest nunion-25 (deftest nunion.25 (let ((x (shuffle '(1 4 6 10 45 101))) (y '(102 5 2 11 44 6))) (let ((result (nunion-with-copy x y ... ... @@ -187,7 +187,7 @@ ;; Check that nunion uses eql, not equal or eq (deftest nunion-26 (deftest nunion.26 (let ((x 1000) (y 1000)) (loop ... ... @@ -203,7 +203,7 @@ 1)))) t) (deftest nunion-27 (deftest nunion.27 (nunion-with-copy (list (copy-seq "aa")) (list (copy-seq "aa"))) ("aa" "aa")) ... ... @@ -212,7 +212,7 @@ ;; Check that nunion does not reverse the arguments to :test, :test-not (deftest nunion-28 (deftest nunion.28 (block fail (sort (nunion-with-copy ... ... @@ -224,7 +224,7 @@ #'<)) (1 2 3 4 5 6)) (deftest nunion-29 (deftest nunion.29 (block fail (sort (nunion-with-copy-and-key ... ... @@ -237,7 +237,7 @@ #'<)) (1 2 3 4 5 6)) (deftest nunion-30 (deftest nunion.30 (block fail (sort (nunion-with-copy ... ... @@ -250,7 +250,7 @@ #'<)) (1 2 3 4 5 6)) (deftest nunion-31 (deftest nunion.31 (block fail (sort (nunion-with-copy-and-key ... ... @@ -263,6 +263,46 @@ #'<)) (1 2 3 4 5 6)) ;;; Order of evaluation tests (deftest nunion.32 (let ((i 0) x y) (values (sort (nunion (progn (setf x (incf i)) (copy-list '(1 3 5))) (progn (setf y (incf i)) (copy-list '(2 5 8)))) #'<) i x y)) (1 2 3 5 8) 2 1 2) (deftest nunion.33 (let ((i 0) x y z w) (values (sort (nunion (progn (setf x (incf i)) (copy-list '(1 3 5))) (progn (setf y (incf i)) (copy-list '(2 5 8))) :test (progn (setf z (incf i)) #'eql) :key (progn (setf w (incf i)) #'identity)) #'<) i x y z w)) (1 2 3 5 8) 4 1 2 3 4) (deftest nunion.34 (let ((i 0) x y z w) (values (sort (nunion (progn (setf x (incf i)) (copy-list '(1 3 5))) (progn (setf y (incf i)) (copy-list '(2 5 8))) :key (progn (setf z (incf i)) #'identity) :test (progn (setf w (incf i)) #'eql)) #'<) i x y z w)) (1 2 3 5 8) 4 1 2 3 4) ;;; Keyword tests (deftest nunion.allow-other-keys.1 ... ...
This diff is collapsed.
This diff is collapsed.
 ... ... @@ -12,58 +12,58 @@ (defvar cons-test-24-var '(78 "z" (8 9))) (deftest subsetp-1 (subsetp-with-check (copy-tree '(78)) cons-test-24-var) (deftest subsetp.1 (subsetp-with-check (copy-tree '(78)) cons-test-24-var) t) (deftest subsetp-2 (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var) (deftest subsetp.2 (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var) nil) (deftest subsetp-3 (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var :test 'equal) (deftest subsetp.3 (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var :test 'equal) t) (deftest subsetp-4 (subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var :test #'equalp) (deftest subsetp.4 (subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var :test #'equalp) t) (deftest subsetp-5 (subsetp-with-check (list 1) (list 0 2 3 4) :key #'(lambda (i) (floor (/ i 2)))) (deftest subsetp.5 (subsetp-with-check (list 1) (list 0 2 3 4) :key #'(lambda (i) (floor (/ i 2)))) t) (deftest subsetp-6 (subsetp-with-check (list 1 6) (list 0 2 3 4) :key #'(lambda (i) (floor (/ i 2)))) (deftest subsetp.6 (subsetp-with-check (list 1 6) (list 0 2 3 4) :key #'(lambda (i) (floor (/ i 2)))) nil) (deftest subsetp-7 (subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30)) (list '(z . c) '(a . y) '(b . 100) '(e . f) '(c . foo)) :key #'car) (deftest subsetp.7 (subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30)) (list '(z . c) '(a . y) '(b . 100) '(e . f) '(c . foo)) :key #'car) t) (deftest subsetp-8 (subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30))) (copy-tree '((z . c) (a . y) (b . 100) (e . f) (c . foo))) :key 'car) (deftest subsetp.8 (subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30))) (copy-tree '((z . c) (a . y) (b . 100) (e . f) (c . foo))) :key 'car) t) (deftest subsetp-9 (subsetp-with-check (list 'a 'b 'c) (copy-tree (list '(z . c) '(a . y) '(b . 100) '(e . f) '(c . foo))) :test #'(lambda (e1 e2) (eqt e1 (car e2)))) (deftest subsetp.9 (subsetp-with-check (list 'a 'b 'c) (copy-tree (list '(z . c) '(a . y) '(b . 100) '(e . f) '(c . foo))) :test #'(lambda (e1 e2) (eqt e1 (car e2)))) t) (deftest subsetp-10 (deftest subsetp.10 (subsetp-with-check (list 'a 'b 'c) (copy-tree (list '(z . c) '(a . y) '(b . 100) '(e . f) ... ... @@ -73,58 +73,96 @@ :key nil) t) (deftest subsetp-11 (subsetp-with-check (list 'a 'b 'c) (copy-tree (list '(z . c) '(a . y) '(b . 100) '(e . f) '(c . foo))) :test-not #'(lambda (e1 e2) (not (eqt e1 (car e2))))) (deftest subsetp.11 (subsetp-with-check (list 'a 'b 'c) (copy-tree (list '(z . c) '(a . y) '(b . 100) '(e . f) '(c . foo))) :test-not #'(lambda (e1 e2) (not (eqt e1 (car e2))))) t) ;; Check that it maintains order of arguments (deftest subsetp-12 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :test #'(lambda (x y) (when (< y x) (return-from fail 'fail)) t))) t) (deftest subsetp-13 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :key #'identity :test #'(lambda (x y) (when (< y x) (return-from fail 'fail)) t))) t) (deftest subsetp-14 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :test-not #'(lambda (x y) (when (< y x) (return-from fail 'fail)) nil))) t) (deftest subsetp-15 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :key #'identity :test-not #'(lambda (x y) (when (< y x) (return-from fail 'fail)) nil))) t) (deftest subsetp.12 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :test #'(lambda (x y) (when (< y x) (return-from fail 'fail)) t))) t) (deftest subsetp.13 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :key #'identity :test #'(lambda (x y) (when (< y x) (return-from fail 'fail)) t))) t) (deftest subsetp.14 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :test-not #'(lambda (x y) (when (< y x) (return-from fail 'fail)) nil))) t) (deftest subsetp.15 (block fail (subsetp-with-check (list 1 2 3) (list 4 5 6) :key #'identity :test-not #'(lambda (x y) (when (< y x) (return-from fail 'fail)) nil))) t) ;;; Order of argument evaluation tests (deftest subsetp.16 (let ((i 0) x y) (values (notnot (subsetp (progn (setf x (incf i)) '(a b c)) (progn (setf y (incf i)) '(a b c d)))) i x y)) t 2 1 2) (deftest subsetp.17 (let ((i 0) x y z w) (values (notnot (subsetp (progn (setf x (incf i)) '(a b c)) (progn (setf y (incf i)) '(a b c d)) :test (progn (setf z (incf i)) #'eql) :key (progn (setf w (incf i)) nil))) i x y z w)) t 4 1 2 3 4) (deftest subsetp.18 (let ((i 0) x y z w) (values (notnot (subsetp (progn (setf x (incf i)) '(a b c)) (progn (setf y (incf i)) '(a b c d)) :key (progn (setf z (incf i)) nil) :test (progn (setf w (incf i)) #'eql))) i x y z w)) t 4 1 2 3 4) ;;; Keyword tests ... ...
 ... ... @@ -418,6 +418,36 @@ (count-if-not #'%onep a :from-end t))))) 2 3 2 3) ;;; Argument order tests (deftest count-if-not-order.1 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if-not (progn (setf c1 (incf i)) #'null) (progn (setf c2 (incf i)) '(a nil b c nil d e)) :start (progn (setf c3 (incf i)) 0) :end (progn (setf c4 (incf i)) 3) :key (progn (setf c5 (incf i)) #'not) :from-end (progn (setf c6 (incf i)) nil) ) i c1 c2 c3 c4 c5 c6)) 1 6 1 2 3 4 5 6) (deftest count-if-not-order.2 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if-not (progn (setf c1 (incf i)) #'null) (progn (setf c2 (incf i)) '(a nil b c nil d e)) :from-end (progn (setf c3 (incf i)) nil) :key (progn (setf c4 (incf i)) #'not) :end (progn (setf c5 (incf i)) 3) :start (progn (setf c6 (incf i)) 0) ) i c1 c2 c3 c4 c5 c6)) 1 6 1 2 3 4 5 6) ;;; Keyword tests (deftest count-if-not.keywords.1 ... ...
 ... ... @@ -417,6 +417,35 @@ (count-if #'digit-char-p s :start 1 :end 2))) 3 3 2 2 1) ;;; Argument order tests (deftest count-if-order.1 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if (progn (setf c1 (incf i)) #'null) (progn (setf c2 (incf i)) '(a nil b c nil d e)) :start (progn (setf c3 (incf i)) 0) :end (progn (setf c4 (incf i)) 3) :key (progn (setf c5 (incf i)) #'identity) :from-end (progn (setf c6 (incf i)) nil) ) i c1 c2 c3 c4 c5 c6)) 1 6 1 2 3 4 5 6) (deftest count-if-order.2 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if (progn (setf c1 (incf i)) #'null) (progn (setf c2 (incf i)) '(a nil b c nil d e)) :from-end (progn (setf c3 (incf i)) nil) :key (progn (setf c4 (incf i)) #'identity) :end (progn (setf c5 (incf i)) 3) :start (progn (setf c6 (incf i)) 0) ) i c1 c2 c3 c4 c5 c6)) 1 6 1 2 3 4 5 6) ;;; Keyword tests (deftest count-if.allow-other-keys.1 ... ...
 ... ... @@ -486,6 +486,37 @@ :start 2 :end 5) 3) ;;; Argument order tests (deftest count-order.1 (let ((i 0) c1 c2 c3 c4 c5 c6 c7) (values (count (progn (setf c1 (incf i)) nil) (progn (setf c2 (incf i)) '(a nil b c nil d e)) :start (progn (setf c3 (incf i)) 0) :end (progn (setf c4 (incf i)) 3) :key (progn (setf c5 (incf i)) #'identity) :from-end (progn (setf c6 (incf i)) nil) :test (progn (setf c7 (incf i)) #'eql) ) i c1 c2 c3 c4 c5 c6 c7)) 1 7 1 2 3 4 5 6 7) (deftest count-order.2 (let ((i 0) c1 c2 c3 c4 c5 c6 c7) (values (count (progn (setf c1 (incf i)) nil) (progn (setf c2 (incf i)) '(a nil b c nil d e)) :test (progn (setf c3 (incf i)) #'eql) :from-end (progn (setf c4 (incf i)) nil) :key (progn (setf c5 (incf i)) #'identity) :end (progn (setf c6 (incf i)) 3) :start (progn (setf c7 (incf i)) 0) ) i c1 c2 c3 c4 c5 c6 c7)) 1 7 1 2 3 4 5 6 7) ;;; Keyword tests (deftest count.allow-other-keys.1 ... ...
 ... ... @@ -123,6 +123,25 @@ (elt x #\w))) type-error) (deftest elt.20 (let ((i 0) x y) (values (elt (progn (setf x (incf i)) '(a b c d e)) (progn (setf y (incf i)) 3)) i x y)) d 2 1 2) (deftest elt.21 (let ((i 0) x y z) (let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e)))) (values (setf (elt (aref a (progn (setf x (incf i)) 0)) (progn (setf y (incf i)) 3)) (progn (setf z (incf i)) 'k)) (aref a 0) i x y z))) k (a b c k e) 3 1 2 3) (deftest elt-v-1 (classify-error (elt (make-array '(0)) 0)) ... ... @@ -347,5 +366,3 @@ (deftest elt.error.3 (classify-error (elt nil 0 nil)) program-error)
 ... ... @@ -51,6 +51,13 @@ (eqlt #c(1 -2) (- #c(-1 2))) t) (deftest eql.12 (let ((i 0) x y) (values (eql (setf x (incf i)) (setf y (incf i))) i x y)) nil 2 1 2) (deftest eql.error.1 (classify-error (eql)) program-error) ... ...
 ... ... @@ -61,6 +61,13 @@ (equalt (copy-seq #*000110) (copy-seq #*000111)) nil) (deftest equal.13 (let ((i 0) x y) (values (equal (setf x (incf i)) (setf y (incf i))) i x y)) nil 2 1 2) (deftest equal.error.1 (classify-error (equal)) program-error) ... ...
 ... ... @@ -27,6 +27,13 @@ (equalpt "abc" "abd") nil) (deftest equalp.5 (let ((i 0) x y) (values (equalp (setf x (incf i)) (setf y (incf i))) i x y)) nil 2 1 2) (deftest equalp.error.1 (classify-error (equalp)) program-error) ... ...
 ... ... @@ -78,6 +78,14 @@ (notnot-mv (every 'null '(nil nil nil nil))) t) (deftest every.17 (let ((i 0) x y) (values (every (progn (setf x (incf i)) #'null) (progn (setf y (incf i)) '(nil nil a nil))) i x y)) nil 2 1 2) ;;; Error cases (deftest every.error.1 ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!