From f048dabc37c4d3040a39084562084d8378dcbf48 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 14 Jun 2015 21:30:38 -0500 Subject: [PATCH] refactor & relocate unit tests --- decode.rkt | 83 +++++++++++++++++-- file.rkt | 53 +++++++++++- info.rkt | 1 + pagetree.rkt | 66 +++++++++++++++ render.rkt | 26 +++++- template.rkt | 46 +++++++++- .../samples/sample-01.html.pm | 0 .../samples/sample-02.txt.pp | 0 .../samples/sample-03.txt.p | 0 {tests => test-support}/test.html.pm | 0 {tests => test-support}/test.html.pmd | 0 {tests => test-support}/test.html.pp | 0 {tests => test-support}/test.no-ext | 0 {tests => test-support}/test.ptree | 0 tests/test-file-tools.rkt | 59 ------------- tests/test-langs.rkt | 10 +-- tests/test-ptree.rkt | 61 -------------- tests/test-render.rkt | 25 ------ tests/test-template.rkt | 42 ---------- tests/tests-decode.rkt | 77 ----------------- 20 files changed, 268 insertions(+), 281 deletions(-) rename {tests => test-support}/samples/sample-01.html.pm (100%) rename {tests => test-support}/samples/sample-02.txt.pp (100%) rename {tests => test-support}/samples/sample-03.txt.p (100%) rename {tests => test-support}/test.html.pm (100%) rename {tests => test-support}/test.html.pmd (100%) rename {tests => test-support}/test.html.pp (100%) rename {tests => test-support}/test.no-ext (100%) rename {tests => test-support}/test.ptree (100%) delete mode 100644 tests/test-file-tools.rkt delete mode 100644 tests/test-ptree.rkt delete mode 100644 tests/test-render.rkt delete mode 100644 tests/test-template.rkt delete mode 100644 tests/tests-decode.rkt diff --git a/decode.rkt b/decode.rkt index c4cf994..9fd5f10 100644 --- a/decode.rkt +++ b/decode.rkt @@ -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")))) \ No newline at end of file diff --git a/file.rkt b/file.rkt index 5478f0a..4a550e4 100644 --- a/file.rkt +++ b/file.rkt @@ -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?) diff --git a/info.rkt b/info.rkt index 2040027..17df336 100644 --- a/info.rkt +++ b/info.rkt @@ -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")) diff --git a/pagetree.rkt b/pagetree.rkt index 296d5d8..b011e3f 100644 --- a/pagetree.rkt +++ b/pagetree.rkt @@ -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?) diff --git a/render.rkt b/render.rkt index a62ae61..95f7513 100644 --- a/render.rkt +++ b/render.rkt @@ -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) diff --git a/template.rkt b/template.rkt index 04495dd..792df99 100644 --- a/template.rkt +++ b/template.rkt @@ -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) "

hello

") + (check-equal? (->html #:tag 'brennan tx) "

hello

") + (check-equal? (->html #:attrs '((id "dale")) tx) "

hello

") + (check-equal? (->html #:splice #t tx) "

hello

") + (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) tx) "

hello

") + (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t tx) "

hello

") + (define x "hello") + (check-equal? (->html x) "hello") + (check-equal? (->html #:tag 'brennan x) "hello") + (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) "hello") + (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "hello")) (provide when/block) (define-syntax (when/block stx) diff --git a/tests/samples/sample-01.html.pm b/test-support/samples/sample-01.html.pm similarity index 100% rename from tests/samples/sample-01.html.pm rename to test-support/samples/sample-01.html.pm diff --git a/tests/samples/sample-02.txt.pp b/test-support/samples/sample-02.txt.pp similarity index 100% rename from tests/samples/sample-02.txt.pp rename to test-support/samples/sample-02.txt.pp diff --git a/tests/samples/sample-03.txt.p b/test-support/samples/sample-03.txt.p similarity index 100% rename from tests/samples/sample-03.txt.p rename to test-support/samples/sample-03.txt.p diff --git a/tests/test.html.pm b/test-support/test.html.pm similarity index 100% rename from tests/test.html.pm rename to test-support/test.html.pm diff --git a/tests/test.html.pmd b/test-support/test.html.pmd similarity index 100% rename from tests/test.html.pmd rename to test-support/test.html.pmd diff --git a/tests/test.html.pp b/test-support/test.html.pp similarity index 100% rename from tests/test.html.pp rename to test-support/test.html.pp diff --git a/tests/test.no-ext b/test-support/test.no-ext similarity index 100% rename from tests/test.no-ext rename to test-support/test.no-ext diff --git a/tests/test.ptree b/test-support/test.ptree similarity index 100% rename from tests/test.ptree rename to test-support/test.ptree diff --git a/tests/test-file-tools.rkt b/tests/test-file-tools.rkt deleted file mode 100644 index 193cbe6..0000000 --- a/tests/test-file-tools.rkt +++ /dev/null @@ -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")) \ No newline at end of file diff --git a/tests/test-langs.rkt b/tests/test-langs.rkt index 7213df7..2419149 100644 --- a/tests/test-langs.rkt +++ b/tests/test-langs.rkt @@ -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 diff --git a/tests/test-ptree.rkt b/tests/test-ptree.rkt deleted file mode 100644 index 1b66746..0000000 --- a/tests/test-ptree.rkt +++ /dev/null @@ -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))))) - - - diff --git a/tests/test-render.rkt b/tests/test-render.rkt deleted file mode 100644 index 6a12252..0000000 --- a/tests/test-render.rkt +++ /dev/null @@ -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 - - diff --git a/tests/test-template.rkt b/tests/test-template.rkt deleted file mode 100644 index 4d73376..0000000 --- a/tests/test-template.rkt +++ /dev/null @@ -1,42 +0,0 @@ -#lang racket/base -(require rackunit) -(require "../template.rkt") - -(define tx '(root (p "hello"))) - -(check-equal? (->html tx) "

hello

") -(check-equal? (->html #:tag 'brennan tx) "

hello

") -(check-equal? (->html #:attrs '((id "dale")) tx) "

hello

") -(check-equal? (->html #:splice #t tx) "

hello

") -(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) tx) "

hello

") -(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t tx) "

hello

") - -(define x "hello") - -(check-equal? (->html x) "hello") -(check-equal? (->html #:tag 'brennan x) "hello") -(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) "hello") -(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))) diff --git a/tests/tests-decode.rkt b/tests/tests-decode.rkt deleted file mode 100644 index ee200a3..0000000 --- a/tests/tests-decode.rkt +++ /dev/null @@ -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))) \ No newline at end of file