Skip to content
Snippets Groups Projects
Commit 5463b7bf authored by pfdietz's avatar pfdietz
Browse files

Tests for possible compiler folding bugs

parent 8a210df6
No related branches found
No related tags found
No related merge requests found
Showing
with 314 additions and 1 deletion
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*0 2 1 2) #*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 ;;; Error tests
(deftest bit-and.error.1 (deftest bit-and.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*0 2 1 2) #*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 ;;; Error tests
(deftest bit-andc1.error.1 (deftest bit-andc1.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*0 2 1 2) #*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 ;;; Error tests
(deftest bit-andc2.error.1 (deftest bit-andc2.error.1
......
...@@ -229,6 +229,12 @@ ...@@ -229,6 +229,12 @@
x y z)) x y z))
#*1 2 1 2) #*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 ;;; Error tests
(deftest bit-eqv.error.1 (deftest bit-eqv.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*0 2 1 2) #*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 ;;; Error tests
(deftest bit-ior.error.1 (deftest bit-ior.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*1 2 1 2) #*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 ;;; Error tests
(deftest bit-nand.error.1 (deftest bit-nand.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*1 2 1 2) #*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 ;;; Error tests
(deftest bit-nor.error.1 (deftest bit-nor.error.1
......
...@@ -127,6 +127,12 @@ ...@@ -127,6 +127,12 @@
i x)) i x))
#*110010 1 1) #*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 ;;; Error tests
(deftest bit-not.error.1 (deftest bit-not.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*1 2 1 2) #*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 ;;; Error tests
(deftest bit-orc1.error.1 (deftest bit-orc1.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*1 2 1 2) #*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 ;;; Error tests
(deftest bit-orc2.error.1 (deftest bit-orc2.error.1
......
...@@ -228,6 +228,12 @@ ...@@ -228,6 +228,12 @@
x y z)) x y z))
#*0 2 1 2) #*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 ;;; Error tests
(deftest bit-xor.error.1 (deftest bit-xor.error.1
......
...@@ -139,6 +139,24 @@ ...@@ -139,6 +139,24 @@
i a b)) i a b))
10.0f0 2 1 2) 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 ;;; Error tests
;;; (deftest coerce.error.1 ;;; (deftest coerce.error.1
...@@ -198,4 +216,3 @@ ...@@ -198,4 +216,3 @@
(t t))) (t t)))
(error (c) (declare (ignore c)) t)))) (error (c) (declare (ignore c)) t))))
t) t)
...@@ -287,6 +287,38 @@ ...@@ -287,6 +287,38 @@
i x y z)) i x y z))
"abcdefghi" 3 1 2 3) "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 ;;; Error tests
(deftest concatenate.error.1 (deftest concatenate.error.1
......
...@@ -425,3 +425,14 @@ ...@@ -425,3 +425,14 @@
(progn (setf d (incf i)) '(b c d))) (progn (setf d (incf i)) '(b c d)))
i a b c d)) i a b c d))
((a b)(b c)(c d)) 4 1 2 3 4) ((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))
...@@ -54,6 +54,27 @@ ...@@ -54,6 +54,27 @@
(delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql
:test #'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 ;;; Order of evaluation tests
......
...@@ -461,6 +461,104 @@ ...@@ -461,6 +461,104 @@
(delete #\0 (copy-seq "0001100100") :test-not #'eql :test #'eql)) (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 ;;; Order of evaluation tests
(deftest remove.order.1 (deftest remove.order.1
......
...@@ -166,6 +166,28 @@ ...@@ -166,6 +166,28 @@
i)) i))
(d c b a) 1) (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 ;;; Error cases
(deftest reverse.error.1 (deftest reverse.error.1
......
...@@ -281,6 +281,18 @@ ...@@ -281,6 +281,18 @@
s i a b c)) s i a b c))
"xyz" "axyz" 3 1 2 3) "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 ;;; Error cases
(deftest subseq.error.1 (deftest subseq.error.1
......
...@@ -816,6 +816,23 @@ ...@@ -816,6 +816,23 @@
(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil)
(a a 0 a a 0 a)) (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 ;;; Error cases
(deftest substitute-if-not.error.1 (deftest substitute-if-not.error.1
......
...@@ -840,6 +840,23 @@ ...@@ -840,6 +840,23 @@
(substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil) (substitute-if 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil)
(1 2 a 3 1 a 3)) (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 ;;; Error cases
(deftest substitute-if.error.1 (deftest substitute-if.error.1
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment