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 |
|
|