From 5463b7bf0748577dd35b0513a7219abeb74de9bf Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 13 Jun 2005 13:01:35 +0000 Subject: [PATCH] Tests for possible compiler folding bugs --- ansi-tests/bit-and.lsp | 6 ++ ansi-tests/bit-andc1.lsp | 6 ++ ansi-tests/bit-andc2.lsp | 6 ++ ansi-tests/bit-eqv.lsp | 6 ++ ansi-tests/bit-ior.lsp | 6 ++ ansi-tests/bit-nand.lsp | 6 ++ ansi-tests/bit-nor.lsp | 6 ++ ansi-tests/bit-not.lsp | 6 ++ ansi-tests/bit-orc1.lsp | 6 ++ ansi-tests/bit-orc2.lsp | 6 ++ ansi-tests/bit-xor.lsp | 6 ++ ansi-tests/coerce.lsp | 19 ++++++- ansi-tests/concatenate.lsp | 32 +++++++++++ ansi-tests/map.lsp | 11 ++++ ansi-tests/remove-duplicates.lsp | 21 +++++++ ansi-tests/remove.lsp | 98 ++++++++++++++++++++++++++++++++ ansi-tests/reverse.lsp | 22 +++++++ ansi-tests/subseq.lsp | 12 ++++ ansi-tests/substitute-if-not.lsp | 17 ++++++ ansi-tests/substitute-if.lsp | 17 ++++++ ansi-tests/substitute.lsp | 32 +++++++++++ 21 files changed, 346 insertions(+), 1 deletion(-) diff --git a/ansi-tests/bit-and.lsp b/ansi-tests/bit-and.lsp index ef1e91c4..df27299c 100644 --- a/ansi-tests/bit-and.lsp +++ b/ansi-tests/bit-and.lsp @@ -228,6 +228,12 @@ x y z)) #*0 2 1 2) +(deftest bit-and.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-and #*01101 #*01011))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 1) bv) (%f))) + #*01001 #*11001 #*01001) + ;;; Error tests (deftest bit-and.error.1 diff --git a/ansi-tests/bit-andc1.lsp b/ansi-tests/bit-andc1.lsp index 67f72b38..571fda87 100644 --- a/ansi-tests/bit-andc1.lsp +++ b/ansi-tests/bit-andc1.lsp @@ -228,6 +228,12 @@ x y z)) #*0 2 1 2) +(deftest bit-andc1.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-andc1 #*10010 #*01011))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 1) bv) (%f))) + #*01001 #*11001 #*01001) + ;;; Error tests (deftest bit-andc1.error.1 diff --git a/ansi-tests/bit-andc2.lsp b/ansi-tests/bit-andc2.lsp index 54b57f79..646ef3ec 100644 --- a/ansi-tests/bit-andc2.lsp +++ b/ansi-tests/bit-andc2.lsp @@ -228,6 +228,12 @@ x y z)) #*0 2 1 2) +(deftest bit-andc2.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-andc2 #*01101 #*10100))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 1) bv) (%f))) + #*01001 #*11001 #*01001) + ;;; Error tests (deftest bit-andc2.error.1 diff --git a/ansi-tests/bit-eqv.lsp b/ansi-tests/bit-eqv.lsp index b44847b7..60290002 100644 --- a/ansi-tests/bit-eqv.lsp +++ b/ansi-tests/bit-eqv.lsp @@ -229,6 +229,12 @@ x y z)) #*1 2 1 2) +(deftest bit-eqv.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-eqv #*01101 #*10100))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 1) bv) (%f))) + #*00110 #*10110 #*00110) + ;;; Error tests (deftest bit-eqv.error.1 diff --git a/ansi-tests/bit-ior.lsp b/ansi-tests/bit-ior.lsp index 87401cc0..b213b9e4 100644 --- a/ansi-tests/bit-ior.lsp +++ b/ansi-tests/bit-ior.lsp @@ -228,6 +228,12 @@ x y z)) #*0 2 1 2) +(deftest bit-ior.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-ior #*00101 #*10100))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 0) bv) (%f))) + #*10101 #*00101 #*10101) + ;;; Error tests (deftest bit-ior.error.1 diff --git a/ansi-tests/bit-nand.lsp b/ansi-tests/bit-nand.lsp index 07e6c071..75bf5c0b 100644 --- a/ansi-tests/bit-nand.lsp +++ b/ansi-tests/bit-nand.lsp @@ -228,6 +228,12 @@ x y z)) #*1 2 1 2) +(deftest bit-nand.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-nand #*00101 #*10100))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 0) bv) (%f))) + #*11011 #*01011 #*11011) + ;;; Error tests (deftest bit-nand.error.1 diff --git a/ansi-tests/bit-nor.lsp b/ansi-tests/bit-nor.lsp index 0064fd83..866b8658 100644 --- a/ansi-tests/bit-nor.lsp +++ b/ansi-tests/bit-nor.lsp @@ -228,6 +228,12 @@ x y z)) #*1 2 1 2) +(deftest bit-nor.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-nor #*00101 #*10100))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 1) bv) (%f))) + #*01010 #*11010 #*01010) + ;;; Error tests (deftest bit-nor.error.1 diff --git a/ansi-tests/bit-not.lsp b/ansi-tests/bit-not.lsp index 44c9832a..a62a0192 100644 --- a/ansi-tests/bit-not.lsp +++ b/ansi-tests/bit-not.lsp @@ -127,6 +127,12 @@ i x)) #*110010 1 1) +(deftest bit-not.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-not #*00101))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 0) bv) (%f))) + #*11010 #*01010 #*11010) + ;;; Error tests (deftest bit-not.error.1 diff --git a/ansi-tests/bit-orc1.lsp b/ansi-tests/bit-orc1.lsp index 33b651ad..49a344a5 100644 --- a/ansi-tests/bit-orc1.lsp +++ b/ansi-tests/bit-orc1.lsp @@ -228,6 +228,12 @@ x y z)) #*1 2 1 2) +(deftest bit-orc1.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-orc1 #*11010 #*10100))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 0) bv) (%f))) + #*10101 #*00101 #*10101) + ;;; Error tests (deftest bit-orc1.error.1 diff --git a/ansi-tests/bit-orc2.lsp b/ansi-tests/bit-orc2.lsp index cbd172eb..f85a5423 100644 --- a/ansi-tests/bit-orc2.lsp +++ b/ansi-tests/bit-orc2.lsp @@ -228,6 +228,12 @@ x y z)) #*1 2 1 2) +(deftest bit-orc2.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-orc2 #*00101 #*01011))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 0) bv) (%f))) + #*10101 #*00101 #*10101) + ;;; Error tests (deftest bit-orc2.error.1 diff --git a/ansi-tests/bit-xor.lsp b/ansi-tests/bit-xor.lsp index 4e7955e7..230028df 100644 --- a/ansi-tests/bit-xor.lsp +++ b/ansi-tests/bit-xor.lsp @@ -228,6 +228,12 @@ x y z)) #*0 2 1 2) +(deftest bit-xor.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (bit-xor #*00101 #*10100))) + (values (%f) (let ((bv (%f))) (setf (elt bv 0) 0) bv) (%f))) + #*10001 #*00001 #*10001) + ;;; Error tests (deftest bit-xor.error.1 diff --git a/ansi-tests/coerce.lsp b/ansi-tests/coerce.lsp index 9fb48f08..863e8930 100644 --- a/ansi-tests/coerce.lsp +++ b/ansi-tests/coerce.lsp @@ -139,6 +139,24 @@ i a b)) 10.0f0 2 1 2) +;;; Constant folding test +;;; If the coerce call is folded to a constant, this will fail +;;; when that constant is modified. + +(deftest coerce.fold.1 + (flet ((%f () (declare (optimize speed (safety 0))) + (coerce '(1 2 3) 'vector))) + (values + (%f) + (let ((v (%f))) + (setf (aref v 0) 0) + v) + (%f))) + #(1 2 3) + #(0 2 3) + #(1 2 3)) + + ;;; Error tests ;;; (deftest coerce.error.1 @@ -198,4 +216,3 @@ (t t))) (error (c) (declare (ignore c)) t)))) t) - diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index f9384490..a98539bb 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -287,6 +287,38 @@ i x y z)) "abcdefghi" 3 1 2 3) +;;; Constant folding tests + +(deftest concatenate.fold.1 + (flet ((%f () (declaim (optimize speed (safety 0) (space 0))) + (concatenate 'list '(a b) '(c d)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + (a b c d) (z b c d) (a b c d)) + +(deftest concatenate.fold.2 + (flet ((%f () (declaim (optimize speed (safety 0) (space 0))) + (concatenate 'vector '(a b) '(c d)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + #(a b c d) #(z b c d) #(a b c d)) + +(deftest concatenate.fold.3 + (flet ((%f () (declaim (optimize speed (safety 0) (space 0))) + (concatenate 'bit-vector '(0 0) '(1 0 1)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 1) seq) (%f))) + #*00101 #*10101 #*00101) + +(deftest concatenate.fold.4 + (flet ((%f () (declaim (optimize speed (safety 0) (space 0))) + (concatenate 'string "ab" "cd"))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) #\z) seq) (%f))) + "abcd" "zbcd" "abcd") + +(deftest concatenate.fold.5 + (flet ((%f () (declaim (optimize speed (safety 0) (space 0))) + (concatenate 'list '(a b c d)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + (a b c d) (z b c d) (a b c d)) + ;;; Error tests (deftest concatenate.error.1 diff --git a/ansi-tests/map.lsp b/ansi-tests/map.lsp index e29e1a06..40184a33 100644 --- a/ansi-tests/map.lsp +++ b/ansi-tests/map.lsp @@ -425,3 +425,14 @@ (progn (setf d (incf i)) '(b c d))) i a b c d)) ((a b)(b c)(c d)) 4 1 2 3 4) + +;;; Constant folding test + +(deftest map.fold.1 + (let ((f (compile nil '(lambda () (declare (optimize speed (safety 0))) + (map 'vector #'identity '(a b c)))))) + (let ((v (funcall f))) + (setf (aref v 0) nil) + (values v (funcall f)))) + #(nil b c) + #(a b c)) diff --git a/ansi-tests/remove-duplicates.lsp b/ansi-tests/remove-duplicates.lsp index f1d83779..2e738a09 100644 --- a/ansi-tests/remove-duplicates.lsp +++ b/ansi-tests/remove-duplicates.lsp @@ -54,6 +54,27 @@ (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql :test #'eql)) +;;; Const fold tests + +(deftest remove-duplicates.fold.1 + (flet ((%f () (remove-duplicates '(1 2 3 3)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 0) seq) (%f))) + (1 2 3) (0 2 3) (1 2 3)) + +(deftest remove-duplicates.fold.2 + (flet ((%f () (remove-duplicates #(1 2 3 3)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 0) seq) (%f))) + #(1 2 3) #(0 2 3) #(1 2 3)) + +(deftest remove-duplicates.fold.3 + (flet ((%f () (remove-duplicates #*0011))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 1) seq) (%f))) + #*01 #*11 #*01) + +(deftest remove-duplicates.fold.4 + (flet ((%f () (remove-duplicates "1233"))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) #\0) seq) (%f))) + "123" "023" "123") ;;; Order of evaluation tests diff --git a/ansi-tests/remove.lsp b/ansi-tests/remove.lsp index db015a49..f8aee212 100644 --- a/ansi-tests/remove.lsp +++ b/ansi-tests/remove.lsp @@ -461,6 +461,104 @@ (delete #\0 (copy-seq "0001100100") :test-not #'eql :test #'eql)) +;;; Const fold tests + +(deftest remove.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove 'c '(a b c d e)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + (a b d e) + (z b d e) + (a b d e)) + +(deftest remove.fold.2 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove 'c #(a b c d e)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + #(a b d e) + #(z b d e) + #(a b d e)) + +(deftest remove.fold.3 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove 1 #*0011011001))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 1) seq) (%f))) + #*00000 + #*10000 + #*00000) + +(deftest remove.fold.4 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove #\c "abcde"))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) #\z) seq) (%f))) + "abde" + "zbde" + "abde") + +(deftest remove-if.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if 'null '(a b nil d e)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + (a b d e) + (z b d e) + (a b d e)) + +(deftest remove-if.fold.2 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if #'null #(a b nil d e)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + #(a b d e) + #(z b d e) + #(a b d e)) + +(deftest remove-if.fold.3 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if 'plusp #*0011011001))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 1) seq) (%f))) + #*00000 + #*10000 + #*00000) + +(deftest remove-if.fold.4 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if 'digit-char-p "ab0de"))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) #\z) seq) (%f))) + "abde" + "zbde" + "abde") + +(deftest remove-if-not.fold.1 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if-not #'identity '(a b nil d e)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + (a b d e) + (z b d e) + (a b d e)) + +(deftest remove-if-not.fold.2 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if-not 'identity #(a b nil d e)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'z) seq) (%f))) + #(a b d e) + #(z b d e) + #(a b d e)) + +(deftest remove-if-not.fold.3 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if-not #'zerop #*0011011001))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 1) seq) (%f))) + #*00000 + #*10000 + #*00000) + +(deftest remove-if-not.fold.4 + (flet ((%f () (declare (optimize speed (safety 0) (space 0))) + (remove-if-not #'alpha-char-p "ab-de"))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) #\z) seq) (%f))) + "abde" + "zbde" + "abde") + ;;; Order of evaluation tests (deftest remove.order.1 diff --git a/ansi-tests/reverse.lsp b/ansi-tests/reverse.lsp index 2038683a..96f68fa0 100644 --- a/ansi-tests/reverse.lsp +++ b/ansi-tests/reverse.lsp @@ -166,6 +166,28 @@ i)) (d c b a) 1) +;;; Constant folding tests + +(deftest reverse.fold.1 + (flet ((%f () (reverse '(a b c)))) + (values + (%f) + (let ((seq (%f))) (setf (elt seq 0) 'z) seq) + (%f))) + (c b a) + (z b a) + (c b a)) + +(deftest reverse.fold.2 + (flet ((%f () (reverse #(a b c)))) + (values + (%f) + (let ((seq (%f))) (setf (elt seq 0) 'z) seq) + (%f))) + #(c b a) + #(z b a) + #(c b a)) + ;;; Error cases (deftest reverse.error.1 diff --git a/ansi-tests/subseq.lsp b/ansi-tests/subseq.lsp index ef78aaa8..793c35fa 100644 --- a/ansi-tests/subseq.lsp +++ b/ansi-tests/subseq.lsp @@ -281,6 +281,18 @@ s i a b c)) "xyz" "axyz" 3 1 2 3) +;;; Constant folding + +(deftest subseq.fold.1 + (flet ((%f () (subseq '(1 2 3) 0))) + (values + (%f) + (let ((seq (%f))) (setf (elt seq 0) 0) seq) + (%f))) + (1 2 3) + (0 2 3) + (1 2 3)) + ;;; Error cases (deftest subseq.error.1 diff --git a/ansi-tests/substitute-if-not.lsp b/ansi-tests/substitute-if-not.lsp index 186c9548..b703c048 100644 --- a/ansi-tests/substitute-if-not.lsp +++ b/ansi-tests/substitute-if-not.lsp @@ -816,6 +816,23 @@ (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) (a a 0 a a 0 a)) +;;; Constant folding tests + +(deftest substitute-if-not.fold.1 + (flet ((%f () (substitute-if-not 'z 'identity '(a nil b)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'd) seq) (%f))) + (a z b) (d z b) (a z b)) + +(deftest substitute-if-not.fold.2 + (flet ((%f () (substitute-if-not 'z 'identity #(a nil b)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'd) seq) (%f))) + #(a z b) #(d z b) #(a z b)) + +(deftest substitute-if-not.fold.3 + (flet ((%f () (substitute-if-not 0 'zerop #*100110))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 1) seq) (%f))) + #*000000 #*100000 #*000000) + ;;; Error cases (deftest substitute-if-not.error.1 diff --git a/ansi-tests/substitute-if.lsp b/ansi-tests/substitute-if.lsp index 8a031356..561fc957 100644 --- a/ansi-tests/substitute-if.lsp +++ b/ansi-tests/substitute-if.lsp @@ -840,6 +840,23 @@ (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) (1 2 a 3 1 a 3)) +;;; Constant folding tests + +(deftest substitute-if.fold.1 + (flet ((%f () (substitute-if 'z 'null '(a nil b)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'd) seq) (%f))) + (a z b) (d z b) (a z b)) + +(deftest substitute-if.fold.2 + (flet ((%f () (substitute-if 'z 'null #(a nil b)))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 'd) seq) (%f))) + #(a z b) #(d z b) #(a z b)) + +(deftest substitute-if.fold.3 + (flet ((%f () (substitute-if 0 'plusp #*100110))) + (values (%f) (let ((seq (%f))) (setf (elt seq 0) 1) seq) (%f))) + #*000000 #*100000 #*000000) + ;;; Error cases (deftest substitute-if.error.1 diff --git a/ansi-tests/substitute.lsp b/ansi-tests/substitute.lsp index f8c24e95..ea0274e5 100644 --- a/ansi-tests/substitute.lsp +++ b/ansi-tests/substitute.lsp @@ -1092,6 +1092,38 @@ (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys nil) (1 2 a 3 1 a 3)) +;;; Constant folding tests + +(deftest substitute.fold.1 + (flet ((%f () (substitute 'z 'b '(a b c)))) + (values + (%f) + (let ((seq (%f))) (setf (elt seq 0) 'd) seq) + (%f))) + (a z c) + (d z c) + (a z c)) + +(deftest substitute.fold.2 + (flet ((%f () (substitute 'z 'b #(a b c)))) + (values + (%f) + (let ((seq (%f))) (setf (elt seq 0) 'd) seq) + (%f))) + #(a z c) + #(d z c) + #(a z c)) + +(deftest substitute.fold.3 + (flet ((%f () (substitute 0 1 #*001101))) + (values + (%f) + (let ((seq (%f))) (setf (elt seq 0) 1) seq) + (%f))) + #*000000 + #*100000 + #*000000) + ;;; Error cases (deftest substitute.error.1 -- GitLab