From 77c4724cfaebe07bdaaef3b309a518103739f70b Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sat, 12 Jun 2004 03:13:42 +0000
Subject: [PATCH] Added more backquote printing tests

---
 ansi-tests/backquote-aux.lsp   | 50 ++++++++++++++++++++++++++++++++++
 ansi-tests/print-backquote.lsp |  6 ++++
 2 files changed, 56 insertions(+)
 create mode 100644 ansi-tests/backquote-aux.lsp

diff --git a/ansi-tests/backquote-aux.lsp b/ansi-tests/backquote-aux.lsp
new file mode 100644
index 00000000..2c858dc1
--- /dev/null
+++ b/ansi-tests/backquote-aux.lsp
@@ -0,0 +1,50 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Fri Jun 11 08:04:23 2004
+;;;; Contains: Aux. functions associated with backquote tests
+
+(in-package :cl-test)
+
+;;; Not yet finished
+
+
+;;; Create random backquoted forms
+(defun make-random-backquoted-form (size)
+  (my-with-standard-io-syntax
+   (let ((*print-readably* nil)
+	 (*package* (find-package "CL-TEST")))
+     (read-from-string
+      (concatenate 'string
+		   "`"
+		   (make-random-backquoted-sequence-string size))))))
+
+(defun make-random-backquoted-sequence-string (size)
+  (case size
+    ((0 1) (make-random-backquoted-string size))
+    (t
+     (let* ((nelements (1+ (min (random (1- size)) (random (1- size)) 9)))
+	    (sizes (random-partition (1- size) nelements))
+	    (substrings (mapcar #'make-random-backquoted-string sizes)))
+       (apply #'concatenate
+	      'string
+	      "("
+	      (car substrings)
+	      (if nil ; (and (> nelements 1) (coin))
+		  (nconc
+		   (loop for s in (cddr substrings) collect " " collect s)
+		   (list " . " (cadr substrings) ")"))
+		(nconc
+		 (loop for s in (cdr substrings) collect " " collect s)
+		 (list ")"))))))))
+
+;;; Create a string that is a backquoted form
+(defun make-random-backquoted-string (size)
+  (if (<= size 1)
+      (rcase
+       (1 "()")
+       (1 (string (random-from-seq #.(coerce *cl-symbol-names* 'vector))))
+       (1 (write-to-string (- (random 2001) 1000)))
+       (2 (concatenate 'string "," (string (random-from-seq "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))))
+       )
+    ;; size > 1
+    (make-random-backquoted-sequence-string size)))
diff --git a/ansi-tests/print-backquote.lsp b/ansi-tests/print-backquote.lsp
index 2f07e0c6..a5a8d43d 100644
--- a/ansi-tests/print-backquote.lsp
+++ b/ansi-tests/print-backquote.lsp
@@ -6,6 +6,7 @@
 (in-package :cl-test)
 
 (compile-and-load "printer-aux.lsp")
+(compile-and-load "backquote-aux.lsp")
 
 (deftest print.backquote.random.1
   (let* ((x '`(a ,b ,@c (d . ,e) ,.f #(1 2 ,p ,@q ,.r s) g))
@@ -126,3 +127,8 @@
      (and (not (is-similar x y)) (list :modified x y))))     
   nil)
 
+(deftest print.backquote.random.14
+  (loop for x = (make-random-backquoted-form 100)
+	repeat 1000
+	nconc (randomly-check-readability x :test #'is-similar))
+  nil)
\ No newline at end of file
-- 
GitLab