Add tests for templates

hssg.asd

@@ -40,4 +40,19 @@
                                                          (:file "xml")
                                                          (:file "verbatim")
                                                          (:file "directory")))
-                                           (:file "template")))))))
+                                           (:file "template"))))))
+  :in-order-to ((test-op (test-op "hssg/test"))))
+
+(asdf:defsystem #:hssg/test
+  :description "Tests for HSSG"
+  :author "HiPhish <hiphish@posteo.de>"
+  :license "AGPL-3.0-or-later"
+  :version "0.0.0"
+  :depends-on ("hssg" "fiveam")
+  :serial t
+  :perform (test-op (o s)
+             (symbol-call :hssg/test :test-all))
+  :components ((:module "test"
+                :components ((:module "hssg"
+                              :components ((:file "package")
+                                           (:file "main")))))))

src/hssg/template.lisp

@@ -25,7 +25,7 @@
   template function."
   '(or symbol function))
 
-(defmacro template ((&rest bindings) &rest entries)
+(defmacro template ((&rest bindings) &body entries)
   "Define an anonymous template. A template is a function which maps an a-list
   onto another a-list.
 
@@ -46,7 +46,7 @@
                      entries))
            ,data)))))
 
-(defmacro deftemplate (name (&rest bindings) &rest entries)
+(defmacro deftemplate (name (&rest bindings) &body entries)
   "Define a named template, which is just an ordinary function. Refer to
   TEMPLATE for details."
   (let* ((docstring (and (typep (car entries) 'string)
@@ -71,7 +71,7 @@
       (let-metadata data ((a :a)
                           (b :b)
                           (c :c \"c\")  ; Explicit default
-                          (d :d))     ; Implicit default
+                          (d :d))       ; Implicit default
         (list a b c d)))
     --
     (\"a\" \"b\" \"c\" NIL)"

test/hssg/main.lisp

@@ -0,0 +1,11 @@
+(in-package #:hssg/test)
+
+(defun test-all () 
+  (run! 'all-tests))
+
+(def-suite all-tests
+  :description "The root suite of all tests.")
+
+(def-suite hssg
+  :description ""
+  :in hssg/test:all-tests)

test/hssg/package.lisp

@@ -0,0 +1,5 @@
+(defpackage #:hssg/test
+  (:documentation "Main test package")
+  (:use #:cl #:fiveam)
+  (:export test-all all-tests))
+

test/hssg/template.lisp

@@ -0,0 +1,81 @@
+(in-package #:hssg/test)
+
+(def-suite hssg/template
+  :description "Tests for the HTML template engine")
+
+(in-suite hssg/template)
+
+(test let-metadata-form
+  "The LET-METADATA form can bind data from an association list"
+  (let ((data '((:foo . "foo") (:bar . "bar"))))
+    (hssg:let-metadata data ((foo :foo)
+                             (bar :bar)
+                             (baz :baz)
+                             (qux :qux "qux"))
+      (is-every equal
+        (foo "foo")
+        (bar "bar")
+        (baz nil)
+        (qux "qux")))))
+
+(test identity-template-unchanged
+  "The identity template returns its input unchanged"
+  (let* ((data '((:foo . "foo") (:bar . "bar")))
+         (out  (hssg:apply-template 'hssg:identity-template data)))
+    (is-true (equal data out))))
+
+(test identity-template-eq
+  "Applying the identity template does not produce a new object"
+  (let* ((data '((:foo . "foo") (:bar . "bar")))
+         (out  (hssg:apply-template 'hssg:identity-template data)))
+    (is-true (eq data out))))
+
+(test anonymous-template
+  "Defines an anonous template"
+  (let* ((data '((:foo . "foo") (:bar . "bar")))
+         (template (hssg:template (foo)
+                     (:foo (string-upcase foo))
+                     (:baz "baz")))
+         (out (hssg:apply-template template data)))
+    (hssg:let-metadata out ((foo :foo)
+                            (bar :bar)
+                            (baz :baz))
+      (is-every string-equal
+        (foo "FOO")
+        (bar "bar")
+        (baz "baz")))))
+
+(test template-chaining
+  "Chaining two templates produces a new template"
+  (let* ((data '((:foo . "foo")))
+         (t1 (hssg:template ()
+               (:bar "bar")))
+         (t2 (hssg:template (foo)
+               (:foo (string-upcase foo))
+               (:baz "baz")))
+         (t3 (hssg:template (bar)
+               (:bar (string-upcase bar))))
+         (template (hssg:chain-templates t1 t2 t3))
+         (out (hssg:apply-template template data)))
+    (hssg:let-metadata out ((foo :foo)
+                            (bar :bar)
+                            (baz :baz))
+      (is-every string-equal
+        (foo "FOO")
+        (bar "BAR")
+        (baz "baz")))))
+
+
+(test initial-data
+  "Providing a tamplate with initial data produces a new template"
+  (let* ((data '((:foo . "foo")))
+         (template (hssg:template-with-data (hssg:template () (:baz "baz"))
+                                            '((:bar . "bar"))))
+         (out (hssg:apply-template template data)))
+    (hssg:let-metadata out ((foo :foo)
+                            (bar :bar)
+                            (baz :baz))
+      (is-every string-equal
+        (foo "foo")
+        (bar "bar")
+        (baz "baz")))))