/[gcl]/gcl/ansi-tests/describe.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/describe.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Sun Dec 12 22:00:12 2004 UTC revision 1.2 by pfdietz, Sun Dec 12 22:12:11 2004 UTC
# Line 5  Line 5 
5    
6  (in-package :cl-test)  (in-package :cl-test)
7    
8    (defun harness-for-describe (fn)
9      (let (s1 s2)
10        (with-open-stream
11         (*standard-output* (make-string-output-stream))
12         (with-open-stream
13          (tio-input (make-string-input-stream "X"))
14          (with-open-stream
15           (tio-output (make-string-output-stream))
16           (with-open-stream
17            (*terminal-io* (make-two-way-stream tio-input tio-output))
18            (let ((*print-circle* t)
19                  (*print-readably* nil))
20              (assert (null (multiple-value-list (funcall fn))))))
21           (setq s2 (get-output-stream-string tio-output)))
22          (assert (equal (read-char tio-input) #\X)))
23         (setq s1 (get-output-stream-string *standard-output*)))
24        (values s1 s2)))
25    
26  (deftest describe.1  (deftest describe.1
27    (loop for x in *universe*    (loop for x in *universe*
28          for s1 = nil          for (s1 s2) = (multiple-value-list (harness-for-describe #'(lambda () (describe x))))
         for s2 = nil  
         do  
         (with-open-stream  
          (*standard-output* (make-string-output-stream))  
          (with-open-stream  
           (tio-input (make-string-input-stream "X"))  
           (with-open-stream  
            (tio-output (make-string-output-stream))  
            (with-open-stream  
             (*terminal-io* (make-two-way-stream tio-input tio-output))  
             (let ((*print-circle* t)  
                   (*print-readably* nil))  
               (assert (null (multiple-value-list (describe x))))))  
            (setq s2 (get-output-stream-string tio-output)))  
           (assert (equal (read-char tio-input) #\X)))  
          (setq s1 (get-output-stream-string *standard-output*)))  
29          when (and (equal s1 "") (equal s2 ""))          when (and (equal s1 "") (equal s2 ""))
30          collect x)          collect x)
31    nil)    nil)
# Line 32  Line 34 
34    (loop for x in *universe*    (loop for x in *universe*
35          for s1 = nil          for s1 = nil
36          for s2 = nil          for s2 = nil
37          for s3 =          for s3 = (with-output-to-string (s) (setf (values s1 s2) (harness-for-describe #'(lambda () (describe x s)))))
         (with-output-to-string  
           (s)  
           (with-open-stream  
            (*standard-output* (make-string-output-stream))  
            (with-open-stream  
             (tio-input (make-string-input-stream "X"))  
             (with-open-stream  
              (tio-output (make-string-output-stream))  
              (with-open-stream  
               (*terminal-io* (make-two-way-stream tio-input tio-output))  
               (let ((*print-circle* t)  
                     (*print-readably* nil))  
                 (assert (null (multiple-value-list (describe x s))))))  
              (setq s2 (get-output-stream-string tio-output)))  
             (assert (equal (read-char tio-input) #\X)))  
            (setq s1 (get-output-stream-string *standard-output*))))  
38          when (or (equal s3 "") (not (equal "" s2)) (not (equal "" s1)))          when (or (equal s3 "") (not (equal "" s2)) (not (equal "" s1)))
39          collect (list x s1 s2 s3))          collect (list x s1 s2 s3))
40    nil)    nil)
41    
42  (deftest describe.3  (deftest describe.3
43    (loop for x in *universe*    (loop for x in *universe*
44          for s1 = nil          for (s1 s2) = (multiple-value-list (harness-for-describe #'(lambda () (describe x t))))
         for s2 = nil  
         do  
         (with-open-stream  
          (*standard-output* (make-string-output-stream))  
          (with-open-stream  
           (tio-input (make-string-input-stream "X"))  
           (with-open-stream  
            (tio-output (make-string-output-stream))  
            (with-open-stream  
             (*terminal-io* (make-two-way-stream tio-input tio-output))  
             (let ((*print-circle* t)  
                   (*print-readably* nil))  
               (assert (null (multiple-value-list (describe x t))))))  
            (setq s2 (get-output-stream-string tio-output)))  
           (assert (equal (read-char tio-input) #\X)))  
          (setq s1 (get-output-stream-string *standard-output*)))  
45          when (or (equal "" s2) (not (equal "" s1)))          when (or (equal "" s2) (not (equal "" s1)))
46          collect (list x s1 s2))          collect (list x s1 s2))
47    nil)    nil)
48    
49  (deftest describe.4  (deftest describe.4
50    (loop for x in *universe*    (loop for x in *universe*
51          for s1 = nil          for (s1 s2) = (multiple-value-list (harness-for-describe #'(lambda () (describe x nil))))
         for s2 = nil  
         do  
         (with-open-stream  
          (*standard-output* (make-string-output-stream))  
          (with-open-stream  
           (tio-input (make-string-input-stream "X"))  
           (with-open-stream  
            (tio-output (make-string-output-stream))  
            (with-open-stream  
             (*terminal-io* (make-two-way-stream tio-input tio-output))  
             (let ((*print-circle* t)  
                   (*print-readably* nil))  
               (assert (null (multiple-value-list (describe x nil))))))  
            (setq s2 (get-output-stream-string tio-output)))  
           (assert (equal (read-char tio-input) #\X)))  
          (setq s1 (get-output-stream-string *standard-output*)))  
52          when (or (equal "" s1) (not (equal "" s2)))          when (or (equal "" s1) (not (equal "" s2)))
53          collect (list x s1 s2))          collect (list x s1 s2))
54    nil)    nil)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26