Compare commits
2 commits
cd5d7afc96
...
bec53ee0a6
Author | SHA1 | Date | |
---|---|---|---|
bec53ee0a6 | |||
457cfa9763 |
50
block.fnl
50
block.fnl
|
@ -42,7 +42,8 @@
|
||||||
{:name "Paragraph"
|
{:name "Paragraph"
|
||||||
:regex ".-\n"}])
|
:regex ".-\n"}])
|
||||||
|
|
||||||
(fn block-lexer [contents grammar]
|
(fn block-lexer [contents grammar ?debug]
|
||||||
|
(var d (or ?debug false))
|
||||||
(var current 1)
|
(var current 1)
|
||||||
(var blocks [])
|
(var blocks [])
|
||||||
(var current-block-type nil)
|
(var current-block-type nil)
|
||||||
|
@ -53,31 +54,36 @@
|
||||||
(let [start (string.find contents "\n" current)
|
(let [start (string.find contents "\n" current)
|
||||||
current-str (string.sub contents current start)]
|
current-str (string.sub contents current start)]
|
||||||
(each [_ g (ipairs grammar) &until matched]
|
(each [_ g (ipairs grammar) &until matched]
|
||||||
(print (.. "Current: " current))
|
(if d
|
||||||
(print (.. "Start: " start))
|
(do
|
||||||
(print (.. "Current-str: " current-str))
|
(print (.. "Current: " current))
|
||||||
(print (.. "checking regex: " (if (not capture-mode)
|
(print (.. "Start: " start))
|
||||||
(. g :regex)
|
(print (.. "Current-str: " current-str))
|
||||||
(tostring (. g :mode-regex)))))
|
(print (.. "checking regex: " (if (not capture-mode)
|
||||||
|
(. g :regex)
|
||||||
|
(tostring (. g :mode-regex)))))))
|
||||||
(let [m (if (not capture-mode)
|
(let [m (if (not capture-mode)
|
||||||
(string.match current-str (. g :regex)) ; We're not in previous capture mode
|
(string.match current-str (. g :regex)) ; We're not in previous capture mode
|
||||||
(if (= (. g :name) current-block-type) ; And the regex we're checking is the one we want
|
(if (= (. g :name) current-block-type) ; And the regex we're checking is the one we want
|
||||||
(string.match current-str (. g :mode-regex)) ; Use the mode specific regex
|
(string.match current-str (. g :mode-regex)) ; Use the mode specific regex
|
||||||
nil))] ; Or don't check
|
nil))] ; Or don't check
|
||||||
(print (.. "M: " (tostring m)))
|
(if d
|
||||||
|
(print (.. "M: " (tostring m))))
|
||||||
(if (not (= nil m)) ; This is a match or move on
|
(if (not (= nil m)) ; This is a match or move on
|
||||||
(do
|
(do
|
||||||
(set matched true)
|
(set matched true)
|
||||||
(if
|
(if
|
||||||
capture-mode ; We matched and it's capture-mode, so we end capture mode
|
capture-mode ; We matched and it's capture-mode, so we end capture mode
|
||||||
(do
|
(do
|
||||||
(print "Capture-mode completed")
|
|
||||||
(set current-block (.. current-block current-str "\n"))
|
(set current-block (.. current-block current-str "\n"))
|
||||||
(table.insert blocks {:type current-block-type
|
(table.insert blocks {:type current-block-type
|
||||||
:block current-block})
|
:block current-block})
|
||||||
(print (.. "Inserted into table: " current-block))
|
|
||||||
(set current-block "")
|
(set current-block "")
|
||||||
(print (.. "New current-block: " current-block))
|
(if d
|
||||||
|
(do
|
||||||
|
(print "Capture-mode completed")
|
||||||
|
(print (.. "Inserted into table: " current-block))
|
||||||
|
(print (.. "New current-block: " current-block))))
|
||||||
(set capture-mode nil)
|
(set capture-mode nil)
|
||||||
(set current-block-type nil))
|
(set current-block-type nil))
|
||||||
(or ; We append to the current block
|
(or ; We append to the current block
|
||||||
|
@ -88,29 +94,35 @@
|
||||||
(set current-block-type (. g :name))
|
(set current-block-type (. g :name))
|
||||||
(set capture-mode (. g :capture-mode))
|
(set capture-mode (. g :capture-mode))
|
||||||
(set current-block (.. current-block current-str "\n"))
|
(set current-block (.. current-block current-str "\n"))
|
||||||
(print (.. "Set current-block: " current-block)))
|
(if d
|
||||||
|
(print (.. "Set current-block: " current-block))))
|
||||||
(do ; Else we start a new block, and insert our accumulation
|
(do ; Else we start a new block, and insert our accumulation
|
||||||
(table.insert blocks {:type current-block-type
|
(table.insert blocks {:type current-block-type
|
||||||
:block current-block})
|
:block current-block})
|
||||||
(print (.. "Inserted into table: " current-block))
|
|
||||||
(set current-block current-str)
|
(set current-block current-str)
|
||||||
(print (.. "New current-block: " current-block))
|
|
||||||
(set capture-mode (. g :capture-mode))
|
(set capture-mode (. g :capture-mode))
|
||||||
(print (.. "New Capture-mode: " (tostring (. g :capture-mode))))
|
(if d
|
||||||
|
(do
|
||||||
|
(print (.. "Inserted into table: " current-block))
|
||||||
|
(print (.. "New current-block: " current-block))
|
||||||
|
(print (.. "New Capture-mode: " (tostring (. g :capture-mode))))))
|
||||||
(set current-block-type (. g :name))))
|
(set current-block-type (. g :name))))
|
||||||
(set current (+ 1 start)))
|
(set current (+ 1 start)))
|
||||||
(if (and ; We didn't match, BUT
|
(if (and ; We didn't match, BUT
|
||||||
capture-mode ; Or we're in capture mode
|
capture-mode ; Or we're in capture mode
|
||||||
(= (. g :name) current-block-type)) ; And are testing the right regex (should be implicitly true if we reached here)
|
(= (. g :name) current-block-type)) ; And are testing the right regex (should be implicitly true if we reached here)
|
||||||
(do
|
(do
|
||||||
(print (.. "Didnt match capture-mode regex, appending anyway"))
|
|
||||||
(set current-block (.. current-block current-str "\n"))
|
(set current-block (.. current-block current-str "\n"))
|
||||||
(print (.. "New current-block: " current-block))
|
|
||||||
(set matched true) ; We don't need to check the others
|
(set matched true) ; We don't need to check the others
|
||||||
(set current (+ 1 start)))))))))
|
(set current (+ 1 start))
|
||||||
|
(if d
|
||||||
|
(do
|
||||||
|
(print (.. "Didnt match capture-mode regex, appending anyway"))
|
||||||
|
(print (.. "New current-block: " current-block)))))))))))
|
||||||
(if current-block-type
|
(if current-block-type
|
||||||
(do
|
(do
|
||||||
(print "End of file reached, unloading current")
|
(if d
|
||||||
|
(print "End of file reached, unloading current"))
|
||||||
(table.insert blocks {:type current-block-type
|
(table.insert blocks {:type current-block-type
|
||||||
:block current-block})))
|
:block current-block})))
|
||||||
blocks)
|
blocks)
|
||||||
|
|
20
main.fnl
20
main.fnl
|
@ -5,17 +5,21 @@
|
||||||
(local inline (require :inline))
|
(local inline (require :inline))
|
||||||
(local render (require :render))
|
(local render (require :render))
|
||||||
|
|
||||||
(local test-input "= Big Test File =\n%title Some Title\n:note:\n*This* is a paragraph.\n- This\n- List\n- Should\n- Be One\n-----\n= A new Section Title =\n![Has an Image](file:///link-to-image.png)\n> With some quoted matieral\n>Across multiple lines\n > and different indents\n\n{{{python \n def file(arg, other):\n rturn rg + other\n}}}\n\nMore Paragraphs\n-----\n\nThis has a footnote [#]_ \n\n:: \n\n- This is the first note\n-This is the second\n::\n")
|
|
||||||
|
|
||||||
(fn write-file [text]
|
(fn write-file [text]
|
||||||
(_G.pp text)
|
(_G.pp text)
|
||||||
(let [f (assert (io.open "./test.html" :w))]
|
(let [f (assert (io.open "./test.html" :w))]
|
||||||
(f:write text)
|
(f:write text)
|
||||||
(f:close)))
|
(f:close)))
|
||||||
|
|
||||||
(let [inline-blocks (-> test-input
|
(fn render-to-html [input]
|
||||||
(blocks.lexer blocks.grammar)
|
(let [b-blocks (-> input
|
||||||
(inline.inline-lexer inline.inline-grammar))
|
(blocks.lexer blocks.grammar))
|
||||||
(html metadata) (render.render inline-blocks render.render-grammar)]
|
inline-blocks (inline.inline-lexer b-blocks inline.inline-grammar)
|
||||||
(_G.pp html)
|
(html metadata) (render.render inline-blocks render.render-grammar)]
|
||||||
(write-file html))
|
; (_G.pp b-blocks)
|
||||||
|
; (_G.pp inline-blocks)
|
||||||
|
; (_G.pp metadata)
|
||||||
|
(values html metadata)))
|
||||||
|
|
||||||
|
{: write-file
|
||||||
|
: render-to-html}
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
(var footnote-counter 1)
|
(var footnote-counter 1)
|
||||||
|
|
||||||
(fn render-contents [contents]
|
(fn render-contents [contents]
|
||||||
(var rendered "<p>\n")
|
(var rendered "<p>")
|
||||||
(each [_ line (ipairs contents)]
|
(each [_ line (ipairs contents)]
|
||||||
(_G.pp line)
|
(_G.pp line)
|
||||||
(match (. line :type)
|
(match (. line :type)
|
||||||
|
@ -15,9 +15,9 @@
|
||||||
"Monospace" (set rendered (.. rendered "<code>" line.text "</code>\n"))
|
"Monospace" (set rendered (.. rendered "<code>" line.text "</code>\n"))
|
||||||
"Link" (set rendered (.. rendered "<a href=\"" line.destination "\" class=\"" line.class "\">" line.title "</a>\n"))
|
"Link" (set rendered (.. rendered "<a href=\"" line.destination "\" class=\"" line.class "\">" line.title "</a>\n"))
|
||||||
"Footnote-Link" (do
|
"Footnote-Link" (do
|
||||||
(set rendered (.. rendered "<sup>\n<a href=fn:" (tostring footnote-counter) " id=fnref:" (tostring footnote-counter) ">note " (tostring footnote-counter) "</a>\n</sup>\n"))
|
(set rendered (.. rendered "<sup>\n<a href=fn:" (tostring footnote-counter) " id=fnref:" (tostring footnote-counter) ">[" (tostring footnote-counter) "]</a>\n</sup>\n"))
|
||||||
(set footnote-counter (+ footnote-counter 1)))))
|
(set footnote-counter (+ footnote-counter 1)))))
|
||||||
(.. rendered "</p>\n"))
|
(.. rendered "</p>"))
|
||||||
|
|
||||||
(local render-grammar
|
(local render-grammar
|
||||||
{:Header (fn render-header [{: contents : size}]
|
{:Header (fn render-header [{: contents : size}]
|
||||||
|
@ -86,8 +86,8 @@
|
||||||
(each [_ element (ipairs elements)]
|
(each [_ element (ipairs elements)]
|
||||||
(let [contents-render (render-contents element.contents)]
|
(let [contents-render (render-contents element.contents)]
|
||||||
(set rendered (.. rendered "<li id=fn:" count ">\n"))
|
(set rendered (.. rendered "<li id=fn:" count ">\n"))
|
||||||
(set rendered (.. rendered "<a href=\"#fnref:" count "\">Back</a>\n"))
|
|
||||||
(set rendered (.. rendered contents-render "</li>\n"))
|
(set rendered (.. rendered contents-render "</li>\n"))
|
||||||
|
(set rendered (.. rendered "<a href=\"#fnref:" count "\">Back</a>\n"))
|
||||||
(set count (+ count 1))))
|
(set count (+ count 1))))
|
||||||
(.. rendered "</ol>\n"))})
|
(.. rendered "</ol>\n"))})
|
||||||
|
|
||||||
|
|
12
test/data/lists.incd
Normal file
12
test/data/lists.incd
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
= The List Page =
|
||||||
|
|
||||||
|
- First Element
|
||||||
|
- Second Element
|
||||||
|
- Sub element
|
||||||
|
- Second Sub Element
|
||||||
|
- Third sub element
|
||||||
|
- Third Element
|
||||||
|
|
||||||
|
- This is the second list
|
||||||
|
- With only single layer
|
||||||
|
- And three elements
|
0
test/data/sections.incd
Normal file
0
test/data/sections.incd
Normal file
301
test/faith.fnl
Normal file
301
test/faith.fnl
Normal file
|
@ -0,0 +1,301 @@
|
||||||
|
;;; faith.fnl --- The Fennel Advanced Interactive Test Helper
|
||||||
|
|
||||||
|
;; https://git.sr.ht/~technomancy/faith
|
||||||
|
|
||||||
|
;; SPDX-License-Identifier: MIT
|
||||||
|
;; SPDX-FileCopyrightText: Scott Vokes, Phil Hagelberg, and contributors
|
||||||
|
|
||||||
|
;; To use Faith, create a test runner file which calls the `run` function with
|
||||||
|
;; a list of module names. The modules should export functions whose
|
||||||
|
;; names start with `test-` and which call the assertion functions in the
|
||||||
|
;; `faith` module.
|
||||||
|
|
||||||
|
;; Copyright © 2009-2013 Scott Vokes and contributors
|
||||||
|
;; Copyright © 2023 Phil Hagelberg and contributors
|
||||||
|
|
||||||
|
;; Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
;; of this software and associated documentation files (the "Software"), to deal
|
||||||
|
;; in the Software without restriction, including without limitation the rights
|
||||||
|
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||||
|
;; copies of the Software, and to permit persons to whom the Software is
|
||||||
|
;; furnished to do so, subject to the following conditions:
|
||||||
|
|
||||||
|
;; The above copyright notice and this permission notice shall be included in
|
||||||
|
;; all copies or substantial portions of the Software.
|
||||||
|
|
||||||
|
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||||
|
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||||
|
;; SOFTWARE.
|
||||||
|
|
||||||
|
(local fennel (require :fennel))
|
||||||
|
|
||||||
|
;;; helper functions
|
||||||
|
|
||||||
|
(local unpack (or table.unpack _G.unpack))
|
||||||
|
|
||||||
|
(fn now []
|
||||||
|
{:real (or (and (pcall require :socket)
|
||||||
|
(package.loaded.socket.gettime))
|
||||||
|
(and (pcall require :posix)
|
||||||
|
(package.loaded.posix.gettimeofday)
|
||||||
|
(let [t (package.loaded.posix.gettimeofday)]
|
||||||
|
(+ t.sec (/ t.usec 1000000))))
|
||||||
|
nil)
|
||||||
|
:approx (os.time)
|
||||||
|
:cpu (os.clock)})
|
||||||
|
|
||||||
|
(fn result-table [name]
|
||||||
|
{:started-at (now) :err [] :fail [] : name :pass [] :skip [] :ran 0 :tests []})
|
||||||
|
|
||||||
|
(fn combine-results [to from]
|
||||||
|
(each [_ s (ipairs [:pass :fail :skip :err])]
|
||||||
|
(each [name val (pairs (. from s))]
|
||||||
|
(tset (. to s) name val))))
|
||||||
|
|
||||||
|
(fn fn? [v] (= (type v) :function))
|
||||||
|
|
||||||
|
(fn count [t] (accumulate [c 0 _ (pairs t)] (+ c 1)))
|
||||||
|
|
||||||
|
(fn fail->string [{: where : reason : msg} name]
|
||||||
|
(string.format "FAIL: %s: %s\n %s%s\n"
|
||||||
|
where name (or reason "")
|
||||||
|
(or (and msg (.. " - " (tostring msg))) "")))
|
||||||
|
|
||||||
|
(fn err->string [{: msg} name]
|
||||||
|
(or msg (string.format "ERROR (in %s, couldn't get traceback)"
|
||||||
|
(or name "(unknown)"))))
|
||||||
|
|
||||||
|
(fn get-where [start]
|
||||||
|
(let [traceback (fennel.traceback nil start)
|
||||||
|
(_ _ where) (traceback:find "\n *([^:]+:[0-9]+):")]
|
||||||
|
(or where "?")))
|
||||||
|
|
||||||
|
;;; assertions
|
||||||
|
|
||||||
|
;; while I'd prefer to remove all top-level state, this one is difficult
|
||||||
|
;; because it has to be set by every assertion, and the assertion functions
|
||||||
|
;; themselves do not have access to any stateful arguments given that they
|
||||||
|
;; are called directly from user code.
|
||||||
|
(var checked 0)
|
||||||
|
|
||||||
|
(macro wrap [flag msg ...]
|
||||||
|
`(do (set ,(sym :checked) (+ ,(sym :checked) 1))
|
||||||
|
(when (not ,flag)
|
||||||
|
(error {:char "F" :type :fail :tostring fail->string
|
||||||
|
:reason (string.format ,...) :msg ,msg :where (get-where 4)}))))
|
||||||
|
|
||||||
|
(fn pass [] {:char "." :type :pass})
|
||||||
|
|
||||||
|
(fn error-result [msg] {:char "E" :type :err :tostring err->string :msg msg})
|
||||||
|
|
||||||
|
(fn skip []
|
||||||
|
(error {:char :s :type :skip}))
|
||||||
|
|
||||||
|
(fn is [got ?msg]
|
||||||
|
(wrap got ?msg "Expected truthy value"))
|
||||||
|
|
||||||
|
(fn error-match [pat f ?msg]
|
||||||
|
(case (pcall f)
|
||||||
|
(true ?val) (wrap false ?msg "Expected an error, got %s" (fennel.view ?val))
|
||||||
|
(_ err) (let [err-string (if (= (type err) :string) err (fennel.view err))]
|
||||||
|
(wrap (: err-string :match pat) ?msg
|
||||||
|
"Expected error to match pattern %s, was %s"
|
||||||
|
pat err-string))))
|
||||||
|
|
||||||
|
(fn extra-fields? [t keys]
|
||||||
|
(or (accumulate [extra? false k (pairs t) &until extra?]
|
||||||
|
(if (= nil (. keys k))
|
||||||
|
true
|
||||||
|
(tset keys k nil)))
|
||||||
|
(next keys)))
|
||||||
|
|
||||||
|
(fn table= [x y equal?]
|
||||||
|
(let [keys {}]
|
||||||
|
(and (accumulate [same? true k v (pairs x) &until (not same?)]
|
||||||
|
(do (tset keys k true)
|
||||||
|
(equal? v (. y k))))
|
||||||
|
(not (extra-fields? y keys)))))
|
||||||
|
|
||||||
|
(fn equal? [x y]
|
||||||
|
(or (= x y)
|
||||||
|
(and (= (type x) :table (type y)) (table= x y equal?))))
|
||||||
|
|
||||||
|
(fn =* [exp got ?msg]
|
||||||
|
(wrap (equal? exp got) ?msg "Expected %s, got %s"
|
||||||
|
(fennel.view exp) (fennel.view got)))
|
||||||
|
|
||||||
|
(fn not=* [exp got ?msg]
|
||||||
|
(wrap (not (equal? exp got)) ?msg "Expected something other than %s"
|
||||||
|
(fennel.view exp)))
|
||||||
|
|
||||||
|
(fn <* [...]
|
||||||
|
(let [args [...]
|
||||||
|
msg (if (= :string (type (. args (length args)))) (table.remove args))
|
||||||
|
correct? (faccumulate [ok? true i 2 (length args) &until (not ok?)]
|
||||||
|
(< (. args (- i 1)) (. args i)))]
|
||||||
|
(wrap correct? msg
|
||||||
|
"Expected arguments in strictly increasing order, got %s"
|
||||||
|
(fennel.view args))))
|
||||||
|
|
||||||
|
(fn <=* [...]
|
||||||
|
(let [args [...]
|
||||||
|
msg (if (= :string (type (. args (length args)))) (table.remove args))
|
||||||
|
correct? (faccumulate [ok? true i 2 (length args) &until (not ok?)]
|
||||||
|
(<= (. args (- i 1)) (. args i)))]
|
||||||
|
(wrap correct? msg
|
||||||
|
"Expected arguments in increasing/equal order, got %s"
|
||||||
|
(fennel.view args))))
|
||||||
|
|
||||||
|
(fn almost= [exp got tolerance ?msg]
|
||||||
|
(wrap (<= (math.abs (- exp got)) tolerance) ?msg
|
||||||
|
"Expected %s +/- %s, got %s" exp tolerance got))
|
||||||
|
|
||||||
|
(fn identical [exp got ?msg]
|
||||||
|
(wrap (= exp got) ?msg
|
||||||
|
"Expected %s, got %s" (fennel.view exp) (fennel.view got)))
|
||||||
|
|
||||||
|
(fn match* [pat s ?msg]
|
||||||
|
(wrap (: (tostring s) :match pat) ?msg
|
||||||
|
"Expected string to match pattern %s, was\n%s" pat s))
|
||||||
|
|
||||||
|
(fn not-match [pat s ?msg]
|
||||||
|
(wrap (or (not= (type s) :string) (not (s:match pat))) ?msg
|
||||||
|
"Expected string not to match pattern %s, was\n %s" pat s))
|
||||||
|
|
||||||
|
;;; running
|
||||||
|
|
||||||
|
(fn dot [c ran]
|
||||||
|
(io.write c)
|
||||||
|
(when (= 0 (math.fmod ran 76))
|
||||||
|
(io.write "\n"))
|
||||||
|
(io.stdout:flush))
|
||||||
|
|
||||||
|
(fn print-totals [{: pass : fail : skip : err : started-at : ended-at}]
|
||||||
|
(let [duration (fn [start end]
|
||||||
|
(let [decimal-places 2]
|
||||||
|
(: (.. "%." (tonumber decimal-places) "f")
|
||||||
|
:format
|
||||||
|
(math.max (- end start)
|
||||||
|
(^ 10 (- decimal-places))))))]
|
||||||
|
(print (: (.. "Testing finished %s with %d assertion(s)\n"
|
||||||
|
"%d passed, %d failed, %d error(s), %d skipped\n"
|
||||||
|
"%.2f second(s) of CPU time used")
|
||||||
|
:format
|
||||||
|
(if started-at.real
|
||||||
|
(: "in %s second(s)" :format
|
||||||
|
(duration started-at.real ended-at.real))
|
||||||
|
(: "in approximately %s second(s)" :format
|
||||||
|
(- ended-at.approx started-at.approx)))
|
||||||
|
checked
|
||||||
|
(count pass) (count fail) (count err) (count skip)
|
||||||
|
(duration started-at.cpu ended-at.cpu)))))
|
||||||
|
|
||||||
|
(fn begin-module [s-env tests]
|
||||||
|
(print (string.format "\nStarting module %s with %d test(s)"
|
||||||
|
s-env.name (count tests))))
|
||||||
|
(fn done [results]
|
||||||
|
(print "\n")
|
||||||
|
(each [_ ts (ipairs [results.fail results.err results.skip])]
|
||||||
|
(each [name result (pairs ts)]
|
||||||
|
(when result.tostring (print (result:tostring name)))))
|
||||||
|
(print-totals results))
|
||||||
|
|
||||||
|
(local default-hooks {:begin false
|
||||||
|
: done
|
||||||
|
: begin-module
|
||||||
|
:end-module false
|
||||||
|
:begin-test false
|
||||||
|
:end-test (fn [_name result ran] (dot result.char ran))})
|
||||||
|
|
||||||
|
(fn test-key? [k]
|
||||||
|
(and (= (type k) :string) (k:match :^test.*)))
|
||||||
|
|
||||||
|
(local ok-types {:fail true :pass true :skip true})
|
||||||
|
|
||||||
|
(fn err-handler [name]
|
||||||
|
(fn [e]
|
||||||
|
(if (and (= (type e) :table) (. ok-types e.type))
|
||||||
|
e
|
||||||
|
(error-result (-> (string.format "\nERROR: %s:\n%s\n" name e)
|
||||||
|
(fennel.traceback 4))))))
|
||||||
|
|
||||||
|
(fn run-test [name ?setup test ?teardown module-result hooks context]
|
||||||
|
(when (fn? hooks.begin-test) (hooks.begin-test name))
|
||||||
|
(let [started-at (now)
|
||||||
|
result (case-try (if ?setup (xpcall ?setup (err-handler name)) true)
|
||||||
|
true (xpcall #(test (unpack context)) (err-handler name))
|
||||||
|
true (pass)
|
||||||
|
(catch (_ err) err))]
|
||||||
|
(when ?teardown (pcall ?teardown (unpack context)))
|
||||||
|
(tset module-result result.type name result)
|
||||||
|
(set module-result.ran (+ module-result.ran 1))
|
||||||
|
(when (fn? hooks.end-test) (hooks.end-test name result module-result.ran))))
|
||||||
|
|
||||||
|
(fn run-setup-all [setup-all results module-name]
|
||||||
|
(if (fn? setup-all)
|
||||||
|
(case [(pcall setup-all)]
|
||||||
|
[true & context] context
|
||||||
|
[false err] (let [msg (: "ERROR in test module %s setup-all: %s"
|
||||||
|
:format module-name err)]
|
||||||
|
(tset results.err module-name (error-result msg))
|
||||||
|
(values nil err)))
|
||||||
|
[]))
|
||||||
|
|
||||||
|
(fn run-module [hooks results module-name test-module]
|
||||||
|
(assert (= :table (type test-module)) (.. "test module must be table: "
|
||||||
|
module-name))
|
||||||
|
(let [result (result-table module-name)]
|
||||||
|
(case (run-setup-all test-module.setup-all results module-name)
|
||||||
|
context (do
|
||||||
|
(when hooks.begin-module (hooks.begin-module result test-module))
|
||||||
|
(each [name test (pairs test-module)]
|
||||||
|
(when (test-key? name)
|
||||||
|
(table.insert result.tests test)
|
||||||
|
(run-test name
|
||||||
|
test-module.setup
|
||||||
|
test
|
||||||
|
test-module.teardown
|
||||||
|
result
|
||||||
|
hooks
|
||||||
|
context)))
|
||||||
|
(case test-module.teardown-all
|
||||||
|
teardown (pcall teardown (unpack context)))
|
||||||
|
(when hooks.end-module (hooks.end-module result))
|
||||||
|
(combine-results results result)))))
|
||||||
|
|
||||||
|
(fn exit [hooks]
|
||||||
|
(if hooks.exit (hooks.exit 1)
|
||||||
|
_G.___replLocals___ :failed
|
||||||
|
(and os os.exit) (os.exit 1)))
|
||||||
|
|
||||||
|
(fn run [module-names ?hooks]
|
||||||
|
(set checked 0)
|
||||||
|
(io.stdout:setvbuf :line)
|
||||||
|
;; don't count load time against the test runtime
|
||||||
|
(each [_ m (ipairs module-names)]
|
||||||
|
(when (not (pcall require m))
|
||||||
|
(tset package.loaded m nil)))
|
||||||
|
(let [hooks (setmetatable (or ?hooks {}) {:__index default-hooks})
|
||||||
|
results (result-table :main)]
|
||||||
|
(when hooks.begin
|
||||||
|
(hooks.begin results module-names))
|
||||||
|
(each [_ module-name (ipairs module-names)]
|
||||||
|
(case (pcall require module-name)
|
||||||
|
(true test-mod) (run-module hooks results module-name test-mod)
|
||||||
|
(false err) (tset results.err module-name
|
||||||
|
(error-result (: "ERROR: Cannot load %q:\n%s"
|
||||||
|
:format module-name err)))))
|
||||||
|
(set results.ended-at (now))
|
||||||
|
(when hooks.done (hooks.done results))
|
||||||
|
(when (or (next results.err) (next results.fail))
|
||||||
|
(exit hooks))))
|
||||||
|
|
||||||
|
(if (= ... "--tests")
|
||||||
|
(run (doto [...] (table.remove 1)))
|
||||||
|
{: run : skip :version "0.1.3-dev"
|
||||||
|
: is : error-match := =* :not= not=* :< <* :<= <=* : almost=
|
||||||
|
: identical :match match* : not-match})
|
9
test/main.fnl
Normal file
9
test/main.fnl
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
(local fennel (require :fennel))
|
||||||
|
(fn _G.pp [x] (print (fennel.view x)))
|
||||||
|
(set fennel.path (table.concat ["./test/?.fnl" fennel.path] ";"))
|
||||||
|
|
||||||
|
(local t (require :faith))
|
||||||
|
(local default-modules [:test.test-block]) ; test.test-inline test.test-render test.test-integration
|
||||||
|
|
||||||
|
(t.run (if (= 0 (length arg)) default-modules arg))
|
||||||
|
|
51
test/test-block.fnl
Normal file
51
test/test-block.fnl
Normal file
|
@ -0,0 +1,51 @@
|
||||||
|
(local blocks (require :block))
|
||||||
|
(local t (require :test.faith))
|
||||||
|
|
||||||
|
|
||||||
|
(fn setup-all []
|
||||||
|
(let [f (assert (io.open "./test/data/lists.incd"))
|
||||||
|
contents (f:read "*all")]
|
||||||
|
{:lists contents}))
|
||||||
|
|
||||||
|
(fn test-section [])
|
||||||
|
(fn test-image [])
|
||||||
|
(fn test-tag [])
|
||||||
|
(fn test-quote [])
|
||||||
|
(fn test-metadata [])
|
||||||
|
(fn test-code [])
|
||||||
|
(fn test-header [])
|
||||||
|
(fn test-list [{: lists}]
|
||||||
|
(let [expected [{:block "= The List Page =
|
||||||
|
|
||||||
|
"
|
||||||
|
:type "Header"}
|
||||||
|
|
||||||
|
{:block "\n" :type "Paragraph"}
|
||||||
|
{:block "- First Element
|
||||||
|
- Second Element
|
||||||
|
|
||||||
|
\t- Sub element
|
||||||
|
|
||||||
|
\t- Second Sub Element
|
||||||
|
|
||||||
|
\t\t- Third sub element
|
||||||
|
|
||||||
|
- Third Element
|
||||||
|
|
||||||
|
"
|
||||||
|
:type "List"}
|
||||||
|
{:block "\n" :type "Paragraph"}
|
||||||
|
{:block "- This is the second list
|
||||||
|
- With only single layer
|
||||||
|
|
||||||
|
- And three elements
|
||||||
|
|
||||||
|
"
|
||||||
|
:type "List"}]
|
||||||
|
actual (blocks.lexer lists blocks.grammar)]
|
||||||
|
(t.= expected actual)))
|
||||||
|
(fn test-footnote [])
|
||||||
|
(fn test-paragraph [])
|
||||||
|
|
||||||
|
{: setup-all
|
||||||
|
: test-list}
|
0
test/test-inline.fnl
Normal file
0
test/test-inline.fnl
Normal file
0
test/test-integration.fnl
Normal file
0
test/test-integration.fnl
Normal file
0
test/test-render.fnl
Normal file
0
test/test-render.fnl
Normal file
Loading…
Reference in a new issue