Skip to content
Snippets Groups Projects
Commit 77c4724c authored by pfdietz's avatar pfdietz
Browse files

Added more backquote printing tests

parent 76643119
No related branches found
No related tags found
No related merge requests found
;-*- 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)))
......@@ -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
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