aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorHans Hübner <hans.huebner@gmail.com>2012-04-10 01:54:45 -0700
committerHans Hübner <hans.huebner@gmail.com>2012-04-10 01:54:45 -0700
commitda66bc56812dd3faf62672939ed0c54adacb9a2a (patch)
treee4c6e2ecd5989f90bef3a7778d076f23a27b9ab4
parente6e4f0e22afa9df7f801a34062e30fdf429f2f9b (diff)
parent9bb6ab173dad9d309e7f7299193959328defdfa9 (diff)
downloadtl-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-xspecials.lisp2
-rw-r--r--test/simple23
-rw-r--r--test/tests.lisp12
-rw-r--r--who.lisp6
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&#xEA;te</p><p style='background-color:orange'>S&#xF8;rensen</p><p style='background-color:blue'>na&#xEF;ve</p><p style='background-color:red'>H&#xFC;hner</p><p style='background-color:orange'>Stra&#xDF;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)))))
diff --git a/who.lisp b/who.lisp
index 823ea46..f6dea56 100644
--- a/who.lisp
+++ b/who.lisp
@@ -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)