shrub/lib/ph/tests.hoon

::  Useful tests for testing things
::
/+  ph, ph-util
=,  ph
=,  ph-util
|=  our=ship
::
::  Useful tests
::
|%
::
::  Never-ending test, for development.
::
++  stall
  |=  ph-input
  [& ~ %wait ~]
::
::  Stall until you run :aqua|dojo ~ship "%go" on any ship.
::
++  please-press-enter
  ^+  *form:(ph ,~)
  |=  pin=ph-input
  :+  &  ~
  ?:  (is-dojo-output who.pin who.pin uf.pin "%go")
    [%done ~]
  [%wait ~]
::
::  Test to produce events unconditionally.
::
++  just-events
  |=  events=(list ph-event)
  =/  m  (ph ,~)
  ^-  form:m
  |=  ph-input
  [& events %done ~]
::
::
::
++  wait-for-dojo
  |=  [her=@p what=tape]
  =/  m  (ph ,~)
  ^-  form:m
  |=  pin=ph-input
  :+  &  ~
  ?.  (is-dojo-output her who.pin uf.pin what)
    [%wait ~]
  [%done ~]
::
::  Boot ship; don't check it succeeded.
::
++  boot-ship
  |=  [her=ship keys=(unit dawn-event)]
  ^+  *form:(ph ,~)
  |=  ph-input
  [& (init her keys) %done ~]
::
::  Wait until ship has finished booting.
::
++  check-ship-booted
  |=  her=ship
  ^+  *form:(ph ,~)
  |=  ph-input
  =;  done=?
    :+  &  ~
    ?:  done
      [%done ~]
    [%wait ~]
  ::  This is a pretty bad heuristic, but in general galaxies will
  ::  hit the first of these cases, and other ships will hit the
  ::  second.
  ::
  ?|
    %^  is-dojo-output  her  who  :-  uf
    "clay: committed initial filesystem (all)"
  ::
    %^  is-dojo-output  her  who  :-  uf
    "is your neighbor"
  ==
::
::  Send "|hi" from one ship to another
::
++  send-hi
  |=  [from=@p to=@p]
  =/  m  (ph ,~)
  ;<  ~  bind:m  (just-events (dojo from "|hi {(scow %p to)}"))
  (wait-for-dojo from "hi {(scow %p to)} successful")
::
::  Send "|hi" and wait for "not responding" message
::
++  send-hi-not-responding
  |=  [from=@p to=@p]
  =/  m  (ph ,~)
  ;<  ~  bind:m  (just-events (dojo from "|hi {(scow %p to)}"))
  (wait-for-dojo from "{(scow %p to)} not responding still trying")
::
::  Boot a ship and verify it booted.  Parent must already be booted.
::
++  raw-ship
  |=  [her=ship keys=(unit dawn-event)]
  =/  m  (ph ,~)
  ^-  form:m
  ;<  ~  bind:m  (boot-ship her keys)
  (check-ship-booted her)
::
::  Boot a fake star and its parent.
::
++  star
  |=  her=ship
  =/  m  (ph ,~)
  ^-  form:m
  ;<  ~  bind:m  (raw-ship (^sein:title her) ~)
  (raw-ship her ~)
::
::  Boot a fake planet, its parent, and its grandparent.
::
++  planet
  |=  her=ship
  =/  m  (ph ,~)
  ^-  form:m
  ;<  ~  bind:m  (star (^sein:title her))
  (raw-ship her ~)
::
::  Mount a desk.
::
++  mount
  |=  [her=ship des=desk]
  =/  m  (ph ,~)
  ^-  form:m
  ;<  ~  bind:m  (just-events (dojo her "|mount /={(trip des)}="))
  |=  pin=ph-input
  ?:  (is-ergo her who.pin uf.pin)
    [& ~ %done ~]
  [& ~ %wait ~]
::
::  Modify /sur/aquarium/hoon on the given ship
::
++  touch-file
  |=  [her=ship des=desk]
  =/  m  (ph ,@t)
  ^-  form:m
  ;<  ~  bind:m  (mount her des)
  |=  pin=ph-input
  =/  host-pax
    /(scot %p our)/home/(scot %da now.pin)/sur/aquarium/hoon
  =/  pax  /sur/aquarium/hoon
  =/  aqua-pax
    ;:  weld
        /i/(scot %p her)/cx/(scot %p her)/[des]/(scot %da now.pin)
        pax
        /noun
    ==
  =/  warped
    %^  cat  3  '=>  .  '
    (need (scry-aqua (unit @) our now.pin aqua-pax))
  [& (insert-file her des host-pax warped) %done warped]
::
::  Check /sur/aquarium/hoon on the given has the given contents.
::
++  check-file-touched
  |=  [her=ship des=desk warped=@t]
  =/  m  (ph ,~)
  ;<  ~  bind:m  (mount her des)
  ^-  form:m
  |=  pin=ph-input
  ?.  &(=(her who.pin) ?=(?(%init %ergo) -.q.uf.pin))
    [& ~ %wait ~]
  =/  pax  /sur/aquarium/hoon
  =/  aqua-pax
    ;:  weld
        /i/(scot %p her)/cx/(scot %p her)/[des]/(scot %da now.pin)
        pax
        /noun
    ==
  ?:  =(warped (need (scry-aqua (unit @) our now.pin aqua-pax)))
    [& ~ %done ~]
  [& ~ %wait ~]
--