diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/helper.scm | 27 | ||||
| -rw-r--r-- | tests/post.scm | 88 | ||||
| -rw-r--r-- | tests/utils.scm | 99 |
3 files changed, 116 insertions, 98 deletions
diff --git a/tests/helper.scm b/tests/helper.scm new file mode 100644 index 0000000..f224ba1 --- /dev/null +++ b/tests/helper.scm @@ -0,0 +1,27 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2022 David Thompson <davet@gnu.org> +;;; +;;; This file is part of Haunt. +;;; +;;; Haunt is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Haunt is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Haunt. If not, see <http://www.gnu.org/licenses/>. + +(define-module (tests helper) + #:use-module (srfi srfi-64) + #:export (with-tests)) + +(define-syntax-rule (with-tests name body ...) + (begin + (test-begin name) + body ... + (exit (zero? (test-runner-fail-count (test-end)))))) diff --git a/tests/post.scm b/tests/post.scm index b0407c9..db1a82c 100644 --- a/tests/post.scm +++ b/tests/post.scm @@ -1,5 +1,5 @@ ;;; Haunt --- Static site generator for GNU Guile -;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2015, 2022 David Thompson <davet@gnu.org> ;;; ;;; This file is part of Haunt. ;;; @@ -17,11 +17,10 @@ ;;; along with Haunt. If not, see <http://www.gnu.org/licenses/>. (define-module (test-post) + #:use-module (haunt post) #:use-module (srfi srfi-19) #:use-module (srfi srfi-64) - #:use-module (haunt post)) - -(test-begin "post") + #:use-module (tests helper)) (define (make-date* year month day) (make-date 0 0 0 0 day month year 0)) @@ -29,57 +28,54 @@ (define %tzoffset (date-zone-offset (string->date "2015-09-05" "~Y~m~d"))) -(test-equal "post-ref" - '(hello test) - (post-ref (make-post "foo.skr" '((tags hello test)) '()) 'tags)) +(with-tests "post" + (test-equal "post-ref" + '(hello test) + (post-ref (make-post "foo.skr" '((tags hello test)) '()) 'tags)) -(test-equal "post-slug" - "hello-world" - (post-slug (make-post "foo.skr" '((title . "Hello, world!")) '()))) + (test-equal "post-slug" + "hello-world" + (post-slug (make-post "foo.skr" '((title . "Hello, world!")) '()))) -(test-equal "post-date, no date metadata" - %default-date - (post-date (make-post "foo.skr" '() '()))) + (test-equal "post-date, no date metadata" + %default-date + (post-date (make-post "foo.skr" '() '()))) -(let ((date (make-date* 2015 10 15))) - (test-equal "post-date, date metadata" - date - (post-date (make-post "foo.skr" `((date . ,date)) '())))) + (let ((date (make-date* 2015 10 15))) + (test-equal "post-date, date metadata" + date + (post-date (make-post "foo.skr" `((date . ,date)) '())))) -(let ((oldest (make-post "foo.skr" `((date . ,(make-date* 2015 10 13))) '())) - (newest (make-post "bar.skr" `((date . ,(make-date* 2015 10 15))) '())) - (middle (make-post "baz.skr" `((date . ,(make-date* 2015 10 14))) '()))) - (test-equal "posts/reverse-chronological" - (list newest middle oldest) - (posts/reverse-chronological (list oldest newest middle)))) + (let ((oldest (make-post "foo.skr" `((date . ,(make-date* 2015 10 13))) '())) + (newest (make-post "bar.skr" `((date . ,(make-date* 2015 10 15))) '())) + (middle (make-post "baz.skr" `((date . ,(make-date* 2015 10 14))) '()))) + (test-equal "posts/reverse-chronological" + (list newest middle oldest) + (posts/reverse-chronological (list oldest newest middle)))) -(let ((foo-post (make-post "foo.skr" '((tags "foo")) '())) - (another-foo-post (make-post "another-foo.skr" '((tags "foo")) '())) - (bar-post (make-post "bar.skr" '((tags "bar")) '()))) - (test-equal "posts/group-by-tag" - `(("foo" ,foo-post ,another-foo-post) ("bar" ,bar-post)) - (posts/group-by-tag (list another-foo-post foo-post bar-post)))) + (let ((foo-post (make-post "foo.skr" '((tags "foo")) '())) + (another-foo-post (make-post "another-foo.skr" '((tags "foo")) '())) + (bar-post (make-post "bar.skr" '((tags "bar")) '()))) + (test-equal "posts/group-by-tag" + `(("foo" ,foo-post ,another-foo-post) ("bar" ,bar-post)) + (posts/group-by-tag (list another-foo-post foo-post bar-post)))) -(test-equal "parse-metadata, tags" - '("foo" "bar" "baz") - (parse-metadata 'tags "foo, bar, baz")) + (test-equal "parse-metadata, tags" + '("foo" "bar" "baz") + (parse-metadata 'tags "foo, bar, baz")) -(test-equal "parse-metadata, date" - (make-date 0 0 30 22 15 10 2015 %tzoffset) - (parse-metadata 'date "2015-10-15 22:30")) + (test-equal "parse-metadata, date" + (make-date 0 0 30 22 15 10 2015 %tzoffset) + (parse-metadata 'date "2015-10-15 22:30")) -(test-equal "read-metadata-headers" - `((tags "foo" "bar" "baz") - (date . ,(make-date 0 0 30 22 15 10 2015 %tzoffset)) - (title . "Hello, World!")) - (pk 'meta (call-with-input-string "title: Hello, World! + (test-equal "read-metadata-headers" + `((tags "foo" "bar" "baz") + (date . ,(make-date 0 0 30 22 15 10 2015 %tzoffset)) + (title . "Hello, World!")) + (call-with-input-string "title: Hello, World! date: 2015-10-15 22:30 tags: foo, bar, baz --- " - read-metadata-headers))) - -(test-end) - - -(exit (zero? (test-runner-fail-count (test-runner-current)))) + read-metadata-headers)) + ) diff --git a/tests/utils.scm b/tests/utils.scm index c2fc55b..c140520 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; Haunt --- Static site generator for GNU Guile -;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2015, 2022 David Thompson <davet@gnu.org> ;;; ;;; This file is part of Haunt. ;;; @@ -17,70 +17,65 @@ ;;; along with Haunt. If not, see <http://www.gnu.org/licenses/>. (define-module (test-utils) + #:use-module (haunt utils) #:use-module (srfi srfi-19) #:use-module (srfi srfi-64) - #:use-module (haunt utils)) + #:use-module (tests helper)) -(test-begin "utils") +(with-tests "utils" + (test-equal "flatten, all" + '(1 2 3 4 5 6) + (flatten '(1 (2 3 (4) (5 (6)))))) -(test-equal "flatten, all" - '(1 2 3 4 5 6) - (flatten '(1 (2 3 (4) (5 (6)))))) + (test-equal "flatten, limited depth" + '(1 2 3 4 5 (6)) + (flatten '(1 (2 3 (4) (5 (6)))) 2)) -(test-equal "flatten, limited depth" - '(1 2 3 4 5 (6)) - (flatten '(1 (2 3 (4) (5 (6)))) 2)) + (test-equal "flat-map" + '(5 7 9) + (flat-map (compose list +) '(1 2 3) '(4 5 6))) -(test-equal "flat-map" - '(5 7 9) - (flat-map (compose list +) '(1 2 3) '(4 5 6))) + (test-equal "string-split-at, no match" + '("foo") + (string-split-at "foo" #\z)) -(test-equal "string-split-at, no match" - '("foo") - (string-split-at "foo" #\z)) + (test-equal "string-split-at, match" + '("foo" "bar") + (string-split-at "foo/bar" #\/)) -(test-equal "string-split-at, match" - '("foo" "bar") - (string-split-at "foo/bar" #\/)) + (test-equal "file-name-components, empty string" + '() + (file-name-components "")) -(test-equal "file-name-components, empty string" - '() - (file-name-components "")) + (test-equal "file-name-components, root directory" + '("") + (file-name-components "/")) -(test-equal "file-name-components, root directory" - '("") - (file-name-components "/")) + (test-equal "file-name-components, full file name" + '("share" "haunt") + (file-name-components "/share/haunt")) -(test-equal "file-name-components, full file name" - '("share" "haunt") - (file-name-components "/share/haunt")) + (test-equal "join-file-name-components" + "share/haunt/info/haunt.info" + (join-file-name-components '("share" "haunt" "info" "haunt.info"))) -(test-equal "join-file-name-components" - "share/haunt/info/haunt.info" - (join-file-name-components '("share" "haunt" "info" "haunt.info"))) + (test-equal "absolute-file-name, already absolute" + "/share/haunt" + (absolute-file-name "/share/haunt")) -(test-equal "absolute-file-name, already absolute" - "/share/haunt" - (absolute-file-name "/share/haunt")) + (test-equal "absolute-file-name, relative file name" + (string-append (getcwd) "/share/haunt") + (absolute-file-name "share/haunt")) -(test-equal "absolute-file-name, relative file name" - (string-append (getcwd) "/share/haunt") - (absolute-file-name "share/haunt")) + (test-equal "take-up-to, less than n elements" + '(1 2 3) + (take-up-to 4 '(1 2 3))) -(test-equal "take-up-to, less than n elements" - '(1 2 3) - (take-up-to 4 '(1 2 3))) + (test-equal "take-up-to, more than n elements" + '(1 2) + (take-up-to 2 '(1 2 3))) -(test-equal "take-up-to, more than n elements" - '(1 2) - (take-up-to 2 '(1 2 3))) - -(test-equal "string->date*" - (make-date 0 0 15 06 05 09 2015 - (date-zone-offset (string->date "2015-09-05" "~Y~m~d"))) - (string->date* "2015-09-05 06:15")) - -(test-end) - - -(exit (zero? (test-runner-fail-count (test-runner-current)))) + (test-equal "string->date*" + (make-date 0 0 15 06 05 09 2015 + (date-zone-offset (string->date "2015-09-05" "~Y~m~d"))) + (string->date* "2015-09-05 06:15"))) |