shrub/main/app/test/core.hook
2014-09-17 00:04:58 +00:00

333 lines
9.7 KiB
Plaintext

:: Test suite
::
:: runnable from unix with command:
:: curl http://localhost:8080/gog/test/all-tests
::
:::: /hook/core/test/app
::
/? 314 :: need urbit 314
/= front /:/%%/front:/hymn/ :: load front page
::
:::: structures
::
|% :: structures
++ axle ,[%0 tests=(map term test)] :: application state
++ gilt :: subscription frame
$% [%json p=json] :: json data
[%html p=@t] :: html text
[%hymn p=manx] :: html tree
[%mime p=mite q=octs] :: mime data
== ::
++ gift :: output action
$% [%rust gilt] :: total update
[%mean p=ares] :: message failure
[%nice ~] :: succeed
== ::
++ hapt ,[p=ship q=path] :: see %gall
++ move ,[p=bone q=(mold note gift)] :: output operation
++ result :: test result
$% [%mean p=ares] :: failure
[%nice ~] :: success
== ::
++ note :: system request
$% $: %g :: to %gall
$% [%mess p=hapt q=ship r=cage] ::
[%cide p=span] ::
[%show p=hapt q=ship r=path] ::
[%sire p=term q=span] ::
== == == ::
++ test :: test template
$_ ^? |% ::
++ poke |+([bone ship] [_(list move) +>]) :: start test
++ pour |+([bone path *] [_(list move) +>]) :: system response
-- ::
-- ::
!:
:::: program
::
|_ $: hid=hide :: system state
axle :: custom state
==
++ et :: tests
|%
++ tests-json
%- jobe
%+ turn (~(tap by tests))
|= [nam=@t tes=test]
:- nam
%- jobe
^- (list ,[@t json])
~[[%name %s nam] [%result %s %untested]]
++ succeed
^- test
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
[[ost %give %nice ~]~ +>.$]
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
!!
--
++ cede
^- test
=> |%
++ sign
$% $: %g
$% [%nice ~]
[%gone p=hapt]
== == ==
--
=| cnt=?
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
~& [%cide-poke cub.hid sup.hid our.hid]
:_ +>.$(cnt !cnt)
?: cnt
:~
[ost %pass /cede/sire %g %sire %cede %babe]
:* ost %pass /cede/poke %g
%mess [our.hid babe/imp.hid] you
%json !>(~)
==
==
[ost %give %nice ~]~
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
~& [%cede-pour pax]
?+ -.pax `+>
%sire
~& %child-dead
:_ +>.$ :_ ~
[ost %give %nice ~]
==
--
++ cide
^- test
=> |%
++ sign
$% $: %g
$% [%nice ~]
[%rust %hymn p=manx]
== == ==
--
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
~& [%cide-poke cub.hid sup.hid our.hid]
:_ +>.$
:~
[ost %pass /cide/hi %g %cide %baby]
[ost %give %nice ~]
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
!!
--
++ sire
^- test
=> |%
++ sign
$% $: %g
$% [%nice ~]
[%rust %hymn p=manx]
== == ==
--
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
:_ +>.$
:~
[ost %pass /sire/hi %g %sire %demo %baby]
[ost %pass /sire/ho %g %mess our.hid^baby/imp.hid you %json !>(*json)]
[ost %pass /sire/ho %g %show our.hid^baby/imp.hid you /]
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=((hard sign) sih)
:_ +>.$
[ost %give %nice ~]~
--
++ poke-local
^- test
=> |%
++ sign ,[%g result]
--
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
:_ +>.$ :_ ~
:* ost %pass /poke-local %g
%mess [our.hid %test ~] you %json
!> (joba %test %s %bad-test-name)
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
:_ +>.$
=+ sih=((soft sign) sih)
:_ ~ :+ ost %give
?~ sih [%mean ~ %poke-local-pour-bad-sign ~]
?- +<.u.sih
%nice [%mean ~ %poke-local-pour-unexpected-nice ~]
%mean
?: ?=([~ %bad-test ~] p.u.sih)
[%nice ~]
[%mean ~ %poke-local-pour-unexpected-mean ~]
==
--
++ ze
^- test
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
:_ +>.$ :_ ~
=+ ^= zez
%+ ~(edit ^ze lat.hid *dome *rang)
lat.hid
[%& [0v0 0v0] [/hello %ins 'hello, world']~]
=+ `[l=@da d=dome r=rang]`+<.zez
?: .= lat.r
:_ [~ ~]
[p=1.292.805.149 q=[%direct p=1.292.805.149 q='hello, world' r=%c]]
[ost %give %nice ~]
[ost %give %mean ~ %bad-rang ~[leaf/<d> leaf/<r>]]
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
!!
--
++ all-tests
^- test
=> |%
++ sign ,[%g result]
++ sult
$? result
[%pending ~]
==
--
=| results=(map ,@t sult)
|%
++ poke
|+ [ost=bone you=ship]
^- [(list move) _+>]
=. results
%- mo
%+ turn (~(tap by tests))
|= [nam=@t tes=test]
[nam %pending ~]
:_ +>.$
%+ turn (~(tap by tests))
|= [nam=@t tes=test]
:* ost %pass /all-tests/[nam] %g
%mess [our.hid %test ~] you %json
!> (joba %test %s nam)
==
++ pour
|+ [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=((hard sign) sih)
?. ?=([@ ~] pax) ~& [%all-tests-strange-path pax] [~ +>.$]
=. results (~(put by results) -.pax +.sih)
:_ +>.$
?: (~(any by results) |=([res=sult] ?=(%pending -.res)))
~
:_ ~
?: (~(all by results) |=([res=sult] ?=(%nice -.res)))
[ost %give %nice ~]
:^ ost %give %mean
:+ ~ %failed-tests
%- zing
%+ turn
(skim (~(tap by results)) |=([nam=@t res=sult] ?=(%mean -.res)))
|= [nam=@t res=sult]
?> ?=(%mean -.res)
^- (list tank)
:_ ?~ p.res ~ q.u.p.res
:- %leaf
%+ weld "test %{(trip nam)} failed with "
?~ p.res "no error message"
%+ weld "error code %{(trip p.u.p.res)} and "
?~ q.u.p.res "no error info"
"the following error info:"
--
--
++ spec-pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
=+ sih=((hard ,[%g result]) sih)
:_ +>.$ :_ ~
[ost %give %rust %mime /text/plain (taco (cat 3 (crip <sih>) 10))]
++ prep
|= old=(unit (unit axle))
^- [(list move) _+>]
:- ~
%= +>.$
tests
?~ old
~& %prep-sig tests
?^ u.old
~& %prep-no-sig tests.u.u.old
=. tests
%- mo
^- (list ,[@t test])
=> et
:~ [%succeed succeed]
[%sire sire]
[%cide cide]
[%cede cede]
[%ze ze]
[%poke-local poke-local]
==
(~(put by tests) %all-tests all-tests:et)
==
++ peer :: accept subscriber
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
~& [%test-peer hid]
?~ pax [[ost %give %rust %hymn front]~ +>.$]
?: ?=(%tests -.pax)
[[ost %give %rust %json tests-json:et]~ +>.$]
:_ +>.$ :_ ~
:* ost %pass /automagic %g
%mess [our.hid %test ~] you %json
!> (joba %test %s -.pax)
==
++ poke-json :: browser message
|= [ost=bone you=ship jon=json]
^- [(list move) _+>]
~& [%test-poke hid]
=+ tes=((of [%test so] ~):jo jon)
?~ tes [[ost %give %mean ~ %strange-json ~]~ +>.$]
=+ tst=(~(get by tests) +.u.tes)
?~ tst
[[ost %give %mean ~ %bad-test leaf/<+.u.tes> ~]~ +>.$]
~& [%running-test +.u.tes]
=+ res=(poke:u.tst ost you)
:- -.res
+>.$(tests (~(put by tests) +.u.tes +.res))
++ pour :: response
|= [ost=bone pax=path sih=*]
^- [(list move) _+>]
~& [%test-pour ost pax -.sih +<.sih]
?~ pax ~& %test-strange-path [~ +>.$]
?: ?=(%automagic -.pax)
(spec-pour ost pax sih)
=+ tst=(~(get by tests) -.pax)
?~ tst
~& [%test-bad-path pax] [~ +>.$]
=+ res=(pour:u.tst ost +.pax sih)
:- -.res
+>.$(tests (~(put by tests) -.pax +.res))
--