Merge branch 'next/kelvin/411' into pkova/mirger

This commit is contained in:
pkova 2024-02-23 00:35:30 +02:00
commit 0d9a0cdb6c
3 changed files with 38 additions and 75 deletions

View File

@ -3,7 +3,7 @@
flake-utils.url = "github:numtide/flake-utils";
tools = {
flake = false;
url = "github:urbit/tools";
url = "github:urbit/tools/d454e2482c3d4820d37db6d5625a6d40db975864";
};
};

View File

@ -28,17 +28,6 @@ let
--
'';
testThread = dojoCommand:
pkgs.writeTextFile {
name = "${dojoCommand}.hoon";
text = ''
${poke}
=/ m (strand ,vase)
;< [=ship =desk =case] bind:m get-beak
;< ok=? bind:m (poke [ship %dojo] %lens-command !>([%$ [%dojo '${dojoCommand}'] [%stdout ~]]))
(pure:m !>(ok))
'';
};
appThread = generator: app:
pkgs.writeTextFile {
name = ":${app}|${generator}.hoon";
@ -87,7 +76,7 @@ in pkgs.stdenvNoCC.mkDerivation {
sleep 2
${click} -k -p -i ${testThread "-test %/tests ~"} ./pier
${click} -c ./pier "[0 %fyrd [%base %test %noun %noun 0]]"
${click} -k -p -i ${pokeApp "%agents" "noun" "test"} ./pier
${click} -k -p -i ${pokeApp "%generators" "noun" "test"} ./pier

View File

@ -7,52 +7,42 @@
:: $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 [=beam func=test-func]
+$ test [=path func=test-func]
+$ test-arm [name=term func=test-func]
+$ test-func (trap tang)
+$ args quiet=?
--
=>
|_ =args
++ build-file
|= =beam
=/ m (strand ,[(unit vase) tang])
^- form:m
;< res=(unit vase) bind:m
(build-file:strandio beam)
%+ pure:m res
?. =(res ~)
~
~[leaf+"FAILED"]
:: +run-test: execute an individual test
|%
:: +run-test: execute an individual test
::
++ run-test
|= [bem=beam test=test-func]
|= [pax=path test=test-func]
^- [ok=? =tang]
=+ name=(spud pax)
=+ run=(mule test)
?- -.run
%| |+p.run
%| |+(welp p.run leaf+"CRASHED {name}" ~)
%& ?: =(~ p.run)
&+~
|+(flop `tang`[leaf+"FAILED" p.run])
&+[leaf+"OK {name}"]~
|+(flop `tang`[leaf+"FAILED {name}" p.run])
==
:: +resolve-test-paths: add test names to file paths to form full identifiers
::
++ resolve-test-paths
|= paths-to-tests=(map beam (list test-arm))
|= paths-to-tests=(map path (list test-arm))
^- (list test)
%- sort :_ |=([a=test b=test] !(aor s.beam.a s.beam.b))
%- sort :_ |=([a=test b=test] !(aor path.a path.b))
^- (list test)
%- zing
%+ turn ~(tap by paths-to-tests)
|= [=beam test-arms=(list test-arm)]
|= [=path test-arms=(list test-arm)]
^- (list test)
:: for each test, add the test's name to :path
::
%+ turn test-arms
|= =test-arm
^- test
[beam(s (weld s.beam /[name.test-arm])) func.test-arm]
[(weld path /[name.test-arm]) func.test-arm]
:: +get-test-arms: convert test arms to functions and produce them
::
++ get-test-arms
@ -65,7 +55,7 @@
=/ fire-arm=nock
~| [%failed-to-compile-test-arm name]
q:(~(mint ut typ) p:!>(*tang) [%limb name])
[name |.(;;(tang ?:(quiet.args .*(cor fire-arm) ~>(%bout.[1 name] .*(cor fire-arm)))))]
[name |.(;;(tang ~>(%bout.[1 name] .*(cor fire-arm))))]
:: +has-test-prefix: does the arm define a test we should run?
::
++ has-test-prefix
@ -102,66 +92,50 @@
?. hov
~|(no-tests-at-path+i.bez !!)
loop(bez t.bez, fiz (~(put in fiz) [[-.i.bez (snoc xup %hoon)] `tex]))
++ print-failures
|= ls=(list [=beam =tang])
^+ same
?~ ls
same
=/ =tank
[%rose ["\0a" "/={(trip q.beam.i.ls)}={(spud s.beam.i.ls)}:\0a" ""] tang.i.ls]
~> %slog.[3 tank]
$(ls t.ls)
--
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
;< =bowl:strand bind:m get-bowl:strandio
=/ [quiet=? paz=(list path)]
:: if no args, test everything under /=base=/tests
=/ paz=(list path)
:: if no args, test everything under /=base=/tests
::
=* default-tests
?~ q.arg
~[/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/tests]
?+ q.arg !!
~ [& default-tests]
[~ ?] =+ !<([~ quiet=?] arg) [quiet default-tests]
[~ ? ^ *] =+ !<([~ quiet=? paz=(list path)] arg) [quiet paz]
[~ ? ^] =+ !<([~ quiet=? pax=path] arg) [quiet pax ~]
[~ ^ *] =+ !<([~ paz=(list path)] arg) [& paz]
[~ *] =+ !<([~ pax=path] arg) [& pax ~]
==
=. quiet.args quiet
?~ +.q.arg
~[/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/tests]
:: else cast path to ~[path] if needed
::
?@ +<.q.arg
[(tail !<([~ path] arg)) ~]
(tail !<([~ (list path)] arg))
=/ bez=(list beam)
(turn paz |=(p=path ~|([%test-not-beam p] (need (de-beam p)))))
;< fiz=(set [=beam test=(unit term)]) bind:m (find-test-files bez)
=> .(fiz (sort ~(tap in fiz) aor))
=| test-arms=(map beam (list test-arm))
=| build-failed=(list [beam tang])
=| test-arms=(map path (list test-arm))
=| build-ok=?
|- ^- form:m
=* gather-tests $
?^ fiz
;< [cor=(unit vase) =tang] bind:m (build-file beam.i.fiz)
;< cor=(unit vase) bind:m (build-file:strandio beam.i.fiz)
?~ cor
gather-tests(fiz t.fiz, build-failed [[beam.i.fiz tang] build-failed])
~> %slog.0^leaf+"FAILED {(spud s.beam.i.fiz)} (build)"
gather-tests(fiz t.fiz, build-ok |)
~> %slog.0^leaf+"built {(spud s.beam.i.fiz)}"
=/ arms=(list test-arm) (get-test-arms u.cor)
:: if test path specified an arm prefix, filter arms to match
=? arms ?=(^ test.i.fiz)
%+ skim arms
|= test-arm
=((end [3 (met 3 u.test.i.fiz)] name) u.test.i.fiz)
=. test-arms (~(put by test-arms) beam.i.fiz(s (snip s.beam.i.fiz)) arms)
=. test-arms (~(put by test-arms) (snip s.beam.i.fiz) arms)
gather-tests(fiz t.fiz)
=; res=_build-failed
%- (print-failures res)
%- pure:m !> ^= failed
%+ turn res
|= [=beam *]
beam
%- pure:m !> ^= ok
%+ roll (resolve-test-paths test-arms)
|= [[=beam =test-func] failed=_build-failed]
^+ failed
=/ res (run-test beam test-func)
?: -.res
failed
:_ failed
[beam +.res]
|= [[=path =test-func] ok=_build-ok]
^+ ok
=/ res (run-test path test-func)
%- (slog (flop tang.res))
&(ok ok.res)