README TODO formatters.lisp @@ -1,5 +1,5 @@ -bdd.el from Yurii Rashkovskii +bdd.el is by Yurii Rashkovskii, used with implicit permission (it's on his blog) -template.html layout from rspec +The css and structure of template.html are from rspec. -inspiration from rspec +Inspiration from rspec. CREDITS @@ -8,7 +8,9 @@ :version "0.1" :author "Oliver Steele <steele@osteele.com>" :licence "unknown" - :components ((:file "cl-spec" :depends-on ("bdd" "utilities")) + :components ((:file "formatters" + :depends-on ("specify" "utilities" "templates")) + (:file "specify" :depends-on ("bdd" "utilities")) (:file "templates" :depends-on ("utilities")) (:file "utilities") (:file "bdd")) cl-spec.asdf @@ -17,16 +17,15 @@ since it runs the specifications once it has collected them all.") "(RUN-SPECIFICATION PATHNAME) binds this to a list of specifications for DEFINE-SPECIFICATION to collect into.") -;; this doesn't really test that every element has type TYPE, but -;; I don't think there's a way to do that in CL -(deftype list-type (&optional (type t)) - `(and list (or null (cons ,type)))) - -;; DEFINE-SPECIFICATION instantiates this. It holds a list of named -;; examples. -(define-class specification name - (setup nil (or function null)) ; a function to run before each example - (examples nil (list-type (cons string function)))) +(defclass specification () + ((name :initarg :name :reader specification-name :type string) + (setup :initarg :setup :reader specification-setup :initform nil + :type (or function null) + :documentation "Run this before each example") + (examples :initarg :examples :reader specification-examples + :type (list-type (cons string function)))) + (:documentation "DEFINE-SPECIFICATION instantiates this. It holds a list +of named examples.")) (define-print-method (specification name) "#<specification ~S>" name) @@ -73,30 +72,32 @@ subdirectory for examples in Lisp syntax." ;; but they work fine for now. (define-accumulating-method (specification-results-examples - (self abstract-specification-results) - :child-reader specification-results-children) - append) + (self specification-results-group)) + append + :child-reader specification-results-children) (define-accumulating-method (specification-results-failures - (self abstract-specification-results) - :child-reader specification-results-children) - append) + (self specification-results-group)) + append + :child-reader specification-results-children) (define-accumulating-method (specification-results-elapsed-time - (self abstract-specification-results) - :child-reader specification-results-children) - sum) + (self specification-results-group)) + sum + :child-reader specification-results-children) -(define-method (specification-results-examples-count - (self abstract-specification-results)) - (length (specification-results-examples self))) +(define-accumulating-method (specification-results-examples-count + (self specification-results-group)) + sum + :child-reader specification-results-children) -(define-method (specification-results-failures-count - (self abstract-specification-results)) - (length (specification-results-failures self))) +(define-accumulating-method (specification-results-failures-count + (self specification-results-group)) + sum + :child-reader specification-results-children) -;; TODO: reify example's type? +;; TODO: reify example result's type? (defclass specification-results (abstract-specification-results) ((specification :initarg :specification :reader specification-results-specification @@ -121,11 +122,11 @@ subdirectory for examples in Lisp syntax." ;;; (define-method (run-specification (self specification) &key onsuccess onerror) - "Test all the examples, and returns a list of dictionaries {:name, :success, :condition, :time}. + "Run all the examples. Returns a SPECIFICATION-RESULTS. -Applies ONSUCCESS or ONERROR to each one, depending on whether it -passes. Callbacks are used so that the caller can show incremental -progress during execution." +Applies ONSUCCESS or ONERROR to each example name, depending on +whether the example passes. Callbacks are used so that the caller can +show incremental progress during execution." (flet ((run-example (name fn) "Returns values success and condition" (if (specification-setup self) @@ -201,78 +202,3 @@ progress during execution." (define-method (specification-runner (string string) &rest args &key &allow-other-keys) (apply #'run-specification (pathname string) args)) - - -;;; -;;; Formatters -;;; - -(define-class specification-formatter) -(define-class text-specification-formatter (specification-formatter)) - -(define-method (format-specification-results - (formatter text-specification-formatter) - results - &key (output-stream t) pathname - &allow-other-keys) - (format t "~%~%") - (loop for result in (specification-results-failures results) - for i upfrom 1 - do (format output-stream "~D)~%~A~%~A~%~%" i (ref1 result :condition) pathname)) - (format output-stream "Finished in ~F seconds~%~%" - (specification-results-elapsed-time results)) - (format output-stream "~D example~:P, ~D failure~:P" - (specification-results-examples-count results) - (specification-results-failures-count results))) - -(define-class html-specification-formatter (specification-formatter)) - -(defvar *html-spec-parameter-pathname* - (merge-pathnames "template.html" *load-pathname*) - "The :FORMAT 'HTML option to RUN-SPECIFICATION starts with this.") - -(define-method (format-specification-results - (formatter html-specification-formatter) - results - &key - &allow-other-keys) - ;; for now, the group hierarchy must be exactly one deep - (labels ((translate-results (results depth) - (etypecase results - (specification-results-group - (assert (= depth 0) () "for now, groups can't be nested") - ;; TODO: would be nicer with a general serialization - ;; mechanism instead of adding keys afterwards; or - ;; else maybe the templater should use accessors - ;; instead of dictionary conversion - (let ((dict - (object->dictionary results - '(examples-count - failures-count - elapsed-time) - :basename 'specification-results))) - (setref dict 'name - (specification-name (specification-results-specification (first (specification-results-children results))))) - (setref dict 'children - (loop for child in (specification-results-children results) - collect (translate-results child (1+ depth)))) - dict)) - (specification-results - (assert (= depth 1) () - "for now, specification result leaves must be exactly one deep") - (let ((dict - (object->dictionary results '(examples-count - failures-count - elapsed-time) - :basename 'specification-results))) - (setref dict 'name - (specification-name (specification-results-specification results))) - (setref dict 'examples - (mapcar #'translate-example (specification-results-examples results))) - dict)))) - (translate-example (example) - ;; it's already in dictionary form - example)) - (copy-template *html-spec-parameter-pathname* - (merge-pathnames "spec.html" *html-spec-parameter-pathname*) - (translate-results results 0)))) specify.lisp @@ -1,5 +1,10 @@ ;;; Copyright 2008 by Oliver Steele. Released under the MIT License. +;; this doesn't really test that every element has type TYPE, but +;; I don't think there's a way to do that in CL +(deftype list-type (&optional (type t)) + `(and list (or null (cons ,type)))) + (define-method (trim (s string)) (flet ((whitespace-char-p (char) (or(char= #\space char) (not (graphic-char-p char))))) @@ -12,6 +17,8 @@ (t (subseq s start (1+ end))))))) +(defsetf rref setref) + ;; TODO: default slot-names by introspection (define-method (object->dictionary (object t) reader-names &key basename) (plist->dictionary @@ -36,10 +43,17 @@ 'float))) (values value elapsed-time)))) -(defmacro define-accumulating-method ((function-name (self type) &rest args) - accumulation-construct) +(defmacro define-accumulating-method ((function-name (self type)) + accumulation-construct + &key child-reader) + "Defines a method on FUNCTION-NAME, specialized on a first argument of TYPE, +that uses ACCUMALATION-CONSTRUCT (a LOOP-friendly accumulation keyword) to +accumulate the values of the projections of its children. + +Children are accessed via CHILD-READER, which defaults to {TYPE}-CHILDREN, +and projected via FUNCTION-NAME." (let ((value-reader function-name) - (child-reader (or (getf args :child-reader) + (child-reader (or child-reader (concatenate-symbol type "-CHILDREN"))) (child (gensym "child"))) `(define-method (,function-name (,self ,type)) utilities.lisp README.txt agenda.txt f497b7165c15396b673cbd3a1d71323c2f1fffc3 Oliver Steele steele@osteele.com http://github.com/osteele/cl-spec/commit/25a9d6585673e18268f395d16c7328483180a0b2 25a9d6585673e18268f395d16c7328483180a0b2 2008-01-07T19:32:25-08:00 2008-01-07T19:32:25-08:00 factor out formatters; lots more file-level rearrangement 55f98626372becfae6a58bfc941e48075ef499a7 Oliver Steele steele@osteele.com