nockchain/hoon/common/test.hoon

::  testing utilities meant to be directly used from files in %/tests
::
|%
::  +expect-eq: compares :expected and :actual and pretty-prints the result
::
++  expect-eq
  |=  [expected=vase actual=vase]
  ^-  tang
  ::
  =|  result=tang
  ::
  =?  result  !=(q.expected q.actual)
    %+  weld  result
    ^-  tang
    :~  [%palm [": " ~ ~ ~] [leaf+"expected" (sell expected) ~]]
        [%palm [": " ~ ~ ~] [leaf+"actual  " (sell actual) ~]]
    ==
  ::
  =?  result  !(~(nest ut p.actual) | p.expected)
    %+  weld  result
    ^-  tang
    :~  :+  %palm  [": " ~ ~ ~]
        :~  [%leaf "failed to nest"]
            (~(dunk ut p.actual) %actual)
            (~(dunk ut p.expected) %expected)
    ==  ==
  result
::  +expect: compares :actual to %.y and pretty-prints anything else
::
++  expect
  |=  actual=vase
  (expect-eq !>(%.y) actual)
::  +expect-fail: kicks a trap, expecting crash. pretty-prints if succeeds
::
++  expect-fail
  |=  [a=(trap) err=(unit tape)]
  ^-  tang
  =/  b  (mule a)
  ?:  ?=(%& -.b)
    =-  (welp - ~[(sell !>(p.b))])
    ~['expected crash, got: ']
  ?~  err
    %.  ~
    (%*(. slog pri 1) ['caught expected failure: ' p.b])
  =/  found=(unit tank)
    (find-tank p.b u.err)
  ?:  ?=(^ found)
    %.  ~
    (%*(. slog pri 1) ['caught expected failure: ' p.b])
  %+  weld
    ^-  tang
    :~  [%palm [": " ~ ~ ~] [leaf+"expected" leaf+u.err ~]]
        [%palm [": " ~ ~ ~] [leaf+"actual  " ~]]
    ==
  p.b
    ::
::  +expect-runs: kicks a trap, expecting success; returns trace on failure
::
++  expect-success
  |=  a=(trap)
  ^-  tang
  =/  b  (mule a)
  ?-  -.b
    %&  ~
    %|  ['expected success - failed' ((slog p.b) p.b)]
  ==
::  $a-test-chain: a sequence of tests to be run
::
::  NB: arms shouldn't start with `test-` so that `-test % ~` runs
::
+$  a-test-chain
  $_
  |?
  ?:  =(0 0)
    [%& p=*tang]
  [%| p=[tang=*tang next=^?(..$)]]
::  +run-chain: run a sequence of tests, stopping at first failure
::
++  run-chain
  |=  seq=a-test-chain
  ^-  tang
  =/  res  $:seq
  ?-  -.res
    %&  p.res
    %|  ?.  =(~ tang.p.res)
          tang.p.res
        $(seq next.p.res)
  ==
::  +category: prepends a name to an error result; passes successes unchanged
::
++  category
  |=  [a=tape b=tang]  ^-  tang
  ~&  >  "category: {a}"
  ?:  =(~ b)  ~  :: test OK
  :-  leaf+"in: '{a}'"
  (turn b |=(c=tank rose+[~ "  " ~]^~[c]))
::  +give-result: runs a test, pretty-prints the result
::
++  give-result
  |=  [name=tape test=(trap tang)]
  ^-  [ok=? =tang]
  =+  run=(mule test)
  ?-  -.run
    %|  |+(welp p.run leaf+"CRASHED {name}" ~)
    %&  ?:  =(~ p.run)
          &+[leaf+"OK      {name}"]~
        |+(flop `tang`[leaf+"FAILED  {name}" p.run])
  ==
++  find-tank
  |=  [=tang =tape]
  ^-  (unit tank)
  ?~  tang  ~
  ::  %-  (slog i.tang ~)
  ?.  ?=(%leaf -.i.tang)  $(tang t.tang)
  ?:  ?=(^ (find tape i.tang))
    `i.tang
  $(tang t.tang)
::
::
::  Convenience functions for roswell testing modules
::
+$  test-arm  [name=term func=test-func]
+$  test-func  (trap tang)
++  succeed
  |=  res=(list [ok=? =tang])
  ^-  ?
  %+  roll  res
  |=  [[ok=? =tang] pass=?]
  %-  (slog (flop tang))
  &(pass ok)
::
++  run-tests
  |=  test-arms=(list test-arm)
  ^-  (list [ok=? =tang])
  %+  turn  test-arms
  |=  =test-arm
  (run-test test-arm)
::
++  run-test
  |=  =test-arm
  ^-  [ok=? =tang]
  =+  name=(trip name.test-arm)
  ~&  test-name+name
  =+  run=(mule func.test-arm)
  ?-  -.run
    %|  [| `tang`(welp p.run leaf+"CRASHED {name}" ~)]
    %&  ?:  =(~ p.run)
          [& `tang`[leaf+"OK      {name}"]~]
        [| (flop `tang`[leaf+"FAILED  {name}" p.run])]
  ==
::
++  get-test-arms
  |=  tests-core=vase
  ^-  (list test-arm)
  (get-prefix-arms 'test-' tests-core)
::
::  +get-prefix-arms: produce arms that begin with .prefix
++  get-prefix-arms
  |=  [prefix=term tests-core=vase]
  ^-  (list test-arm)
  |^
  =/  arms=(list @tas)  (sloe p:tests-core)
  %+  turn  (skim arms has-prefix)
  |=  name=term
  ^-  test-arm
  =/  fire-arm=nock
    ~|  [%failed-to-compile-test-arm name]
    q:(~(mint ut p:tests-core) p:!>(*tang) [%limb name])
  :-  name
  |.(;;(tang ~>(%bout.[1 name] .*(q:tests-core fire-arm))))
::
  ++  has-prefix
    |=  a=term  ^-  ?
    =((end [3 (met 3 prefix)] a) prefix)
  --
--