Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
320 lines (282 sloc) 15.6 KB
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: X-HTML-TEMPLATE-TEST; Base: 10 -*-
;;; $Header: /usr/local/cvsrep/html-template/test.lisp,v 1.13 2007/01/01 23:49:16 edi Exp $
;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. All rights reserved.
;;; Copyright (C) 2012 Eyecarepro.net
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package #:cl-user)
#-:cormanlisp
(defpackage #:x-html-template-test
(:use #:cl #:x-html-template))
#+:cormanlisp
(defpackage "X-HTML-TEMPLATE-TEST"
(:use "CL" "X-HTML-TEMPLATE"))
(in-package #:x-html-template-test)
(format t "~&Please wait a couple of seconds.")
(force-output)
(defvar tmp-dir #p"/tmp/")
(defmacro failedp (&body body)
`(handler-case
(progn ,@body nil)
(condition () t)))
(defmacro warnedp (&body body)
`(handler-case
(progn ,@body nil)
(warning () t)))
(defmacro test (result &rest args)
(cond (result
`(assert (string= ,result
(with-output-to-string (*default-template-output*)
(fill-and-print-template ,@args)))))
(`(assert (failedp (fill-and-print-template ,@args))))))
(test "abc" "<!-- TMPL_VAR foo -->" '(:foo "abc"))
(test "abc" "<!-- tmpl_var foo -->" '(:foo "abc"))
(test "<!-- tmpl_vaar foo -->" "<!-- tmpl_vaar foo -->" '(:foo "abc"))
(test "xabcy" "x<!-- TMPL_VAR foo -->y" '(:foo "abc"))
(test "" "<!-- TMPL_VAR foo -->" nil)
(test "" "<!-- TMPL_VAR foo -->" '(foo "abc"))
(test "" "<!-- TMPL_VAR foo -->" '(:bar "abc"))
(test "" "<!-- TMPL_IF foo -->abc<!-- /TMPL_IF -->" nil)
(test "" "<!-- TMPL_IF foo -->abc<!-- /TMPL_IF -->" '(:foo nil))
(test "abc" "<!-- TMPL_IF foo -->abc<!-- /TMPL_IF -->" '(:foo t))
(test "abc" "<!-- TMPL_IF foo -->abc<!-- /TMPL_IF -->" '(:foo t :bar 42))
(test nil "<!-- TMPL_IF foo -->abc<!-- /TMPL_IF foo -->" nil)
(test nil "<!-- TMPL_IF -->abc<!-- /TMPL_IF -->" nil)
(test "def" "<!-- TMPL_IF foo -->abc<!-- TMPL_ELSE-->def<!-- /TMPL_IF -->" nil)
(test nil "<!-- TMPL_IF foo -->abc<!-- TMPL_ELSE-->def<!-- /TMPL_UNLESS -->" nil)
(test "def" "<!-- TMPL_IF foo -->abc<!-- TMPL_ELSE-->def<!-- /TMPL_IF -->" '(:foo nil))
(test "abc" "<!-- TMPL_IF foo -->abc<!-- TMPL_ELSE-->def<!-- /TMPL_IF -->" '(:foo t))
(test "abc" "<!-- TMPL_UNLESS foo -->abc<!-- TMPL_ELSE-->def<!-- /TMPL_UNLESS -->" '(:foo nil))
(test "def" "<!-- TMPL_UNLESS foo -->abc<!-- TMPL_ELSE-->def<!-- /TMPL_UNLESS -->" '(:foo t))
(test nil "<!-- TMPL_UNLESS foo -->abc<!-- TMPL_ELSE-->def<!-- /TMPL_IF -->" '(:foo t))
(test "abc" "<!-- TMPL_IF foo --><!-- TMPL_VAR foo --><!-- TMPL_ELSE-->def<!-- /TMPL_IF -->" '(:foo "abc"))
(test "def" "<!-- TMPL_IF foo --><!-- TMPL_VAR foo --><!-- TMPL_ELSE-->def<!-- /TMPL_IF -->" '(:foo nil))
(test "abcabcabc" "<!-- TMPL_IF foo --><!-- TMPL_VAR foo -->abc<!-- TMPL_VAR foo --><!-- TMPL_ELSE-->def<!-- /TMPL_IF -->" '(:foo "abc"))
(test "defdefdef" "<!-- TMPL_IF foo --><!-- TMPL_VAR foo -->abc<!-- TMPL_VAR foo --><!-- TMPL_ELSE--><!-- TMPL_VAR bar -->def<!-- TMPL_VAR bar --><!-- /TMPL_IF -->" '(:bar "def"))
(test "[]" "[<!-- TMPL_LOOP foo -->[x]<!-- /TMPL_LOOP -->]" '(:foo nil))
(test "[xxx]" "[<!-- TMPL_REPEAT foo -->x<!-- /TMPL_REPEAT -->]" '(:foo 3))
(test "[]" "[<!-- TMPL_REPEAT foo -->x<!-- /TMPL_REPEAT -->]" '(:foo 0))
(test "[]" "[<!-- TMPL_REPEAT foo -->x<!-- /TMPL_REPEAT -->]" '(:foo "foo"))
(test nil "[<!-- TMPL_REPEAT foo -->x<!-- /TMPL_LOOP -->]" '(:foo 3))
(test nil "[<!-- TMPL_LOOP foo -->x<!-- /TMPL_REPEAT -->]" '(:foo 3))
(test "[[x][x][x]]" "[<!-- TMPL_LOOP foo -->[x]<!-- /TMPL_LOOP -->]" '(:foo (1 2 3)))
(test "[[1][2][3]]" "[<!-- TMPL_LOOP foo -->[<!-- TMPL_VAR bar -->]<!-- /TMPL_LOOP -->]" '(:foo ((:bar "1") (:bar "2") (:bar "3"))))
(test "[[][][]]" "[<!-- TMPL_LOOP foo -->[<!-- TMPL_VAR bar -->]<!-- /TMPL_LOOP -->]" '(:foo (() () ())))
(test "[[1][2][3]]" "[<!-- TMPL_LOOP foo -->[<!-- TMPL_VAR bar -->]<!-- /TMPL_LOOP -->]" '(:foo ((:bar "1") (:bar "2") (:bar "3"))))
(test "[[1][][3]]" "[<!-- TMPL_LOOP foo -->[<!-- TMPL_VAR bar -->]<!-- /TMPL_LOOP -->]" '(:foo ((:bar "1") () (:bar "3"))))
(test "[[1][2][3]]" "[<!-- TMPL_LOOP foo -->[<!-- TMPL_IF bar --><!-- TMPL_VAR bar --><!-- TMPL_ELSE-->2<!-- /TMPL_IF -->]<!-- /TMPL_LOOP -->]" '(:foo ((:bar "1") () (:bar "3"))))
(test "[[123][456][789]]" "[<!-- TMPL_LOOP foo -->[<!-- TMPL_LOOP bar --><!-- TMPL_VAR bar --><!-- /TMPL_LOOP -->]<!-- /TMPL_LOOP -->]" '(:foo ((:bar ((:bar "1") (:bar "2") (:bar "3")))
(:bar ((:bar "4") (:bar "5") (:bar "6")))
(:bar ((:bar "7") (:bar "8") (:bar "9"))))))
(test "[[123][baz][789]]" "[<!-- TMPL_LOOP foo -->[<!-- TMPL_IF baz --><!-- TMPL_LOOP baz --><!-- TMPL_VAR bar --><!-- /TMPL_LOOP --><!-- TMPL_ELSE -->baz<!-- /TMPL_IF -->]<!-- /TMPL_LOOP -->]"
'(:foo ((:baz ((:bar "1") (:bar "2") (:bar "3")))
()
(:baz ((:bar "7") (:bar "8") (:bar "9"))))))
(test nil "<!-- TMPL_ELSE -->" nil)
(test "<!-- /TMPL_ELSE -->" "<!-- /TMPL_ELSE -->" nil)
(test nil "<!-- /TMPL_IF -->" nil)
(test nil "<!-- /TMPL_UNLESS -->" nil)
(test nil "<!-- /TMPL_LOOP -->" nil)
(test nil "<!-- TMPL_IF foo --><!-- TMPL_ELSE -->" nil)
(test nil "<!-- TMPL_UNLESS foo --><!-- TMPL_ELSE -->" nil)
(test nil "<!-- TMPL_LOOP foo --><!-- TMPL_ELSE -->" nil)
(test nil "<!-- TMPL_LOOP foo --><!-- TMPL_ELSE --><!-- /TMPL_LOOP -->" nil)
(test nil "<!-- TMPL_IF bar --><!-- TMPL_LOOP foo --><!-- TMPL_ELSE --><!-- /TMPL_LOOP -->" nil)
(test nil "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF -->" nil)
(test "1" "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF --><!-- /TMPL_IF -->" '(:foo t :bar t))
(test "2" "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF --><!-- /TMPL_IF -->" '(:foo t :bar nil))
(test "3" "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF --><!-- /TMPL_IF -->" '(:foo nil :baz t))
(test "4" "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF --><!-- /TMPL_IF -->" '(:foo nil :baz nil))
(test "X" "<!-- TMPL_CALL foo -->" '(:foo (("X"))))
(test "QUUX" "<!-- TMPL_VAR baz --><!-- TMPL_CALL foo -->" '(:baz "Q"
:foo (("<!-- TMPL_VAR bar -->" :bar "U")
("<!-- TMPL_VAR bar -->X" :bar "U"))))
(test "" "<!-- TMPL_IF foo --><!-- TMPL_CALL bar --><!-- /TMPL_IF -->" '(:foo (("---"))))
(test nil "<!-- TMPL_CALL foo -->" '(:foo 57))
(let ((temp-name (make-pathname :name (format nil "template-test-~A" (random 1000000))
:defaults tmp-dir)))
(with-open-file (stream temp-name :direction :output :if-exists :error)
(write-string "<!-- TMPL_VAR foo -->" stream))
(let ((*warn-on-creation* nil))
(test "abc" temp-name '(:foo "abc")))
(with-open-file (stream temp-name :direction :input)
(test "def" stream '(:foo "def")))
(with-open-file (stream temp-name :direction :input)
(let ((tp (create-template-printer stream)))
(test "ghi" tp '(:foo "ghi"))))
(let ((tp (create-template-printer temp-name)))
(test "jkl" tp '(:foo "jkl")))
(let ((tp (create-template-printer "<!-- TMPL_VAR foo -->")))
(test "mno" tp '(:foo "mno")))
(delete-file temp-name)
;; sleep because of FILE-WRITE-DATE
(sleep 2)
(with-open-file (stream temp-name :direction :output :if-exists :error)
(write-string "<!-- TMPL_VAR bar -->" stream))
(assert (warnedp (create-template-printer temp-name)))
(assert (not (warnedp (create-template-printer temp-name))))
(assert (warnedp (create-template-printer temp-name :force t)))
(delete-from-template-cache temp-name)
(assert (warnedp (create-template-printer temp-name)))
(clear-template-cache)
(assert (warnedp (create-template-printer temp-name)))
(delete-file temp-name))
(let ((*template-start-marker* "<")
(*template-end-marker* ">"))
(test "The quick <brown> fox" "The <TMPL_VAR speed> <brown> fox"
'(:speed "quick")))
(let* ((random-string (format nil "template-test-~A" (random 1000000)))
(temp-name (merge-pathnames random-string tmp-dir))
(*default-template-pathname* tmp-dir))
(with-open-file (stream temp-name :direction :output :if-exists :error)
(write-string "The <!-- TMPL_VAR speed --> brown fox" stream))
(let ((*warn-on-creation* nil))
(test "The very fast brown fox"
(make-pathname :name random-string)
'(:speed "very fast")))
(delete-file temp-name)
;; sleep because of FILE-WRITE-DATE
(sleep 2)
(with-open-file (stream temp-name :direction :output :if-exists :error)
(write-string "The <!-- TMPL_VAR speed --> brown fox" stream))
(let ((*warn-on-creation* nil))
(test "The very fast brown fox"
(format nil "<!-- TMPL_INCLUDE '~A' -->" random-string)
'(:speed "very fast")))
(delete-file temp-name))
(let* ((random-string (format nil "template-test-~A" (random 1000000)))
(temp-name (merge-pathnames random-string tmp-dir))
(random-string-2 (format nil "template-test-2-~A" (random 1000000)))
(temp-name-2 (merge-pathnames random-string-2 tmp-dir))
(*default-template-pathname* tmp-dir))
(with-open-file (stream temp-name :direction :output :if-exists :error)
(format stream "<!-- TMPL_INCLUDE '~A' -->" random-string-2))
(with-open-file (stream temp-name-2 :direction :output :if-exists :error)
(format stream "<!-- TMPL_INCLUDE '~A' -->" random-string))
(test nil (format nil "<!-- TMPL_INCLUDE '~A' -->" random-string) nil)
(delete-file temp-name)
(delete-file temp-name-2))
(assert (string= "The slow brown fox"
(with-output-to-string (stream)
(let ((*default-template-output* stream))
(fill-and-print-template "The <!-- TMPL_VAR speed --> brown fox"
'(:speed "slow"))))))
(let* ((tp (create-template-printer "The <!-- TMPL_VAR speed --> brown fox"))
(*convert-nil-to-empty-string* nil))
(with-output-to-string (*default-template-output*)
(test nil tp '(:foo "bar"))))
(let ((tp (create-template-printer "The <!-- TMPL_VAR speed --> brown fox")))
(handler-bind
((template-missing-value-error (lambda (condition)
(declare (ignore condition))
(use-value "slow"))))
(let ((*convert-nil-to-empty-string* nil))
(test "The slow brown fox" tp '(:foo "bar")))))
(let ((*sequences-are-lists* nil))
(test "[1][2][3]"
"<!-- TMPL_LOOP vector -->[<!-- TMPL_VAR item -->]<!-- /TMPL_LOOP -->"
'(:vector #((:item "1")
(:item "2")
(:item "3"))))
(test "QUUX" "<!-- TMPL_VAR baz --><!-- TMPL_CALL foo -->"
'(:baz "Q"
:foo #(("<!-- TMPL_VAR bar -->" :bar "U")
("<!-- TMPL_VAR bar -->X" :bar "U")))))
(let ((*upcase-attribute-strings* nil))
(test "The slow brown fox"
"The <!-- TMPL_VAR speed --> brown fox"
'(:speed "quick" :|speed| "slow")))
(let ((*template-symbol-package* *package*))
(test "The slow brown fox"
"The <!-- TMPL_VAR speed --> brown fox"
'(:speed "quick" speed "slow")))
(let ((tp (create-template-printer "The <!-- TMPL_VAR speed --> brown fox"))
(*value-access-function* #'gethash)
(hash (make-hash-table :test #'eq)))
(setf (gethash :speed hash) "fast")
(test "The fast brown fox" tp hash))
(let ((values (list :row-loop
(loop for row in '((1 2 3 4) (2 3 4 5) (3 4 5 6))
collect (list :col-loop
(loop for col in row
collect (list :item
(format nil "~A" col)))))))
(template "<table>
<!-- TMPL_LOOP row-loop -->
<tr>
<!-- TMPL_LOOP col-loop -->
<td><!-- TMPL_VAR item --></td>
<!-- /TMPL_LOOP -->
</tr>
<!-- /TMPL_LOOP -->
</table>")
(result "<table>
<tr>
<td>1</td>
<td>2</td>
<td>3</td>
<td>4</td>
</tr>
<tr>
<td>2</td>
<td>3</td>
<td>4</td>
<td>5</td>
</tr>
<tr>
<td>3</td>
<td>4</td>
<td>5</td>
<td>6</td>
</tr>
</table>")
(*ignore-empty-lines* t))
(test result template values))
(test "[FOO]" "[<!-- tmpl_var upcase(string) -->]" '(:string "foo" :upcase string-upcase))
(test "[STRING]" "[<!-- tmpl_var upcase('string') -->]" '(:string "foo" :upcase string-upcase))
(let ((*string-modifier* #'identity))
(test "[upcase(\"string\")]" "[<!-- tmpl_var 'upcase(\"string\")' -->]"
'(:string "foo" :upcase string-upcase)))
(test "[x]" "[<!-- tmpl_if equal(string, 'foobar') -->x<!-- /tmpl_if -->]"
(list :equal (lambda (arg1 arg2)
(equal (prin1-to-string arg1) (prin1-to-string arg2)))
:string "foobar"))
(test "[]" "[<!-- tmpl_unless equal(string, 'foobar') -->x<!-- /tmpl_unless -->]"
(list :equal (lambda (arg1 arg2)
(equal (prin1-to-string arg1) (prin1-to-string arg2)))
:string "foobar"))
(test "[xxx]" "[<!-- tmpl_loop list-fun() --><!-- tmpl_var char --><!-- /tmpl_loop -->]"
(list :list-fun (lambda ()
'((:key "value")
(:key "value")
(:key "value")))
:char #\x))
(test "[xxx]" "[<!-- tmpl_repeat inc(x) --><!-- tmpl_var char --><!-- /tmpl_repeat -->]"
(list :inc #'1+ :x 2 :char #\x))
(let ((tp (create-template-printer "A square has <!-- TMPL_VAR number --> corners"))
(*format-non-strings* nil))
(handler-bind
((template-not-a-string-error (lambda (condition)
(use-value
(format nil "~R"
(template-not-a-string-error-value condition))))))
(test "A square has four corners" tp '(:number 4))))
(format t "~&All tests passed...")