3 ;;; Package definition and other basic stuff for SOD tests
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensble Object Design, an object system for C.
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.
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.
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.
26 (cl:defpackage #:sod-test
30 #+(or cmu clisp) #:mop
35 #:sod-utilities #:sod-parser #:sod)
37 ;; Some internal symbols which are useful. This is somewhat bletcherous.
38 (:import-from #:sod-parser #:charbuf-size))
40 (cl:in-package #:sod-test)
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."))
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' ~_~
53 object print string))))
55 (defclass base-test (test-case) ())
56 (add-test *sod-test-suite* (get-suite base-test))
58 (export '*build-version*)
59 (defvar *build-version* nil)
61 (def-test-method check-version ((test base-test) :run nil)
62 (unless (or (null *build-version*)
63 (and (>= (length *build-version*) (length *sod-version*))
64 (string= *build-version* *sod-version*
65 :end1 (length *sod-version*))))
66 (failure "Build version ~A doesn't match package version ~A."
67 *build-version* *sod-version*)))
69 (defun run-tests (&optional which)
70 (textui-test-run (acond
71 ((null which) *sod-test-suite*)
72 ((labels ((dredge (suite)
74 ((typep suite 'test-suite)
75 (some #'dredge (tests suite)))
76 ((eq (xlunit::name suite) which)
80 (dredge *sod-test-suite*))
82 ((find-class which nil)
83 (suite (make-instance it)))
85 (error "Don't know how to turn ~S into a test suite"
88 ;;;----- That's all, folks --------------------------------------------------