/[gcl]/gcl/tests/tests.lsp
ViewVC logotype

Diff of /gcl/tests/tests.lsp

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

revision 1.1 by camm, Thu Dec 20 20:29:54 2001 UTC revision 1.2 by camm, Sun Feb 3 18:44:08 2002 UTC
# Line 0  Line 1 
1    ;; Test-Suiten ablaufen lassen:
2    
3    #+CLISP
4    (defmacro with-ignored-errors (&rest forms)
5      (let ((b (gensym)))
6        `(BLOCK ,b
7           (LET ((*ERROR-HANDLER*
8                   #'(LAMBDA (&REST ARGS) (RETURN-FROM ,b 'ERROR))
9                ))
10             ,@forms
11         ) )
12    ) )
13    
14    (defun run-test (testname
15                     &aux (logname (merge-pathnames ".erg" testname)) log-empty-p)
16      (with-open-file (s (merge-pathnames ".tst" testname) :direction :input)
17        (with-open-file (log logname :direction :output)
18          (let ((*package* *package*)
19                (*print-pretty* nil)
20                (eof "EOF"))
21            (loop
22              (let ((form (read s nil eof))
23                    (result (read s nil eof)))
24                (when (or (eq form eof) (eq result eof)) (return))
25                (print form)
26                (let ((my-result (with-ignored-errors (eval form))))
27                  (cond ((eql result my-result)
28                         (format t "~%EQL-OK: ~S" result)
29                        )
30                        ((equal result my-result)
31                         (format t "~%EQUAL-OK: ~S" result)
32                        )
33                        ((equalp result my-result)
34                         (format t "~%EQUALP-OK: ~S" result)
35                        )
36                        (t
37                         (format t "~%FEHLER!! ~S sollte ~S sein!" my-result result)
38                         (format log "~%Form: ~S~%SOLL: ~S~%CLISP: ~S~%" form result my-result)
39                        )
40            ) ) ) )
41          )
42          (setq log-empty-p (zerop (file-length log)))
43      ) )
44      (when log-empty-p (delete-file logname))
45      (values)
46    )
47    
48    (defun run-all-tests ()
49      (mapc #'run-test
50            '("alltest" "array" "backquot" "characters" "eval20" "format"
51              "hashlong" "iofkts" "lambda" "lists151" "lists152" "lists153"
52              "lists154" "lists155" "lists156" "macro8" "map" "number" "pack11"
53              "path" "setf" "steele7" "streams" "streamslong" "strings"
54              "symbol10" "symbols" "type"
55      )      )
56      t
57    )
58    

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