Permalink
Browse files

added tests

darcs-hash:20081003033113-3cc5d-f6cb2ff0b6574f74f227ded22455a89bf30f9d01.gz
  • Loading branch information...
1 parent adcc46e commit 91d828c58abfe3397137ac544661d3bb6e826f57 @gwkkwg committed Oct 3, 2008
Showing with 168 additions and 0 deletions.
  1. +27 −0 metatilities-test.asd
  2. +9 −0 tests/unit-tests/package.lisp
  3. +127 −0 tests/unit-tests/test-parse-brief-class.lisp
  4. +5 −0 tests/unit-tests/tests.lisp
View
@@ -0,0 +1,27 @@
+#|
+Author: Gary King
+
+See file COPYING for details
+|#
+
+(defpackage :metatilities-test-system (:use #:cl #:asdf))
+(in-package :metatilities-test-system)
+
+(defsystem metatilities-test
+ :author "Gary Warren King <gwking@metabang.com>"
+ :maintainer "Gary Warren King <gwking@metabang.com>"
+ :licence "MIT Style License"
+ :description "Tests for metatilities"
+ :components ((:module
+ "setup"
+ :pathname "tests/"
+ :components ((:file "package")
+ (:file "tests"
+ :depends-on ("package"))))
+ (:module
+ "tests"
+ :depends-on ("setup")
+ :components ((:file "test-date-and-time"))))
+ :depends-on (:lift :metatilities))
+
+
@@ -0,0 +1,9 @@
+(in-package #:common-lisp-user)
+
+(defpackage #:metatilities-base-test
+ (:use #:common-lisp #:lift #:metatilities)
+ (:import-from #:metatilities
+ #:*automatic-slot-accessors?*
+ #:*automatic-slot-initargs?*
+ #:*prune-unknown-slot-options*))
+
@@ -0,0 +1,127 @@
+(in-package metatilities-base-test)
+
+(defun slot-specs-same-p (spec-1 spec-2)
+ (cond ((and (atom spec-1) (atom spec-2))
+ (eq spec-1 spec-2))
+ ((and (consp spec-1) (consp spec-2))
+ (and (slot-specs-same-p (first spec-1) (first spec-2))
+ (same-options-p (rest spec-1) (rest spec-2))
+ (same-options-p (rest spec-2) (rest spec-1))))))
+
+(defun same-options-p (options-1 options-2)
+ (loop for name in options-1 by #'cddr
+ for value in (rest options-1) by #'cddr do
+ ;; cons up something fresh to ensure that we don't get equality
+ (unless (samep value (getf options-2 name (cons nil nil)))
+ (return-from same-options-p nil)))
+ (values t))
+
+(deftestsuite test-parse-brief-slot (metatilities-base-test)
+ ()
+ (:dynamic-variables (*automatic-slot-accessors?* nil)
+ (*automatic-slot-initargs?* nil)
+ (*prune-unknown-slot-options* nil))
+ (:equality-test #'slot-specs-same-p))
+
+(addtest
+ simple-1
+ (ensure-same (parse-brief-slot 'foo) '(foo)))
+
+(addtest
+ simple-2
+ (ensure-same (parse-brief-slot '(foo)) '(foo)))
+
+(addtest
+ initform-1
+ (ensure-same (parse-brief-slot '(foo t)) '(foo :initform t)))
+
+(addtest
+ initform-initarg-1
+ (ensure-same (parse-brief-slot '(foo t i)) '(foo :initform t :initarg :foo)))
+
+(addtest
+ initform-reader-1
+ (ensure-same (parse-brief-slot '(foo t r)) '(foo :reader foo :initform t)))
+
+(addtest
+ initform-accessor-1
+ (ensure-same (parse-brief-slot '(foo t a)) '(foo :accessor foo :initform t)))
+
+(addtest
+ initform-accessor-with-extra
+ (ensure-same (parse-brief-slot '(foo t a :wow 2))
+ '(foo :accessor foo :initform t :wow 2)))
+
+(addtest
+ unbound-with-extra
+ (ensure-same (parse-brief-slot '(bar :unbound :component nil))
+ '(bar :component nil)))
+
+(addtest
+ initform-accessor-documentation
+ (ensure-same (parse-brief-slot '(foo t ia "test slot"))
+ '(foo :accessor foo :initform t :initarg :foo
+ :documentation "test slot")))
+
+(addtest
+ unbound-with-extra
+ (ensure-same (parse-brief-slot '(bar :unbound :component nil))
+ '(bar :component nil)))
+
+#|
+ (spy (parse-brief-slot '(foo t ia "test slot")))
+ (spy (parse-brief-slot '(foo t * "test slot")))
+ (spy (parse-brief-slot '(foo t "slot")))
+ (spy (parse-brief-slot '(bar :initform nil)))
+ (spy (parse-brief-slot 'baz t t))
+ (spy (parse-brief-slot 'baz t t 'class))
+ (spy (parse-brief-slot '(baz nil) t t 'class))
+ (spy (parse-brief-slot '(baz nil) nil t 'class))
+ (spy (parse-brief-slot '(baz nil) t nil 'class))
+ (spy (parse-brief-slot '(baz nil) nil nil 'class))
+ (spy (parse-brief-slot '(baz nil "the baz slot") t t 'class))
+ (spy (parse-brief-slot '(baz nil a) nil nil 'class))
+ (spy (parse-brief-slot '(baz nil r) nil nil 'class))
+ (spy (parse-brief-slot '(baz nil r) nil nil 'class nil "."))
+ (spy (parse-brief-slot '(baz nil r) t t 'class nil "."))
+ (spy (parse-brief-slot '(foo 2 :type 'fixnum ia "the foo class" :initarg :what)))
+|#
+
+#+test
+(defclass-brief foo ()
+ "the Foo class"
+ (a
+ (b)
+ (c 1)
+ (d 2 i)
+ (e 3 ia "The E slot")))
+
+#+test
+(defclass-brief foo ()
+ "the Foo class"
+ (a b)
+ :automatic-accessors
+ :automatic-initargs
+ :name-prefix)
+
+#+test
+(defclass-brief foo ()
+ "the Foo class"
+ ((a 1 r)
+ (c 3 a))
+ :name-prefix)
+
+#+test
+(defclass-brief foo ()
+ "the Foo class"
+ (a b)
+ :automatic-accessors
+ :name-prefix)
+
+#+test
+(defclass-brief foo ()
+ "the Foo class"
+ (a b)
+ :automatic-accessors
+ :automatic-initargs
+ (:name-prefix ugly))
@@ -0,0 +1,5 @@
+(in-package #:metatilities-base-test)
+
+(deftestsuite metatilities-base-test () ())
+
+

0 comments on commit 91d828c

Please sign in to comment.