Merge pull request #3 from nikodemus/master^^^

cleanups and test fixes
edicl · Apr 10, 2012 · da66bc5 · da66bc5
2 parents e6e4f0e + 9bb6ab1
commit da66bc5
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 6 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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)