diff options
Diffstat (limited to 'test/simple.tl')
| -rw-r--r-- | test/simple.tl | 306 |
1 files changed, 306 insertions, 0 deletions
diff --git a/test/simple.tl b/test/simple.tl new file mode 100644 index 0000000..1100f25 --- /dev/null +++ b/test/simple.tl @@ -0,0 +1,306 @@ +;;; some simple tests for TL-WHO. + +(load "../tl-who") + +(defpackage "tl-who-test" + (:fallback "tl-who" "usr")) + +(in-package "tl-who-test") + +(defmacro test (test-expr expected-expr) + (with-gensyms (te ee) + ^(let ((,te ,test-expr) + (,ee ,expected-expr)) + (unless (equal ,te ,ee) + (error "~s\nproduced:\n~s\nrather than:\n~s" + ',test-expr ,te ,ee))))) + +;;; 1 +(test (with-out-string-stream (out) + (with-html-output (out) + (keep-matches ((@link . @title) '(("http://zappa.com/" . "Frank Zappa") + ("http://marcusmiller.com/" . "Marcus Miller") + ("http://www.milesdavis.com/" . "Miles Davis"))) + (htm (:a :href link + (:b (str title))) + :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 />") + +(exit) + +;;; 2 +(string= (with-output-to-string (out) + (with-html-output (out nil) + (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") + ("http://marcusmiller.com/" . "Marcus Miller") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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") + ("http://marcusmiller.com/" . "Marcus Miller") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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") + ("http://marcusmiller.com/" . "Marcus Miller") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :br))) + "<!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\">")) + (eval `(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") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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 />") + +;;; 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") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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 />") + +;;; 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") + ("http://www.milesdavis.com/" . "Miles Davis")) + do (htm (:a :href link + (:b (str title))) + :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 />") + +;;; 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>") + +;;; 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ê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)))) + (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' />"))) + +;;; 18 +(string= (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 />") + +;;; 20 +(string= (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>") + +;;; 22 +(string= (let ((*downcase-tokens-p* nil)) + (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 />") + +;;; 24 +(string= (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>") + +;;; 26 +(string= (with-html-output-to-string (out nil :indent t) + (:div (:p "Bar"))) + " +<div> + <p>Bar + </p> +</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>") |