mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

refactor & relocate unit tests

Browse Source
pull/58/head
Matthew Butterick 9 years ago
parent d07db3750c
commit f048dabc37
20 changed files with 268 additions and 281 deletions
Show Stats Download Patch File Download Diff File

83
decode.rkt
Unescape Escape View File

@ -1,5 +1,5 @@
#lang racket/base
(require xml txexpr sugar racket/match racket/list (prefix-in html: pollen/html))
(require xml txexpr sugar racket/match racket/list (prefix-in html: pollen/html) sugar/test)
(require "debug.rkt" "world.rkt")
@ -132,6 +132,9 @@
(txexpr-tag? . -> . void?)
(project-block-tags (cons tag (project-block-tags))))
(module-test-external
(check-true (begin (register-block-tag 'barfoo) (block-txexpr? '(barfoo "foo")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -149,16 +152,19 @@
(define+provide/contract (smart-dashes str)
(string? . -> . string?)
(define dashes
;; fix em dashes first, else they'll be mistaken for en dashes
;; \\s is whitespace + #\u00A0 is nonbreaking space
'((#px"[\\s#\u00A0]*(---|—)[\\s#\u00A0]*" "—") ; em dash
(#px"[\\s#\u00A0]*(--|–)[\\s#\u00A0]*" "–"))) ; en dash
((make-replacer dashes) str))
(module-test-external
(check-equal? (smart-dashes "I had --- maybe 13 -- 20 --- hob-nobs.") "I had—maybe 13–20—hob-nobs.")
(check-equal? (smart-quotes "\"Why,\" she could've asked, \"are we in O‘ahu watching 'Mame'?\"")
"“Why,” she could’ve asked, “are we in O‘ahu watching ‘Mame’?”")
(check-equal? (smart-quotes "\"\'Impossible.\' Yes.\"") "“‘Impossible.’ Yes.”"))
(define+provide/contract (smart-quotes str)
(string? . -> . string?)
@ -215,6 +221,14 @@
(find-last-word-space x)
x))
(module-test-external
;; todo: make some tougher tests, it gets flaky with edge cases
(check-equal? (nonbreaking-last-space '(p "Hi there")) '(p "Hi " "there")) ; nbsp in between last two words
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "Ø") '(p "HiØ" "there")) ; but let's make it visible
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_") '(p "Hi_up_" "there"))
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_" #:minimum-word-length 3)
'(p "Hi " "there"))
(check-equal? (nonbreaking-last-space '(p "Hi here" (em "ho there")) #:nbsp "Ø") '(p "Hi here" (em "hoØ" "there"))))
; wrap initial quotes for hanging punctuation
; todo: improve this
@ -245,7 +259,14 @@
(cons new-car-elements (cdr elements)))
elements)))
(module-test-external
(check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "“" "Hi\" there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (squo "‘" "Hi' there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there") #:single-prepend '(foo ((bar "ino"))))
'(p (foo ((bar "ino")) "‘" "Hi' there")))
;; make sure txexpr without elements passes through unscathed
(check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em")))))
@ -278,6 +299,14 @@
[else empty])] ; otherwise delete
[else item])))))
(module-test-external
(check-equal? (detect-linebreaks '("foo" "\n" "bar")) '("foo" (br) "bar"))
(check-equal? (detect-linebreaks '("\n" "foo" "\n" "bar" "\n")) '("\n" "foo" (br) "bar" "\n"))
(check-equal? (detect-linebreaks '((p "foo") "\n" (p "bar"))) '((p "foo") (p "bar")))
(check-equal? (detect-linebreaks '("foo" "\n" (p "bar"))) '("foo" (p "bar")))
(check-equal? (detect-linebreaks '("foo" "moo" "bar")) '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "moo" "bar") #:insert "moo") '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "\n\n" "bar")) '("foo" "\n\n" "bar")))
(define+provide/contract (whitespace? x [nbsp? #f])
@ -289,6 +318,16 @@
[(or (list? x) (vector? x)) (and (not (empty? x)) (andmap (λ(i) (whitespace? i nbsp?)) (->list x)))] ; andmap returns #t for empty lists
[else #f]))
(module-test-external
(require racket/format)
(check-true (whitespace? " "))
(check-false (whitespace? (~a #\u00A0)))
(check-true (whitespace/nbsp? (~a #\u00A0)))
(check-true (whitespace/nbsp? (vector (~a #\u00A0))))
(check-false (whitespace? (format " ~a " #\u00A0)))
(check-true (whitespace/nbsp? (format " ~a " #\u00A0))))
(define+provide/contract (whitespace/nbsp? x)
(any/c . -> . coerce/boolean?)
(whitespace? x #t))
@ -331,7 +370,9 @@
[(list? x) (do-merge (map merge-newlines x))]
[else x]))
(module-test-external
(check-equal? (merge-newlines '(p "\n" "foo" "\n" "\n" "bar" (em "\n" "\n" "\n")))
'(p "\n" "foo" "\n\n" "bar" (em "\n\n\n"))))
@ -363,3 +404,33 @@
(if force-paragraph
(append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs
elements))))
(module-test-external
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para"))
'((p "First para") (p "Second para")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line"))
'((p "First para") (p "Second para" (br) "Second line")))
(check-equal? (detect-paragraphs '("First para" "\n\n" (div "Second block")))
'((p "First para") (div "Second block")))
(check-equal? (detect-paragraphs '((div "First block") "\n\n" (div "Second block")))
'((div "First block") (div "Second block")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para") #:tag 'ns:p)
'((ns:p "First para") (ns:p "Second para")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (detect-linebreaks x #:insert '(newline))))
'((p "First para") (p "Second para" (newline) "Second line")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (detect-paragraphs '("foo")) '("foo"))
(check-equal? (detect-paragraphs '("foo") #:force? #t) '((p "foo")))
(check-equal? (detect-paragraphs '((div "foo"))) '((div "foo")))
(check-equal? (detect-paragraphs '((div "foo")) #:force? #t) '((div "foo")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar")) #:force? #t) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar") "zam")) '((p "foo") (div "bar") (p "zam")))
(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam")) '((p "foo" (span "zing")) (div "bar") (p "zam")))
(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam") #:force? #t) '((p "foo" (span "zing")) (div "bar") (p "zam"))))

53
file.rkt
Unescape Escape View File

@ -2,7 +2,7 @@
(require (for-syntax racket/base racket/syntax))
(require racket/contract racket/path)
(require (only-in racket/path filename-extension))
(require "world.rkt" sugar)
(require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
;; for files like svg that are not source in pollen terms,
;; but have a textual representation separate from their display.
@ -10,7 +10,11 @@
(any/c . -> . coerce/boolean?)
(define sourceish-extensions (list "svg"))
(with-handlers ([exn:fail? (λ(e) #f)])
((get-ext x) . in? . sourceish-extensions)))
(member (get-ext x) sourceish-extensions)))
(module-test-external
(check-true (sourceish? "foo.svg"))
(check-false (sourceish? "foo.gif")))
;; compare directories by their exploded path elements,
@ -19,6 +23,9 @@
(coerce/path? coerce/path? . -> . coerce/boolean?)
(equal? (explode-path dirx) (explode-path diry)))
(module-test-external
(check-true (directories-equal? "/Users/MB/foo" "/Users/MB/foo/"))
(check-false (directories-equal? "/Users/MB/foo" "Users/MB/foo")))
;; helper function for pagetree
@ -88,11 +95,45 @@
(make-source-utility-functions preproc)
(module-test-external
(require sugar/coerce)
(check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar"))
(check-false (preproc-source? #f))
(check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp"))
(check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp"))
(check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.pp")))
(make-source-utility-functions null)
(make-source-utility-functions pagetree)
(module-test-external
(require pollen/world)
(check-true (pagetree-source? (format "foo.~a" world:pagetree-source-ext)))
(check-false (pagetree-source? (format "~a.foo" world:pagetree-source-ext)))
(check-false (pagetree-source? #f)))
(make-source-utility-functions markup)
(module-test-external
(require sugar/coerce)
(check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p"))
(check-false (markup-source? #f))
(check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm"))
(check-equal? (->markup-source-path (->path "foo.html")) (->path "foo.html.pm"))
(check-equal? (->markup-source-path "foo") (->path "foo.pm"))
(check-equal? (->markup-source-path 'foo) (->path "foo.pm")))
(make-source-utility-functions markdown)
(make-source-utility-functions template)
(module-test-external
(check-true (template-source? "foo.html.pt"))
(check-false (template-source? "foo.html"))
(check-false (template-source? #f)))
(make-source-utility-functions scribble)
@ -108,6 +149,14 @@
[(scribble-source? x) (add-ext (remove-ext x) 'html)]
[else x]))
(module-test-external
(require sugar/coerce)
(check-equal? (->output-path (->path "foo.pmap")) (->path "foo.pmap"))
(check-equal? (->output-path "foo.html") (->path "foo.html"))
(check-equal? (->output-path 'foo.html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo.xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo.barml.p) (->path "foo.barml")))
(define+provide/contract (project-files-with-ext ext)
(coerce/symbol? . -> . complete-paths?)

1
info.rkt
Unescape Escape View File

@ -7,3 +7,4 @@
(define scribblings '(("scribblings/pollen.scrbl" (multi-page))))
(define raco-commands '(("pollen" (submod pollen/raco main) "issue Pollen command" #f)))
(define compile-omit-paths '("tests" "raco.rkt"))
(define test-omit-paths '("scribblings" "test-support"))

66
pagetree.rkt
Unescape Escape View File

@ -10,6 +10,17 @@
(->boolean (and (symbol? x) (with-handlers ([exn:fail? (λ(e) #f)])
(not (whitespace/nbsp? (->string x)))))))
(module-test-external
(check-false (pagenode? "foo-bar"))
(check-false (pagenode? "Foo_Bar_0123"))
(check-true (pagenode? 'foo-bar))
(check-false (pagenode? "foo-bar.p"))
(check-false (pagenode? "/Users/MB/foo-bar"))
(check-false (pagenode? #f))
(check-false (pagenode? ""))
(check-false (pagenode? " ")))
(define+provide (pagenodes? x)
(and (list? x) (andmap pagenode? x)))
@ -46,6 +57,12 @@
(with-handlers ([exn:fail? (λ(e) #f)])
(->boolean (validate-pagetree x))))
(module-test-external
(check-true (pagetree? '(foo)))
(check-true (pagetree? '(foo (hee))))
(check-true (pagetree? '(foo (hee (uncle foo)))))
(check-false (pagetree? '(foo (hee hee (uncle foo))))))
(define+provide/contract (directory->pagetree dir)
(coerce/path? . -> . pagetree?)
@ -80,6 +97,14 @@
(ormap (λ(x) (parent pagenode x)) (filter list? pt))))))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (parent 'three test-pagetree) 'two)
(check-equal? (parent "three" test-pagetree) 'two)
(check-false (parent #f test-pagetree))
(check-false (parent 'nonexistent-name test-pagetree)))
(define+provide/contract (children p [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(and pt p
@ -88,11 +113,27 @@
(map (λ(x) (if (list? x) (car x) x)) (cdr pt))
(ormap (λ(x) (children pagenode x)) (filter list? pt))))))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (children 'one test-pagetree) '(two))
(check-equal? (children 'two test-pagetree) '(three))
(check-false (children 'three test-pagetree))
(check-false (children #f test-pagetree))
(check-false (children 'fooburger test-pagetree)))
(define+provide/contract (siblings pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(children (parent pnish pt) pt))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (siblings 'one test-pagetree) '(foo bar one))
(check-equal? (siblings 'foo test-pagetree) '(foo bar one))
(check-equal? (siblings 'two test-pagetree) '(two))
(check-false (siblings #f test-pagetree))
(check-false (siblings 'invalid-key test-pagetree)))
;; flatten tree to sequence
(define+provide/contract (pagetree->list pt)
@ -100,6 +141,10 @@
; use cdr to get rid of root tag at front
(cdr (flatten pt)))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (pagetree->list test-pagetree) '(foo bar one two three)))
(define (adjacents side pnish [pt (current-pagetree)])
(and pt pnish
@ -113,6 +158,12 @@
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(adjacents 'left pnish pt))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (previous* 'one test-pagetree) '(foo bar))
(check-equal? (previous* 'three test-pagetree) '(foo bar one two))
(check-false (previous* 'foo test-pagetree)))
(define+provide/contract (next* pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
@ -124,12 +175,27 @@
(let ([result (previous* pnish pt)])
(and result (last result))))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (previous 'one test-pagetree) 'bar)
(check-equal? (previous 'three test-pagetree) 'two)
(check-false (previous 'foo test-pagetree)))
(define+provide/contract (next pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))
(let ([result (next* pnish pt)])
(and result (first result))))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (next 'foo test-pagetree) 'bar)
(check-equal? (next 'one test-pagetree) 'two)
(check-false (next 'three test-pagetree)))
(define/contract+provide (path->pagenode path)
(coerce/path? . -> . coerce/symbol?)

26
render.rkt
Unescape Escape View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/file racket/rerequire racket/path racket/match)
(require sugar "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "pagetree.rkt" "project.rkt" "template.rkt")
(require sugar/coerce sugar/test sugar/define sugar/container sugar/file sugar/len)
(require "file.rkt" "cache.rkt" "world.rkt" "debug.rkt" "pagetree.rkt" "project.rkt" "template.rkt")
;; when you want to generate everything fresh,
@ -13,6 +14,8 @@
;; and lists of modification times as values.
(define modification-date-hash #f)
(reset-modification-dates)
(module-test-internal
(check-pred hash? modification-date-hash))
;; using internal contracts to provide some extra safety (negligible performance hit)
@ -29,17 +32,33 @@
(valid-path-args? . -> . valid-path-args?)
paths) ; for now, this does nothing; maybe later, it will do more
(module-test-internal
(require racket/runtime-path)
(define-runtime-path sample-dir "test-support/samples")
(define samples (parameterize ([current-directory sample-dir])
(map path->complete-path (directory-list "."))))
(define-values (sample-01 sample-02 sample-03) (apply values samples))
(check-equal? (make-mod-dates-key samples) samples))
(define/contract (path->mod-date-value path)
((or/c #f complete-path?) . -> . (or/c #f integer?))
(and path (file-exists? path) (file-or-directory-modify-seconds path)))
(module-test-internal
(check-false (path->mod-date-value (path->complete-path "garbage-path.zzz")))
(check-equal? (path->mod-date-value sample-01) (file-or-directory-modify-seconds sample-01)))
(define/contract (store-render-in-modification-dates . rest-paths)
(() #:rest valid-path-args? . ->* . void?)
(define key (make-mod-dates-key rest-paths))
(hash-set! modification-date-hash key (map path->mod-date-value key)))
(module-test-internal
(check-equal? (store-render-in-modification-dates sample-01 sample-02 sample-03) (void))
(check-true (hash-has-key? modification-date-hash (list sample-01 sample-02 sample-03))))
(define/contract (modification-date-expired? . rest-paths)
(() #:rest valid-path-args? . ->* . boolean?)
@ -47,6 +66,11 @@
(or (not (key . in? . modification-date-hash)) ; no stored mod date
(not (equal? (map path->mod-date-value key) (get modification-date-hash key))))) ; data has changed
(module-test-internal
(check-true (modification-date-expired? sample-01)) ; because key hasn't been stored
(check-false (apply modification-date-expired? samples))) ; because files weren't changed
(define (list-of-pathish? x) (and (list? x) (andmap pathish? x)))
(define/contract+provide (render-batch . xs)

46
template.rkt
Unescape Escape View File

@ -1,6 +1,6 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/string xml xml/path sugar/define sugar/container sugar/coerce)
(require racket/string xml xml/path sugar/define sugar/container sugar/coerce sugar/test)
(require "file.rkt" txexpr "world.rkt" "cache.rkt" "pagetree.rkt" "debug.rkt")
(provide (all-from-out sugar/coerce))
@ -22,7 +22,7 @@
;; otherwise look in metas, then in doc for key
(define (do-doc-result)
(define doc-result (select-from-doc key value-source))
(and doc-result (car doc-result)))
(and doc-result (car doc-result)))
(cond
[(or (hash? value-source) (equal? value-source world:meta-pollen-export)) (select-from-metas key value-source)]
[(equal? value-source world:main-pollen-export) (do-doc-result)]
@ -30,6 +30,18 @@
(define metas-result (and (not (txexpr? value-source)) (select-from-metas key value-source)))
(or metas-result (do-doc-result))]))
(module-test-external
(check-equal? (select 'key '#hash((key . "value"))) "value")
(check-false (select 'absent-key '#hash((key . "value"))))
(check-equal? (select 'key '(root (key "value"))) "value")
(check-false (select 'absent-key '(root (key "value"))))
(let ([metas '#hash((key . "value"))])
(check-equal? (select 'key metas) "value")
(check-false (select 'absent-key metas)))
(let ([doc '(root (key "value"))])
(check-equal? (select 'key doc) "value")
(check-false (select 'absent-key doc))))
(define+provide/contract (select* key value-source)
(coerce/symbol? (or/c hash? txexpr? pagenode? pathish?) . -> . (or/c #f txexpr-elements?))
@ -46,6 +58,11 @@
[else (get-metas metas-source)]))
(and (hash-has-key? metas key) (hash-ref metas key)))
(module-test-external
(let ([metas '#hash((key . "value"))])
(check-equal? (select-from-metas 'key metas) "value")
(check-false (select-from-metas 'absent-key metas))))
(define+provide/contract (select-from-doc key doc-source)
(coerce/symbol? (or/c txexpr? pagenode? pathish?) . -> . (or/c #f txexpr-elements?))
@ -55,6 +72,13 @@
(define result (se-path*/list (list key) doc))
(and (not (null? result)) result))
(module-test-external
(check-equal? (select-from-doc 'key '(root (key "value"))) '("value"))
(check-false (select-from-doc 'absent-key '(root (key "value"))))
(let ([doc '(root (key "value"))])
(check-equal? (select-from-doc 'key doc) '("value"))
(check-false (select-from-doc 'absent-key doc))))
(define (get-metas pagenode-or-path)
; ((or/c pagenode? pathish?) . -> . hash?)
@ -96,7 +120,23 @@
(if splice?
(trim-outer-tag html)
html))
(xexpr->html x)))
(xexpr->html x)))
(module-test-external
(define tx '(root (p "hello")))
(check-equal? (->html tx) "<root><p>hello</p></root>")
(check-equal? (->html #:tag 'brennan tx) "<brennan><p>hello</p></brennan>")
(check-equal? (->html #:attrs '((id "dale")) tx) "<root id=\"dale\"><p>hello</p></root>")
(check-equal? (->html #:splice #t tx) "<p>hello</p>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) tx) "<brennan id=\"dale\"><p>hello</p></brennan>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t tx) "<p>hello</p>")
(define x "hello")
(check-equal? (->html x) "hello")
(check-equal? (->html #:tag 'brennan x) "<brennan>hello</brennan>")
(check-exn exn:fail? (λ() (->html #:attrs '((id "dale")) x) "hello")) ;; won't work without tag
(check-equal? (->html #:splice #t x) "hello")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) x) "<brennan id=\"dale\">hello</brennan>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "hello"))
(provide when/block)
(define-syntax (when/block stx)

0
tests/samples/sample-01.html.pm → test-support/samples/sample-01.html.pm
Unescape Escape View File

0
tests/samples/sample-02.txt.pp → test-support/samples/sample-02.txt.pp
Unescape Escape View File

0
tests/samples/sample-03.txt.p → test-support/samples/sample-03.txt.p
Unescape Escape View File

0
tests/test.html.pm → test-support/test.html.pm
Unescape Escape View File

0
tests/test.html.pmd → test-support/test.html.pmd
Unescape Escape View File

0
tests/test.html.pp → test-support/test.html.pp
Unescape Escape View File

0
tests/test.no-ext → test-support/test.no-ext
Unescape Escape View File

0
tests/test.ptree → test-support/test.ptree
Unescape Escape View File

59
tests/test-file-tools.rkt
Unescape Escape View File

@ -1,59 +0,0 @@
#lang racket/base
(require rackunit "../file.rkt" "../world.rkt" sugar)
(check-true (sourceish? "foo.svg"))
(check-false (sourceish? "foo.gif"))
(check-true (urlish? (->path "/Users/MB/home.html")))
(check-true (urlish? "/Users/MB/home.html?foo=bar"))
(check-true (urlish? (->symbol "/Users/MB/home")))
(check-true (pathish? (->path "/Users/MB/home")))
(check-true (pathish? "/Users/MB/home"))
(check-true (pathish? (->symbol "/Users/MB/home")))
(check-true (directories-equal? "/Users/MB/foo" "/Users/MB/foo/"))
(check-false (directories-equal? "/Users/MB/foo" "Users/MB/foo"))
(check-equal? (get-enclosing-dir "/Users/MB/foo.txt") (->path "/Users/MB/"))
(check-equal? (get-enclosing-dir "/Users/MB/foo/") (->path "/Users/MB/"))
(check-true (has-binary-ext? "foo.MP3"))
(check-false (has-binary-ext? "foo.py"))
(check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar"))
(check-false (preproc-source? #f))
(check-true (pagetree-source? (format "foo.~a" world:pagetree-source-ext)))
(check-false (pagetree-source? (format "~a.foo" world:pagetree-source-ext)))
(check-false (pagetree-source? #f))
(check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p"))
(check-false (markup-source? #f))
(check-true (template-source? "foo.html.pt"))
(check-false (template-source? "foo.html"))
(check-false (template-source? #f))
(check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp"))
(check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp"))
(check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.pp"))
(check-equal? (->output-path (->path "foo.pmap")) (->path "foo.pmap"))
(check-equal? (->output-path "foo.html") (->path "foo.html"))
(check-equal? (->output-path 'foo.html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo.xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))
(check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm"))
(check-equal? (->markup-source-path (->path "foo.html")) (->path "foo.html.pm"))
(check-equal? (->markup-source-path "foo") (->path "foo.pm"))
(check-equal? (->markup-source-path 'foo) (->path "foo.pm"))

10
tests/test-langs.rkt
Unescape Escape View File

@ -32,11 +32,11 @@
;; define-runtime-path only allowed at top level
(define-runtime-path test.ptree "test.ptree")
(define-runtime-path test.html.pm "test.html.pm")
(define-runtime-path test.html.pmd "test.html.pmd")
(define-runtime-path test.html.pp "test.html.pp")
(define-runtime-path test.no-ext "test.no-ext")
(define-runtime-path test.ptree "../test-support/test.ptree")
(define-runtime-path test.html.pm "../test-support/test.html.pm")
(define-runtime-path test.html.pmd "../test-support/test.html.pmd")
(define-runtime-path test.html.pp "../test-support/test.html.pp")
(define-runtime-path test.no-ext "../test-support/test.no-ext")
;; `find-exe` avoids reliance on $PATH of the host system

61
tests/test-ptree.rkt
Unescape Escape View File

@ -1,61 +0,0 @@
#lang racket/base
(require rackunit)
(require "../pagetree.rkt" "../world.rkt")
(check-false (pagenode? "foo-bar"))
(check-false (pagenode? "Foo_Bar_0123"))
(check-true (pagenode? 'foo-bar))
(check-false (pagenode? "foo-bar.p"))
(check-false (pagenode? "/Users/MB/foo-bar"))
(check-false (pagenode? #f))
(check-false (pagenode? ""))
(check-false (pagenode? " "))
(check-true (pagetree? '(foo)))
(check-true (pagetree? '(foo (hee))))
(check-true (pagetree? '(foo (hee (uncle foo)))))
(check-false (pagetree? '(foo (hee hee (uncle foo)))))
(define test-pagetree `(pagetree-main foo bar (one (two three))))
;(define test-pagetree (pagetree-root->pagetree test-pagetree-main))
(check-equal? (parent 'three test-pagetree) 'two)
(check-equal? (parent "three" test-pagetree) 'two)
(check-false (parent #f test-pagetree))
(check-false (parent 'nonexistent-name test-pagetree))
(check-equal? (children 'one test-pagetree) '(two))
(check-equal? (children 'two test-pagetree) '(three))
(check-false (children 'three test-pagetree))
(check-false (children #f test-pagetree))
(check-false (children 'fooburger test-pagetree))
(check-equal? (siblings 'one test-pagetree) '(foo bar one))
(check-equal? (siblings 'foo test-pagetree) '(foo bar one))
(check-equal? (siblings 'two test-pagetree) '(two))
(check-false (siblings #f test-pagetree))
(check-false (siblings 'invalid-key test-pagetree))
(check-equal? (previous* 'one test-pagetree) '(foo bar))
(check-equal? (previous* 'three test-pagetree) '(foo bar one two))
(check-false (previous* 'foo test-pagetree))
(check-equal? (previous 'one test-pagetree) 'bar)
(check-equal? (previous 'three test-pagetree) 'two)
(check-false (previous 'foo test-pagetree))
(check-equal? (next 'foo test-pagetree) 'bar)
(check-equal? (next 'one test-pagetree) 'two)
(check-false (next 'three test-pagetree))
(check-equal? (pagetree->list test-pagetree) '(foo bar one two three))
(let ([sample-main `(world:pollen-tree-root-name foo bar (one (two three)))])
(check-equal? sample-main
`(world:pollen-tree-root-name foo bar (one (two three)))))

25
tests/test-render.rkt
Unescape Escape View File

@ -1,25 +0,0 @@
#lang racket/base
(require rackunit racket/runtime-path)
(require "../render.rkt")
(require/expose "../render.rkt" (modification-date-hash make-mod-dates-key path->mod-date-value store-render-in-modification-dates modification-date-expired?))
(check-pred hash? modification-date-hash)
(define-runtime-path sample-dir "samples")
(define samples (parameterize ([current-directory sample-dir])
(map path->complete-path (directory-list "."))))
(define-values (sample-01 sample-02 sample-03) (apply values samples))
(check-equal? (make-mod-dates-key samples) samples)
(check-false (path->mod-date-value (path->complete-path "garbage-path.zzz")))
(check-equal? (path->mod-date-value sample-01) (file-or-directory-modify-seconds sample-01))
(check-equal? (store-render-in-modification-dates sample-01 sample-02 sample-03) (void))
(check-true (hash-has-key? modification-date-hash (list sample-01 sample-02 sample-03)))
(check-true (modification-date-expired? sample-01)) ; because key hasn't been stored
(check-false (apply modification-date-expired? samples)) ; because files weren't changed

42
tests/test-template.rkt
Unescape Escape View File

@ -1,42 +0,0 @@
#lang racket/base
(require rackunit)
(require "../template.rkt")
(define tx '(root (p "hello")))
(check-equal? (->html tx) "<root><p>hello</p></root>")
(check-equal? (->html #:tag 'brennan tx) "<brennan><p>hello</p></brennan>")
(check-equal? (->html #:attrs '((id "dale")) tx) "<root id=\"dale\"><p>hello</p></root>")
(check-equal? (->html #:splice #t tx) "<p>hello</p>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) tx) "<brennan id=\"dale\"><p>hello</p></brennan>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t tx) "<p>hello</p>")
(define x "hello")
(check-equal? (->html x) "hello")
(check-equal? (->html #:tag 'brennan x) "<brennan>hello</brennan>")
(check-exn exn:fail? (λ() (->html #:attrs '((id "dale")) x) "hello")) ;; won't work without tag
(check-equal? (->html #:splice #t x) "hello")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) x) "<brennan id=\"dale\">hello</brennan>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "hello")
(check-equal? (select 'key '#hash((key . "value"))) "value")
(check-false (select 'absent-key '#hash((key . "value"))))
(let ([metas '#hash((key . "value"))])
(check-equal? (select 'key metas) "value")
(check-false (select 'absent-key metas))
(check-equal? (select-from-metas 'key metas) "value")
(check-false (select-from-metas 'absent-key metas)))
(check-equal? (select 'key '(root (key "value"))) "value")
(check-false (select 'absent-key '(root (key "value"))))
(check-equal? (select-from-doc 'key '(root (key "value"))) '("value"))
(check-false (select-from-doc 'absent-key '(root (key "value"))))
(let ([doc '(root (key "value"))])
(check-equal? (select 'key doc) "value")
(check-false (select 'absent-key doc))
(check-equal? (select-from-doc 'key doc) '("value"))
(check-false (select-from-doc 'absent-key doc)))

77
tests/tests-decode.rkt
Unescape Escape View File

@ -1,77 +0,0 @@
#lang racket/base
(require pollen/decode racket/format rackunit txexpr)
(check-true (begin (register-block-tag 'barfoo) (block-txexpr? '(barfoo "foo"))))
(check-equal? (smart-dashes "I had --- maybe 13 -- 20 --- hob-nobs.") "I had—maybe 13–20—hob-nobs.")
(check-equal? (smart-quotes "\"Why,\" she could've asked, \"are we in O‘ahu watching 'Mame'?\"")
"“Why,” she could’ve asked, “are we in O‘ahu watching ‘Mame’?”")
(check-equal? (smart-quotes "\"\'Impossible.\' Yes.\"") "“‘Impossible.’ Yes.”")
;; todo: make some tougher tests, it gets flaky with edge cases
(check-equal? (nonbreaking-last-space '(p "Hi there")) '(p "Hi " "there")) ; nbsp in between last two words
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "Ø") '(p "HiØ" "there")) ; but let's make it visible
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_") '(p "Hi_up_" "there"))
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_" #:minimum-word-length 3)
'(p "Hi " "there"))
(check-equal? (nonbreaking-last-space '(p "Hi here" (em "ho there")) #:nbsp "Ø") '(p "Hi here" (em "hoØ" "there")))
(check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "“" "Hi\" there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (squo "‘" "Hi' there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there") #:single-prepend '(foo ((bar "ino"))))
'(p (foo ((bar "ino")) "‘" "Hi' there")))
;; make sure txexpr without elements passes through unscathed
(check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em"))))
(check-equal? (detect-linebreaks '("foo" "\n" "bar")) '("foo" (br) "bar"))
(check-equal? (detect-linebreaks '("\n" "foo" "\n" "bar" "\n")) '("\n" "foo" (br) "bar" "\n"))
(check-equal? (detect-linebreaks '((p "foo") "\n" (p "bar"))) '((p "foo") (p "bar")))
(check-equal? (detect-linebreaks '("foo" "\n" (p "bar"))) '("foo" (p "bar")))
(check-equal? (detect-linebreaks '("foo" "moo" "bar")) '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "moo" "bar") #:insert "moo") '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "\n\n" "bar")) '("foo" "\n\n" "bar"))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para"))
'((p "First para") (p "Second para")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line"))
'((p "First para") (p "Second para" (br) "Second line")))
(check-equal? (detect-paragraphs '("First para" "\n\n" (div "Second block")))
'((p "First para") (div "Second block")))
(check-equal? (detect-paragraphs '((div "First block") "\n\n" (div "Second block")))
'((div "First block") (div "Second block")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para") #:tag 'ns:p)
'((ns:p "First para") (ns:p "Second para")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (detect-linebreaks x #:insert '(newline))))
'((p "First para") (p "Second para" (newline) "Second line")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (detect-paragraphs '("foo")) '("foo"))
(check-equal? (detect-paragraphs '("foo") #:force? #t) '((p "foo")))
(check-equal? (detect-paragraphs '((div "foo"))) '((div "foo")))
(check-equal? (detect-paragraphs '((div "foo")) #:force? #t) '((div "foo")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar")) #:force? #t) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar") "zam")) '((p "foo") (div "bar") (p "zam")))
(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam")) '((p "foo" (span "zing")) (div "bar") (p "zam")))
(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam") #:force? #t) '((p "foo" (span "zing")) (div "bar") (p "zam")))
(check-equal? (merge-newlines '(p "\n" "foo" "\n" "\n" "bar" (em "\n" "\n" "\n")))
'(p "\n" "foo" "\n\n" "bar" (em "\n\n\n")))
(check-true (whitespace? " "))
(check-false (whitespace? (~a #\u00A0)))
(check-true (whitespace/nbsp? (~a #\u00A0)))
(check-true (whitespace/nbsp? (vector (~a #\u00A0))))
(check-false (whitespace? (format " ~a " #\u00A0)))
(check-true (whitespace/nbsp? (format " ~a " #\u00A0)))
Write Preview
Loading…
Cancel
Save