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 10 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