src/module-impl.lisp: Don't emit `#line' to non-position-aware streams.
[sod] / src / test-base.lisp
CommitLineData
abdf50aa
MW
1;;; -*-lisp-*-
2;;;
dea4d055 3;;; Package definition and other basic stuff for SOD tests
abdf50aa
MW
4;;;
5;;; (c) 2009 Straylight/Edgeware
6;;;
7
8;;;----- Licensing notice ---------------------------------------------------
9;;;
dea4d055 10;;; This file is part of the Sensble Object Design, an object system for C.
abdf50aa
MW
11;;;
12;;; SOD is free software; you can redistribute it and/or modify
13;;; it under the terms of the GNU General Public License as published by
14;;; the Free Software Foundation; either version 2 of the License, or
15;;; (at your option) any later version.
16;;;
17;;; SOD is distributed in the hope that it will be useful,
18;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;;; GNU General Public License for more details.
21;;;
22;;; You should have received a copy of the GNU General Public License
23;;; along with SOD; if not, write to the Free Software Foundation,
24;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25
dea4d055 26(cl:defpackage #:sod-test
abdf50aa
MW
27 (:use #:common-lisp
28
abdf50aa
MW
29 #+sbcl #:sb-mop
30 #+(or cmu clisp) #:mop
31 #+ecl #:mop
32
dea4d055 33 #:xlunit
abdf50aa 34
dea4d055
MW
35 #:sod-utilities #:sod-parser #:sod)
36
37 ;; Some internal symbols which are useful. This is somewhat bletcherous.
38 (:import-from #:sod-parser #:charbuf-size))
39
40(cl:in-package #:sod-test)
41
42(defvar *sod-test-suite*
43 (make-instance 'test-suite
44 :name "Sod master test suite"
45 :description "Top-level test for the Sod translator."))
46
47(defun assert-princ (object string)
48 (let ((*print-right-margin* 77)
49 (print (princ-to-string object)))
50 (assert-equal print string
51 (format nil "Assert princ: ~S ~_prints as `~A' ~_~
52 rather than `~A'."
53 object print string))))
54
bf090e02
MW
55(defun run-tests (&optional which)
56 (textui-test-run (acond
57 ((null which) *sod-test-suite*)
58 ((labels ((dredge (suite)
59 (cond
60 ((typep suite 'test-suite)
61 (some #'dredge (tests suite)))
62 ((eq (xlunit::name suite) which)
63 suite)
64 (t
65 nil))))
66 (dredge *sod-test-suite*))
67 it)
68 ((find-class which nil)
69 (suite (make-instance it)))
70 (t
71 (error "Don't know how to turn ~S into a test suite"
72 which)))))
abdf50aa
MW
73
74;;;----- That's all, folks --------------------------------------------------