[cl-who-devel] patch + unit test code (Re: *html-empty-tag* bug)

[Mac Chan]

Attached is a patch to fix html-empty-tag bug and also some unit test
code to help spotting problems in case there are ignorant people like
me who submit bad code ;-)

Thanks,
-- Mac
-------------- next part --------------
Index: test.lisp
===================================================================
--- test.lisp	(revision 0)
+++ test.lisp	(revision 0)
@@ -0,0 +1,90 @@
+(in-package #:cl-user)
+
+(defpackage #:cl-who-test
+  (:use #:cl #:cl-who))
+
+(in-package #:cl-who-test)
+
+(defmacro with-html (&body body)
+  `(with-html-output-to-string
+    (*standard-output* nil :prologue nil :indent nil)
+    , at body))
+
+(defmacro test= (result &rest args)
+  `(assert (string= ,result
+            (with-html , at args))))
+
+(defmacro test/= (result &rest args)
+  `(assert (string/= ,result
+            (with-html , at args))))
+
+(format t "~&Start running test...~%")
+
+(eval-when (:compile-toplevel :load-toplevel :execute) 
+  (setq *downcase-tags-p* t)
+  (setf (html-mode) :xml)
+  (setq *attribute-quote-char* #\')
+  (setq *html-empty-tag-aware-p* t))
+
+(test= "&" (esc "&"))
+(test= "<" (esc "<"))
+(test= ">" (esc ">"))
+(test= "'" (esc "'"))
+(test= """ (esc  "\""))
+(test= "&#x2713;" (esc (string (code-char #x2713))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf (html-mode) :sgml))
+
+(test= "✓" (esc (string (code-char #x2713))))
+
+(test= "<input type='checkbox' checked>"
+       (:input :type "checkbox" :checked t))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf (html-mode) :xml))
+
+(test= "<input type='checkbox' checked='checked' />"
+       (:input :type "checkbox" :checked t))
+
+(test= "<div></div>"
+       (:div))
+
+(test= "<br />"
+       (:br))
+
+(test= "<script src='http://www.yahoo.com/yui.js'></script>"
+       (:script :src "http://www.yahoo.com/yui.js"))
+
+(defun lookup-author ()
+  (values "Zappa"))
+
+(test= "<item><asin>123456</asin><item-attributes><author>Zappa</author></item-attributes></item>"
+       (:|Item|
+         (:|ASIN| "123456")
+         (:|Item-Attributes|
+           (:|Author| (str (lookup-author))))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setq *downcase-tags-p* nil))
+
+(test= "<Item><ASIN>123456</ASIN><Item-Attributes><Author>Zappa</Author></Item-Attributes></Item>"
+       (:|Item|
+         (:|ASIN| "123456")
+         (:|Item-Attributes|
+           (:|Author| (str (lookup-author))))))
+
+;; we're generating xml that happens to have these html tags <div> and
+;; <script>
+(eval-when (:compile-toplevel :load-toplevel :execute) 
+  (setq *html-empty-tag-aware-p* nil))
+
+(test= "<xml-rpc><type><script /></type><opcode><div /></opcode><operand>1</operand><operand>0</operand></xml-rpc>"
+       (:|xml-rpc|
+         (:|type| (:|script|))
+         (:|opcode| (:|div|))
+         (:|operand| (str 1))
+         (:|operand| (str 0))))
+
+
+(format t "~&Finish testing.~%")
Index: who.lisp
===================================================================
--- who.lisp	(revision 1278)
+++ who.lisp	(working copy)
@@ -240,7 +240,7 @@
         (list "</" tag ">"))
        ;; no body, so no closing tag unless defined in *HTML-EMPTY-TAGS*
        (if (or (not *html-empty-tag-aware-p*)
-               (member tag *html-empty-tags*))
+               (member tag *html-empty-tags* :test #'string-equal))
          (list *empty-tag-end*)
          (list ">" "</" tag ">"))))))