source: trunk/source/tests/ansi-tests/backquote-aux.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 1.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Jun 11 08:04:23 2004
4;;;; Contains: Aux. functions associated with backquote tests
5
6(in-package :cl-test)
7
8;;; Not yet finished
9
10
11;;; Create random backquoted forms
12(defun make-random-backquoted-form (size)
13  (my-with-standard-io-syntax
14   (let ((*print-readably* nil)
15         (*package* (find-package "CL-TEST")))
16     (read-from-string
17      (concatenate 'string
18                   "`"
19                   (make-random-backquoted-sequence-string size))))))
20
21(defun make-random-backquoted-sequence-string (size)
22  (case size
23    ((0 1) (make-random-backquoted-string size))
24    (t
25     (let* ((nelements (1+ (min (random (1- size)) (random (1- size)) 9)))
26            (sizes (random-partition (1- size) nelements))
27            (substrings (mapcar #'make-random-backquoted-string sizes)))
28       (apply #'concatenate
29              'string
30              "("
31              (car substrings)
32              (if nil ; (and (> nelements 1) (coin))
33                  (nconc
34                   (loop for s in (cddr substrings) collect " " collect s)
35                   (list " . " (cadr substrings) ")"))
36                (nconc
37                 (loop for s in (cdr substrings) collect " " collect s)
38                 (list ")"))))))))
39
40;;; Create a string that is a backquoted form
41(defun make-random-backquoted-string (size)
42  (if (<= size 1)
43      (rcase
44       (1 "()")
45       (1 (string (random-from-seq #.(coerce *cl-symbol-names* 'vector))))
46       (1 (write-to-string (- (random 2001) 1000)))
47       (2 (concatenate 'string "," (string (random-from-seq "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))))
48       )
49    ;; size > 1
50    (make-random-backquoted-sequence-string size)))
Note: See TracBrowser for help on using the repository browser.