From 3ccb26a9adb4817ef285475b54cc38172d6a7734 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 13 Jun 2005 14:24:44 +0000 Subject: [PATCH] Refactor fold tests using a convenient macro. --- ansi-tests/ansi-aux.lsp | 10 +++ 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-xor.lsp | 6 +- ansi-tests/coerce.lsp | 16 +---- ansi-tests/concatenate.lsp | 37 +++-------- ansi-tests/copy-seq.lsp | 5 ++ ansi-tests/make-sequence.lsp | 11 ++++ ansi-tests/map.lsp | 9 +-- ansi-tests/remove-duplicates.lsp | 23 ++----- ansi-tests/remove.lsp | 109 ++++--------------------------- ansi-tests/reverse.lsp | 23 ++----- ansi-tests/subseq.lsp | 13 ++-- ansi-tests/substitute-if-not.lsp | 22 +++---- ansi-tests/substitute-if.lsp | 19 ++---- ansi-tests/substitute.lsp | 33 ++-------- 22 files changed, 90 insertions(+), 294 deletions(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 24c5cc3e..11daeb72 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -1155,3 +1155,13 @@ the condition to go uncaught if it cannot be classified." (string x)) t) (type-error () nil)))) + +(defmacro def-fold-test (name form) + "Create a test that FORM, which should produce a fresh value, + does not improperly introduce sharing during constant folding." + `(deftest ,name + (flet ((%f () (declare (optimize (speed 3) (safety 0) (space 0) + (compilation-speed 0) (debug 0))) + ,form)) + (eq (%f) (%f))) + nil)) diff --git a/ansi-tests/bit-and.lsp b/ansi-tests/bit-and.lsp index df27299c..2f1c23e3 100644 --- a/ansi-tests/bit-and.lsp +++ b/ansi-tests/bit-and.lsp @@ -228,11 +228,7 @@ 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) +(def-fold-test bit-and.fold.1 (bit-and #*01101 #*01011)) ;;; Error tests diff --git a/ansi-tests/bit-andc1.lsp b/ansi-tests/bit-andc1.lsp index 571fda87..22eae68b 100644 --- a/ansi-tests/bit-andc1.lsp +++ b/ansi-tests/bit-andc1.lsp @@ -228,11 +228,7 @@ 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) +(def-fold-test bit-andc1.fold.1 (bit-andc1 #*10010 #*01011)) ;;; Error tests diff --git a/ansi-tests/bit-andc2.lsp b/ansi-tests/bit-andc2.lsp index 646ef3ec..c439b428 100644 --- a/ansi-tests/bit-andc2.lsp +++ b/ansi-tests/bit-andc2.lsp @@ -228,11 +228,7 @@ 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) +(def-fold-test bit-andc2.fold.1 (bit-andc2 #*01101 #*10100)) ;;; Error tests diff --git a/ansi-tests/bit-eqv.lsp b/ansi-tests/bit-eqv.lsp index 60290002..28e74619 100644 --- a/ansi-tests/bit-eqv.lsp +++ b/ansi-tests/bit-eqv.lsp @@ -229,11 +229,7 @@ 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) +(def-fold-test bit-eqv.fold.1 (bit-eqv #*01101 #*10100)) ;;; Error tests diff --git a/ansi-tests/bit-ior.lsp b/ansi-tests/bit-ior.lsp index b213b9e4..966058f0 100644 --- a/ansi-tests/bit-ior.lsp +++ b/ansi-tests/bit-ior.lsp @@ -228,11 +228,7 @@ 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) +(def-fold-test bit-ior.fold.1 (bit-ior #*00101 #*10100)) ;;; Error tests diff --git a/ansi-tests/bit-nand.lsp b/ansi-tests/bit-nand.lsp index 75bf5c0b..cb31e209 100644 --- a/ansi-tests/bit-nand.lsp +++ b/ansi-tests/bit-nand.lsp @@ -228,11 +228,7 @@ 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) +(def-fold-test bit-nand.fold.1 (bit-nand #*00101 #*10100)) ;;; Error tests diff --git a/ansi-tests/bit-nor.lsp b/ansi-tests/bit-nor.lsp index 866b8658..e42957c8 100644 --- a/ansi-tests/bit-nor.lsp +++ b/ansi-tests/bit-nor.lsp @@ -228,11 +228,7 @@ 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) +(def-fold-test bit-nor.fold.1 (bit-nor #*00101 #*10100)) ;;; Error tests diff --git a/ansi-tests/bit-not.lsp b/ansi-tests/bit-not.lsp index a62a0192..65752ec8 100644 --- a/ansi-tests/bit-not.lsp +++ b/ansi-tests/bit-not.lsp @@ -127,11 +127,7 @@ 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) +(def-fold-test bit-not.fold.1 (bit-not #*00101)) ;;; Error tests diff --git a/ansi-tests/bit-xor.lsp b/ansi-tests/bit-xor.lsp index 230028df..61b44981 100644 --- a/ansi-tests/bit-xor.lsp +++ b/ansi-tests/bit-xor.lsp @@ -228,11 +228,7 @@ 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) +(def-fold-test bit-xor.fold.1 (bit-xor #*00101 #*10100)) ;;; Error tests diff --git a/ansi-tests/coerce.lsp b/ansi-tests/coerce.lsp index 863e8930..126b5f66 100644 --- a/ansi-tests/coerce.lsp +++ b/ansi-tests/coerce.lsp @@ -143,19 +143,9 @@ ;;; 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)) - +(def-fold-test coerce.fold.1 (coerce '(1 2 3) 'vector)) +(def-fold-test coerce.fold.2 (coerce '(1 0 1) 'bit-vector)) +(def-fold-test coerce.fold.3 (coerce '(#\a #\b #\c) 'string)) ;;; Error tests diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index a98539bb..5bfceb63 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -289,35 +289,14 @@ ;;; 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)) +(def-fold-test concatenate.fold.1 (concatenate 'list '(a b) '(c d))) +(def-fold-test concatenate.fold.2 (concatenate 'vector '(a b) '(c d))) +(def-fold-test concatenate.fold.3 (concatenate 'bit-vector '(0 0) '(1 0 1))) +(def-fold-test concatenate.fold.4 (concatenate 'string "ab" "cd")) +(def-fold-test concatenate.fold.5 (concatenate 'list '(a b c d))) +(def-fold-test concatenate.fold.6 (concatenate 'vector #(a b c d))) +(def-fold-test concatenate.fold.7 (concatenate 'bit-vector #*110101101)) +(def-fold-test concatenate.fold.8 (concatenate 'string "abcdef")) ;;; Error tests diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index 8d974b12..a3a9f761 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -227,6 +227,11 @@ (values (copy-seq (progn (incf i) "abc")) i)) "abc" 1) +(def-fold-test copy-seq.fold.1 (copy-seq '(a b c))) +(def-fold-test copy-seq.fold.2 (copy-seq #(a b c))) +(def-fold-test copy-seq.fold.3 (copy-seq #*01101100)) +(def-fold-test copy-seq.fold.4 (copy-seq "abcdef")) + ;;; Error tests (deftest copy-seq.error.1 diff --git a/ansi-tests/make-sequence.lsp b/ansi-tests/make-sequence.lsp index 6ef56a47..7cfb549e 100644 --- a/ansi-tests/make-sequence.lsp +++ b/ansi-tests/make-sequence.lsp @@ -502,4 +502,15 @@ i a b c d e)) (a a a a a) 5 1 2 3 4 5) +;;; Const fold tests + +(def-fold-test make-sequence.fold.1 + (make-sequence 'list 5 :initial-element 'a)) +(def-fold-test make-sequence.fold.2 + (make-sequence 'vector 5 :initial-element 'a)) +(def-fold-test make-sequence.fold.3 + (make-sequence 'bit-vector 5 :initial-element 0)) +(def-fold-test make-sequence.fold.4 + (make-sequence 'string 5 :initial-element #\a)) + ;;; FIXME: Add tests for upgrading of character subtypes diff --git a/ansi-tests/map.lsp b/ansi-tests/map.lsp index 40184a33..eae2525a 100644 --- a/ansi-tests/map.lsp +++ b/ansi-tests/map.lsp @@ -428,11 +428,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)) +(def-fold-test map.fold.1 (map 'vector #'identity '(a b c))) diff --git a/ansi-tests/remove-duplicates.lsp b/ansi-tests/remove-duplicates.lsp index 2e738a09..28a8d6ad 100644 --- a/ansi-tests/remove-duplicates.lsp +++ b/ansi-tests/remove-duplicates.lsp @@ -56,25 +56,10 @@ ;;; 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") +(def-fold-test remove-duplicates.fold.1 (remove-duplicates '(1 2 3 3))) +(def-fold-test remove-duplicates.fold.2 (remove-duplicates #(1 2 3 3))) +(def-fold-test remove-duplicates.fold.3 (remove-duplicates #*0011)) +(def-fold-test remove-duplicates.fold.4 (remove-duplicates "1233")) ;;; Order of evaluation tests diff --git a/ansi-tests/remove.lsp b/ansi-tests/remove.lsp index f8aee212..8e3a16b2 100644 --- a/ansi-tests/remove.lsp +++ b/ansi-tests/remove.lsp @@ -463,101 +463,20 @@ ;;; 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") +(def-fold-test remove.fold.1 (remove 'c '(a b c d e))) +(def-fold-test remove.fold.2 (remove 'c #(a b c d e))) +(def-fold-test remove.fold.3 (remove 1 #*0011011001)) +(def-fold-test remove.fold.4 (remove #\c "abcde")) + +(def-fold-test remove-if.fold.1 (remove-if 'null '(a b nil d e))) +(def-fold-test remove-if.fold.2 (remove-if #'null #(a b nil d e))) +(def-fold-test remove-if.fold.3 (remove-if 'plusp #*0011011001)) +(def-fold-test remove-if.fold.4 (remove-if 'digit-char-p "ab0de")) + +(def-fold-test remove-if-not.fold.1 (remove-if-not #'identity '(a b nil d e))) +(def-fold-test remove-if-not.fold.2 (remove-if-not 'identity #(a b nil d e))) +(def-fold-test remove-if-not.fold.3 (remove-if-not #'zerop #*0011011001)) +(def-fold-test remove-if-not.fold.4 (remove-if-not #'alpha-char-p "ab-de")) ;;; Order of evaluation tests diff --git a/ansi-tests/reverse.lsp b/ansi-tests/reverse.lsp index 96f68fa0..db2411b2 100644 --- a/ansi-tests/reverse.lsp +++ b/ansi-tests/reverse.lsp @@ -168,25 +168,10 @@ ;;; 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)) +(def-fold-test reverse.fold.1 (reverse '(a b c))) +(def-fold-test reverse.fold.2 (reverse #(a b c))) +(def-fold-test reverse.fold.3 (reverse #*00111101011011)) +(def-fold-test reverse.fold.4 (reverse "abcdefgh")) ;;; Error cases diff --git a/ansi-tests/subseq.lsp b/ansi-tests/subseq.lsp index 793c35fa..780aba85 100644 --- a/ansi-tests/subseq.lsp +++ b/ansi-tests/subseq.lsp @@ -283,15 +283,10 @@ ;;; 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)) +(def-fold-test subseq.fold.1 (subseq '(1 2 3) 0)) +(def-fold-test subseq.fold.2 (subseq #(1 2 3) 0)) +(def-fold-test subseq.fold.3 (subseq #*011101 0)) +(def-fold-test subseq.fold.4 (subseq "abcdef" 0)) ;;; Error cases diff --git a/ansi-tests/substitute-if-not.lsp b/ansi-tests/substitute-if-not.lsp index b703c048..484869cc 100644 --- a/ansi-tests/substitute-if-not.lsp +++ b/ansi-tests/substitute-if-not.lsp @@ -818,20 +818,14 @@ ;;; 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) +(def-fold-test substitute-if-not.fold.1 + (substitute-if-not 'z 'identity '(a nil b))) +(def-fold-test substitute-if-not.fold.2 + (substitute-if-not 'z 'identity #(a nil b))) +(def-fold-test substitute-if-not.fold.3 + (substitute-if-not 0 'zerop #*100110)) +(def-fold-test substitute-if-not.fold.4 + (substitute-if-not #\0 #'digit-char-p "asdaw82213nn1239123dd")) ;;; Error cases diff --git a/ansi-tests/substitute-if.lsp b/ansi-tests/substitute-if.lsp index 561fc957..8dd45171 100644 --- a/ansi-tests/substitute-if.lsp +++ b/ansi-tests/substitute-if.lsp @@ -842,20 +842,11 @@ ;;; 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) +(def-fold-test substitute-if.fold.1 (substitute-if 'z 'null '(a nil b))) +(def-fold-test substitute-if.fold.2 (substitute-if 'z 'null #(a nil b))) +(def-fold-test substitute-if.fold.3 (substitute-if 0 'plusp #*100110)) +(def-fold-test substitute-if.fold.4 (substitute-if #\x 'digit-char-p + "asdf8234n123f")) ;;; Error cases diff --git a/ansi-tests/substitute.lsp b/ansi-tests/substitute.lsp index ea0274e5..d7fef60b 100644 --- a/ansi-tests/substitute.lsp +++ b/ansi-tests/substitute.lsp @@ -1094,35 +1094,10 @@ ;;; 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) +(def-fold-test substitute.fold.1 (substitute 'z 'b '(a b c))) +(def-fold-test substitute.fold.2 (substitute 'z 'b #(a b c))) +(def-fold-test substitute.fold.3 (substitute 0 1 #*001101)) +(def-fold-test substitute.fold.4 (substitute #\a #\b "abcebadfke")) ;;; Error cases -- GitLab