Skip to content
Snippets Groups Projects
Commit ca33f1bc authored by Elliott Shugerman's avatar Elliott Shugerman
Browse files

debuggin'

parent 5aac497a
No related branches found
No related tags found
No related merge requests found
......@@ -4,39 +4,43 @@
(def divider-heavy "================================================================================")
(def divider-light "--------------------------------------------------------------------------------")
(defn- group/new []
(defn- group/new [description]
@{:type 'group
:description nil
:description description
:children @[]
:before nil
:before-each nil
:after nil
:after-each nil})
(setdyn :group (group/new))
(var top-group (group/new "<top>"))
(defn- get-parent-group []
(or (dyn :group) top-group))
(defn group [description thunk]
(array/push
((dyn :group) :children)
(with-dyns [:group (group/new)]
(def parent-group (get-parent-group))
(def this-group
(with-dyns [:group (group/new description)]
(thunk)
(dyn :group))))
(dyn :group)))
(array/push (parent-group :children) this-group))
(defn before [thunk]
(set ((dyn :group) :before) thunk))
(set ((get-parent-group) :before) thunk))
(defn before-each [thunk]
(set ((dyn :group) :before-each) thunk))
(set ((get-parent-group) :before-each) thunk))
(defn after [thunk]
(set ((dyn :group) :after) thunk))
(set ((get-parent-group) :after) thunk))
(defn after-each [thunk]
(set ((dyn :group) :after-each) thunk))
(set ((get-parent-group) :after-each) thunk))
(defn test [description thunk]
(array/push
((dyn :group) :children)
((get-parent-group) :children)
{:type 'test
:description description
:thunk thunk}))
......@@ -44,54 +48,40 @@
(defn execute-group [group]
# TODO: catch errors in hooks?
# TODO: print output indentation
(print (group :description))
(when-let [before (group :before)]
(before))
(def child-results
(def children-results
(map (fn [child]
(when-let [before-each (group :before-each)]
(before-each))
(match child
{:type 'test :thunk thunk :description desc}
(try
(do
(thunk)
(printf "* %s ✅" desc)
{:type 'test :test child :passed true})
([err]
(printf "* %s ❌" desc)
{:type 'test :test child :passed false :error err}))
{:type 'group}
(execute-group child))
(def child-result
(match child
{:type 'test :thunk thunk :description desc}
(try
(do
(thunk)
(printf "* %s ✅" desc)
{:type 'test :description desc :passed true})
([err]
(printf "* %s ❌" desc)
{:type 'test :description desc :passed false :error err}))
{:type 'group}
(execute-group child)))
(when-let [after-each (group :after-each)]
(after-each)))
(after-each))
child-result)
(group :children)))
(when-let [after (group :after)]
(after))
{:type 'group :group group :children child-results})
{:type 'group :description (group :description) :children children-results})
(defn- get-spaces [n]
(->> [" "]
(generators/cycle)
(generators/take 10)
(generators/to-array)
(splice)
(string)))
(defn- print-failures [results depth]
(def indent (get-spaces (* 2 depth)))
(match results
{:type 'group :group {:description desc} :children children}
(do
(print indent (or desc "<default>"))
(each child children
(print-failures child (+ 1 depth))))
{:type 'test :test {:description desc} :error err}
(do
(print indent desc)
(print err)
(print))))
(->> (range n)
(map (fn [x] " "))
(string/join)))
(defn- filter-failures [results]
......@@ -107,20 +97,41 @@
(merge results {:children filtered-children}))
(defn- print-failures [results depth]
(def indent (get-spaces (* 2 depth)))
(match results
{:type 'group :description desc :children children}
(do
(print indent desc)
(each child children
(print-failures child (+ 1 depth))))
{:type 'test :description desc :error err}
(do
(print indent desc)
(print err)
(print))))
(defn- count-tests [results]
(reduce
(fn [acc child]
(match child
{:type 'test :passed true} (merge acc {:passed (+ 1 (acc :passed))})
{:type 'test :passed false} (merge acc {:failed (+ 1 (acc :failed))})))
{:type 'test :passed false} (merge acc {:failed (+ 1 (acc :failed))})
{:type 'group} (let [counts (count-tests child)]
{:passed (+ (acc :passed) (counts :passed))
:failed (+ (acc :failed) (counts :failed))})))
{:passed 0 :failed 0}
(results :children)))
(defn- report "Default reporter" [results]
# TODO: elide implicit top group
(print "FAILURES:")
(print divider-light)
(print-failures (filter-failures results) 0)
(print divider-heavy)
(print "SUMMARY:")
(print divider-light)
(let [{:passed num-passed :failed num-failed} (count-tests results)
......@@ -131,18 +142,22 @@
(print divider-heavy))
(defn run-tests []
(def result (execute-group (dyn :group)))
(defn run-tests [&keys {:exit-on-failure exit-on-failure}]
(print divider-heavy)
(print "Running tests...")
(print divider-light)
(def results (execute-group top-group))
(print divider-heavy)
(report result)
(report results)
(let
# TODO: do better and/or suppor override for exit 1
[is-repl (and (= "janet" (path/basename (dyn *executable*)))
(all (fn [arg] (not= ".janet" (path/ext arg))) (dyn *args*)))
some-failed (some (fn [res] (not (res :passed))) result)]
(when (and some-failed (not is-repl))
# TODO: do better and/or support override
[is-repl (and (= "janet" (path/basename (dyn *executable*)))
(all (fn [arg] (not= ".janet" (path/ext arg))) (dyn *args*)))
{:failed num-failed} (count-tests results)]
(when (and (> num-failed 0) exit-on-failure (not is-repl))
(os/exit 1))))
(defn reset "Clear defined tests" []
(setdyn :group (group/new)))
(defn reset []
(set top-group (group/new "<top>")))
(import ./lib :as t)
(def things-ran @[])
(t/group
"test/lib.janet works"
(fn []
(t/before (fn [] (array/push things-ran 'before)))
(t/before-each (fn [] (array/push things-ran 'before-each)))
(t/test
"this should pass"
(fn []
(array/push things-ran 'passing-test)
(assert true)))
(t/test
"this should fail"
(fn []
(array/push things-ran 'failing-test)
(assert false)))
(t/after (fn [] (array/push things-ran 'after)))
(t/after-each (fn [] (array/push things-ran 'after-each)))))
(t/run-tests :exit-on-failure false)
(assert (deep= things-ran @['before
'before-each
'passing-test
'after-each
'before-each
'failing-test
'after-each
'after]))
# implicit group
(t/reset)
(array/clear things-ran)
(t/before (fn [] (array/push things-ran 'before)))
(t/before-each (fn [] (array/push things-ran 'before-each)))
(t/test
"this should pass"
(fn []
(array/push things-ran 'passing-test)
(assert true)))
(t/test
"this should fail"
(fn []
(array/push things-ran 'failing-test)
(assert false)))
(t/after (fn [] (array/push things-ran 'after)))
(t/after-each (fn [] (array/push things-ran 'after-each)))
(t/run-tests :exit-on-failure false)
(assert (deep= things-ran @['before
'before-each
'passing-test
'after-each
'before-each
'failing-test
'after-each
'after]))
(import testament :prefix "" :exit true)
(import sh)
(import csv)
(import ./lib)
(def bootstrap-database "postgres")
......@@ -55,7 +56,7 @@
(defn assert-test-db-populated []
(let [rows (exec-sql :sql "SELECT count(1) from public.customer")]
(is (pos? (length rows)) "Not populated: table is empty")))
(assert (pos? (length rows)) "Not populated: table is empty")))
(defn- includes [arr val]
(reduce (fn [acc elem] (or acc (= elem val)))
......@@ -65,7 +66,7 @@
(defn assert-test-db-dne []
(let [rows (exec-sql :sql "\\l" :database "postgres")
dbs (map (fn [db] (db :Name)) rows)]
(is (not (includes dbs seed-database)))))
(assert (not (includes dbs seed-database)))))
(defn export-env [env]
(loop [[name val] :pairs env]
......@@ -103,10 +104,12 @@
(assert-test-db-populated) # asserts there's actually data in the table
(delete-services)))
(deftest pg-12 (full-test "12" "3.12"))
(deftest pg-13 (full-test "13" "3.14"))
(deftest pg-14 (full-test "14" "3.16"))
(deftest pg-15 (full-test "15" "3.18"))
# (deftest pg-12 (full-test "12" "3.12"))
# (deftest pg-13 (full-test "13" "3.14"))
# (deftest pg-14 (full-test "14" "3.16"))
# (deftest pg-15 (full-test "15" "3.18"))
(run-tests!)
# (run-tests!)
(import ./lib)
(print "is repl? " (lib/is-repl?))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment