diff options
author | Hans Hübner <hans.huebner@gmail.com> | 2012-04-10 01:54:45 -0700 |
---|---|---|
committer | Hans Hübner <hans.huebner@gmail.com> | 2012-04-10 01:54:45 -0700 |
commit | da66bc56812dd3faf62672939ed0c54adacb9a2a (patch) | |
tree | e4c6e2ecd5989f90bef3a7778d076f23a27b9ab4 | |
parent | e6e4f0e22afa9df7f801a34062e30fdf429f2f9b (diff) | |
parent | 9bb6ab173dad9d309e7f7299193959328defdfa9 (diff) | |
download | tl-who-da66bc56812dd3faf62672939ed0c54adacb9a2a.tar.gz tl-who-da66bc56812dd3faf62672939ed0c54adacb9a2a.tar.bz2 tl-who-da66bc56812dd3faf62672939ed0c54adacb9a2a.zip |
Merge pull request #3 from nikodemus/master^^^
cleanups and test fixes
-rwxr-xr-x | specials.lisp | 2 | ||||
-rw-r--r-- | test/simple | 23 | ||||
-rw-r--r-- | test/tests.lisp | 12 | ||||
-rw-r--r-- | who.lisp | 6 |
4 files changed, 37 insertions, 6 deletions
diff --git a/specials.lisp b/specials.lisp index 8808f2f..349c7fc 100755 --- a/specials.lisp +++ b/specials.lisp @@ -89,7 +89,7 @@ needs to output case sensitive XML.") :of :over :param - :range + :range :right :source :spacer diff --git a/test/simple b/test/simple index 128c62b..6fa48e5 100644 --- a/test/simple +++ b/test/simple @@ -5,6 +5,7 @@ ;;; in the CL-WHO-TEST package; all forms are expected to return a ;;; true value on success when EVALuated +;;; 1 (string= (with-output-to-string (out) (with-html-output (out) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") @@ -15,6 +16,7 @@ :br)))) "<a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />") +;;; 2 (string= (with-output-to-string (out) (with-html-output (out nil) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") @@ -25,6 +27,7 @@ :br)))) "<a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />") +;;; 3 (string= (with-output-to-string (foo) (with-html-output (out foo) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") @@ -35,6 +38,7 @@ :br)))) "<a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />") +;;; 4 (string= (with-html-output-to-string (out) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") @@ -44,6 +48,7 @@ :br))) "<a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />") +;;; 5 (string= (with-html-output-to-string (out nil) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") @@ -53,6 +58,7 @@ :br))) "<a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />") +;;; 6 (string= (with-html-output-to-string (out nil :prologue nil) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") @@ -62,11 +68,13 @@ :br))) "<a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />") +;;; 7 (eq (array-element-type (with-html-output-to-string (out nil :element-type 'base-char) (:br))) 'base-char) +;;; 8 (string= (let ((*attribute-quote-char* #\")) (with-html-output-to-string (out) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") @@ -77,6 +85,7 @@ :br)))) "<a href=\"http://zappa.com/\"><b>Frank Zappa</b></a><br /><a href=\"http://marcusmiller.com/\"><b>Marcus Miller</b></a><br /><a href=\"http://www.milesdavis.com/\"><b>Miles Davis</b></a><br />") +;;; 9 (string= (with-html-output-to-string (out nil :prologue t) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") @@ -87,18 +96,21 @@ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> <a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />") +;;; 10 (string= (with-html-output-to-string (out nil :prologue "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\">") (:apply (:factorial) (:cn "3"))) "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\"> <apply><factorial></factorial><cn>3</cn></apply>") +;;; 11 (string= (let ((*prologue* "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\">")) (with-html-output-to-string (out nil :prologue t) (:apply (:factorial) (:cn "3")))) "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\"> <apply><factorial></factorial><cn>3</cn></apply>") +;;; 12 (string= (with-html-output-to-string (out nil :indent t) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") @@ -123,6 +135,7 @@ </a> <br />") +;;; 13 (string= (with-html-output-to-string (out nil :indent 0) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") @@ -147,6 +160,7 @@ </a> <br />") +;;; 14 (string= (with-html-output-to-string (out nil :indent 3) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") @@ -171,6 +185,7 @@ </a> <br />") +;;; 15 (string= (with-html-output-to-string (out) (:table :border 0 :cellpadding 4 (loop for i below 25 by 5 @@ -184,6 +199,7 @@ (fmt "~@R" (1+ j)))))))))) "<table border='0' cellpadding='4'><tr align='right'><td bgcolor='green'>I</td><td bgcolor='pink'>II</td><td bgcolor='green'>III</td><td bgcolor='pink'>IV</td><td bgcolor='green'>V</td></tr><tr align='right'><td bgcolor='pink'>VI</td><td bgcolor='green'>VII</td><td bgcolor='pink'>VIII</td><td bgcolor='green'>IX</td><td bgcolor='pink'>X</td></tr><tr align='right'><td bgcolor='green'>XI</td><td bgcolor='pink'>XII</td><td bgcolor='green'>XIII</td><td bgcolor='pink'>XIV</td><td bgcolor='green'>XV</td></tr><tr align='right'><td bgcolor='pink'>XVI</td><td bgcolor='green'>XVII</td><td bgcolor='pink'>XVIII</td><td bgcolor='green'>XIX</td><td bgcolor='pink'>XX</td></tr><tr align='right'><td bgcolor='green'>XXI</td><td bgcolor='pink'>XXII</td><td bgcolor='green'>XXIII</td><td bgcolor='pink'>XXIV</td><td bgcolor='green'>XXV</td></tr></table>") +;;; 16 (string= (with-html-output-to-string (out) (:h4 "Look at the character entities generated by this example") (loop for i from 0 @@ -196,6 +212,7 @@ (htm (esc string)))))) "<h4>Look at the character entities generated by this example</h4><p style='background-color:red'>Fête</p><p style='background-color:orange'>Sørensen</p><p style='background-color:blue'>naïve</p><p style='background-color:red'>Hühner</p><p style='background-color:orange'>Straße</p>") +;;; 17 (flet ((checkbox (stream name checked &optional value) (with-html-output (stream) (:input :type "checkbox" :name name :checked checked :value value)))) @@ -208,30 +225,36 @@ (string= (with-output-to-string (s) (checkbox s "foo" t "bar")) "<input type='checkbox' name='foo' checked='checked' value='bar' />"))) +;;; 18 (string= (with-html-output-to-string (out) (:p)) "<p></p>") +;;; 19 (string= (let ((*html-empty-tag-aware-p* nil)) (with-html-output-to-string (out) (:p))) "<p />") +;;; 20 (string= (let ((*html-empty-tag-aware-p* t) (*html-empty-tags* '(:p))) (with-html-output-to-string (out) (:p))) "<p />") +;;; 21 (string= (with-html-output-to-string (out) (:|Foo| :bar 42)) "<foo bar='42'></foo>") +;;; 22 (string= (let ((*downcase-tokens-p* nil)) (with-html-output-to-string (out) (:|Foo| :bar 42))) "<Foo BAR='42'></Foo>") +;;; 23 (string= (let* ((list (list (make-string-output-stream) (make-string-output-stream))) (stream (first list))) (with-html-output (var (pop list)) diff --git a/test/tests.lisp b/test/tests.lisp index 44ea411..bbd2294 100644 --- a/test/tests.lisp +++ b/test/tests.lisp @@ -58,7 +58,7 @@ :of :over :param - :range + :range :right :spacer :spot @@ -134,7 +134,15 @@ tests succeeded." (let ((form (or (read stream nil) (done)))) (when verbose (format t "~&~S" form)) - (cond ((eval form) nil) + (cond ((and (consp form) (eq 'string= (car form)) + (stringp (third form))) + (destructuring-bind (gen expected) (cdr form) + (let ((actual (eval gen))) + (unless (string= actual expected) + (list (format nil "~@<~:@_ ~2:I~S~:@_Expected: ~S~ + ~@:_ Actual: ~S~:>" + form expected actual)))))) + ((eval form) nil) (t (list (format nil "~S returned NIL" form))))))) (setf (html-mode) html-mode))))) @@ -114,7 +114,7 @@ forms." ;; do the same things as above but at runtime nconc (list `(let ((,=var= ,val)) (cond ((null ,=var=)) - ((eq ,=var= t) + ((eq ,=var= t) ,(case *html-mode* (:sgml `(fmt " ~A" attr)) @@ -189,7 +189,7 @@ flattened list of strings. Utility function used by TREE-TO-COMMANDS-AUX." ;; list - insert as sexp else if (consp element) collect `(let ((*indent* ,*indent*)) ,element) - ;; something else - insert verbatim + ;; something else - insert verbatim else collect element)) @@ -276,7 +276,7 @@ supplied." (macrolet ((htm (&body body) `(with-html-output (,',var nil :prologue nil :indent ,,indent) ,@body)) - (fmt (&rest args) + (fmt (&rest args) `(format ,',var ,@args)) (esc (thing) (with-unique-names (result) |