diff --git a/ansi-tests/bit-and.lsp b/ansi-tests/bit-and.lsp index 4a15b3c352020635cab220f61bd2631fc947e473..0b62bb383d92838a3c4f9cac126b16545d1d00a0 100644 --- a/ansi-tests/bit-and.lsp +++ b/ansi-tests/bit-and.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((0 0)(0 1))) -(deftest bit-and.20 +(deftest bit-and.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-andc1.lsp b/ansi-tests/bit-andc1.lsp index fecdbaa79516fa162b9e4cc9897106477baa4690..5597ad16d620af969ca53538eb4144ee80007bdd 100644 --- a/ansi-tests/bit-andc1.lsp +++ b/ansi-tests/bit-andc1.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((0 0)(1 0))) -(deftest bit-andc1.20 +(deftest bit-andc1.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-andc2.lsp b/ansi-tests/bit-andc2.lsp index 0778d711f3c4b10be2c771a919797c010fda57d0..b61cbf7d14258e957f3e09a1470d58cb38c2cfa0 100644 --- a/ansi-tests/bit-andc2.lsp +++ b/ansi-tests/bit-andc2.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((0 1)(0 0))) -(deftest bit-andc2.20 +(deftest bit-andc2.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-eqv.lsp b/ansi-tests/bit-eqv.lsp index 43674aa24809d05ef0c0712660ac9bc4b4d354f9..6593d97dd9552e5a6efd803cde93b212260b9454 100644 --- a/ansi-tests/bit-eqv.lsp +++ b/ansi-tests/bit-eqv.lsp @@ -219,7 +219,7 @@ #2a((0 0)(1 1)) #2a((1 0)(0 1))) -(deftest bit-eqv.20 +(deftest bit-eqv.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-ior.lsp b/ansi-tests/bit-ior.lsp index 5b9940e012371c56d4493917bb3339f8486b5672..469c778069761c9f12714f679a506dc23dd08b5b 100644 --- a/ansi-tests/bit-ior.lsp +++ b/ansi-tests/bit-ior.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((0 1)(1 1))) -(deftest bit-ior.20 +(deftest bit-ior.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-nand.lsp b/ansi-tests/bit-nand.lsp index 266f3e3cb7f5c7966cc863f0bad02d76d2afda47..840e686743576b7e5574041f2ca17ebcf2e3d9ad 100644 --- a/ansi-tests/bit-nand.lsp +++ b/ansi-tests/bit-nand.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((1 1)(1 0))) -(deftest bit-nand.20 +(deftest bit-nand.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-nor.lsp b/ansi-tests/bit-nor.lsp index 3055c1233ea5a94d65fc3bab733886fa8cb5fe14..36031ef39f29cfd8ecb83d4ede296759911e78e0 100644 --- a/ansi-tests/bit-nor.lsp +++ b/ansi-tests/bit-nor.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((1 0)(0 0))) -(deftest bit-nor.20 +(deftest bit-nor.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-not.lsp b/ansi-tests/bit-not.lsp index c8da583a09d329ce05a5ad299197a6c0324bea59..550dce3abbd7aa3dd9499df26e55cbe622a9ac7f 100644 --- a/ansi-tests/bit-not.lsp +++ b/ansi-tests/bit-not.lsp @@ -119,6 +119,14 @@ #2a((0 1)(1 0)) #2a((1 0)(0 1))) +(deftest bit-not.order.1 + (let ((a (copy-seq #*001101)) + (i 0) x) + (values + (bit-not (progn (setf x (incf i)) a)) + i x)) + #*110010 1 1) + ;;; Error tests (deftest bit-not.error.1 diff --git a/ansi-tests/bit-orc1.lsp b/ansi-tests/bit-orc1.lsp index 7fe27f2d515071950d648e013347eb8e97de421b..96467f90db864b3116081e109289084d07f43f62 100644 --- a/ansi-tests/bit-orc1.lsp +++ b/ansi-tests/bit-orc1.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((1 0)(1 1))) -(deftest bit-orc1.20 +(deftest bit-orc1.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-orc2.lsp b/ansi-tests/bit-orc2.lsp index c91450540316e6b301895bbe45cc346b5ebfc04a..1f7af7244c55c49c9a2978194c0a1c9be7dcc7fc 100644 --- a/ansi-tests/bit-orc2.lsp +++ b/ansi-tests/bit-orc2.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((1 1)(0 1))) -(deftest bit-orc2.20 +(deftest bit-orc2.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit-vector-p.lsp b/ansi-tests/bit-vector-p.lsp index 6038ca3ac5e6888b65d4635c2d69dc0b3944052f..93ebbd221b85b5063fcfcdd12d560fcd756f0c98 100644 --- a/ansi-tests/bit-vector-p.lsp +++ b/ansi-tests/bit-vector-p.lsp @@ -53,6 +53,23 @@ always (if p1 p2 (not p2))) t) +(deftest bit-vector-p.order.1 + (let ((i 0) x) + (values + (notnot (bit-vector-p (progn (setf x (incf i)) #*0010))) + i x)) + t 1 1) + +(deftest bit-vector-p.order.2 + (let ((i 0) x) + (values + (bit-vector-p (progn (setf x (incf i)) 'a)) + i x)) + nil 1 1) + + + + (deftest bit-vector-p.error.1 (classify-error (bit-vector-p)) program-error) diff --git a/ansi-tests/bit-xor.lsp b/ansi-tests/bit-xor.lsp index e0e5a8a007a83c10646a4c810c4215fb929a5d36..a2b58dd58e40e7fc1e1d79bc48ed8d4cab32202e 100644 --- a/ansi-tests/bit-xor.lsp +++ b/ansi-tests/bit-xor.lsp @@ -218,7 +218,7 @@ #2a((0 0)(1 1)) #2a((0 1)(1 0))) -(deftest bit-xor.20 +(deftest bit-xor.order.1 (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit)) (s2 (make-array 1 :initial-element 0 :element-type 'bit)) (x 0) y z) diff --git a/ansi-tests/bit.lsp b/ansi-tests/bit.lsp index 5a88fd35b75516828e45a45a53c1d10d25511fd8..70b807c3d23e35037d4d3cde0df1b045daf838cf 100644 --- a/ansi-tests/bit.lsp +++ b/ansi-tests/bit.lsp @@ -111,7 +111,7 @@ ;;; Order of evaluation tests -(deftest bit.9 +(deftest bit.order.1 (let ((x 0) y z (b (copy-seq #*01010))) (values @@ -120,7 +120,7 @@ x y z)) 1 2 1 2) -(deftest bit.10 +(deftest bit.order.2 (let ((x 0) y z w (b (copy-seq #*01010))) (values diff --git a/ansi-tests/boundp.lsp b/ansi-tests/boundp.lsp index 7a84dec98bf33a83f7a2e67e833bc1bd83e2dfdb..b0385ff1cafab4178a60b8b18f5efdc0d419a903 100644 --- a/ansi-tests/boundp.lsp +++ b/ansi-tests/boundp.lsp @@ -46,3 +46,11 @@ (deftest boundp.4 (boundp '#:foo) nil) + +(deftest boundp.order.1 + (let ((i 0) x) + (values + (boundp (progn (setf x (incf i)) '#:foo)) + i x)) + nil 1 1) + diff --git a/ansi-tests/cell-error-name.lsp b/ansi-tests/cell-error-name.lsp index c8bf93b83c140554725544be92186894d55e2cec..3a418acfb014a2d80f576845ba4824e7a48ccf34 100644 --- a/ansi-tests/cell-error-name.lsp +++ b/ansi-tests/cell-error-name.lsp @@ -14,6 +14,7 @@ (deftest cell-error-name.2 (handler-case (eval '(my-undefined-function)) + ;; (warning (c) (muffle-warning c)) (cell-error (c) (cell-error-name c))) my-undefined-function) @@ -28,6 +29,15 @@ (deftest cell-error-name.5 (cell-error-name (make-condition 'unbound-slot :name 's)) s) + +(deftest cell-error-name.6 + (let ((i 0)) + (values + (cell-error-name (progn (incf i) (make-condition + 'unbound-slot :name 's))) + i)) + s 1) + ;;; Need test raising condition unbound-slot diff --git a/ansi-tests/char-compare.lsp b/ansi-tests/char-compare.lsp index ff4c7e3a2e995f86cd7b95c7930352c267af04b8..e26205e0947d80158a16e37b868c3b60ac66db33 100644 --- a/ansi-tests/char-compare.lsp +++ b/ansi-tests/char-compare.lsp @@ -35,7 +35,19 @@ #'(lambda (c1 c2) (not (char= c1 c2)))) t) -(deftest char=.5 +(deftest char=.order.1 + (let ((i 0)) + (values (not (char= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char=.order.2 + (let ((i 0) a b) + (values (char= (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b)) + i a b)) + nil 2 1 2) + +(deftest char=.order.3 (let ((i 0) a b c) (values (char= (progn (setq a (incf i)) #\a) @@ -44,6 +56,8 @@ i a b c)) nil 3 1 2 3) +;;; + (deftest char/=.1 (is-ordered-by +code-chars+ #'char/=) t) @@ -61,7 +75,19 @@ (is-ordered-by +rev-code-chars+ #'char/=) t) -(deftest char/=.5 +(deftest char/=.order.1 + (let ((i 0)) + (values (not (char/= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char/=.order.2 + (let ((i 0) a b) + (values (not (char/= (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char/=.order.3 (let ((i 0) a b c) (values (char/= (progn (setq a (incf i)) #\a) @@ -70,6 +96,8 @@ i a b c)) nil 3 1 2 3) +;;; + (deftest char<=.1 (loop for c across +code-chars+ always (char<= c c)) @@ -103,7 +131,19 @@ (notnot-mv (or (char<= #\9 #\a) (char<= #\z #\0))) t) -(deftest char<=.9 +(deftest char<=.order.1 + (let ((i 0)) + (values (not (char<= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char<=.order.2 + (let ((i 0) a b) + (values (not (char<= (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char<=.order.3 (let ((i 0) a b c) (values (char<= (progn (setq a (incf i)) #\a) @@ -112,6 +152,8 @@ i a b c)) nil 3 1 2 3) +;;; + (deftest char<.1 (loop for c across +code-chars+ never (char< c c)) @@ -145,7 +187,19 @@ (notnot-mv (or (char< #\9 #\a) (char< #\z #\0))) t) -(deftest char<.9 +(deftest char<.order.1 + (let ((i 0)) + (values (not (char< (progn (incf i) #\a))) i)) + nil 1) + +(deftest char<.order.2 + (let ((i 0) a b) + (values (not (char< (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char<.order.3 (let ((i 0) a b c) (values (char< (progn (setq a (incf i)) #\a) @@ -154,6 +208,17 @@ i a b c)) nil 3 1 2 3) +(deftest char<.order.4 + (let ((i 0) a b c) + (values + (char< (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + (deftest char>=.1 (loop for c across +code-chars+ always (char>= c c)) @@ -187,7 +252,19 @@ (notnot-mv (or (char>= #\a #\9) (char>= #\0 #\z))) t) -(deftest char>=.9 +(deftest char>=.order.1 + (let ((i 0)) + (values (not (char>= (progn (incf i) #\a))) i)) + nil 1) + +(deftest char>=.order.2 + (let ((i 0) a b) + (values (not (char>= (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char>=.order.3 (let ((i 0) a b c) (values (char>= (progn (setq a (incf i)) #\b) @@ -196,6 +273,17 @@ i a b c)) nil 3 1 2 3) +(deftest char>=.order.4 + (let ((i 0) a b c) + (values + (char>= (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + (deftest char>.1 (loop for c across +code-chars+ never (char> c c)) @@ -229,7 +317,19 @@ (notnot-mv (or (char> #\a #\9) (char> #\0 #\z))) t) -(deftest char>.9 +(deftest char>.order.1 + (let ((i 0)) + (values (not (char> (progn (incf i) #\a))) i)) + nil 1) + +(deftest char>.order.2 + (let ((i 0) a b) + (values (not (char> (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char>.order.3 (let ((i 0) a b c) (values (char> (progn (setq a (incf i)) #\b) @@ -238,6 +338,15 @@ i a b c)) nil 3 1 2 3) +(deftest char>.order.4 + (let ((i 0) a b c) + (values + (char> (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + ;;; Case-insensitive comparisons (deftest char-equal.1 @@ -266,7 +375,19 @@ (not (char-equal c1 c2))))) t) -(deftest char-equal.5 +(deftest char-equal.order.1 + (let ((i 0)) + (values (not (char-equal (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-equal.order.2 + (let ((i 0) a b) + (values (char-equal (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a)) + i a b)) + nil 2 1 2) + +(deftest char-equal.order.3 (let ((i 0) a b c) (values (char-equal (progn (setq a (incf i)) #\a) @@ -275,6 +396,17 @@ i a b c)) nil 3 1 2 3) +(deftest char-equal.order.4 + (let ((i 0) a b c) + (values + (char-equal (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + (deftest char-not-equal.1 (is-ordered-by +code-chars+ #'(lambda (c1 c2) (or (char= (char-downcase c1) @@ -298,7 +430,19 @@ (char-not-equal c1 c2)))) t) -(deftest char-not-equal.5 +(deftest char-not-equal.order.1 + (let ((i 0)) + (values (not (char-not-equal (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-not-equal.order.2 + (let ((i 0) a b) + (values (not (char-not-equal (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char-not-equal.order.3 (let ((i 0) a b c) (values (char-not-equal (progn (setq a (incf i)) #\a) @@ -307,6 +451,17 @@ i a b c)) nil 3 1 2 3) +(deftest char-not-equal.order.4 + (let ((i 0) a b c) + (values + (char-not-equal (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + (deftest char-not-greaterp.1 (loop for c across +code-chars+ always (char-not-greaterp c c)) @@ -340,7 +495,19 @@ (notnot-mv (or (char-not-greaterp #\9 #\a) (char-not-greaterp #\z #\0))) t) -(deftest char-not-greaterp.9 +(deftest char-not-greaterp.order.1 + (let ((i 0)) + (values (not (char-not-greaterp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-not-greaterp.order.2 + (let ((i 0) a b) + (values (not (char-not-greaterp (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char-not-greaterp.order.3 (let ((i 0) a b c) (values (char-not-greaterp (progn (setq a (incf i)) #\a) @@ -349,6 +516,17 @@ i a b c)) nil 3 1 2 3) +(deftest char-not-greaterp.order.4 + (let ((i 0) a b c) + (values + (char-not-greaterp (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + (deftest char-lessp.1 (loop for c across +code-chars+ never (char-lessp c c)) @@ -382,7 +560,19 @@ (notnot-mv (or (char-lessp #\9 #\a) (char-lessp #\z #\0))) t) -(deftest char-lessp.9 +(deftest char-lessp.order.1 + (let ((i 0)) + (values (not (char-lessp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-lessp.order.2 + (let ((i 0) a b) + (values (not (char-lessp (progn (setf a (incf i)) #\a) + (progn (setf b (incf i)) #\b))) + i a b)) + nil 2 1 2) + +(deftest char-lessp.order.3 (let ((i 0) a b c) (values (char-lessp (progn (setq a (incf i)) #\a) @@ -391,6 +581,17 @@ i a b c)) nil 3 1 2 3) +(deftest char-lessp.order.4 + (let ((i 0) a b c) + (values + (char-lessp (progn (setq a (incf i)) #\b) + (progn (setq b (incf i)) #\a) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) + +;;; + (deftest char-not-lessp.1 (loop for c across +code-chars+ always (char-not-lessp c c)) @@ -425,7 +626,19 @@ (notnot-mv (or (char-not-lessp #\a #\9) (char-not-lessp #\0 #\z))) t) -(deftest char-not-lessp.9 +(deftest char-not-lessp.order.1 + (let ((i 0)) + (values (not (char-not-lessp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-not-lessp.order.2 + (let ((i 0) a b) + (values (not (char-not-lessp (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char-not-lessp.order.3 (let ((i 0) a b c) (values (char-not-lessp (progn (setq a (incf i)) #\b) @@ -434,6 +647,17 @@ i a b c)) nil 3 1 2 3) +(deftest char-not-lessp.order.4 + (let ((i 0) a b c) + (values + (char-not-lessp (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\b)) + i a b c)) + nil 3 1 2 3) + +;;; + (deftest char-greaterp.1 (loop for c across +code-chars+ never (char-greaterp c c)) @@ -468,7 +692,19 @@ (notnot-mv (or (char-greaterp #\a #\9) (char-greaterp #\0 #\z))) t) -(deftest char-greaterp.9 +(deftest char-greaterp.order.1 + (let ((i 0)) + (values (not (char-greaterp (progn (incf i) #\a))) i)) + nil 1) + +(deftest char-greaterp.order.2 + (let ((i 0) a b) + (values (not (char-greaterp (progn (setf a (incf i)) #\b) + (progn (setf b (incf i)) #\a))) + i a b)) + nil 2 1 2) + +(deftest char-greaterp.order.3 (let ((i 0) a b c) (values (char-greaterp (progn (setq a (incf i)) #\b) @@ -476,3 +712,12 @@ (progn (setq c (incf i)) #\b)) i a b c)) nil 3 1 2 3) + +(deftest char-greaterp.order.4 + (let ((i 0) a b c) + (values + (char-greaterp (progn (setq a (incf i)) #\a) + (progn (setq b (incf i)) #\b) + (progn (setq c (incf i)) #\a)) + i a b c)) + nil 3 1 2 3) diff --git a/ansi-tests/char-schar.lsp b/ansi-tests/char-schar.lsp index af00f03eeb60e6cb3ef42708d7e10a18db58ead1..617316fad91f1ae1b80099cd9dea433193e5dc27 100644 --- a/ansi-tests/char-schar.lsp +++ b/ansi-tests/char-schar.lsp @@ -78,7 +78,7 @@ s) "aaaXa") -(deftest char.11 +(deftest char.order.1 (let ((i 0) a b) (values (char (progn (setf a (incf i)) "abc") @@ -86,7 +86,7 @@ i a b)) #\b 2 1 2) -(deftest char.12 +(deftest char.order.2 (let ((i 0) a b c (s (make-string 5 :initial-element #\z))) (values (setf @@ -145,7 +145,7 @@ s) "xxXxxx") -(deftest schar.11 +(deftest schar.order.1 (let ((i 0) a b) (values (schar (progn (setf a (incf i)) "abc") @@ -153,7 +153,7 @@ i a b)) #\b 2 1 2) -(deftest schar.12 +(deftest schar.order.2 (let ((i 0) a b c (s (copy-seq "zzzzz"))) (values (setf diff --git a/ansi-tests/character.lsp b/ansi-tests/character.lsp index 3b9ee51bc7ae004b595d5adf193e03349de74e7d..923439ef6a194f60554725fbb5f5738baf50e5e7 100644 --- a/ansi-tests/character.lsp +++ b/ansi-tests/character.lsp @@ -63,14 +63,23 @@ (character.2.body) nil) -(deftest character.3 +(deftest character.order.1 + (let ((i 0)) + (values + (character (progn (incf i) #\a)) + i)) + #\a 1) + +(deftest character.error.1 (classify-error (character)) program-error) -(deftest character.4 +(deftest character.error.2 (classify-error (character #\a #\a)) program-error) +;;; + (deftest characterp.1 (every #'characterp +standard-chars+) t) @@ -83,6 +92,13 @@ (characterp.3.body) t) +(deftest characterp.order.1 + (let ((i 0)) + (values + (characterp (incf i)) + i)) + nil 1) + (deftest characterp.error.1 (classify-error (characterp)) program-error) @@ -99,6 +115,8 @@ (not (alpha-char-p c)))) t) +;;; + (deftest alpha-char-p.2 (every #'alpha-char-p +alpha-chars+) t) @@ -107,6 +125,13 @@ (char-type-error-check #'alpha-char-p) t) +(deftest alpha-char-p.order.1 + (let ((i 0)) + (values + (alpha-char-p (progn (incf i) #\8)) + i)) + nil 1) + (deftest alpha-char-p.error.1 (classify-error (alpha-char-p)) program-error) @@ -115,6 +140,8 @@ (classify-error (alpha-char-p #\a #\b)) program-error) +;;; + (deftest alphanumericp.1 (loop for c across +standard-chars+ always @@ -130,7 +157,6 @@ (char-type-error-check #'alphanumericp) t) - (deftest alphanumericp.4 (alphanumericp.4.body) t) @@ -139,6 +165,13 @@ (alphanumericp.5.body) t) +(deftest alphanumericp.order.1 + (let ((i 0)) + (values + (alphanumericp (progn (incf i) #\?)) + i)) + nil 1) + (deftest alphanumericp.error.1 (classify-error (alphanumericp)) program-error) @@ -147,6 +180,8 @@ (classify-error (alphanumericp #\a #\b)) program-error) +;;; + (deftest digit-char.1 (digit-char.1.body) t) @@ -158,6 +193,20 @@ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)) +(deftest digit-char.order.1 + (let ((i 0)) + (values + (digit-char (incf i)) + i)) + #\1 1) + +(deftest digit-char.order.2 + (let ((i 0) x) + (values + (digit-char (incf i) (progn (setf x (incf i)) 10)) + i x)) + #\1 2 2) + (deftest digit-char.error.1 (classify-error (digit-char)) program-error) @@ -166,6 +215,8 @@ (classify-error (digit-char 0 10 'foo)) program-error) +;;; + (deftest digit-char-p.1 (digit-char-p.1.body) t) @@ -195,6 +246,21 @@ always (eqlt (digit-char-p c) i)) t) +(deftest digit-char-p.order.1 + (let ((i 0)) + (values + (digit-char-p (progn (incf i) #\0)) + i)) + 0 1) + +(deftest digit-char-p.order.2 + (let ((i 0) x y) + (values + (digit-char-p (progn (setf x (incf i)) #\0) + (progn (setf y (incf i)) 10)) + i x y)) + 0 2 1 2) + (deftest digit-char-p.error.1 (classify-error (digit-char-p)) program-error) @@ -202,7 +268,8 @@ (deftest digit-char-p.error.2 (classify-error (digit-char-p #\1 10 'foo)) program-error) - + +;;; (deftest graphic-char-p.1 (loop for c across +standard-chars+ @@ -211,17 +278,24 @@ (graphic-char-p c))) t) -(deftest graphic-char.2 +(deftest graphic-char-p.2 (loop for name in '("Rubout" "Page" "Backspace" "Tab" "Linefeed" "Return") for c = (name-char name) when (and c (graphic-char-p c)) collect c) nil) -(deftest graphic-char.3 +(deftest graphic-char-p.3 (char-type-error-check #'graphic-char-p) t) +(deftest graphic-char-p.order.1 + (let ((i 0)) + (values + (not (graphic-char-p (progn (incf i) #\a))) + i)) + nil 1) + (deftest graphic-char-p.error.1 (classify-error (graphic-char-p)) program-error) @@ -230,6 +304,8 @@ (classify-error (graphic-char-p #\a #\a)) program-error) +;;; + (deftest standard-char-p.1 (every #'standard-char-p +standard-chars+) t) @@ -246,6 +322,13 @@ (char-type-error-check #'standard-char-p) t) +(deftest standard-char-p.order.1 + (let ((i 0)) + (values + (not (standard-char-p (progn (incf i) #\a))) + i)) + nil 1) + (deftest standard-char-p.error.1 (classify-error (standard-char-p)) program-error) @@ -253,7 +336,8 @@ (deftest standard-char-p.error.2 (classify-error (standard-char-p #\a #\a)) program-error) - + +;;; (deftest char-upcase.1 (char-upcase.1.body) @@ -271,6 +355,13 @@ (char-type-error-check #'char-upcase) t) +(deftest char-upcase.order.1 + (let ((i 0)) + (values + (char-upcase (progn (incf i) #\a)) + i)) + #\A 1) + (deftest char-upcase.error.1 (classify-error (char-upcase)) program-error) @@ -279,6 +370,8 @@ (classify-error (char-upcase #\a #\a)) program-error) +;;; + (deftest char-downcase.1 (char-downcase.1.body) t) @@ -295,6 +388,13 @@ (char-type-error-check #'char-downcase) t) +(deftest char-downcase.order.1 + (let ((i 0)) + (values + (char-downcase (progn (incf i) #\A)) + i)) + #\a 1) + (deftest char-downcase.error.1 (classify-error (char-downcase)) program-error) @@ -303,6 +403,8 @@ (classify-error (char-downcase #\A #\A)) program-error) +;;; + (deftest upper-case-p.1 (find-if-not #'upper-case-p +standard-chars+ :start 26 :end 52) nil) @@ -319,6 +421,13 @@ (char-type-error-check #'upper-case-p) t) +(deftest upper-case-p.order.1 + (let ((i 0)) + (values + (upper-case-p (progn (incf i) #\a)) + i)) + nil 1) + (deftest upper-case-p.error.1 (classify-error (upper-case-p)) program-error) @@ -327,6 +436,8 @@ (classify-error (upper-case-p #\a #\A)) program-error) +;;; + (deftest lower-case-p.1 (find-if-not #'lower-case-p +standard-chars+ :end 26) nil) @@ -339,6 +450,13 @@ (char-type-error-check #'lower-case-p) t) +(deftest lower-case-p.order.1 + (let ((i 0)) + (values + (lower-case-p (progn (incf i) #\A)) + i)) + nil 1) + (deftest lower-case-p.error.1 (classify-error (lower-case-p)) program-error) @@ -347,6 +465,8 @@ (classify-error (lower-case-p #\a #\a)) program-error) +;;; + (deftest both-case-p.1 (both-case-p.1.body) t) @@ -359,6 +479,13 @@ (char-type-error-check #'both-case-p) t) +(deftest both-case-p.order.1 + (let ((i 0)) + (values + (both-case-p (progn (incf i) #\5)) + i)) + nil 1) + (deftest both-case-p.error.1 (classify-error (both-case-p)) program-error) @@ -367,6 +494,8 @@ (classify-error (both-case-p #\a #\a)) program-error) +;;; + (deftest char-code.1 (char-type-error-check #'char-code) t) @@ -375,6 +504,13 @@ (char-code.2.body) t) +(deftest char-code.order.1 + (let ((i 0)) + (values + (not (numberp (char-code (progn (incf i) #\a)))) + i)) + nil 1) + (deftest char-code.error.1 (classify-error (char-code)) program-error) @@ -383,11 +519,20 @@ (classify-error (char-code #\a #\a)) program-error) +;;; + (deftest code-char.1 (loop for x across +standard-chars+ always (eqlt (code-char (char-code x)) x)) t) +(deftest code-char.order.1 + (let ((i 0)) + (values + (code-char (progn (incf i) (char-code #\a))) + i)) + #\a 1) + (deftest code-char.error.1 (classify-error (code-char)) program-error) @@ -396,6 +541,8 @@ (classify-error (code-char 1 1)) program-error) +;;; + (deftest char-int.1 (loop for x across +standard-chars+ always (eqlt (char-int x) (char-code x))) @@ -405,6 +552,13 @@ (char-int.2.fn) t) +(deftest char-int.order.1 + (let ((i 0)) + (values + (code-char (char-int (progn (incf i) #\a))) + i)) + #\a 1) + (deftest char-int.error.1 (classify-error (char-int)) program-error) @@ -413,6 +567,8 @@ (classify-error (char-int #\a #\a)) program-error) +;;; + (deftest char-name.1 (char-name.1.fn) t) @@ -447,6 +603,13 @@ (char-type-error-check #'char-name) t) +(deftest char-name.order.1 + (let ((i 0)) + (values + (char-name (progn (incf i) #\Space)) + i)) + "Space" 1) + (deftest char-name.error.1 (classify-error (char-name)) program-error) @@ -455,6 +618,8 @@ (classify-error (char-name #\a #\a)) program-error) +;;; + (deftest name-char.1 (name-char.1.body) t) @@ -470,6 +635,13 @@ (and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4)))) t) +(deftest name-char.order.1 + (let ((i 0)) + (values + (name-char (progn (incf i) "Space")) + i)) + #\Space 1) + (deftest name-char.error.1 (classify-error (name-char)) program-error) diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp index eda4cd89fb359ccb253fa9cd60de2a264aa9ac4d..4dda1cdfd080ce0d3f6a59873448664def4eba23 100644 --- a/ansi-tests/cl-symbols.lsp +++ b/ansi-tests/cl-symbols.lsp @@ -1048,6 +1048,12 @@ collect name)) nil) +(deftest special-operator-p.order.1 + (let ((i 0)) + (values (notnot (special-operator-p (progn (incf i) 'catch))) + i)) + t 1) + (deftest special-operator-p.error.1 (classify-error (special-operator-p 1)) type-error) @@ -1063,142 +1069,163 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; keywordp -(deftest keywordp-1 (keywordp 'hefalump) nil) -(deftest keywordp-2 (keywordp 17) nil) -(deftest keywordp-3 (notnot-mv (keywordp :stream)) t) -(deftest keywordp-4 (notnot-mv (keywordp ':stream)) t) -(deftest keywordp-5 (keywordp nil) nil) -(deftest keywordp-6 (notnot-mv (keywordp :nil)) t) -(deftest keywordp-7 (keywordp '(:stream)) nil) -(deftest keywordp-8 (keywordp "rest") nil) -(deftest keywordp-9 (keywordp ":rest") nil) -(deftest keywordp-10 (keywordp '&body) nil) +(deftest keywordp.1 (keywordp 'hefalump) nil) +(deftest keywordp.2 (keywordp 17) nil) +(deftest keywordp.3 (notnot-mv (keywordp :stream)) t) +(deftest keywordp.4 (notnot-mv (keywordp ':stream)) t) +(deftest keywordp.5 (keywordp nil) nil) +(deftest keywordp.6 (notnot-mv (keywordp :nil)) t) +(deftest keywordp.7 (keywordp '(:stream)) nil) +(deftest keywordp.8 (keywordp "rest") nil) +(deftest keywordp.9 (keywordp ":rest") nil) +(deftest keywordp.10 (keywordp '&body) nil) ;;; This next test was busted. ::foo is not portable syntax -;;(deftest keywordp-11 (notnot-mv (keywordp ::foo)) t) -(deftest keywordp-12 (keywordp t) nil) -(deftest keywordp-13 (classify-error (keywordp)) program-error) -(deftest keywordp-14 (classify-error (keywordp :x :x)) program-error) +;;(deftest keywordp.11 (notnot-mv (keywordp ::foo)) t) +(deftest keywordp.12 (keywordp t) nil) + +(deftest keywordp.order.1 + (let ((i 0)) + (values (keywordp (progn (incf i) nil)) i)) + nil 1) + +(deftest keywordp.error.1 (classify-error (keywordp)) program-error) +(deftest keywordp.error.2 (classify-error (keywordp :x :x)) program-error) + +(deftest keywordp.error.3 + (classify-error (keywordp)) + program-error) + +(deftest keywordp.error.4 + (classify-error (keywordp nil nil)) + program-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; symbol-name -(deftest symbol-name-1 +(deftest symbol-name.1 (safe-symbol-name '|ABCD|) "ABCD") -(deftest symbol-name-2 +(deftest symbol-name.2 (safe-symbol-name '|1234abcdABCD|) "1234abcdABCD") -(deftest symbol-name-3 +(deftest symbol-name.3 (safe-symbol-name 1) type-error) -(deftest symbol-name-4 +(deftest symbol-name.4 (safe-symbol-name '(a)) type-error) -(deftest symbol-name-5 +(deftest symbol-name.5 (safe-symbol-name "ABCDE") type-error) -(deftest symbol-name-6 +(deftest symbol-name.6 (safe-symbol-name 12913.0213) type-error) -(deftest symbol-name-7 +(deftest symbol-name.7 (symbol-name :|abcdefg|) "abcdefg") -(deftest symbol-name-8 +(deftest symbol-name.error.1 (classify-error (symbol-name)) program-error) -(deftest symbol-name-9 +(deftest symbol-name.error.2 (classify-error (symbol-name 'a 'b)) program-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; make-symbol -(deftest make-symbol-1 +(deftest make-symbol.1 (notnot-mv (symbolp (make-symbol "FOO"))) t) -(deftest make-symbol-2 +(deftest make-symbol.2 (symbol-package (make-symbol "BAR")) nil) -(deftest make-symbol-3 +(deftest make-symbol.3 (symbol-package (make-symbol "CL::FOO")) nil) -(deftest make-symbol-4 +(deftest make-symbol.4 (symbol-package (make-symbol "CL:FOO")) nil) -(deftest make-symbol-5 +(deftest make-symbol.5 (symbol-name (make-symbol "xyz")) "xyz") -(deftest make-symbol-6 +(deftest make-symbol.6 (eqt (make-symbol "A") (make-symbol "A")) nil) -(deftest make-symbol-7 +(deftest make-symbol.7 (boundp (make-symbol "B")) nil) -(deftest make-symbol-8 +(deftest make-symbol.8 (symbol-plist (make-symbol "C")) nil) -(deftest make-symbol-9 +(deftest make-symbol.9 + (fboundp (make-symbol "D")) + nil) + +(deftest make-symbol.10 + (symbol-name (safe-make-symbol "")) + "") + +(deftest make-symbol.order.1 + (let ((i 0)) + (values + (symbol-name (make-symbol (progn (incf i) "ABC"))) + i)) + "ABC" 1) + +(deftest make-symbol.error.1 (safe-make-symbol nil) type-error) -(deftest make-symbol-10 +(deftest make-symbol.error.2 (safe-make-symbol 'a) type-error) -(deftest make-symbol-11 +(deftest make-symbol.error.3 (safe-make-symbol 1) type-error) -(deftest make-symbol-12 +(deftest make-symbol.error.4 (safe-make-symbol -1) type-error) -(deftest make-symbol-13 +(deftest make-symbol.error.5 (safe-make-symbol 1.213) type-error) -(deftest make-symbol-14 +(deftest make-symbol.error.6 (safe-make-symbol -1312.2) type-error) -(deftest make-symbol-15 +(deftest make-symbol.error.7 (safe-make-symbol #\w) type-error) -(deftest make-symbol-16 +(deftest make-symbol.error.8 (safe-make-symbol '(a)) type-error) -(deftest make-symbol-17 - (fboundp (make-symbol "D")) - nil) - -(deftest make-symbol-18 - (symbol-name (safe-make-symbol "")) - "") - -(deftest make-symbol-19 +(deftest make-symbol.error.9 (classify-error (make-symbol)) program-error) -(deftest make-symbol-20 +(deftest make-symbol.error.10 (classify-error (make-symbol "a" "a")) program-error) @@ -1296,54 +1323,54 @@ ;;; gensym ;;; Gensym returns unique symbols -(deftest gensym-1 - (equal (gensym) (gensym)) +(deftest gensym.1 + (equal (gensym) (gensym)) nil) ;;; Gensym returns symbols with distinct print names -(deftest gensym-2 - (string= (symbol-name (gensym)) - (symbol-name (gensym))) +(deftest gensym.2 + (string= (symbol-name (gensym)) + (symbol-name (gensym))) nil) ;;; Gensym uses the *gensym-counter* special variable, ;;; but does not increment it until after the symbol ;;; has been created. -(deftest gensym-3 +(deftest gensym.3 (let ((*gensym-counter* 1)) (declare (special *gensym-counter*)) (symbol-name (gensym))) "G1") ;;; Gensym uses the string argument instead of the default -(deftest gensym-4 +(deftest gensym.4 (let ((*gensym-counter* 1327)) (declare (special *gensym-counter*)) (symbol-name (gensym "FOO"))) "FOO1327") ;;; The symbol returned by gensym should be unbound -(deftest gensym-5 - (boundp (gensym)) +(deftest gensym.5 + (boundp (gensym)) nil) ;;; The symbol returned by gensym should have no function binding -(deftest gensym-6 - (fboundp (gensym)) +(deftest gensym.6 + (fboundp (gensym)) nil) ;;; The symbol returned by gensym should have no property list -(deftest gensym-7 - (symbol-plist (gensym)) +(deftest gensym.7 + (symbol-plist (gensym)) nil) ;;; The symbol returned by gensym should be uninterned -(deftest gensym-8 - (symbol-package (gensym)) +(deftest gensym.8 + (symbol-package (gensym)) nil) ;;; *gensym-counter* is incremented by gensym -(deftest gensym-9 +(deftest gensym.9 (let ((*gensym-counter* 12345)) (declare (special *gensym-counter*)) (gensym) @@ -1353,14 +1380,14 @@ ;;; Gensym works when *gensym-counter* is Really Big ;;; (and does not increment the counter until after creating ;;; the symbol.) -(deftest gensym-10 +(deftest gensym.10 (let ((*gensym-counter* 1234567890123456789012345678901234567890)) (declare (special *gensym-counter*)) (symbol-name (gensym))) "G1234567890123456789012345678901234567890") ;;; gensym increments Really Big values of *gensym-counter* -(deftest gensym-11 +(deftest gensym.11 (let ((*gensym-counter* 12345678901234567890123456789012345678901234567890)) (declare (special *gensym-counter*)) (gensym) @@ -1368,7 +1395,7 @@ 12345678901234567890123456789012345678901234567891) ;;; Gensym uses an integer argument instead of the counter -(deftest gensym-12 +(deftest gensym.12 (let ((*gensym-counter* 10)) (declare (special *gensym-counter*)) (symbol-name (gensym 123))) @@ -1376,7 +1403,7 @@ ;;; When given an integer argument, gensym does not increment the ;;; *gensym-counter* -(deftest gensym-13 +(deftest gensym.13 (let ((*gensym-counter* 10)) (declare (special *gensym-counter*)) (gensym 123) @@ -1523,14 +1550,6 @@ (classify-error (symbolp nil nil)) program-error) -(deftest keywordp.error.1 - (classify-error (keywordp)) - program-error) - -(deftest keywordp.error.2 - (classify-error (keywordp nil nil)) - program-error) - (deftest symbol-function.error.1 (classify-error (symbol-function)) program-error) @@ -1539,14 +1558,6 @@ (classify-error (symbol-function 'cons nil)) program-error) -(deftest symbol-name.error.1 - (classify-error (symbol-name)) - program-error) - -(deftest symbol-name.error.2 - (classify-error (symbol-name 'cons nil)) - program-error) - (deftest symbol-package.error.1 (classify-error (symbol-package)) program-error) diff --git a/ansi-tests/coerce.lsp b/ansi-tests/coerce.lsp index 783b735c9297aeb736435678f4583a43410a3879..a2dec7202f36806ad32b86601185dca234ede84e 100644 --- a/ansi-tests/coerce.lsp +++ b/ansi-tests/coerce.lsp @@ -130,7 +130,7 @@ (funcall (coerce '(lambda () 10) 'function)) 10) -(deftest coerce.23 +(deftest coerce.order.1 (let ((i 0) a b) (values (coerce (progn (setf a (incf i)) 10) diff --git a/ansi-tests/compile.lsp b/ansi-tests/compile.lsp index 0658648ccaa5d1e2f5ba63eb36e8931fc3bb7e85..f3d61f541a8ac39c21f4aa14516e3f7c8bc9df6c 100644 --- a/ansi-tests/compile.lsp +++ b/ansi-tests/compile.lsp @@ -75,9 +75,17 @@ t) (deftest compile.9 + (let ((i 0) a b) + (values + (funcall (compile (progn (setf a (incf i)) nil) + (progn (setf b (incf i)) '(lambda () 'z)))) + i a b)) + z 2 1 2) + +(deftest compile.error.1 (classify-error (compile)) program-error) -(deftest compile.10 +(deftest compile.error.2 (classify-error (compile nil '(lambda () nil) 'garbage)) program-error) diff --git a/ansi-tests/compiled-function-p.lsp b/ansi-tests/compiled-function-p.lsp index 95bf9e9dee70e42a736682bba792469f10a3d697..f43018220186be8b47468a53233e043e9ed7d051 100644 --- a/ansi-tests/compiled-function-p.lsp +++ b/ansi-tests/compiled-function-p.lsp @@ -21,6 +21,13 @@ (notnot-mv (compiled-function-p (compile nil '(lambda (y x) (cons x y))))) t) +(deftest compiled-function-p.order.1 + (let ((i 0)) + (values + (compiled-function-p (progn (incf i) '(lambda () nil))) + i)) + nil 1) + (deftest compiled-function-p.error.1 (classify-error (compiled-function-p)) program-error) diff --git a/ansi-tests/complement.lsp b/ansi-tests/complement.lsp index 5194fff89411d8794859ea9ae79f34a17e9b2985..e387c0c6adcebef31e2f1317d5c84b7afa2d417d 100644 --- a/ansi-tests/complement.lsp +++ b/ansi-tests/complement.lsp @@ -31,6 +31,15 @@ (notnot-mv (complement #'identity)) t) +(deftest complement.order.1 + (let ((i 0)) + (let ((fn (complement (progn (incf i) #'null)))) + (values + i + (mapcar fn '(a b nil c 1 nil t nil)) + i))) + 1 (t t nil t t nil t nil) 1) + (deftest complement.error.1 (classify-error (complement)) program-error) diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index 31b19a11b90276d832735a4d343eda7d5188d5b0..de8fefa16614170c932220052ba8ebad7275479d 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -184,7 +184,7 @@ #*01100 nil) -(deftest concatenate.31 +(deftest concatenate.order.1 (let ((i 0) w x y z) (values (concatenate (progn (setf w (incf i)) 'string) @@ -194,7 +194,7 @@ i w x y z)) "abcdefghi" 4 1 2 3 4) -(deftest concatenate.32 +(deftest concatenate.order.2 (let ((i 0) x y z) (values (concatenate 'string @@ -206,28 +206,28 @@ ;;; Error tests -(deftest concatenate-error.1 +(deftest concatenate.error.1 (handler-case (progn (proclaim '(optimize (safety 3))) (eval '(concatenate 'sequence '(a b c)))) (error () :caught)) :caught) -(deftest concatenate-error.2 +(deftest concatenate.error.2 (handler-case (progn (proclaim '(optimize (safety 3))) (concatenate 'fixnum '(a b c d e))) (error () :caught)) :caught) -(deftest concatenate-error.3 +(deftest concatenate.error.3 (classify-error (concatenate '(vector * 3) '(a b c d e))) type-error) -(deftest concatenate-error.4 +(deftest concatenate.error.4 (classify-error (concatenate)) program-error) -(deftest concatenate-error.5 +(deftest concatenate.error.5 (classify-error (locally (concatenate '(vector * 3) '(a b c d e)) t)) type-error) diff --git a/ansi-tests/cons-test-01.lsp b/ansi-tests/cons-test-01.lsp index 9d026c3ad0731eaca2e26c9f68b111d17d23b9e1..e15fdaf2e8f2ae8bee0f7eeaa865f039ec6b6467 100644 --- a/ansi-tests/cons-test-01.lsp +++ b/ansi-tests/cons-test-01.lsp @@ -149,10 +149,9 @@ t) ;;; Order of evaluation of cons arguments -(deftest cons-order-of-args +(deftest cons.order.1 (let ((i 0)) (values (cons (incf i) (incf i)) i)) - (1 . 2) - 2) + (1 . 2) 2) ;; Lists satisfy consp (deftest consp-list @@ -193,6 +192,11 @@ (check-type-predicate 'consp 'cons) 0) +(deftest consp.order.1 + (let ((i 0)) + (values (consp (incf i)) i)) + nil 1) + (deftest consp.error.1 (classify-error (consp)) program-error) @@ -201,6 +205,11 @@ (classify-error (consp 'a 'b)) program-error) +(deftest atom.order.1 + (let ((i 0)) + (values (atom (progn (incf i) '(a b))) i)) + nil 1) + (deftest atom.error.1 (classify-error (atom)) program-error) @@ -210,59 +219,59 @@ program-error) ;; Tests of car, cdr and compound forms -(deftest cons-23 +(deftest cons.23 (car '(a)) a) -(deftest cons-24 +(deftest cons.24 (cdr '(a . b)) b) -(deftest cons-25 +(deftest cons.25 (caar '((a))) a) -(deftest cons-26 +(deftest cons.26 (cdar '((a . b))) b) -(deftest cons-27 +(deftest cons.27 (cadr '(a b)) b) -(deftest cons-28 +(deftest cons.28 (cddr '(a b . c)) c) -(deftest cons-29 +(deftest cons.29 (caaar '(((a)))) a) -(deftest cons-30 +(deftest cons.30 (cdaar '(((a . b)))) b) -(deftest cons-31 +(deftest cons.31 (cadar (cons (cons 'a (cons 'b 'c)) 'd)) b) -(deftest cons-32 +(deftest cons.32 (cddar (cons (cons 'a (cons 'b 'c)) 'd)) c) -(deftest cons-33 +(deftest cons.33 (caadr (cons 'a (cons (cons 'b 'c) 'd))) b) -(deftest cons-34 +(deftest cons.34 (caddr (cons 'a (cons 'b (cons 'c 'd)))) c) -(deftest cons-36 +(deftest cons.36 (cdadr (cons 'a (cons (cons 'b 'c) 'd))) c) -(deftest cons-37 +(deftest cons.37 (cdddr (cons 'a (cons 'b (cons 'c 'd)))) d) @@ -277,69 +286,69 @@ (cons 'o 'p))))) -(deftest cons-38 +(deftest cons.38 (caaaar *cons-test-4*) a) -(deftest cons-39 +(deftest cons.39 (cdaaar *cons-test-4*) b) -(deftest cons-40 +(deftest cons.40 (cadaar *cons-test-4*) c) -(deftest cons-41 +(deftest cons.41 (cddaar *cons-test-4*) d) -(deftest cons-42 +(deftest cons.42 (caadar *cons-test-4*) e) -(deftest cons-43 +(deftest cons.43 (cdadar *cons-test-4*) f) -(deftest cons-44 +(deftest cons.44 (caddar *cons-test-4*) g) -(deftest cons-45 +(deftest cons.45 (cdddar *cons-test-4*) h) ;;; -(deftest cons-46 +(deftest cons.46 (caaadr *cons-test-4*) i) -(deftest cons-47 +(deftest cons.47 (cdaadr *cons-test-4*) j) -(deftest cons-48 +(deftest cons.48 (cadadr *cons-test-4*) k) -(deftest cons-49 +(deftest cons.49 (cddadr *cons-test-4*) l) -(deftest cons-50 +(deftest cons.50 (caaddr *cons-test-4*) m) -(deftest cons-51 +(deftest cons.51 (cdaddr *cons-test-4*) n) -(deftest cons-52 +(deftest cons.52 (cadddr *cons-test-4*) o) -(deftest cons-53 +(deftest cons.53 (cddddr *cons-test-4*) p) @@ -366,7 +375,7 @@ (eqt (cdr x) 'b)))) t) -(deftest rplaca.2 +(deftest rplaca.order.1 (let ((x (cons 'a 'b)) (i 0) a b) (values @@ -384,7 +393,7 @@ (eqt (cdr x) 'd)))) t) -(deftest rplacd.2 +(deftest rplacd.order.1 (let ((x (cons 'a 'b)) (i 0) a b) (values diff --git a/ansi-tests/cons-test-02.lsp b/ansi-tests/cons-test-02.lsp index bb31637f24465d2e07ddbde19a4a825db3f8f687..117c1aaa068d1505af3c5967c8f1864bf912d3e1 100644 --- a/ansi-tests/cons-test-02.lsp +++ b/ansi-tests/cons-test-02.lsp @@ -29,6 +29,13 @@ (check-cons-copy x y)) t) +(deftest copy-tree.order.1 + (let ((i 0)) + (values + (copy-tree (progn (incf i) '(a b c))) + i)) + (a b c) 1) + (deftest copy-tree.error.1 (classify-error (copy-tree)) program-error) @@ -37,6 +44,8 @@ (classify-error (copy-tree 'a 'b)) program-error) +;;; + (deftest sublis.1 (check-sublis '((a b) g (d e 10 g h) 15 . g) '((e . e2) (g . 17))) @@ -96,7 +105,7 @@ (2 2 b b)) ;;; Order of argument evaluation -(deftest sublis.9 +(deftest sublis.order.1 (let ((i 0) w x y z) (values (sublis @@ -110,7 +119,7 @@ (z b c d) 4 1 2 3 4) -(deftest sublis.10 +(deftest sublis.order.2 (let ((i 0) w x y z) (values (sublis @@ -237,7 +246,7 @@ (2 2 b b)) ;;; Order of argument evaluation -(deftest nsublis.10 +(deftest nsublis.order.1 (let ((i 0) w x y z) (values (nsublis @@ -251,7 +260,7 @@ (z b c d) 4 1 2 3 4) -(deftest nsublis.11 +(deftest nsublis.order.2 (let ((i 0) w x y z) (values (nsublis @@ -376,7 +385,7 @@ (a a c d a a)) ;;; Order of argument evaluation -(deftest subst.10 +(deftest subst.order.1 (let ((i 0) v w x y z) (values (subst (progn (setf v (incf i)) 'b) @@ -388,7 +397,7 @@ ((10 b . b) b b c ((b)) z) 5 1 2 3 4 5) -(deftest subst.11 +(deftest subst.order.2 (let ((i 0) v w x y z) (values (subst (progn (setf v (incf i)) 'b) @@ -641,7 +650,7 @@ (a a c d a a)) ;;; Order of argument evaluation -(deftest nsubst.10 +(deftest nsubst.order.1 (let ((i 0) v w x y z) (values (nsubst (progn (setf v (incf i)) 'b) @@ -653,7 +662,7 @@ ((10 b . b) b b c ((b)) z) 5 1 2 3 4 5) -(deftest nsubst.11 +(deftest nsubst.order.2 (let ((i 0) v w x y z) (values (nsubst (progn (setf v (incf i)) 'b) diff --git a/ansi-tests/cons-test-03.lsp b/ansi-tests/cons-test-03.lsp index c444a9c7522ebcbc653acd34bbb86c5d7f326a60..7d9a73fc53b293cb14621fdfc1faccd83a3ff013 100644 --- a/ansi-tests/cons-test-03.lsp +++ b/ansi-tests/cons-test-03.lsp @@ -10,20 +10,26 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; copy-list -(deftest copy-list-1 - (check-copy-list '(a b c d)) +(deftest copy-list.1 + (check-copy-list '(a b c d)) (a b c d)) ;; Check that copy-list works on dotted lists -(deftest copy-list-2 - (check-copy-list '(a . b)) +(deftest copy-list.2 + (check-copy-list '(a . b)) (a . b)) -(deftest copy-list-3 - (check-copy-list '(a b c . d)) +(deftest copy-list.3 + (check-copy-list '(a b c . d)) (a b c . d)) +(deftest copy-list.4 + (let ((i 0)) + (values (copy-list (progn (incf i) '(a b c))) + i)) + (a b c) 1) + (deftest copy-list.error.1 (classify-error (copy-list)) program-error) @@ -43,18 +49,18 @@ (list) nil) -(deftest list.3 +(deftest list.order.1 (let ((i 0)) (list (incf i) (incf i) (incf i) (incf i))) (1 2 3 4)) -(deftest list.4 +(deftest list.order.2 (let ((i 0)) (list (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) (incf i))) (1 2 3 4 5 6 7 8)) -(deftest list.5 +(deftest list.order.3 (let ((i 0)) (list (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) @@ -74,16 +80,16 @@ (list* 'a 'b 'c (list 'd 'e 'f)) (a b c d e f)) -(deftest list*-3 +(deftest list*.3 (list* 1) 1) -(deftest list*.4 +(deftest list*.order.1 (let ((i 0)) (list* (incf i) (incf i) (incf i) (incf i))) (1 2 3 . 4)) -(deftest list*.5 +(deftest list*.order.2 (let ((i 0)) (list* (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) (incf i) @@ -113,6 +119,11 @@ (list-length z)))) nil) +(deftest list-length.order.1 + (let ((i 0)) + (values (list-length (progn (incf i) '(a b c))) i)) + 3 1) + ;; Check that list-length produces a type-error ;; on arguments that are not proper lists or circular lists @@ -174,6 +185,11 @@ (check-type-predicate 'listp 'list) 0) +(deftest listp.order.1 + (let ((i 0)) + (values (listp (incf i)) i)) + nil 1) + (deftest listp.error.1 (classify-error (listp)) program-error) @@ -213,11 +229,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; make-list -(deftest make-list-empty-1 +(deftest make-list-empty.1 (make-list 0) nil) -(deftest make-list-empty-2 +(deftest make-list-empty.2 (make-list 0 :initial-element 'a) nil) @@ -253,7 +269,7 @@ (make-list 5 :initial-element 'a :initial-element 'b) (a a a a a)) -(deftest make-list.order +(deftest make-list.order.1 (let ((i 0) x y) (values (make-list (progn (setf x (incf i)) 5) @@ -263,6 +279,19 @@ (a a a a a) 2 1 2) +(deftest make-list.order.2 + (let ((i 0) x y z) + (values + (make-list (progn (setf x (incf i)) 5) + :initial-element + (progn (setf y (incf i)) 'a) + :initial-element + (progn (setf z (incf i)) 'b)) + i x y z)) + (a a a a a) + 3 1 2 3) + + (deftest make-list.error.1 (catch-type-error (make-list -1)) type-error) diff --git a/ansi-tests/cons-test-04.lsp b/ansi-tests/cons-test-04.lsp index e987beec1fb6d478165221a93ab4ad2e230e1724..2846d52029b4b31f6c0a696fa05396a8c21412ec 100644 --- a/ansi-tests/cons-test-04.lsp +++ b/ansi-tests/cons-test-04.lsp @@ -15,18 +15,18 @@ ;;; See also places.lsp -(deftest push-1 +(deftest push.1 (let ((x nil)) (push 'a x)) (a)) -(deftest push-2 +(deftest push.2 (let ((x 'b)) (push 'a x) (push 'c x)) (c a . b)) -(deftest push-3 +(deftest push.3 (let ((x (copy-tree '(a)))) (push x x) (and @@ -34,23 +34,32 @@ x)) ((a) a)) +(deftest push.order.1 + (let ((x (list nil)) (i 0) a b) + (values + (push (progn (setf a (incf i)) 'z) + (car (progn (setf b (incf i)) x))) + x + i a b)) + (z) ((z)) 2 1 2) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; pop -(deftest pop-1 +(deftest pop.1 (let ((x (copy-tree '(a b c)))) (let ((y (pop x))) (list x y))) ((b c) a)) -(deftest pop-2 +(deftest pop.2 (let ((x nil)) (let ((y (pop x))) (list x y))) (nil nil)) ;;; Confirm argument is executed just once. -(deftest pop-3 +(deftest pop.order.1 (let ((i 0) (a (vector (list 'a 'b 'c)))) (pop (aref a (progn (incf i) 0))) @@ -302,7 +311,7 @@ :test-not (complement #'equal) :key nil) (aaa "AAA" "aaa" #\a)) -(deftest adjoin.19 +(deftest adjoin.order.1 (let ((i 0) w x y z) (values (adjoin (progn (setf w (incf i)) 'a) @@ -313,7 +322,7 @@ (b c d a e) 4 1 2 3 4) -(deftest adjoin.20 +(deftest adjoin.order.2 (let ((i 0) w x y z p) (values (adjoin (progn (setf w (incf i)) 'a) diff --git a/ansi-tests/cons-test-05.lsp b/ansi-tests/cons-test-05.lsp index 28d185ada0bb9b73846ac72f8e0084c7cb029b7a..1f6b79ee22034f35ab9b1f7cfd03b91fcc6eed03 100644 --- a/ansi-tests/cons-test-05.lsp +++ b/ansi-tests/cons-test-05.lsp @@ -156,7 +156,7 @@ t) ;;; Test side effects, evaluation order in assignment to NTH -(deftest nth.3 +(deftest nth.order.1 (let ((i 0) (x (list 'a 'b 'c 'd)) y z) @@ -168,7 +168,7 @@ x)) (a z c d)) -(deftest nth.4 +(deftest nth.order.2 (let ((i 0) x y (z '(a b c d e))) (values (nth (progn (setf x (incf i)) 1) diff --git a/ansi-tests/cons-test-06.lsp b/ansi-tests/cons-test-06.lsp index c0f067e76e760e0d4fe2a5eb41f33d50a1f9c37c..0ea94d4834ca1f8ba2bb7f5f4dd33775569a97fa 100644 --- a/ansi-tests/cons-test-06.lsp +++ b/ansi-tests/cons-test-06.lsp @@ -23,6 +23,13 @@ (endp '(a)) nil) +(deftest endp.order.1 + (let ((i 0)) + (values + (endp (progn (incf i) '(a b c))) + i)) + nil 1) + (deftest endp-symbol-error (catch-type-error (endp 'a)) type-error) diff --git a/ansi-tests/cons-test-07.lsp b/ansi-tests/cons-test-07.lsp index 7460e471680b8c337e5e086bdc07fca4fbeacf6d..ec599146c369df6b4748a5625c0be8dff5debee7 100644 --- a/ansi-tests/cons-test-07.lsp +++ b/ansi-tests/cons-test-07.lsp @@ -61,7 +61,7 @@ 'foo) (a c e . foo)) -(deftest nconc.8 +(deftest nconc.order.1 (let ((i 0) x y z) (values (nconc (progn (setf x (incf i)) (copy-list '(a b c))) @@ -69,7 +69,13 @@ (progn (setf z (incf i)) (copy-list '(g h i)))) i x y z)) (a b c d e f g h i) 3 1 2 3) - + +(deftest nconc.order.2 + (let ((i 0)) + (values + (nconc (incf i)) + i)) + 1 1) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; append @@ -108,7 +114,7 @@ (append-6-body) 0) -(deftest append.7 +(deftest append.order.1 (let ((i 0) x y z) (values (append (progn (setf x (incf i)) (copy-list '(a b c))) @@ -117,6 +123,10 @@ i x y z)) (a b c d e f g h i) 3 1 2 3) +(deftest append.order.2 + (let ((i 0)) (values (append (incf i)) i)) + 1 1) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; revappend @@ -146,7 +156,7 @@ (revappend (copy-tree '(a (b c) d)) nil) (d (b c) a)) -(deftest revappend.5 +(deftest revappend.order.1 (let ((i 0) x y) (values (revappend (progn (setf x (incf i)) (copy-list '(a b c))) @@ -181,7 +191,7 @@ (nreconc nil 'a) a) -(deftest nreconc.3 +(deftest nreconc.order.1 (let ((i 0) x y) (values (nreconc (progn (setf x (incf i)) (copy-list '(a b c))) diff --git a/ansi-tests/cons-test-08.lsp b/ansi-tests/cons-test-08.lsp index 9c10446c13364def30ad9962928042ab9b56beb8..916a1287f6c37af4a7b1931d3c865304a2d3e10b 100644 --- a/ansi-tests/cons-test-08.lsp +++ b/ansi-tests/cons-test-08.lsp @@ -11,7 +11,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Error checking car, cdr, list-length -(deftest car-1 +(deftest car.1 (car '(a)) a) @@ -27,7 +27,12 @@ (classify-error (locally (car 'a) t)) type-error) -(deftest cdr-1 +(deftest car.order.1 + (let ((i 0)) + (values (car (progn (incf i) '(a b))) i)) + a 1) + +(deftest cdr.1 (cdr '(a b)) (b)) @@ -35,6 +40,11 @@ (cdr ()) nil) +(deftest cdr.order.1 + (let ((i 0)) + (values (cdr (progn (incf i) '(a b))) i)) + (b) 1) + (deftest cdr-symbol-error (classify-error (cdr 'a)) type-error) @@ -43,7 +53,7 @@ (classify-error (locally (cdr 'a) t)) type-error) -(deftest list-length-4 +(deftest list-length.4 (list-length (copy-tree '(a b c))) 3) diff --git a/ansi-tests/cons-test-09.lsp b/ansi-tests/cons-test-09.lsp index 8341a373f7a2744865270431332e6161ff1e9a04..d4d0061b306d94b2bd0ac82163c954fa62adbe89 100644 --- a/ansi-tests/cons-test-09.lsp +++ b/ansi-tests/cons-test-09.lsp @@ -50,7 +50,7 @@ (butlast (copy-tree '(a b c . d)) 1) (a b)) -(deftest butlast.6 +(deftest butlast.order.1 (let ((i 0) x y) (values (butlast (progn (setf x (incf i)) @@ -60,6 +60,13 @@ i x y)) (a b c) 2 1 2) +(deftest butlast.order.2 + (let ((i 0)) + (values + (butlast (progn (incf i) '(a b c d))) + i)) + (a b c) 1) + (deftest butlast.error.1 (classify-error (butlast (copy-tree '(a b c d)) 'a)) type-error) @@ -121,7 +128,7 @@ (nbutlast (list 'a)) nil) -(deftest nbutlast.7 +(deftest nbutlast.order.1 (let ((i 0) x y) (values (nbutlast (progn (setf x (incf i)) @@ -131,6 +138,13 @@ i x y)) (a b c) 2 1 2) +(deftest nbutlast.order.2 + (let ((i 0)) + (values + (nbutlast (progn (incf i) (list 'a 'b 'c 'd))) + i)) + (a b c) 1) + (deftest nbutlast.error.1 (classify-error (let ((x (list* 'a 'b 'c 'd))) (nbutlast x 'a))) type-error) diff --git a/ansi-tests/cons-test-10.lsp b/ansi-tests/cons-test-10.lsp index 99e2f790f3e5a7bb776bea58e965b56cc1824354..8779df54ae427903293931550f8a63ca986460e8 100644 --- a/ansi-tests/cons-test-10.lsp +++ b/ansi-tests/cons-test-10.lsp @@ -50,7 +50,7 @@ (last (cons 'a 'b) 2) (a . b)) -(deftest last.11 +(deftest last.order.1 (let ((i 0) x y) (values (last (progn (setf x (incf i)) (list 'a 'b 'c 'd)) @@ -58,6 +58,11 @@ i x y)) (c d) 2 1 2) +(deftest last.order.2 + (let ((i 0)) + (values (last (progn (incf i) (list 'a 'b 'c 'd))) i)) + (d) 1) + (deftest last.error.1 (classify-error (last (list 'a 'b 'c) -1)) type-error) diff --git a/ansi-tests/cons-test-11.lsp b/ansi-tests/cons-test-11.lsp index ebee58526cf58684133183e8ce8238c2e5e6bc88..40cd25595909474aac100e27938f54cedf015a79 100644 --- a/ansi-tests/cons-test-11.lsp +++ b/ansi-tests/cons-test-11.lsp @@ -100,7 +100,7 @@ count (eqt c1 c2))))) 0) -(deftest ldiff.9 +(deftest ldiff.order.1 (let ((i 0) x y) (values (ldiff (progn (setf x (incf i)) @@ -108,7 +108,7 @@ (progn (setf y (incf i)) 'd)) i x y)) - (a b c) 2 1 2) + (a b c) 2 1 2) ;; Error checking @@ -182,7 +182,6 @@ t)) t) - ;; The next four tests test that tailp handles dotted lists. See ;; TAILP-NIL:T in the X3J13 documentation. @@ -251,7 +250,7 @@ 0) |# -(deftest tailp.8 +(deftest tailp.order.1 (let ((i 0) x y) (values (notnot diff --git a/ansi-tests/cons-test-12.lsp b/ansi-tests/cons-test-12.lsp index 7dc703c208f304a5f2f58a100e5f4ea47d109196..2c545df776f88efe7457aac62021b6d2779eb958 100644 --- a/ansi-tests/cons-test-12.lsp +++ b/ansi-tests/cons-test-12.lsp @@ -74,7 +74,7 @@ (nthcdr 1 (cons 'a 'b)) b) -(deftest nthcdr.6 +(deftest nthcdr.order.1 (let ((i 0) x y) (values (nthcdr (setf x (incf i)) @@ -89,6 +89,11 @@ (rest (list 'a 'b 'c)) (b c)) +(deftest rest.order.1 + (let ((i 0)) + (values (rest (progn (incf i) '(a b))) i)) + (b) 1) + (deftest rest.error.1 (classify-error (rest)) program-error) diff --git a/ansi-tests/cons-test-13.lsp b/ansi-tests/cons-test-13.lsp index 50afa2057a12ac24d8b21500d5c4715725ea1283..d2f65eb7b9659b42f135f9418bc020684961c7c9 100644 --- a/ansi-tests/cons-test-13.lsp +++ b/ansi-tests/cons-test-13.lsp @@ -145,7 +145,7 @@ ;;; Order of evaluation -(deftest member.20 +(deftest member.order.1 (let ((i 0) x y) (values (member (progn (setf x (incf i)) 'c) @@ -153,7 +153,7 @@ i x y)) (c d) 2 1 2) -(deftest member.21 +(deftest member.order.2 (let ((i 0) x y z p) (values (member (progn (setf x (incf i)) 'c) @@ -163,7 +163,7 @@ i x y z p)) (c d) 4 1 2 3 4) -(deftest member.22 +(deftest member.order.3 (let ((i 0) x y) (values (member (progn (setf x (incf i)) 'c) @@ -172,7 +172,7 @@ i x y)) (c d) 2 1 2) -(deftest member.23 +(deftest member.order.4 (let ((i 0) x y z p q) (values (member (progn (setf x (incf i)) 'c) @@ -183,7 +183,7 @@ i x y z p q)) (c d) 5 1 2 3 4 5) -(deftest member.24 +(deftest member.order.5 (let ((i 0) x y z q) (values (member (progn (setf x (incf i)) 'c) diff --git a/ansi-tests/cons-test-14.lsp b/ansi-tests/cons-test-14.lsp index 7a2ec3c40ac655b1c7a83c2bd6467fa4b0259505..b85acb74ed5fe24f8cdb70b7321fff3830ff49db 100644 --- a/ansi-tests/cons-test-14.lsp +++ b/ansi-tests/cons-test-14.lsp @@ -46,7 +46,7 @@ ;;; Order of argument tests -(deftest member-if.6 +(deftest member-if.order.1 (let ((i 0) x y) (values (member-if (progn (setf x (incf i)) @@ -56,7 +56,7 @@ i x y)) (a b nil c d) 2 1 2) -(deftest member-if.7 +(deftest member-if.order.2 (let ((i 0) x y z w) (values (member-if (progn (setf x (incf i)) @@ -140,7 +140,7 @@ ;;; Order of evaluation tests -(deftest member-if-not.6 +(deftest member-if-not.order.1 (let ((i 0) x y) (values (member-if-not (progn (setf x (incf i)) @@ -150,7 +150,7 @@ i x y)) (a b nil c d) 2 1 2) -(deftest member-if-not.7 +(deftest member-if-not.order.2 (let ((i 0) x y z w) (values (member-if-not (progn (setf x (incf i)) diff --git a/ansi-tests/cons-test-15.lsp b/ansi-tests/cons-test-15.lsp index 4ef9ce2b6ac6f8a627d1a47c416405dd1ad927c0..9d82f3cff73e4464633faec49b72891e2500541e 100644 --- a/ansi-tests/cons-test-15.lsp +++ b/ansi-tests/cons-test-15.lsp @@ -576,6 +576,3 @@ (deftest mapcon.error.4 (classify-error (locally (mapcon #'identity 1) t)) type-error) - - - diff --git a/ansi-tests/cons-test-16.lsp b/ansi-tests/cons-test-16.lsp index 104201542a3209f832b3585571c98330b5f75bd8..0210a2ad8ab29a3a278824b25151f309e6e9eb6b 100644 --- a/ansi-tests/cons-test-16.lsp +++ b/ansi-tests/cons-test-16.lsp @@ -40,7 +40,7 @@ (acons #\R :foo :bar) ((#\R . :foo) . :bar)) -(deftest acons.7 +(deftest acons.order.1 (let ((i 0) x y z) (values (acons (progn (setf x (incf i)) 'a) @@ -206,7 +206,7 @@ ;;; Order of argument evaluation -(deftest assoc.26 +(deftest assoc.order.1 (let ((i 0) x y) (values (assoc (progn (setf x (incf i)) 'c) @@ -214,7 +214,7 @@ i x y)) (c . 3) 2 1 2) -(deftest assoc.27 +(deftest assoc.order.2 (let ((i 0) x y z) (values (assoc (progn (setf x (incf i)) 'c) @@ -223,7 +223,7 @@ i x y z)) (c . 3) 3 1 2 3) -(deftest assoc.28 +(deftest assoc.order.3 (let ((i 0) x y) (values (assoc (progn (setf x (incf i)) 'c) @@ -232,7 +232,7 @@ i x y)) (c . 3) 2 1 2) -(deftest assoc.29 +(deftest assoc.order.4 (let ((i 0) x y z w) (values (assoc (progn (setf x (incf i)) 'c) @@ -337,7 +337,7 @@ ;;; Order of argument evaluation -(deftest assoc-if.5 +(deftest assoc-if.order.1 (let ((i 0) x y) (values (assoc-if (progn (setf x (incf i)) #'null) @@ -346,7 +346,7 @@ i x y)) (nil . 17) 2 1 2) -(deftest assoc-if.6 +(deftest assoc-if.order.2 (let ((i 0) x y z) (values (assoc-if (progn (setf x (incf i)) #'null) @@ -453,7 +453,7 @@ ;;; Order of argument evaluation tests -(deftest assoc-if-not.5 +(deftest assoc-if-not.order.1 (let ((i 0) x y) (values (assoc-if-not (progn (setf x (incf i)) #'identity) @@ -462,7 +462,7 @@ i x y)) (nil . 17) 2 1 2) -(deftest assoc-if-not.6 +(deftest assoc-if-not.order.2 (let ((i 0) x y z) (values (assoc-if-not (progn (setf x (incf i)) #'identity) diff --git a/ansi-tests/cons-test-17.lsp b/ansi-tests/cons-test-17.lsp index d764aa4247dbc90b55278391e2779e01ed51d07d..862e42c6b5d853cf9df2c489e15c1b3bb507dd19 100644 --- a/ansi-tests/cons-test-17.lsp +++ b/ansi-tests/cons-test-17.lsp @@ -193,7 +193,7 @@ ;;; Order of argument evaluation -(deftest rassoc.26 +(deftest rassoc.order.1 (let ((i 0) x y) (values (rassoc (progn (setf x (incf i)) 'c) @@ -201,7 +201,7 @@ i x y)) (3 . c) 2 1 2) -(deftest rassoc.27 +(deftest rassoc.order.2 (let ((i 0) x y z) (values (rassoc (progn (setf x (incf i)) 'c) @@ -210,7 +210,7 @@ i x y z)) (3 . c) 3 1 2 3) -(deftest rassoc.28 +(deftest rassoc.order.3 (let ((i 0) x y) (values (rassoc (progn (setf x (incf i)) 'c) @@ -219,7 +219,7 @@ i x y)) (3 . c) 2 1 2) -(deftest rassoc.29 +(deftest rassoc.order.4 (let ((i 0) x y z w) (values (rassoc (progn (setf x (incf i)) 'c) @@ -324,7 +324,7 @@ ;;; Order of argument evaluation -(deftest rassoc-if.5 +(deftest rassoc-if.order.1 (let ((i 0) x y) (values (rassoc-if (progn (setf x (incf i)) #'null) @@ -333,7 +333,7 @@ i x y)) (17) 2 1 2) -(deftest rassoc-if.6 +(deftest rassoc-if.order.2 (let ((i 0) x y z) (values (rassoc-if (progn (setf x (incf i)) #'null) @@ -437,7 +437,7 @@ ;;; Order of argument evaluation -(deftest rassoc-if-not.5 +(deftest rassoc-if-not.order.1 (let ((i 0) x y) (values (rassoc-if-not (progn (setf x (incf i)) #'identity) @@ -446,7 +446,7 @@ i x y)) (17) 2 1 2) -(deftest rassoc-if-not.6 +(deftest rassoc-if-not.order.2 (let ((i 0) x y z) (values (rassoc-if-not (progn (setf x (incf i)) #'identity) diff --git a/ansi-tests/cons-test-18.lsp b/ansi-tests/cons-test-18.lsp index 60cef34a74a4d980ae746056d1b900d35d8deaab..41180137ede0e9fbef11a45cf46e75126f1f0ec6 100644 --- a/ansi-tests/cons-test-18.lsp +++ b/ansi-tests/cons-test-18.lsp @@ -57,7 +57,7 @@ (values indicator value tail)))) g h (g h a c)) -(deftest get-properties.10 +(deftest get-properties.order.1 (let ((i 0) x y) (values (multiple-value-list @@ -105,7 +105,7 @@ x)) b 1) -(deftest getf.6 +(deftest getf.order.1 (let ((i 0) x y) (values (getf (progn (setf x (incf i)) '(a b)) @@ -113,7 +113,7 @@ i x y)) b 2 1 2) -(deftest getf.7 +(deftest getf.order.2 (let ((i 0) x y z) (values (getf (progn (setf x (incf i)) '(a b)) @@ -200,7 +200,7 @@ foo)) t) -(deftest setf-getf.6 +(deftest setf-getf.order.1 (let ((p (list (copy-list '(a 1 b 2)))) (cnt1 0) (cnt2 0) (cnt3 0)) (setf (getf (car (progn (incf cnt1) p)) 'c (incf cnt3)) @@ -221,7 +221,7 @@ t)) t) -(deftest setf-getf.7 +(deftest setf-getf.order.2 (let ((p (list (copy-list '(a 1 b 2)))) (i 0) x y z w) (setf (getf (car (progn (setf x (incf i)) p)) @@ -323,7 +323,7 @@ (not (eqt (car ptr) 'a))))) t 0) -(deftest remf.5 +(deftest remf.order.1 (let ((i 0) x y (p (make-array 1 :initial-element (copy-list '(a b c d e f))))) (values diff --git a/ansi-tests/cons-test-19.lsp b/ansi-tests/cons-test-19.lsp index 9037a8486ade255bcb73bc7de38a329c282f8b3b..91f1fec2f95122e46b7b2c781f542c6af709b8c5 100644 --- a/ansi-tests/cons-test-19.lsp +++ b/ansi-tests/cons-test-19.lsp @@ -237,7 +237,7 @@ ;;; Order of argument evaluation tests -(deftest intersection.19 +(deftest intersection.order.1 (let ((i 0) x y) (values (intersection (progn (setf x (incf i)) (list 'a 'b)) @@ -245,7 +245,7 @@ i x y)) nil 2 1 2) -(deftest intersection.20 +(deftest intersection.order.2 (let ((i 0) x y) (values (intersection (progn (setf x (incf i)) (list 'a 'b)) @@ -254,7 +254,7 @@ i x y)) nil 2 1 2) -(deftest intersection.21 +(deftest intersection.order.3 (let ((i 0) x y z w) (values (intersection (progn (setf x (incf i)) (list 'a 'b)) @@ -265,7 +265,7 @@ i x y z w)) nil 4 1 2 3 4) -(deftest intersection.22 +(deftest intersection.order.4 (let ((i 0) x y z w) (values (intersection (progn (setf x (incf i)) (list 'a 'b)) @@ -275,7 +275,7 @@ i x y z w)) nil 4 1 2 3 4) -(deftest intersection.23 +(deftest intersection.order.5 (let ((i 0) x y z w) (values (intersection (progn (setf x (incf i)) (list 'a 'b)) @@ -566,7 +566,7 @@ ;;; Order of argument evaluation tests -(deftest nintersection.19 +(deftest nintersection.order.1 (let ((i 0) x y) (values (nintersection (progn (setf x (incf i)) (list 'a 'b)) @@ -574,7 +574,7 @@ i x y)) nil 2 1 2) -(deftest nintersection.20 +(deftest nintersection.order.2 (let ((i 0) x y) (values (nintersection (progn (setf x (incf i)) (list 'a 'b)) @@ -583,7 +583,7 @@ i x y)) nil 2 1 2) -(deftest nintersection.21 +(deftest nintersection.order.3 (let ((i 0) x y z w) (values (nintersection (progn (setf x (incf i)) (list 'a 'b)) @@ -594,7 +594,7 @@ i x y z w)) nil 4 1 2 3 4) -(deftest nintersection.22 +(deftest nintersection.order.4 (let ((i 0) x y z w) (values (nintersection (progn (setf x (incf i)) (list 'a 'b)) @@ -604,7 +604,7 @@ i x y z w)) nil 4 1 2 3 4) -(deftest nintersection.23 +(deftest nintersection.order.5 (let ((i 0) x y z w) (values (nintersection (progn (setf x (incf i)) (list 'a 'b)) diff --git a/ansi-tests/cons-test-20.lsp b/ansi-tests/cons-test-20.lsp index d0a50bdeb2cd1b48e97ca8600906300b2ee03374..e61b5e4887c9589fba37d823a8a0a9a7a0c562b0 100644 --- a/ansi-tests/cons-test-20.lsp +++ b/ansi-tests/cons-test-20.lsp @@ -266,7 +266,7 @@ ;;; Order of evaluation tests -(deftest union.32 +(deftest union.order.1 (let ((i 0) x y) (values (sort @@ -277,7 +277,7 @@ (1 2 3 5 8) 2 1 2) -(deftest union.33 +(deftest union.order.2 (let ((i 0) x y z w) (values (sort @@ -291,7 +291,7 @@ 4 1 2 3 4) -(deftest union.34 +(deftest union.order.3 (let ((i 0) x y z w) (values (sort diff --git a/ansi-tests/cons-test-21.lsp b/ansi-tests/cons-test-21.lsp index fe1e631b067424e667f61845d8dd21507c252791..ef5c39a7737e744b98e369011e8add9804ca3d53 100644 --- a/ansi-tests/cons-test-21.lsp +++ b/ansi-tests/cons-test-21.lsp @@ -265,39 +265,39 @@ ;;; Order of evaluation tests -(deftest nunion.32 +(deftest nunion.order.1 (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)))) + (progn (setf y (incf i)) (copy-list '(2 5 8)))) #'<) i x y)) (1 2 3 5 8) 2 1 2) -(deftest nunion.33 +(deftest nunion.order.2 (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)) + (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 +(deftest nunion.order.3 (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)) + (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) diff --git a/ansi-tests/cons-test-22.lsp b/ansi-tests/cons-test-22.lsp index 9bf663cd26d99c8ac5c4c7a064aecd00b82a30e6..8ead25af929fad0a66314240ad24d02992746055 100644 --- a/ansi-tests/cons-test-22.lsp +++ b/ansi-tests/cons-test-22.lsp @@ -151,7 +151,7 @@ ;;; Order of argument evaluation tests -(deftest set-difference.20 +(deftest set-difference.order.1 (let ((i 0) x y) (values (set-difference (progn (setf x (incf i)) (list 1 2 3 4)) @@ -159,7 +159,7 @@ i x y)) (1) 2 1 2) -(deftest set-difference.21 +(deftest set-difference.order.2 (let ((i 0) x y z) (values (set-difference (progn (setf x (incf i)) (list 1 2 3 4)) @@ -169,7 +169,7 @@ i x y z)) (4) 3 1 2 3) -(deftest set-difference.22 +(deftest set-difference.order.3 (let ((i 0) x y z w) (values (set-difference (progn (setf x (incf i)) (list 1 2 3 4)) @@ -437,7 +437,7 @@ ;;; Order of argument evaluation tests -(deftest nset-difference.20 +(deftest nset-difference.order.1 (let ((i 0) x y) (values (nset-difference (progn (setf x (incf i)) (list 1 2 3 4)) @@ -445,7 +445,7 @@ i x y)) (1) 2 1 2) -(deftest nset-difference.21 +(deftest nset-difference.order.2 (let ((i 0) x y z) (values (nset-difference (progn (setf x (incf i)) (list 1 2 3 4)) @@ -455,7 +455,7 @@ i x y z)) (4) 3 1 2 3) -(deftest nset-difference.22 +(deftest nset-difference.order.3 (let ((i 0) x y z w) (values (nset-difference (progn (setf x (incf i)) (list 1 2 3 4)) diff --git a/ansi-tests/cons-test-23.lsp b/ansi-tests/cons-test-23.lsp index 971e38681948a4b5027c7b081fc74cd721705963..be6e92eaf1e7ed97b2852c749aa9a9e54cd0f3cd 100644 --- a/ansi-tests/cons-test-23.lsp +++ b/ansi-tests/cons-test-23.lsp @@ -173,7 +173,7 @@ ;;; Order of argument evaluation tests -(deftest set-exclusive-or.19 +(deftest set-exclusive-or.order.1 (let ((i 0) x y) (values (sort @@ -185,7 +185,7 @@ i x y)) (2 4 6 10) 2 1 2) -(deftest set-exclusive-or.20 +(deftest set-exclusive-or.order.2 (let ((i 0) x y z) (values (sort @@ -199,7 +199,7 @@ i x y z)) (2 4 6 10) 3 1 2 3) -(deftest set-exclusive-or.21 +(deftest set-exclusive-or.order.3 (let ((i 0) x y z w) (values (sort @@ -214,7 +214,7 @@ i x y z w)) (2 4 6 10) 4 1 2 3 4) -(deftest set-exclusive-or.22 +(deftest set-exclusive-or.order.4 (let ((i 0) x y z w) (values (sort @@ -229,7 +229,7 @@ i x y z w)) (2 4 6 10) 4 1 2 3 4) -(deftest set-exclusive-or.23 +(deftest set-exclusive-or.order.5 (let ((i 0) x y z w) (values (sort @@ -498,73 +498,73 @@ ;;; Order of argument evaluation tests -(deftest nset-exclusive-or.19 +(deftest nset-exclusive-or.order.1 (let ((i 0) x y) (values (sort (nset-exclusive-or (progn (setf x (incf i)) - (list 1 2 3 4)) - (progn (setf y (incf i)) - (list 1 3 6 10))) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10))) #'<) i x y)) (2 4 6 10) 2 1 2) -(deftest nset-exclusive-or.20 +(deftest nset-exclusive-or.order.2 (let ((i 0) x y z) (values (sort (nset-exclusive-or (progn (setf x (incf i)) - (list 1 2 3 4)) - (progn (setf y (incf i)) - (list 1 3 6 10)) - :test (progn (setf z (incf i)) - #'eql)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :test (progn (setf z (incf i)) + #'eql)) #'<) i x y z)) (2 4 6 10) 3 1 2 3) -(deftest nset-exclusive-or.21 +(deftest nset-exclusive-or.order.3 (let ((i 0) x y z w) (values (sort (nset-exclusive-or (progn (setf x (incf i)) - (list 1 2 3 4)) - (progn (setf y (incf i)) - (list 1 3 6 10)) - :test (progn (setf z (incf i)) - #'eql) - :key (progn (setf w (incf i)) nil)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :test (progn (setf z (incf i)) + #'eql) + :key (progn (setf w (incf i)) nil)) #'<) i x y z w)) (2 4 6 10) 4 1 2 3 4) -(deftest nset-exclusive-or.22 +(deftest nset-exclusive-or.order.4 (let ((i 0) x y z w) (values (sort (nset-exclusive-or (progn (setf x (incf i)) - (list 1 2 3 4)) - (progn (setf y (incf i)) - (list 1 3 6 10)) - :key (progn (setf z (incf i)) nil) - :test (progn (setf w (incf i)) - #'eql)) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :key (progn (setf z (incf i)) nil) + :test (progn (setf w (incf i)) + #'eql)) #'<) i x y z w)) (2 4 6 10) 4 1 2 3 4) -(deftest nset-exclusive-or.23 +(deftest nset-exclusive-or.order.5 (let ((i 0) x y z w) (values (sort (nset-exclusive-or (progn (setf x (incf i)) - (list 1 2 3 4)) - (progn (setf y (incf i)) - (list 1 3 6 10)) - :key (progn (setf z (incf i)) nil) - :key (progn (setf w (incf i)) - (complement #'eql))) + (list 1 2 3 4)) + (progn (setf y (incf i)) + (list 1 3 6 10)) + :key (progn (setf z (incf i)) nil) + :key (progn (setf w (incf i)) + (complement #'eql))) #'<) i x y z w)) (2 4 6 10) 4 1 2 3 4) diff --git a/ansi-tests/cons-test-24.lsp b/ansi-tests/cons-test-24.lsp index 800c51dcc7cf2a58e54332c833016218490cba69..806aaff435e11b2552e6e14f0b742deb769045c1 100644 --- a/ansi-tests/cons-test-24.lsp +++ b/ansi-tests/cons-test-24.lsp @@ -128,7 +128,7 @@ ;;; Order of argument evaluation tests -(deftest subsetp.16 +(deftest subsetp.order.1 (let ((i 0) x y) (values (notnot (subsetp (progn (setf x (incf i)) @@ -138,7 +138,7 @@ i x y)) t 2 1 2) -(deftest subsetp.17 +(deftest subsetp.order.2 (let ((i 0) x y z w) (values (notnot (subsetp (progn (setf x (incf i)) @@ -150,7 +150,7 @@ i x y z w)) t 4 1 2 3 4) -(deftest subsetp.18 +(deftest subsetp.order.3 (let ((i 0) x y z w) (values (notnot (subsetp (progn (setf x (incf i)) @@ -162,8 +162,6 @@ i x y z w)) t 4 1 2 3 4) - - ;;; Keyword tests (deftest subsetp.allow-other-keys.1 diff --git a/ansi-tests/constantly.lsp b/ansi-tests/constantly.lsp index a68a295c9d1cd973caf32862789dd492a9d6e661..59d714308f8747f5b3c8a80bb7c414f957520043 100644 --- a/ansi-tests/constantly.lsp +++ b/ansi-tests/constantly.lsp @@ -17,10 +17,21 @@ (notnot-mv (cl:constantly 1)) t) +(deftest constantly.3 + (let ((i 0)) + (let ((fn (cl:constantly (progn (incf i) 'a)))) + (values + i + (mapcar fn '(1 2 3 4)) + i))) + 1 (a a a a) 1) + (deftest constantly.error.1 (classify-error (cl:constantly)) program-error) +;;; The next test fails in CMUCL, which has non-conformantly extended +;;; the syntax of constantly. (deftest constantly.error.2 (classify-error (cl:constantly 1 1)) program-error) diff --git a/ansi-tests/constantp.lsp b/ansi-tests/constantp.lsp index 39f650d2d7edff432d0ddcba5be2827a43c87d94..99556a207d13b4c2961ca63a259ae5159161f3de 100644 --- a/ansi-tests/constantp.lsp +++ b/ansi-tests/constantp.lsp @@ -66,6 +66,13 @@ t) (deftest constantp.order.1 + (let ((i 0)) + (values + (notnot (constantp (progn (incf i) 1))) + i)) + t 1) + +(deftest constantp.order.2 (let ((i 0) x y) (values (notnot (constantp (progn (setf x (incf i)) 1) diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index 51b1afc5e9542e6ca738be9b26eaad1c98015773..bb2cd1e14767fe33ad83113d5537cd631a469731 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -154,6 +154,11 @@ (equal-array x y)) t) +(deftest copy-seq.order.1 + (let ((i 0)) + (values (copy-seq (progn (incf i) "abc")) i)) + "abc" 1) + ;;; Error tests (deftest copy-seq.error.1 diff --git a/ansi-tests/count-if-not.lsp b/ansi-tests/count-if-not.lsp index 4b1a7d316065abd298f32442b34a945b7cfc3ab4..2e5603c2dd9e7820067e6b681a756b02b5f44ea0 100644 --- a/ansi-tests/count-if-not.lsp +++ b/ansi-tests/count-if-not.lsp @@ -420,7 +420,7 @@ ;;; Argument order tests -(deftest count-if-not-order.1 +(deftest count-if-not.order.1 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if-not @@ -434,7 +434,7 @@ i c1 c2 c3 c4 c5 c6)) 1 6 1 2 3 4 5 6) -(deftest count-if-not-order.2 +(deftest count-if-not.order.2 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if-not diff --git a/ansi-tests/count-if.lsp b/ansi-tests/count-if.lsp index 074bfe6c13f999d40dea805195fee6b2a64734ba..cbc32e87b5bc947c17d97632ffa9cb785f5f1a1f 100644 --- a/ansi-tests/count-if.lsp +++ b/ansi-tests/count-if.lsp @@ -419,7 +419,7 @@ ;;; Argument order tests -(deftest count-if-order.1 +(deftest count-if.order.1 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if (progn (setf c1 (incf i)) #'null) @@ -432,7 +432,7 @@ i c1 c2 c3 c4 c5 c6)) 1 6 1 2 3 4 5 6) -(deftest count-if-order.2 +(deftest count-if.order.2 (let ((i 0) c1 c2 c3 c4 c5 c6) (values (count-if (progn (setf c1 (incf i)) #'null) diff --git a/ansi-tests/count.lsp b/ansi-tests/count.lsp index c43c79e4310860b5cd4c97b20b2186a2ff3208df..33939db365749e09c113f57a0d6f5cdf1327d422 100644 --- a/ansi-tests/count.lsp +++ b/ansi-tests/count.lsp @@ -488,7 +488,7 @@ ;;; Argument order tests -(deftest count-order.1 +(deftest count.order.1 (let ((i 0) c1 c2 c3 c4 c5 c6 c7) (values (count (progn (setf c1 (incf i)) nil) @@ -502,7 +502,7 @@ i c1 c2 c3 c4 c5 c6 c7)) 1 7 1 2 3 4 5 6 7) -(deftest count-order.2 +(deftest count.order.2 (let ((i 0) c1 c2 c3 c4 c5 c6 c7) (values (count (progn (setf c1 (incf i)) nil) diff --git a/ansi-tests/elt.lsp b/ansi-tests/elt.lsp index 22da964c909fad4ed74ac21f7d97450675c8c5b7..16698ccf4bd63be4933b2048c12d0749c24f4c82 100644 --- a/ansi-tests/elt.lsp +++ b/ansi-tests/elt.lsp @@ -9,30 +9,30 @@ ;; elt on lists -(deftest elt-1 +(deftest elt.1 (classify-error (elt nil 0)) type-error) -(deftest elt-1a +(deftest elt.1a (classify-error (elt nil -10)) type-error) -(deftest elt-1b +(deftest elt.1b (classify-error (locally (elt nil 0) t)) type-error) -(deftest elt-2 +(deftest elt.2 (classify-error (elt nil 1000000)) type-error) -(deftest elt-3 (elt '(a b c d e) 0) a) -(deftest elt-4 (elt '(a b c d e) 2) c) -(deftest elt-5 (elt '(a b c d e) 4) e) -(deftest elt-5a +(deftest elt.3 (elt '(a b c d e) 0) a) +(deftest elt.4 (elt '(a b c d e) 2) c) +(deftest elt.5 (elt '(a b c d e) 4) e) +(deftest elt.5a (classify-error (elt '(a b c d e) -4)) type-error) -(deftest elt-6 +(deftest elt.6 (let ((x (make-int-list 1000))) (notnot-mv (every @@ -40,31 +40,31 @@ x))) t) -(deftest elt-7 +(deftest elt.7 (let* ((x (list 'a 'b 'c 'd)) (y (setf (elt x 0) 'e))) (list x y)) ((e b c d) e)) -(deftest elt-8 +(deftest elt.8 (let* ((x (list 'a 'b 'c 'd)) (y (setf (elt x 1) 'e))) (list x y)) ((a e c d) e)) -(deftest elt-9 +(deftest elt.9 (let* ((x (list 'a 'b 'c 'd)) (y (setf (elt x 3) 'e))) (list x y)) ((a b c e) e)) -(deftest elt-10 +(deftest elt.10 (classify-error (let ((x (list 'a 'b 'c))) (setf (elt x 4) 'd))) type-error) -(deftest elt-11 +(deftest elt.11 (let ((x (list 'a 'b 'c 'd 'e))) (let ((y (loop for c on x collect c))) (setf (elt x 2) 'f) @@ -74,12 +74,12 @@ (loop for c on x collect c))))) t) -(deftest elt-12 +(deftest elt.12 (let ((x (make-int-list 100000))) (elt x 90000)) 90000) -(deftest elt-13 +(deftest elt.13 (let ((x (make-int-list 100000))) (setf (elt x 80000) 'foo) (list (elt x 79999) @@ -87,43 +87,43 @@ (elt x 80001))) (79999 foo 80001)) -(deftest elt-14 +(deftest elt.14 (classify-error (let ((x (list 'a 'b 'c))) (elt x 10))) type-error) -(deftest elt-15 +(deftest elt.15 (classify-error (let ((x (list 'a 'b 'c))) (elt x 'a))) type-error) -(deftest elt-16 +(deftest elt.16 (classify-error (let ((x (list 'a 'b 'c))) (elt x 10.0))) type-error) -(deftest elt-17 +(deftest elt.17 (classify-error (let ((x (list 'a 'b 'c))) (elt x -1))) type-error) -(deftest elt-18 +(deftest elt.18 (classify-error (let ((x (list 'a 'b 'c))) (elt x -100000000000000000))) type-error) -(deftest elt-19 +(deftest elt.19 (classify-error (let ((x (list 'a 'b 'c))) (elt x #\w))) type-error) -(deftest elt.20 +(deftest elt.order.1 (let ((i 0) x y) (values (elt (progn (setf x (incf i)) '(a b c d e)) @@ -131,7 +131,7 @@ i x y)) d 2 1 2) -(deftest elt.21 +(deftest elt.order.2 (let ((i 0) x y z) (let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e)))) (values @@ -142,64 +142,64 @@ i x y z))) k (a b c k e) 3 1 2 3) -(deftest elt-v-1 +(deftest elt-v.1 (classify-error (elt (make-array '(0)) 0)) type-error) -;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil) ;; actually undefined -(deftest elt-v-3 +;; (deftest elt-v.2 (elt (make-array '(1)) 0) nil) ;; actually undefined +(deftest elt-v.3 (elt (make-array '(5) :initial-contents '(a b c d e)) 0) a) -(deftest elt-v-4 +(deftest elt-v.4 (elt (make-array '(5) :initial-contents '(a b c d e)) 2) c) -(deftest elt-v-5 +(deftest elt-v.5 (elt (make-array '(5) :initial-contents '(a b c d e)) 4) e) -(deftest elt-v-6 +(deftest elt-v.6 (elt-v-6-body) t) -(deftest elt-v-7 +(deftest elt-v.7 (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) (y (setf (elt x 0) 'e))) (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) (e b c d e)) -(deftest elt-v-8 +(deftest elt-v.8 (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) (y (setf (elt x 1) 'e))) (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) (a e c d e)) -(deftest elt-v-9 +(deftest elt-v.9 (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) (y (setf (elt x 3) 'e))) (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) (a b c e e)) -(deftest elt-v-10 +(deftest elt-v.10 (classify-error (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) (setf (elt x 4) 'd))) type-error) -(deftest elt-v-11 +(deftest elt-v.11 (classify-error (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) (setf (elt x -100) 'd))) type-error) -(deftest elt-v-12 +(deftest elt-v.12 (let ((x (make-int-array 100000))) (elt x 90000)) 90000) -(deftest elt-v-13 +(deftest elt-v.13 (let ((x (make-int-array 100000))) (setf (elt x 80000) 'foo) (list (elt x 79999) @@ -209,64 +209,64 @@ ;;; Adjustable arrays -(deftest elt-adj-array-1 +(deftest elt-adj-array.1 (classify-error (elt (make-adj-array '(0)) 0)) type-error) -;;; (deftest elt-adj-array-2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined +;;; (deftest elt-adj-array.2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined -(deftest elt-adj-array-3 +(deftest elt-adj-array.3 (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0) a) -(deftest elt-adj-array-4 +(deftest elt-adj-array.4 (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2) c) -(deftest elt-adj-array-5 +(deftest elt-adj-array.5 (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4) e) -(deftest elt-adj-array-6 +(deftest elt-adj-array.6 (elt-adj-array-6-body) t) -(deftest elt-adj-array-7 +(deftest elt-adj-array.7 (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) (y (setf (elt x 0) 'e))) (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) (e b c d e)) -(deftest elt-adj-array-8 +(deftest elt-adj-array.8 (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) (y (setf (elt x 1) 'e))) (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) (a e c d e)) -(deftest elt-adj-array-9 +(deftest elt-adj-array.9 (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) (y (setf (elt x 3) 'e))) (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) (a b c e e)) -(deftest elt-adj-array-10 +(deftest elt-adj-array.10 (classify-error (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) (setf (elt x 4) 'd))) type-error) -(deftest elt-adj-array-11 +(deftest elt-adj-array.11 (classify-error (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) (setf (elt x -100) 'd))) type-error) -(deftest elt-adj-array-12 +(deftest elt-adj-array.12 (let ((x (make-int-array 100000 #'make-adj-array))) (elt x 90000)) 90000) -(deftest elt-adj-array-13 +(deftest elt-adj-array.13 (let ((x (make-int-array 100000 #'make-adj-array))) (setf (elt x 80000) 'foo) (list (elt x 79999) @@ -276,27 +276,27 @@ ;; displaced arrays -(deftest elt-displaced-array-1 +(deftest elt-displaced-array.1 (classify-error (elt (make-displaced-array '(0) 100) 0)) type-error) -(deftest elt-displaced-array-2 +(deftest elt-displaced-array.2 (elt (make-displaced-array '(1) 100) 0) 100) -(deftest elt-displaced-array-3 +(deftest elt-displaced-array.3 (elt (make-displaced-array '(5) 100) 4) 104) ;;; Arrays with fill points -(deftest elt-fill-pointer-1 +(deftest elt-fill-pointer.1 (let ((a (make-array '(5) :initial-contents '(a b c d e) :fill-pointer 3))) (values (elt a 0) (elt a 1) (elt a 2))) a b c) -(deftest elt-fill-pointer-2 +(deftest elt-fill-pointer.2 (let ((a (make-array '(5) :initial-contents '(0 0 1 0 0) :element-type 'bit @@ -304,7 +304,7 @@ (values (elt a 0) (elt a 1) (elt a 2))) 0 0 1) -(deftest elt-fill-pointer-3 +(deftest elt-fill-pointer.3 (classify-error (let ((a (make-array '(5) :initial-contents '(0 0 1 0 0) @@ -312,7 +312,7 @@ (elt a 4))) type-error) -(deftest elt-fill-pointer-4 +(deftest elt-fill-pointer.4 (classify-error (let ((a (make-array '(5) :initial-contents '(0 0 1 0 0) @@ -321,7 +321,7 @@ (elt a 4))) type-error) -(deftest elt-fill-pointer-5 +(deftest elt-fill-pointer.5 (let ((a (make-array '(5) :initial-contents '(#\a #\b #\c #\d #\e) :element-type 'character @@ -329,7 +329,7 @@ (values (elt a 0) (elt a 1) (elt a 2))) #\a #\b #\c) -(deftest elt-fill-pointer-6 +(deftest elt-fill-pointer.6 (classify-error (let ((a (make-array '(5) :initial-contents '(#\a #\b #\c #\d #\e) @@ -338,7 +338,7 @@ (elt a 4))) type-error) -(deftest elt-fill-pointer-7 +(deftest elt-fill-pointer.7 (let ((a (make-array '(5) :initial-contents '(#\a #\b #\c #\d #\e) :element-type 'base-char @@ -346,7 +346,7 @@ (values (elt a 0) (elt a 1) (elt a 2))) #\a #\b #\c) -(deftest elt-fill-pointer-8 +(deftest elt-fill-pointer.8 (classify-error (let ((a (make-array '(5) :initial-contents '(#\a #\b #\c #\d #\e) diff --git a/ansi-tests/eql.lsp b/ansi-tests/eql.lsp index d5296562234b44b2072ff8a9708c58661f06a7b2..10318a03b48131e29550a7f228ae33c9a84bf79a 100644 --- a/ansi-tests/eql.lsp +++ b/ansi-tests/eql.lsp @@ -51,7 +51,7 @@ (eqlt #c(1 -2) (- #c(-1 2))) t) -(deftest eql.12 +(deftest eql.order.1 (let ((i 0) x y) (values (eql (setf x (incf i)) (setf y (incf i))) diff --git a/ansi-tests/equal.lsp b/ansi-tests/equal.lsp index 6de2df1fb675b77deccffd8985e3e13cd5b67c5e..a2a524441f06abb7a8ef10feef8afc855a1538da 100644 --- a/ansi-tests/equal.lsp +++ b/ansi-tests/equal.lsp @@ -61,7 +61,7 @@ (equalt (copy-seq #*000110) (copy-seq #*000111)) nil) -(deftest equal.13 +(deftest equal.order.1 (let ((i 0) x y) (values (equal (setf x (incf i)) (setf y (incf i))) diff --git a/ansi-tests/equalp.lsp b/ansi-tests/equalp.lsp index cfb0f088f15874acbfdf86ca98dd36058840903b..5248fc735c7bc5d4b2df3a684d30e4b2bf1077da 100644 --- a/ansi-tests/equalp.lsp +++ b/ansi-tests/equalp.lsp @@ -27,7 +27,7 @@ (equalpt "abc" "abd") nil) -(deftest equalp.5 +(deftest equalp.order.1 (let ((i 0) x y) (values (equalp (setf x (incf i)) (setf y (incf i))) diff --git a/ansi-tests/eval.lsp b/ansi-tests/eval.lsp index a907a37a5024e19939739faa4e830e22a650b5b1..cf16659d42f1a9aded196fc7357fc20ba523eedb 100644 --- a/ansi-tests/eval.lsp +++ b/ansi-tests/eval.lsp @@ -31,6 +31,11 @@ (funcall #'eval 1) 1) +(deftest eval.order.1 + (let ((i 0)) + (values (eval (progn (incf i) 10)) i)) + 10 1) + ;;; Error cases (deftest eval.error.1 @@ -40,3 +45,8 @@ (deftest eval.error.2 (classify-error (eval nil nil)) program-error) + +(deftest eval.error.3 + (classify-error (eval (list (gensym)))) + undefined-function) + diff --git a/ansi-tests/every.lsp b/ansi-tests/every.lsp index 5aa79bebcbb349ed169089714c314029bdf0151b..a09c8047b790ca5c43e2d8288772b7f1a583a07c 100644 --- a/ansi-tests/every.lsp +++ b/ansi-tests/every.lsp @@ -78,7 +78,7 @@ (notnot-mv (every 'null '(nil nil nil nil))) t) -(deftest every.17 +(deftest every.order.1 (let ((i 0) x y) (values (every (progn (setf x (incf i)) #'null) @@ -86,6 +86,15 @@ i x y)) nil 2 1 2) +(deftest every.order.2 + (let ((i 0) x y z) + (values + (every (progn (setf x (incf i)) #'equal) + (progn (setf y (incf i)) '(nil nil a nil)) + (progn (setf z (incf i)) '(nil nil a b))) + i x y z)) + nil 3 1 2 3) + ;;; Error cases (deftest every.error.1 diff --git a/ansi-tests/fboundp.lsp b/ansi-tests/fboundp.lsp index da5b49c772eca0d0b1f197a120e534828c19ffd5..0ec7332dfdebfbcb095d0818453b95e54b634ddf 100644 --- a/ansi-tests/fboundp.lsp +++ b/ansi-tests/fboundp.lsp @@ -39,6 +39,11 @@ (let ((g (gensym))) (fboundp (list 'setf g))) nil) +(deftest fboundp.order.1 + (let ((i 0)) + (values (notnot (fboundp (progn (incf i) 'car))) i)) + t 1) + (deftest fboundp.error.1 (classify-error (fboundp 1)) type-error) diff --git a/ansi-tests/fdefinition.lsp b/ansi-tests/fdefinition.lsp index c49663a7bd9adf424185322f7c5af245cb143a7b..1cfaa8dba03d767d08235a6d9bcd53e054bc97bb 100644 --- a/ansi-tests/fdefinition.lsp +++ b/ansi-tests/fdefinition.lsp @@ -74,3 +74,10 @@ nil (b . a) t) + +(deftest fdefinition.order.1 + (let ((i 0)) + (fdefinition (progn (incf i) 'setq)) + i) + 1) + diff --git a/ansi-tests/fill-pointer.lsp b/ansi-tests/fill-pointer.lsp index 4bde4c2063c90bfc974a6eb4be00d0b4c349ce6c..2f86e42c62db0f97e4e41112f742b75d8214b7e6 100644 --- a/ansi-tests/fill-pointer.lsp +++ b/ansi-tests/fill-pointer.lsp @@ -24,6 +24,26 @@ a)) 5 6 #(1 2 3 4 5 6)) +(deftest fill-pointer.order.1 + (let ((i 0) + (a (make-array '(10) :fill-pointer 5))) + (values + (fill-pointer (progn (incf i) a)) + i)) + 5 1) + +(deftest fill-pointer.order.2 + (let ((i 0) x y + (a (make-array '(10) :fill-pointer 5 + :initial-contents '(1 2 3 4 5 6 7 8 9 10)))) + (values + i + (setf (fill-pointer (progn (setf x (incf i)) a)) + (progn (setf y (incf i)) 6)) + a + i x y)) + 0 6 #(1 2 3 4 5 6) 2 1 2) + ;;; Error tests (deftest fill-pointer.error.1 diff --git a/ansi-tests/fill-strings.lsp b/ansi-tests/fill-strings.lsp index 73446f533a876e44f8167f188b75cf30ad573e95..38bdc3c47a90ce477891f193bd4bf084528ee7e0 100644 --- a/ansi-tests/fill-strings.lsp +++ b/ansi-tests/fill-strings.lsp @@ -5,22 +5,22 @@ (in-package :cl-test) -(deftest array-string-fill-1 +(deftest array-string-fill.1 (array-string-fill-test-fn "abcde" #\Z) t "ZZZZZ") -(deftest array-string-fill-2 +(deftest array-string-fill.2 (array-string-fill-test-fn "abcde" #\Z :start 2) t "abZZZ") -(deftest array-string-fill-3 +(deftest array-string-fill.3 (array-string-fill-test-fn "abcde" #\Z :end 3) t "ZZZde") -(deftest array-string-fill-4 +(deftest array-string-fill.4 (array-string-fill-test-fn "abcde" #\Z :start 1 :end 4) t "aZZZe") -(deftest array-string-fill-5 +(deftest array-string-fill.5 (array-string-fill-test-fn "abcde" #\Z :start 2 :end 3) t "abZde")