From 4bf854c18002114cc3accdc8dc83a945692042db Mon Sep 17 00:00:00 2001
From: Ted Blackman <ted@tlon.io>
Date: Sun, 19 Apr 2020 05:11:01 -0400
Subject: [PATCH] WIP :spider2 using ford-fusion

---
 pkg/arvo/app/dojo.hoon     |  8 ++--
 pkg/arvo/lib/strandio.hoon | 15 ++++++++
 pkg/arvo/ted/test.hoon     | 76 ++++++++++++++++++++++++++++++++++++--
 3 files changed, 92 insertions(+), 7 deletions(-)

diff --git a/pkg/arvo/app/dojo.hoon b/pkg/arvo/app/dojo.hoon
index 09ff73f01..a15302951 100644
--- a/pkg/arvo/app/dojo.hoon
+++ b/pkg/arvo/app/dojo.hoon
@@ -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
diff --git a/pkg/arvo/lib/strandio.hoon b/pkg/arvo/lib/strandio.hoon
index 3734776f6..39aa2b0bc 100644
--- a/pkg/arvo/lib/strandio.hoon
+++ b/pkg/arvo/lib/strandio.hoon
@@ -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
diff --git a/pkg/arvo/ted/test.hoon b/pkg/arvo/ted/test.hoon
index c9015d2fb..420483bab 100644
--- a/pkg/arvo/ted/test.hoon
+++ b/pkg/arvo/ted/test.hoon
@@ -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  $