1
1
mirror of https://github.com/urbit/shrub.git synced 2024-12-24 11:24:21 +03:00
shrub/pkg/arvo/ted/test.hoon
2020-04-20 01:33:29 -04:00

129 lines
3.7 KiB
Plaintext

/- spider
/+ strandio
=, strand=strand:spider
=>
|%
:: $test: a test with a fully resolved path
:: $test-arm: test with name (derived from its arm name in a test core)
:: $test-func: single test, as gate; sample is entropy, produces failures
::
+$ test [=path func=test-func]
+$ test-arm [name=term func=test-func]
+$ test-func (trap tang)
--
=>
|%
:: +run-test: execute an individual test
::
++ run-test
|= [pax=path test=test-func]
^- [ok=? =tang]
=+ name=(spud pax)
=+ run=(mule test)
?- -.run
%| |+(welp p.run leaf+"CRASHED {name}" ~)
%& ?: =(~ p.run)
&+[leaf+"OK {name}"]~
|+(flop `tang`[leaf+"FAILED {name}" p.run])
==
:: +filter-tests-by-prefix: TODO document
::
++ filter-tests-by-prefix
|= [prefix=path tests=(list test)]
^+ tests
=/ prefix-length=@ud (lent prefix)
(skim tests |=([p=path *] =(prefix (scag prefix-length p))))
:: +resolve-test-paths: add test names to file paths to form full identifiers
::
++ resolve-test-paths
|= paths-to-tests=(map path (list test-arm))
^- (list test)
%- sort :_ |=([a=test b=test] !(aor path.a path.b))
^- (list test)
%- zing
%+ turn ~(tap by paths-to-tests)
|= [=path test-arms=(list test-arm)]
^- (list test)
:: strip off leading 'tests' from :path
::
=. path ?>(?=([%tests *] path) t.path)
:: for each test, add the test's name to :path
::
%+ turn test-arms
|= =test-arm
^- test
[(weld path /[name.test-arm]) func.test-arm]
:: +get-test-arms: convert test arms to functions and produce them
::
++ get-test-arms
|= [typ=type cor=*]
^- (list test-arm)
=/ arms=(list @tas) (sloe typ)
%+ turn (skim arms has-test-prefix)
|= name=term
^- test-arm
=/ fire-arm=nock
~| [%failed-to-compile-test-arm name]
q:(~(mint ut typ) p:!>(*tang) [%limb name])
[name |.(;;(tang .*(cor fire-arm)))]
:: +has-test-prefix: does the arm define a test we should run?
::
++ has-test-prefix
|= a=term ^- ?
=((end 3 5 a) 'test-')
::
++ find-test-files
=| fiz=(set [=spur test=(unit term)])
=/ m (strand ,_fiz)
|= [bek=beak paz=(list path)]
^- form:m
=* loop $
?~ paz
(pure:m fiz)
=/ xap=path (flop i.paz)
;< hav=? bind:m (check-for-file:strandio bek hoon+xap)
?: hav
loop(paz t.paz, fiz (~(put in fiz) [hoon+xap ~]))
;< fez=(list path) bind:m (list-tree:strandio bek xap)
?. =(~ fez)
=/ foz (turn fez |=(path [(flop +<) ~]))
loop(paz t.paz, fiz (~(gas in fiz) foz))
~| bad-test-path+i.paz
=/ tex=term =-(?>(((sane %tas) -) -) (head xap))
=/ xup=path (tail xap)
;< hov=? bind:m (check-for-file:strandio bek hoon+xup)
?. hov
~|(no-tests-at-path+paz !!)
loop(paz t.paz, fiz (~(put in fiz) [hoon+xup `tex]))
--
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
=/ paz=(list path) (turn !<((list path) arg) |=(path [%tests +<]))
;< bek=beak bind:m get-beak:strandio
;< fiz=(set [=spur test=(unit term)]) bind:m (find-test-files bek paz)
=> .(fiz ~(tap in fiz))
=| test-arms=(map path (list test-arm))
|- ^- form:m
=* gather-tests $
?^ fiz
~> %slog.0^leaf+"test: building {(spud (flop spur.i.fiz))}"
;< cor=vase bind:m (build-file:strandio bek spur.i.fiz)
=/ arms=(list test-arm) (get-test-arms cor)
=? arms ?=(^ test.i.fiz)
|- ^+ arms
?~ arms ~|(no-test-arm+i.fiz !!)
?: =(name.i.arms u.test.i.fiz)
[i.arms]~
$(arms t.arms)
=. test-arms (~(put by test-arms) (flop (tail spur.i.fiz)) arms)
gather-tests(fiz t.fiz)
%- pure:m !> ^= ok
%+ roll (resolve-test-paths test-arms)
|= [[=path =test-func] ok=_`?`%&]
^+ ok
=/ res (run-test path test-func)
%- (slog (flop tang.res))
&(ok ok.res)