This commit is contained in:
Philip Monk 2019-03-20 13:57:24 -07:00
parent 3d64641da7
commit aba533998f
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
3 changed files with 163 additions and 163 deletions

View File

@ -260,7 +260,7 @@
?: &(?=(^ next-events.q.i.pers) processing-events.q.i.pers)
`p.i.pers
$(pers t.pers)
~& plowing=who
~? aqua-debug=| plowing=who
?~ who
this
=. this abet-pe:plow:(pe u.who)

View File

@ -54,114 +54,106 @@
==
++ this .
++ test-lib ~(. ^test-lib our.hid)
++ install-tests
^+ this
=. raw-test-cores
~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid))
=, test-lib
%- malt
^- (list (pair term raw-test-core))
:~
:- %add
^- raw-test-core
|%
++ label %add
++ ships ~[~bud]
++ start
|= now=@da
^- (pair (list ph-event) _..start)
:_ ..start
%- zing
:~ (init ~bud ~)
(dojo ~bud "[%test-result (add 2 3)]")
==
::
++ route
|= [now=@da who=ship uf=unix-effect]
^- [? (quip ph-event _..start)]
:- &
:_ ..start
(expect-dojo-output ~bud who uf "[%test-result 5]")
--
::
:: Tests that will be run automatically with :ph %run-all-tests
::
++ auto-tests
=, test-lib
%- malt
^- (list (pair term raw-test-core))
:~
:- %boot-bud
(galaxy ~bud)
::
:- %add
^- raw-test-core
%+ compose-tests (galaxy ~bud)
%+ stateless-test
%add
|%
++ start
|= now=@da
(dojo ~bud "[%test-result (add 2 3)]")
::
:- %hi
^- raw-test-core
|%
++ label %hi
++ ships ~[~bud ~dev]
++ start
|= now=@da
^- (pair (list ph-event) _..start)
:_ ..start
%- zing
:~ (init ~bud ~)
(init ~dev ~)
(dojo ~bud "|hi ~dev")
==
::
++ route
|= [now=@da who=ship uf=unix-effect]
^- [? (quip ph-event _..start)]
:- &
:_ ..start
(expect-dojo-output ~bud who uf "hi ~dev successful")
--
::
[%headstart-bud (galaxy ~bud)]
::
:- %composed-child-boot
%+ compose-tests (planet ~linnup-torsyx)
%+ porcelain-test %composed-child-boot
|%
++ start
|= now=@da
[(dojo ~linnup-torsyx "|hi ~bud") ..start]
::
++ route
|= [now=@da who=ship uf=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- on-dojo-output
:^ ~linnup-torsyx who uf
:- "hi ~bud successful"
|= ~
[%test-done &]~
--
::
:- %composed-child-boot-2
++ route
|= [now=@da who=ship uf=unix-effect]
(expect-dojo-output ~bud who uf "[%test-result 5]")
--
::
:- %hi
%+ compose-tests
%+ compose-tests
%+ compose-tests (planet ~mitnep-todsut)
(planet ~haplun-todtus)
%+ porcelain-test
%composed-child-boot-2
|%
++ start
|= now=@da
[(dojo ~haplun-todtus "|hi ~bud") ..start]
::
++ route
|= [now=@da who=ship uf=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- on-dojo-output
:^ ~haplun-todtus who uf
:- "hi ~bud successful"
|= ~
[%test-done &]~
--
(galaxy ~bud)
(galaxy ~dev)
%+ stateless-test
%hi
|%
++ start
|= now=@da
(dojo ~bud "|hi ~dev")
::
:- %change-file
%+ compose-tests (galaxy ~bud)
(touch-file ~bud %home)
++ route
|= [now=@da who=ship uf=unix-effect]
(expect-dojo-output ~bud who uf "hi ~dev successful")
--
::
:- %boot-planet
(planet ~linnup-torsyx)
::
:- %hi-grandparent
%+ compose-tests (planet ~linnup-torsyx)
%+ stateless-test
%hi-grandparent
|%
++ start
|= now=@da
(dojo ~linnup-torsyx "|hi ~bud")
::
:- %child-sync
++ route
|= [now=@da who=ship uf=unix-effect]
(expect-dojo-output ~linnup-torsyx who uf "hi ~bud successful")
--
::
:- %second-cousin-hi
%+ compose-tests
%+ compose-tests (planet ~mitnep-todsut)
(planet ~haplun-todtus)
%+ stateless-test
%second-cousin-hi
|%
++ start
|= now=@da
(dojo ~haplun-todtus "|hi ~bud")
::
++ route
|= [now=@da who=ship uf=unix-effect]
(expect-dojo-output ~haplun-todtus who uf "hi ~bud successful")
--
::
:- %change-file
%+ compose-tests (galaxy ~bud)
(touch-file ~bud %home)
::
:- %child-sync
%+ compose-tests
%+ compose-tests
%+ compose-tests
(star ~marbud)
(touch-file ~bud %base)
(check-file-touched ~marbud %home)
::
:- %boot-azimuth
(star ~marbud)
(touch-file ~bud %base)
(check-file-touched ~marbud %home)
==
::
:: Tests that will not be run automatically.
::
:: Some valid reasons for not running a test automatically:
:: - Nondeterministic
:: - Depends on external services
:: - Is very slow
::
++ manual-tests
=, test-lib
%- malt
^- (list (pair term raw-test-core))
:~ :- %boot-from-azimuth
%+ compose-tests
%+ compose-tests
(raw-ship ~bud `(dawn:azimuth ~bud))
@ -170,27 +162,18 @@
:: :~
:: ==
*raw-test-core
::
:- %individual-breach
*raw-test-core
::
:: (init ~zod)
:: (init ~marzod)
:: wait for sync to finish
:: cycle ~zod keys
:: verify it sunk
:: kill ~zod
:: (init ~zod) w/new keys
:: change file on ~zod
:: wait for sync to finish
:: verify file has changed on ~marzod
::
==
==
::
++ install-tests
^+ this
=. raw-test-cores
(~(uni by auto-tests) manual-tests)
this
::
++ prep
|= old=(unit [@ tests=* rest=*])
^- (quip move _this)
~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid))
=. this install-tests
?~ old
`this

View File

@ -30,6 +30,8 @@
++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start))])
--
::
:: XXX doc
::
++ porcelain-test-core
$_ ^?
|%
@ -42,11 +44,22 @@
++ route |~([now=@da ship unix-effect] *(quip ph-event _^?(..start)))
--
::
:: XXX doc
::
++ stateless-test-core
$_ ^?
|%
++ start |~(now=@da *(list ph-event))
++ route |~([now=@da ship unix-effect] *(list ph-event))
--
::
++ ph-event
$% [%test-done p=?]
aqua-event
==
::
:: XXX doc
::
++ porcelain-test
|= [label=@ta porcelain=porcelain-test-core]
^- raw-test-core
@ -64,6 +77,23 @@
[& events ..start]
--
::
:: XXX doc
::
++ stateless-test
|= [label=@tas stateless=stateless-test-core]
%+ porcelain-test
label
^- porcelain-test-core
|%
++ start
|= now=@da
[(start:stateless now) ..start]
::
++ route
|= args=[@da ship unix-effect]
[(route:stateless args) ..start]
--
::
++ send-events-to
|= [who=ship what=(list unix-event)]
^- (list ph-event)
@ -100,28 +130,23 @@
[//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~]
==
::
++ on-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape fun=$-($~ (list ph-event))]
^- (list ph-event)
?. =(who her)
~
?. ?=(%blit -.q.uf)
~
?. %+ lien p.q.uf
++ is-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
?& =(who her)
?=(%blit -.q.uf)
::
%+ lien p.q.uf
|= =blit:dill
?. ?=(%lin -.blit)
|
!=(~ (find what p.blit))
~
(fun)
==
::
++ expect-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
^- (list ph-event)
%- on-dojo-output
:^ who her uf
:- what
|= ~
?. (is-dojo-output who her uf what)
~
[%test-done &]~
::
++ is-ergo
@ -281,16 +306,14 @@
:: second.
::
:~
%- on-dojo-output
:^ her who uf
:- "+ /{(scow %p her)}/base/2/web/testing/udon"
|= ~
?. %^ is-dojo-output her who :- uf
"+ /{(scow %p her)}/base/2/web/testing/udon"
~
[%test-done &]~
::
%- on-dojo-output
:^ her who uf
:- "is your neighbor"
|= ~
?. %^ is-dojo-output her who :- uf
"is your neighbor"
~
[%test-done &]~
==
--
@ -354,7 +377,6 @@
=/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun
?: =(warped (need (scry-aqua (unit @) now pax)))
[%test-done &]~
~& %not-done-yet
~
--
::
@ -374,32 +396,27 @@
:: ergos (and dojo because we can't guarantee an ergo if the desk
:: is already mounted)
::
~& %mounting
[(dojo her "|mount /={(trip des)}=") ..start]
::
++ route
|= [now=@da who=ship uf=unix-effect]
^- (quip ph-event _..start)
=/ cb
|= $~
~& %cbing
=/ pax /home/(scot %da now)/sur/aquarium/hoon
=/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax)))
=/ aqua-pax
;: weld
/i/(scot %p her)
pax(- des)
/noun
==
?: =(warped (need (scry-aqua (unit @) now aqua-pax)))
[%test-done &]~
~& %not-done-yet
~
:_ ..start
%- zing
:~ (on-ergo her who uf cb)
(on-dojo-output her who uf ">=" cb)
==
?. ?| (is-ergo her who uf)
(is-dojo-output her who uf ">=")
==
~
=/ pax /home/(scot %da now)/sur/aquarium/hoon
=/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax)))
=/ aqua-pax
;: weld
/i/(scot %p her)
pax(- des)
/noun
==
?: =(warped (need (scry-aqua (unit @) now aqua-pax)))
[%test-done &]~
~
--
::
:: Reload vane from filesystem