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