WIP :spider2 using ford-fusion

This commit is contained in:
Ted Blackman 2020-04-19 05:11:01 -04:00
parent 1f91676c97
commit 4bf854c180
3 changed files with 92 additions and 7 deletions

View File

@ -346,7 +346,7 @@
?: =(/wool u.pux)
:: really shoud stop the thread as well
::
[%pass u.pux %agent [our.hid %spider] %leave ~]
[%pass u.pux %agent [our.hid %spider2] %leave ~]
[%pass u.pux %arvo %f %kill ~]
::
++ dy-slam :: call by ford
@ -732,11 +732,11 @@
=. poy `+>+<.$(pux `/wool)
=. +>+>.$
%- he-card
[%pass /wool %agent [our.hid %spider] %watch /thread-result/[tid]]
[%pass /wool %agent [our.hid %spider2] %watch /thread-result/[tid]]
%- he-card
=/ =cage :: also sub
[%spider-start !>([~ `tid fil (dy-sore src)])]
[%pass /wool %agent [our.hid %spider] %poke cage]
[%pass /wool %agent [our.hid %spider2] %poke cage]
::
++ dy-make :: build step
^+ +>
@ -925,7 +925,7 @@
?~ p.sign
+>.$
=. +>.$ (he-diff(poy ~) %tan u.p.sign)
(he-card %pass /wool %agent [our.hid %spider] %leave ~)
(he-card %pass /wool %agent [our.hid %spider2] %leave ~)
::
%watch-ack
?~ p.sign

View File

@ -26,6 +26,12 @@
|= tin=strand-input:strand
`[%done bowl.tin]
::
++ get-beak
=/ m (strand ,beak)
^- form:m
|= tin=strand-input:strand
`[%done [our q.byk da+now]:bowl.tin]
::
++ get-time
=/ m (strand ,@da)
^- form:m
@ -537,6 +543,15 @@
;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff)
(take-writ /warp)
::
++ list-tree
|= [[=ship =desk =case:clay] =spur]
=* arg +<
=/ m (strand ,(list path))
;< =riot:clay bind:m (warp ship desk ~ %sing %t case (flop spur))
?~ riot
(strand-fail %list-tree >arg< ~)
(pure:m !<((list path) q.r.u.riot))
::
:: Take Clay read result
::
++ take-writ

View File

@ -1,13 +1,83 @@
/- spider
/+ strandio, *test-runner
/+ 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-')
--
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
=/ paz=(list path) (turn !<((list path) arg) |=(path [%tests +<]))
;< =bowl:spider bind:m get-bowl:strandio
=/ bek=beak [our q.byk da+now]:bowl
;< bek=beak bind:m get-beak:strandio
=| test-arms=(map path (list test-arm))
|- ^- form:m
=* gather-tests $