diff --git a/app/aqua-behn.hoon b/app/aqua-behn.hoon index d483acb88..6763bd02c 100644 --- a/app/aqua-behn.hoon +++ b/app/aqua-behn.hoon @@ -103,20 +103,20 @@ ++ set-timer |= tim=@da =. tim +(tim) :: nobody's perfect - ~& [who=who %setting-timer tim] + ~? debug=| [who=who %setting-timer tim] =. next-timer `tim =. this (emit-moves [ost %wait /(scot %p who) tim]~) ..abet-pe :: ++ cancel-timer - ~& [who=who %cancell-timer (need next-timer)] + ~? debug=| [who=who %cancell-timer (need next-timer)] =. this (emit-moves [ost %rest /(scot %p who) (need next-timer)]~) =. next-timer ~ ..abet-pe :: ++ take-wake |= [way=wire ~] - ~& [who=who %aqua-behn-wake now] + ~? debug=| [who=who %aqua-behn-wake now] =. next-timer ~ =. this %- emit-aqua-events diff --git a/app/aqua.hoon b/app/aqua.hoon index 7a7d7a347..0c15a412b 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -131,11 +131,9 @@ ?> ?=(%0 -.res) =/ peek p.res =/ pax (path p) - ~& [who=who %peeking-in tym pax] ?> ?=([@ @ @ @ *] pax) =. i.t.t.t.pax (scot %da tym) =/ pek (slum peek [tym pax]) - ~& [who=who %peeked] pek :: :: Wish @@ -166,7 +164,7 @@ =. ..abet-pe =/ sof ((soft unix-effect) i.effects) ?~ sof - ~& [who=who %unknown-effect i.effects] + ~? aqua-debug=| [who=who %unknown-effect i.effects] ..abet-pe (publish-effect u.sof) $(effects t.effects) @@ -500,7 +498,6 @@ ++ peek-x-fleet-snap |= pax=path ^- (unit (unit [%noun noun])) - ~& [%peeking pax] ?. ?=([@ ~] pax) ~ :^ ~ ~ %noun @@ -511,7 +508,6 @@ ++ peek-x-i |= pax=path ^- (unit (unit [%noun noun])) - ~& [%peeking-i pax] ?. ?=([@ @ @ *] pax) ~ =/ who (slav %p i.pax) diff --git a/app/ph.hoon b/app/ph.hoon index 70517068b..03f76ff42 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -33,7 +33,7 @@ +$ state $: %0 raw-test-cores=(map term raw-test-core) - test-cores=(map term test-core-state) + test-core=(unit test-core-state) other-state == :: @@ -44,7 +44,9 @@ == :: +$ other-state - $~ + $: test-qeu=(qeu term) + results=(list (pair term ?)) + == -- =, gall =/ vane-apps=(list term) @@ -59,7 +61,6 @@ :: ++ auto-tests =, test-lib - %- malt ^- (list (pair term raw-test-core)) :~ :- %boot-bud @@ -119,11 +120,11 @@ %second-cousin-hi |_ now=@da ++ start - (dojo ~haplun-todtus "|hi ~bud") + (dojo ~haplun-todtus "|hi ~mitnep-todsut") :: ++ route |= [who=ship uf=unix-effect] - (expect-dojo-output ~haplun-todtus who uf "hi ~bud successful") + (expect-dojo-output ~haplun-todtus who uf "hi ~mitnep-todsut successful") -- :: :- %change-file @@ -147,7 +148,6 @@ :: ++ manual-tests =, test-lib - %- malt ^- (list (pair term raw-test-core)) :~ :- %boot-from-azimuth %+ compose-tests @@ -163,20 +163,21 @@ ++ install-tests ^+ this =. raw-test-cores - (~(uni by auto-tests) manual-tests) + (~(uni by (malt auto-tests)) (malt 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)) + ~& prep=%ph =. this install-tests - ?~ old - `this - =/ new ((soft other-state) rest.u.old) - ?~ new - `this - `this(+<+>+> u.new) + `this + :: ?~ old + :: `this + :: =/ new ((soft other-state) rest.u.old) + :: ?~ new + :: `this + :: `this(+<+>+> u.new) :: ++ publish-aqua-effects |= afs=aqua-effects @@ -194,32 +195,34 @@ ?: =(~ what) `this =/ res - |- ^- (each (list aqua-event) $~) + |- ^- (each (list aqua-event) ?) ?~ what [%& ~] ?: ?=(%test-done -.i.what) - ~& ?~(p.i.what "TEST SUCCESSFUL" "TEST FAILED") - [%| ~] + ~& ?~ p.i.what + "TEST {(trip lab)} SUCCESSFUL" + "TEST {(trip lab)} FAILED" + [%| p.i.what] =/ nex $(what t.what) ?: ?=(%| -.nex) nex [%& `aqua-event`i.what p.nex] ?: ?=(%| -.res) - (cancel-test lab) + =^ moves-1 this (finish-test lab p.res) + =^ moves-2 this run-test + [(weld moves-1 moves-2) this] [[ost.hid %poke /running [our.hid %aqua] %aqua-events p.res]~ this] :: :: Cancel subscriptions to ships :: -++ cancel-test - |= lab=term +++ finish-test + |= [lab=term success=?] ^- (quip move _this) - =/ test (~(get by test-cores) lab) - ?~ test + ?~ test-core `this - =. test-cores (~(del by test-cores) lab) - :_ this + :_ this(test-core ~, results [[lab success] results]) %- zing - %+ turn hers.u.test + %+ turn hers.u.test-core |= her=ship ^- (list move) :~ [ost.hid %pull /[lab]/(scot %p her) [our.hid %aqua] ~] @@ -232,6 +235,42 @@ == == :: +:: XXX doc +:: +++ run-test + ^- (quip move _this) + ?^ test-core + `this + ?: =(~ test-qeu) + ?~ results + `this + =/ throw-away print-results + `this(results ~) + =^ lab test-qeu ~(get to test-qeu) + ~& [running-test=lab test-qeu] + =/ res=[events=(list ph-event) new-state=raw-test-core] + ~(start (~(got by raw-test-cores) lab) now.hid) + => .(test-core `(unit test-core-state)`test-core) + =. test-core `[ships . ~]:new-state.res + =^ moves-1 this (subscribe-to-effects lab ships.new-state.res) + =^ moves-2 this (run-events lab events.res) + [:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this] +:: +:: +:: +++ print-results + ~& "TEST REPORT:" + =/ throw-away + %+ turn + results + |= [lab=term success=?] + ~& "{?:(success "SUCCESS" "FAILURE")}: {(trip lab)}" + ~ + ~& ?: (levy results |=([term s=?] s)) + "ALL TESTS SUCCEEDED" + "FAILURES" + ~ +:: :: Should check whether we're already subscribed :: ++ subscribe-to-effects @@ -291,16 +330,24 @@ %init [init-vanes this] :: - [%run-test lab=@tas] - =/ res=[events=(list ph-event) new-state=raw-test-core] - ~(start (~(got by raw-test-cores) lab.arg) now.hid) - =. test-cores (~(put by test-cores) lab.arg [ships . ~]:new-state.res) - =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) - =^ moves-2 this (run-events lab.arg events.res) - [:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this] + %run-all-tests + =. test-qeu + %- ~(gas to test-qeu) + (turn auto-tests head) + run-test :: - [%print lab=@tas] - =/ log effect-log:(~(got by test-cores) lab.arg) + [%run-test lab=@tas] + ?. (~(has by raw-test-cores) lab.arg) + ~& [%no-test lab.arg] + `this + =. test-qeu (~(put to test-qeu) lab.arg) + run-test + :: + %cancel-test + !! + :: + %print + =/ log effect-log:(need test-core) ~& lent=(lent log) ~& %+ roll log |= [[who=ship uf=unix-effect] ~] @@ -322,29 +369,28 @@ :: ~& [%diff-aqua-effect way who.afs] ?> ?=([@tas @ ~] way) =/ lab i.way - =/ test-cor (~(get by test-cores) lab) - ?~ test-cor + ?~ test-core ~& [%ph-dropping lab] `this =+ |- ^- $: thru-effects=(list unix-effect) events=(list ph-event) - cor=_u.test-cor + cor=_u.test-core == ?~ ufs.afs - [~ ~ u.test-cor] - =. effect-log.u.test-cor - [[who i.ufs]:afs effect-log.u.test-cor] - =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-cor] - (~(route cor.u.test-cor now.hid) who.afs i.ufs.afs) - =. cor.u.test-cor cor + [~ ~ u.test-core] + =. effect-log.u.test-core + [[who i.ufs]:afs effect-log.u.test-core] + =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-core] + (~(route cor.u.test-core now.hid) who.afs i.ufs.afs) + =. cor.u.test-core cor =+ $(ufs.afs t.ufs.afs) :+ ?: thru [i.ufs.afs thru-effects] thru-effects (weld events-1 events) cor - =. u.test-cor cor - =. test-cores (~(put by test-cores) lab u.test-cor) + =. test-core `cor + => .(test-core `(unit test-core-state)`test-core) =/ moves-1 (publish-aqua-effects who.afs thru-effects) =^ moves-2 this (run-events lab events) [(weld moves-1 moves-2) this] @@ -363,6 +409,5 @@ :: ++ pull |= pax=path - ~& [%ph-unsubscribed pax ost.hid] `+>.$ -- diff --git a/lib/ph.hoon b/lib/ph.hoon index 11dcdc8df..9f2ecd00b 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -246,13 +246,13 @@ ^- (quip ph-event _..start) =/ have-cache (scry-aqua ? now /fleet-snap/[label:a]/noun) - :: ?: have-cache - :: ~& [%caching-in label:a label] - :: =. done-with-a & - :: =/ restore-event [%restore-snap label:a] - :: =^ events-start b (start:b now) - :: =^ events ..filter-a (filter-a now restore-event events-start) - :: [events ..start] + ?: have-cache + ~& [%caching-in label:a label] + =. done-with-a & + =/ restore-event [%restore-snap label:a] + =^ events-start b ~(start b now) + =^ events ..filter-a (filter-a now restore-event events-start) + [events ..start] =^ events a ~(start a now) [events ..start] ::