Fix another attribute bug: all tests work.

* simple.tl: Translate and enable all tests.

* who.tl (process-tag): Fix double nreverse bug
causing attr list to be truncated to one tag.

1 files changed, 137 insertions, 82 deletions

diff --git a/test/simple.tl b/test/simple.tl
index 7bd3c61..374bc7e 100644
--- a/test/simple.tl
+++ b/test/simple.tl
@@ -197,112 +197,167 @@
           \   </a>\n \
           \   <br />")
 
-(exit)
-
 ;;; 15
-(string= (with-html-output-to-string (out)
-           (:table :border 0 :cellpadding 4
-            (loop for i below 25 by 5
-                  do (htm
-                      (:tr :align "right"
-                       (loop for j from i below (+ i 5)
-                             do (htm
-                                 (:td :bgcolor (if (oddp j)
-                                                 "pink"
-                                                 "green")
-                                  (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>")
+
+(test (with-html-output-to-string (out)
+        (:table :border 0 :cellpadding 4
+          (for ((i 0)) ((< i 25)) ((inc i 5))
+            (htm
+              (:tr :align "right"
+                 (for ((j i)) ((< j (+ i 5))) ((inc j))
+                   (htm
+                     (:td :bgcolor (if (oddp j)
+                                     "pink"
+                                     "green")
+                          (fmt "~X" (succ j))))))))))
+         "<table border='0' cellpadding='4'>  \
+            <tr align='right'>                \
+              <td bgcolor='green'>1</td>      \
+              <td bgcolor='pink'>2</td>       \
+              <td bgcolor='green'>3</td>      \
+              <td bgcolor='pink'>4</td>       \
+              <td bgcolor='green'>5</td>      \
+            </tr>                             \
+            <tr align='right'>                \
+              <td bgcolor='pink'>6</td>       \
+              <td bgcolor='green'>7</td>      \
+              <td bgcolor='pink'>8</td>       \
+              <td bgcolor='green'>9</td>      \
+              <td bgcolor='pink'>A</td>       \
+            </tr>                             \
+            <tr align='right'>                \
+              <td bgcolor='green'>B</td>      \
+              <td bgcolor='pink'>C</td>       \
+              <td bgcolor='green'>D</td>      \
+              <td bgcolor='pink'>E</td>       \
+              <td bgcolor='green'>F</td>      \
+            </tr>                             \
+            <tr align='right'>                \
+              <td bgcolor='pink'>10</td>      \
+              <td bgcolor='green'>11</td>     \
+              <td bgcolor='pink'>12</td>      \
+              <td bgcolor='green'>13</td>     \
+              <td bgcolor='pink'>14</td>      \
+            </tr>                             \
+            <tr align='right'>                \
+              <td bgcolor='green'>15</td>     \
+              <td bgcolor='pink'>16</td>      \
+              <td bgcolor='green'>17</td>     \
+              <td bgcolor='pink'>18</td>      \
+              <td bgcolor='green'>19</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
-                 for string in '("Fête" "Sørensen" "naïve" "Hühner" "Straße")
-                 do (htm
-                     (:p :style (conc "background-color:" (case (mod i 3)
-                                                            ((0) "red")
-                                                            ((1) "orange")
-                                                            ((2) "blue")))
-                      (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>")
+;;; The non-ASCII characters here are ISO Latin, not UTF-8.
+;;; That's how they are in the original CL-WHO file.
+;;; The TXR Lisp html-esc function doesn't do anything with those characters.
+;;; They are non-UTF8 bytes that get mapped to \xDCxx characters, which
+;;; reproduce those bytes on output.
+(test (with-html-output-to-string (out)
+        (:h4 "Look at the character entities generated by this example")
+        (each ((i 0)
+               (string '("Fête" "Sørensen" "naïve" "Hühner" "Straße")))
+          (htm
+            (:p :style (join "background-color:" (caseql (mod i 3)
+                                                   ((0) "red")
+                                                   ((1) "orange")
+                                                   ((2) "blue")))
+                (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)
+(flet ((checkbox (stream name checked : value)
          (with-html-output (stream)
            (:input :type "checkbox" :name name :checked checked :value value))))
-  (and (string= (with-output-to-string (s) (checkbox s "foo" t))
-                "<input type='checkbox' name='foo' checked='checked' />")
-       (string= (with-output-to-string (s) (checkbox s "foo" nil))
-                "<input type='checkbox' name='foo' />")
-       (string= (with-output-to-string (s) (checkbox s "foo" nil "bar"))
-                "<input type='checkbox' name='foo' value='bar' />")
-       (string= (with-output-to-string (s) (checkbox s "foo" t "bar"))         
-                "<input type='checkbox' name='foo' checked='checked' value='bar' />")))
+  (test (with-out-string-stream (s) (checkbox s "foo" t))
+        "<input type='checkbox' name='foo' checked='checked' />")
+  (test (with-out-string-stream (s) (checkbox s "foo" nil))
+        "<input type='checkbox' name='foo' />")
+  (test (with-out-string-stream (s) (checkbox s "foo" nil "bar"))
+        "<input type='checkbox' name='foo' value='bar' />")
+  (test (with-out-string-stream (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>")
+(test (with-html-output-to-string (out)
+        (:p))
+      "<p></p>")
 
 ;;; 19
-(string= (let ((cl-who:*html-empty-tag-aware-p* nil))
-           (eval `(with-html-output-to-string (out)
-                    (:p))))
-         "<p />")
+(test (let ((tl-who:*html-empty-tag-aware-p* nil))
+        (eval ^(with-html-output-to-string (out)
+                 (:p))))
+      "<p />")
 
 ;;; 20
-(string= (let ((*html-empty-tag-aware-p* t)
-               (*html-empty-tags* '(:p)))
-           (eval `(with-html-output-to-string (out)
-                    (:p))))
-         "<p />")
+(test (let ((*html-empty-tag-aware-p* t)
+            (*html-empty-tags* '(:p)))
+        (eval '(with-html-output-to-string (out)
+                 (:p))))
+      "<p />")
 
 ;;; 21
-(string= (with-html-output-to-string (out)
-           (:|Foo| :bar 42))
-         "<foo bar='42'></foo>")
+;;; Adjusted from CL-WHO test 21.
+;;; TXR Lisp doesn't have || escapes in symbol names, and is case-sensitive.
+(test (with-html-output-to-string (out)
+        (:Foo :bar 42))
+      "<Foo bar='42'></Foo>")
 
 ;;; 22
-(string= (let ((*downcase-tokens-p* nil))
-           (eval `(with-html-output-to-string (out)
-                    (:|Foo| :bar 42))))
-         "<Foo BAR='42'></Foo>")
+;;; Adjusted from CL-WHO test 22
+;;; TL-WHO has *upcase-tokens-p*
+(test (let ((*upcase-tokens-p* t))
+        (eval '(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))
-             (progn (htm (:br))))
-           (get-output-stream-string stream))
-         "<br />")
+(test (let* ((list (list (make-string-output-stream)
+                         (make-string-output-stream)))
+             (stream (first list)))
+        (with-html-output (var (pop list))
+          (progn (htm (:br))))
+        (get-string-from-stream stream))
+      "<br />")
 
 ;;; 24
-(string= (with-html-output-to-string (out)
-           (:div (:pre "Foo")))
-         "<div><pre>Foo</pre></div>")
+(test (with-html-output-to-string (out)
+         (:div (:pre "Foo")))
+       "<div><pre>Foo</pre></div>")
+
 
 ;;; 25
-(string= (with-html-output-to-string (out nil :indent t)
-           (:div (:pre "Foo")))
-         "
-<div>
-  <pre>Foo</pre>
-</div>")
+(test (with-html-output-to-string (out nil :indent t)
+        (:div (:pre "Foo")))
+      "\n                   \
+       <div>\n              \
+       \  <pre>Foo</pre>\n  \
+       </div>")
 
 ;;; 26
-(string= (with-html-output-to-string (out nil :indent t)
-           (:div (:p "Bar")))
-         "
-<div>
-  <p>Bar
-  </p>
-</div>")
+(test (with-html-output-to-string (out nil :indent t)
+        (:div (:p "Bar")))
+      "\n                   \
+       <div>\n              \
+       \  <p>Bar\n          \
+       \  </p>\n            \
+       </div>")
+
 
 ;;; 27
-(string= (let ((*html-no-indent-tags* (cons :p *html-no-indent-tags*)))
-           (eval `(with-html-output-to-string (out nil :indent t)
-                    (:div (:p "Bar")))))
-         "
-<div>
-  <p>Bar</p>
-</div>")
+;;; CL-WHO test 27 uses let and eval; we eliminate that with expander-let.
+(test (expander-let ((*html-no-indent-tags* (cons :p *html-no-indent-tags*)))
+        (with-html-output-to-string (out nil :indent t)
+          (:div (:p "Bar"))))
+      "\n                   \
+       <div>\n              \
+       \  <p>Bar</p>\n      \
+       </div>")