Commit 5463b7bf authored by pfdietz's avatar pfdietz

Tests for possible compiler folding bugs

parent 8a210df6
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......@@ -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
......
......@@ -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))
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment