2019-02-12 02:25:25 +03:00
|
|
|
:: Test the pH of your aquarium. See if it's safe to put in real fish.
|
2019-02-06 05:21:41 +03:00
|
|
|
::
|
|
|
|
:: usage:
|
|
|
|
:: :aqua [%run-test %test-add]
|
|
|
|
::
|
|
|
|
:: TODO:
|
|
|
|
:: - Restore a fleet
|
|
|
|
:: - Compose tests
|
|
|
|
::
|
|
|
|
/- aquarium
|
|
|
|
/+ ph
|
|
|
|
=, aquarium
|
|
|
|
=, ph
|
|
|
|
=> $~ |%
|
2019-03-06 23:22:37 +03:00
|
|
|
+$ move (pair bone card)
|
|
|
|
+$ card
|
2019-03-08 08:15:42 +03:00
|
|
|
$% [%poke wire dock poke-type]
|
2019-02-09 00:34:24 +03:00
|
|
|
[%peer wire dock path]
|
|
|
|
[%pull wire dock ~]
|
2019-03-08 08:15:42 +03:00
|
|
|
[%diff diff-type]
|
2019-02-06 05:21:41 +03:00
|
|
|
==
|
|
|
|
::
|
2019-03-08 08:15:42 +03:00
|
|
|
+$ poke-type
|
2019-03-07 10:31:14 +03:00
|
|
|
$% [%aqua-events (list aqua-event)]
|
|
|
|
[%drum-start term term]
|
2019-03-08 08:15:42 +03:00
|
|
|
[%aqua-vane-control ?(%subscribe %unsubscribe)]
|
|
|
|
==
|
|
|
|
::
|
|
|
|
+$ diff-type
|
|
|
|
$% [%aqua-effects aqua-effects]
|
2019-03-07 10:31:14 +03:00
|
|
|
==
|
|
|
|
::
|
2019-03-06 23:22:37 +03:00
|
|
|
+$ state
|
2019-02-06 05:21:41 +03:00
|
|
|
$: %0
|
2019-03-07 10:31:14 +03:00
|
|
|
raw-test-cores=(map term raw-test-core)
|
2019-03-21 03:37:05 +03:00
|
|
|
test-core=(unit test-core-state)
|
2019-02-06 05:21:41 +03:00
|
|
|
other-state
|
|
|
|
==
|
2019-03-06 23:22:37 +03:00
|
|
|
::
|
|
|
|
+$ test-core-state
|
2019-04-09 07:13:06 +03:00
|
|
|
$: lab=term
|
|
|
|
hers=(list ship)
|
2019-03-07 10:31:14 +03:00
|
|
|
cor=raw-test-core
|
2019-03-06 23:22:37 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
+$ other-state
|
2019-03-21 03:37:05 +03:00
|
|
|
$: test-qeu=(qeu term)
|
|
|
|
results=(list (pair term ?))
|
2019-03-27 04:07:42 +03:00
|
|
|
effect-log=(list [who=ship uf=unix-effect])
|
2019-03-21 03:37:05 +03:00
|
|
|
==
|
2019-02-06 05:21:41 +03:00
|
|
|
--
|
|
|
|
=, gall
|
2019-03-09 00:48:09 +03:00
|
|
|
=/ vane-apps=(list term)
|
2019-03-23 04:11:04 +03:00
|
|
|
~[%aqua-ames %aqua-behn %aqua-dill %aqua-eyre]
|
2019-02-06 05:21:41 +03:00
|
|
|
|_ $: hid=bowl
|
|
|
|
state
|
|
|
|
==
|
|
|
|
++ this .
|
2019-02-12 05:46:36 +03:00
|
|
|
++ test-lib ~(. ^test-lib our.hid)
|
2019-03-20 23:57:24 +03:00
|
|
|
::
|
|
|
|
:: Tests that will be run automatically with :ph %run-all-tests
|
|
|
|
::
|
|
|
|
++ auto-tests
|
|
|
|
=, test-lib
|
|
|
|
^- (list (pair term raw-test-core))
|
|
|
|
:~
|
|
|
|
:- %boot-bud
|
|
|
|
(galaxy ~bud)
|
|
|
|
::
|
|
|
|
:- %add
|
|
|
|
^- raw-test-core
|
|
|
|
%+ compose-tests (galaxy ~bud)
|
|
|
|
%+ stateless-test
|
|
|
|
%add
|
2019-03-21 00:38:42 +03:00
|
|
|
|_ now=@da
|
2019-03-20 23:57:24 +03:00
|
|
|
++ start
|
|
|
|
(dojo ~bud "[%test-result (add 2 3)]")
|
2019-02-12 05:46:36 +03:00
|
|
|
::
|
2019-03-20 23:57:24 +03:00
|
|
|
++ route
|
2019-03-21 00:38:42 +03:00
|
|
|
|= [who=ship uf=unix-effect]
|
2019-03-20 23:57:24 +03:00
|
|
|
(expect-dojo-output ~bud who uf "[%test-result 5]")
|
|
|
|
--
|
|
|
|
::
|
|
|
|
:- %hi
|
|
|
|
%+ compose-tests
|
2019-02-12 22:26:48 +03:00
|
|
|
%+ compose-tests
|
2019-03-20 23:57:24 +03:00
|
|
|
(galaxy ~bud)
|
|
|
|
(galaxy ~dev)
|
2019-03-30 00:59:45 +03:00
|
|
|
(send-hi ~bud ~dev)
|
2019-03-20 23:57:24 +03:00
|
|
|
::
|
|
|
|
:- %boot-planet
|
|
|
|
(planet ~linnup-torsyx)
|
|
|
|
::
|
|
|
|
:- %hi-grandparent
|
|
|
|
%+ compose-tests (planet ~linnup-torsyx)
|
|
|
|
%+ stateless-test
|
|
|
|
%hi-grandparent
|
2019-03-21 00:38:42 +03:00
|
|
|
|_ now=@da
|
2019-03-20 23:57:24 +03:00
|
|
|
++ start
|
|
|
|
(dojo ~linnup-torsyx "|hi ~bud")
|
2019-02-16 12:24:37 +03:00
|
|
|
::
|
2019-03-20 23:57:24 +03:00
|
|
|
++ route
|
2019-03-21 00:38:42 +03:00
|
|
|
|= [who=ship uf=unix-effect]
|
2019-03-20 23:57:24 +03:00
|
|
|
(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
|
2019-03-21 00:38:42 +03:00
|
|
|
|_ now=@da
|
2019-03-20 23:57:24 +03:00
|
|
|
++ start
|
2019-03-21 03:37:05 +03:00
|
|
|
(dojo ~haplun-todtus "|hi ~mitnep-todsut")
|
2019-03-06 23:22:37 +03:00
|
|
|
::
|
2019-03-20 23:57:24 +03:00
|
|
|
++ route
|
2019-03-21 00:38:42 +03:00
|
|
|
|= [who=ship uf=unix-effect]
|
2019-03-21 03:37:05 +03:00
|
|
|
(expect-dojo-output ~haplun-todtus who uf "hi ~mitnep-todsut successful")
|
2019-03-20 23:57:24 +03:00
|
|
|
--
|
|
|
|
::
|
|
|
|
:- %change-file
|
|
|
|
%+ compose-tests (galaxy ~bud)
|
|
|
|
(touch-file ~bud %home)
|
|
|
|
::
|
|
|
|
:- %child-sync
|
|
|
|
%+ compose-tests
|
|
|
|
%+ compose-tests
|
|
|
|
(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
|
|
|
|
^- (list (pair term raw-test-core))
|
2019-03-30 00:59:45 +03:00
|
|
|
=/ static-eth-node
|
|
|
|
%- malt
|
|
|
|
^- (list [@t @t])
|
2019-04-09 07:13:06 +03:00
|
|
|
:~ :- '{"params":[],"id":"block number","jsonrpc":"2.0","method":"eth_blockNumber"}'
|
|
|
|
'{"id":"block number","jsonrpc":"2.0","result":"0x7"}'
|
|
|
|
:- '{"params":[{"fromBlock":"0x0","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381","toBlock":"0x7"}],"id":"catch up","jsonrpc":"2.0","method":"eth_getLogs"}'
|
|
|
|
'{"id":"catch up","jsonrpc":"2.0","result":[{"logIndex":"0x0","transactionIndex":"0x0","transactionHash":"0x68ddd548d852373c1a0647be1b0c3df020e34bacbf6f2e2e9ceb4e80db517e3f","blockHash":"0x3783bf0ba0e9de7449c50375d899a72f00f9423a6dd881b677d4768e3ba7855a","blockNumber":"0x1","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381","data":"0x000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a000000000000000000000000000000000000000000000000000000000000000e0000000000000000000000000000000000000000000000000000000000000000b6578616d706c652e636f6d000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000b6578616d706c652e636f6d000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000b6578616d706c652e636f6d000000000000000000000000000000000000000000","topics":["0xfafd04ade1daae2e1fdb0fc1cc6a899fd424063ed5c92120e67e073053b94898"],"type":"mined"},{"logIndex":"0x0","transactionIndex":"0x0","transactionHash":"0x9ccaa993d930767468a34fa04cd13b0b7868d93eb9900b11f2b1f7d55a0670da","blockHash":"0xff1b610fe58f1938fbccf449363ddd574a902f9a3a71771e0215335b4d99abaa","blockNumber":"0x6","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381","data":"0x","topics":["0x8be0079c531659141344cd1fd0a4f28419497f9722a3daafe3b4186f6b6457e0","0x0000000000000000000000006deffb0cafdb11d175f123f6891aa64f01c24f7d","0x00000000000000000000000056db68f29203ff44a803faa2404a44ecbb7a7480"],"type":"mined"}]}'
|
2019-03-30 00:59:45 +03:00
|
|
|
:- '{"params":[{"fromBlock":"0x0","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381"}],"id":"new filter","jsonrpc":"2.0","method":"eth_newFilter"}'
|
|
|
|
'{"id":"new filter","jsonrpc":"2.0","result":"0xa"}'
|
|
|
|
:- '{"params":["0x0a"],"id":"filter logs","jsonrpc":"2.0","method":"eth_getFilterLogs"}'
|
|
|
|
'{"id":"filter logs","jsonrpc":"2.0","result":[{"logIndex":"0x0","transactionIndex":"0x0","transactionHash":"0x68ddd548d852373c1a0647be1b0c3df020e34bacbf6f2e2e9ceb4e80db517e3f","blockHash":"0x3783bf0ba0e9de7449c50375d899a72f00f9423a6dd881b677d4768e3ba7855a","blockNumber":"0x1","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381","data":"0x000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a000000000000000000000000000000000000000000000000000000000000000e0000000000000000000000000000000000000000000000000000000000000000b6578616d706c652e636f6d000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000b6578616d706c652e636f6d000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000b6578616d706c652e636f6d000000000000000000000000000000000000000000","topics":["0xfafd04ade1daae2e1fdb0fc1cc6a899fd424063ed5c92120e67e073053b94898"],"type":"mined"},{"logIndex":"0x0","transactionIndex":"0x0","transactionHash":"0x9ccaa993d930767468a34fa04cd13b0b7868d93eb9900b11f2b1f7d55a0670da","blockHash":"0xff1b610fe58f1938fbccf449363ddd574a902f9a3a71771e0215335b4d99abaa","blockNumber":"0x6","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381","data":"0x","topics":["0x8be0079c531659141344cd1fd0a4f28419497f9722a3daafe3b4186f6b6457e0","0x0000000000000000000000006deffb0cafdb11d175f123f6891aa64f01c24f7d","0x00000000000000000000000056db68f29203ff44a803faa2404a44ecbb7a7480"],"type":"mined"}]}'
|
|
|
|
:- '{"params":["0x0a"],"id":"poll filter","jsonrpc":"2.0","method":"eth_getFilterChanges"}'
|
|
|
|
'{"id":"poll filter","jsonrpc":"2.0","result":[]}'
|
|
|
|
==
|
2019-04-11 04:49:20 +03:00
|
|
|
=/ eth-node (spawn-galaxy:az ~rel)
|
2019-03-30 00:59:45 +03:00
|
|
|
:~ :- %boot-az
|
2019-04-11 04:49:20 +03:00
|
|
|
%^ wrap-test-stateful
|
|
|
|
%fake-eth-node
|
|
|
|
router:eth-node
|
|
|
|
%- compose-tests
|
|
|
|
:_ *raw-test-core
|
2019-03-06 23:22:37 +03:00
|
|
|
%+ compose-tests
|
2019-04-09 07:13:06 +03:00
|
|
|
(raw-ship ~bud `(dawn:ph-azimuth ~bud))
|
2019-03-27 04:07:42 +03:00
|
|
|
(touch-file ~bud %home)
|
2019-03-30 00:59:45 +03:00
|
|
|
::
|
|
|
|
:- %boot-az-hi
|
2019-04-11 04:49:20 +03:00
|
|
|
%^ wrap-test-stateful
|
|
|
|
%fake-eth-node
|
|
|
|
router:eth-node
|
2019-04-09 07:13:06 +03:00
|
|
|
:: %- compose-tests
|
|
|
|
:: :_ *raw-test-core
|
2019-03-30 00:59:45 +03:00
|
|
|
%+ compose-tests
|
|
|
|
%+ compose-tests
|
2019-04-09 07:13:06 +03:00
|
|
|
(raw-ship ~bud `(dawn:ph-azimuth ~bud))
|
|
|
|
(raw-ship ~dev `(dawn:ph-azimuth ~dev))
|
2019-03-30 00:59:45 +03:00
|
|
|
(send-hi ~bud ~dev)
|
2019-03-23 03:18:54 +03:00
|
|
|
::
|
|
|
|
:- %simple-add
|
|
|
|
%+ compose-tests (galaxy ~bud)
|
|
|
|
%+ stateless-test
|
|
|
|
%add
|
|
|
|
^- stateless-test-core
|
|
|
|
|_ now=@da
|
|
|
|
++ start
|
|
|
|
=/ command "[%test-result (add 2 3)]"
|
|
|
|
:~ [%event ~bud //term/1 %belt %txt ((list @c) command)]
|
|
|
|
[%event ~bud //term/1 %belt %ret ~]
|
|
|
|
==
|
|
|
|
::
|
|
|
|
++ route
|
|
|
|
|= [who=ship uf=unix-effect]
|
|
|
|
?. (is-dojo-output ~bud who uf "[%test-result 5]")
|
|
|
|
~
|
|
|
|
[%test-done &]~
|
|
|
|
--
|
|
|
|
::
|
|
|
|
:- %count
|
|
|
|
%+ compose-tests (galaxy ~bud)
|
|
|
|
%+ porcelain-test
|
|
|
|
%state
|
|
|
|
=| count=@
|
|
|
|
|_ now=@da
|
|
|
|
++ start
|
|
|
|
^- (quip ph-event _..start)
|
|
|
|
[(dojo ~bud "\"count: {<count>}\"") ..start]
|
|
|
|
::
|
|
|
|
++ route
|
|
|
|
|= [who=ship uf=unix-effect]
|
|
|
|
^- (quip ph-event _..start)
|
|
|
|
?. (is-dojo-output ~bud who uf "\"count: {<count>}\"")
|
|
|
|
[~ ..start]
|
|
|
|
?: (gte count 10)
|
|
|
|
[[%test-done &]~ ..start]
|
|
|
|
=. count +(count)
|
|
|
|
start
|
|
|
|
--
|
|
|
|
::
|
|
|
|
:- %break-behn
|
|
|
|
%+ compose-tests
|
|
|
|
%+ compose-tests
|
|
|
|
(galaxy ~bud)
|
|
|
|
(galaxy ~dev)
|
|
|
|
^- raw-test-core
|
|
|
|
|_ now=@da
|
|
|
|
++ label %break-behn
|
|
|
|
++ ships ~
|
|
|
|
++ start
|
|
|
|
[(dojo ~bud "|hi ~dev") ..start]
|
|
|
|
::
|
|
|
|
++ route
|
|
|
|
|= [who=ship uf=unix-effect]
|
|
|
|
^- [? (quip ph-event _..start)]
|
|
|
|
?: ?=(%doze -.q.uf)
|
|
|
|
[| ~ ..start]
|
|
|
|
:- & :_ ..start
|
|
|
|
(expect-dojo-output ~bud who uf "hi ~dev successful")
|
|
|
|
--
|
2019-03-20 23:57:24 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
++ install-tests
|
|
|
|
^+ this
|
|
|
|
=. raw-test-cores
|
2019-03-21 03:37:05 +03:00
|
|
|
(~(uni by (malt auto-tests)) (malt manual-tests))
|
2019-02-06 05:21:41 +03:00
|
|
|
this
|
|
|
|
::
|
|
|
|
++ prep
|
|
|
|
|= old=(unit [@ tests=* rest=*])
|
2019-02-09 00:34:24 +03:00
|
|
|
^- (quip move _this)
|
2019-03-21 03:37:05 +03:00
|
|
|
~& prep=%ph
|
2019-02-06 05:21:41 +03:00
|
|
|
=. this install-tests
|
2019-03-21 03:37:05 +03:00
|
|
|
`this
|
|
|
|
:: ?~ old
|
|
|
|
:: `this
|
|
|
|
:: =/ new ((soft other-state) rest.u.old)
|
|
|
|
:: ?~ new
|
|
|
|
:: `this
|
|
|
|
:: `this(+<+>+> u.new)
|
2019-02-06 05:21:41 +03:00
|
|
|
::
|
2019-03-07 10:31:14 +03:00
|
|
|
++ publish-aqua-effects
|
|
|
|
|= afs=aqua-effects
|
|
|
|
^- (list move)
|
|
|
|
%+ murn ~(tap by sup.hid)
|
|
|
|
|= [b=bone her=ship pax=path]
|
|
|
|
^- (unit move)
|
|
|
|
?. ?=([%effects ~] pax)
|
|
|
|
~
|
2019-03-08 09:28:10 +03:00
|
|
|
`[b %diff %aqua-effects afs]
|
2019-03-07 10:31:14 +03:00
|
|
|
::
|
2019-02-06 05:21:41 +03:00
|
|
|
++ run-events
|
2019-02-09 00:34:24 +03:00
|
|
|
|= [lab=term what=(list ph-event)]
|
|
|
|
^- (quip move _this)
|
2019-02-06 05:21:41 +03:00
|
|
|
?: =(~ what)
|
|
|
|
`this
|
|
|
|
=/ res
|
2019-03-21 03:37:05 +03:00
|
|
|
|- ^- (each (list aqua-event) ?)
|
2019-02-06 05:21:41 +03:00
|
|
|
?~ what
|
|
|
|
[%& ~]
|
|
|
|
?: ?=(%test-done -.i.what)
|
2019-03-21 03:37:05 +03:00
|
|
|
~& ?~ p.i.what
|
|
|
|
"TEST {(trip lab)} SUCCESSFUL"
|
|
|
|
"TEST {(trip lab)} FAILED"
|
|
|
|
[%| p.i.what]
|
2019-02-06 05:21:41 +03:00
|
|
|
=/ nex $(what t.what)
|
|
|
|
?: ?=(%| -.nex)
|
|
|
|
nex
|
|
|
|
[%& `aqua-event`i.what p.nex]
|
|
|
|
?: ?=(%| -.res)
|
2019-03-21 03:37:05 +03:00
|
|
|
=^ moves-1 this (finish-test lab p.res)
|
|
|
|
=^ moves-2 this run-test
|
|
|
|
[(weld moves-1 moves-2) this]
|
2019-02-06 05:21:41 +03:00
|
|
|
[[ost.hid %poke /running [our.hid %aqua] %aqua-events p.res]~ this]
|
|
|
|
::
|
2019-02-09 00:34:24 +03:00
|
|
|
:: Cancel subscriptions to ships
|
|
|
|
::
|
2019-03-21 03:37:05 +03:00
|
|
|
++ finish-test
|
|
|
|
|= [lab=term success=?]
|
2019-02-09 00:34:24 +03:00
|
|
|
^- (quip move _this)
|
2019-03-21 03:37:05 +03:00
|
|
|
?~ test-core
|
2019-02-09 00:34:24 +03:00
|
|
|
`this
|
2019-03-21 03:37:05 +03:00
|
|
|
:_ this(test-core ~, results [[lab success] results])
|
2019-02-09 00:34:24 +03:00
|
|
|
%- zing
|
2019-03-21 03:37:05 +03:00
|
|
|
%+ turn hers.u.test-core
|
2019-02-09 00:34:24 +03:00
|
|
|
|= her=ship
|
|
|
|
^- (list move)
|
|
|
|
:~ [ost.hid %pull /[lab]/(scot %p her) [our.hid %aqua] ~]
|
|
|
|
:* ost.hid
|
|
|
|
%poke
|
|
|
|
/cancelling
|
|
|
|
[our.hid %aqua]
|
|
|
|
%aqua-events
|
|
|
|
[%pause-events her]~
|
|
|
|
==
|
|
|
|
==
|
|
|
|
::
|
2019-03-23 03:18:54 +03:00
|
|
|
:: Start another test if one is in the queue
|
2019-03-21 03:37:05 +03:00
|
|
|
::
|
|
|
|
++ 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]
|
2019-03-27 04:07:42 +03:00
|
|
|
=. effect-log ~
|
2019-03-21 03:37:05 +03:00
|
|
|
=/ 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)
|
2019-04-09 07:13:06 +03:00
|
|
|
=. test-core `[lab [ships .]:new-state.res]
|
2019-03-21 03:37:05 +03:00
|
|
|
=^ 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]
|
|
|
|
::
|
2019-03-23 03:18:54 +03:00
|
|
|
:: Print results with ~&
|
2019-03-21 03:37:05 +03:00
|
|
|
::
|
|
|
|
++ 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"
|
|
|
|
~
|
|
|
|
::
|
2019-02-06 05:21:41 +03:00
|
|
|
:: Should check whether we're already subscribed
|
|
|
|
::
|
|
|
|
++ subscribe-to-effects
|
|
|
|
|= [lab=@tas hers=(list ship)]
|
|
|
|
:_ this
|
|
|
|
%+ turn hers
|
|
|
|
|= her=ship
|
|
|
|
^- move
|
|
|
|
:* ost.hid
|
|
|
|
%peer
|
|
|
|
/[lab]/(scot %p her)
|
|
|
|
[our.hid %aqua]
|
|
|
|
/effects/(scot %p her)
|
|
|
|
==
|
|
|
|
::
|
2019-03-09 00:48:09 +03:00
|
|
|
:: Start the vane drivers
|
|
|
|
::
|
|
|
|
++ init-vanes
|
|
|
|
^- (list move)
|
|
|
|
%+ murn
|
|
|
|
`(list term)`[%aqua vane-apps]
|
|
|
|
|= vane-app=term
|
|
|
|
^- (unit move)
|
|
|
|
=/ app-started
|
|
|
|
.^(? %gu /(scot %p our.hid)/[vane-app]/(scot %da now.hid))
|
|
|
|
?: app-started
|
|
|
|
~
|
|
|
|
`[ost.hid %poke /start [our.hid %hood] %drum-start %home vane-app]
|
|
|
|
::
|
|
|
|
:: Restart the vane drivers' subscriptions
|
|
|
|
::
|
|
|
|
++ subscribe-vanes
|
|
|
|
^- (list move)
|
|
|
|
%+ turn
|
|
|
|
vane-apps
|
|
|
|
|= vane-app=term
|
|
|
|
[ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe]
|
|
|
|
::
|
2019-03-13 14:50:56 +03:00
|
|
|
:: Pause all existing ships
|
|
|
|
::
|
|
|
|
++ pause-fleet
|
|
|
|
^- (list move)
|
|
|
|
:_ ~
|
|
|
|
:* ost.hid %poke /pause-fleet [our.hid %aqua] %aqua-events
|
|
|
|
%+ turn
|
|
|
|
.^((list ship) %gx /(scot %p our.hid)/aqua/(scot %da now.hid)/ships/noun)
|
|
|
|
|= who=ship
|
|
|
|
[%pause-events who]
|
|
|
|
==
|
|
|
|
::
|
2019-03-09 00:48:09 +03:00
|
|
|
:: User interface
|
|
|
|
::
|
2019-02-06 05:21:41 +03:00
|
|
|
++ poke-noun
|
|
|
|
|= arg=*
|
|
|
|
^- (quip move _this)
|
|
|
|
?+ arg ~|(%bad-noun-arg !!)
|
2019-03-07 10:31:14 +03:00
|
|
|
%init
|
2019-03-09 00:48:09 +03:00
|
|
|
[init-vanes this]
|
2019-03-21 03:37:05 +03:00
|
|
|
::
|
|
|
|
%run-all-tests
|
|
|
|
=. test-qeu
|
|
|
|
%- ~(gas to test-qeu)
|
|
|
|
(turn auto-tests head)
|
|
|
|
run-test
|
2019-03-07 10:31:14 +03:00
|
|
|
::
|
2019-02-06 05:21:41 +03:00
|
|
|
[%run-test lab=@tas]
|
2019-03-21 03:37:05 +03:00
|
|
|
?. (~(has by raw-test-cores) lab.arg)
|
|
|
|
~& [%no-test lab.arg]
|
|
|
|
`this
|
|
|
|
=. test-qeu (~(put to test-qeu) lab.arg)
|
|
|
|
run-test
|
|
|
|
::
|
2019-03-21 03:45:36 +03:00
|
|
|
%cancel
|
|
|
|
=^ moves-1 this (finish-test %last |)
|
|
|
|
=. test-qeu ~
|
|
|
|
=^ moves-2 this run-test
|
|
|
|
[:(weld moves-1 moves-2) this]
|
2019-03-06 23:22:37 +03:00
|
|
|
::
|
2019-03-21 03:37:05 +03:00
|
|
|
%print
|
2019-03-27 04:07:42 +03:00
|
|
|
~& lent=(lent effect-log)
|
|
|
|
~& %+ roll effect-log
|
2019-03-07 10:31:14 +03:00
|
|
|
|= [[who=ship uf=unix-effect] ~]
|
|
|
|
?: ?=(?(%blit %doze) -.q.uf)
|
2019-03-06 23:22:37 +03:00
|
|
|
~
|
2019-03-07 10:31:14 +03:00
|
|
|
?: ?=(%ergo -.q.uf)
|
|
|
|
~& [who [- +<]:uf %omitted-by-ph]
|
2019-03-06 23:22:37 +03:00
|
|
|
~
|
2019-03-07 10:31:14 +03:00
|
|
|
~& [who uf]
|
2019-03-06 23:22:37 +03:00
|
|
|
~
|
|
|
|
`this
|
2019-02-06 05:21:41 +03:00
|
|
|
==
|
|
|
|
::
|
2019-03-09 00:48:09 +03:00
|
|
|
:: Receive effects back from aqua
|
|
|
|
::
|
2019-02-08 05:03:46 +03:00
|
|
|
++ diff-aqua-effects
|
2019-03-07 10:31:14 +03:00
|
|
|
|= [way=wire afs=aqua-effects]
|
2019-02-06 05:21:41 +03:00
|
|
|
^- (quip move _this)
|
2019-03-08 08:15:42 +03:00
|
|
|
:: ~& [%diff-aqua-effect way who.afs]
|
2019-02-09 00:34:24 +03:00
|
|
|
?> ?=([@tas @ ~] way)
|
2019-02-06 05:21:41 +03:00
|
|
|
=/ lab i.way
|
2019-03-21 03:37:05 +03:00
|
|
|
?~ test-core
|
2019-04-09 07:13:06 +03:00
|
|
|
~& [%ph-dropping-done lab]
|
|
|
|
[[ost.hid %pull way [our.hid %aqua] ~]~ this]
|
|
|
|
?. =(lab lab.u.test-core)
|
|
|
|
~& [%ph-dropping-strange lab]
|
|
|
|
[[ost.hid %pull way [our.hid %aqua] ~]~ this]
|
2019-03-08 08:15:42 +03:00
|
|
|
=+ |- ^- $: thru-effects=(list unix-effect)
|
|
|
|
events=(list ph-event)
|
2019-03-21 03:37:05 +03:00
|
|
|
cor=_u.test-core
|
2019-03-27 04:07:42 +03:00
|
|
|
log=_effect-log
|
2019-03-07 10:31:14 +03:00
|
|
|
==
|
2019-03-08 08:15:42 +03:00
|
|
|
?~ ufs.afs
|
2019-03-27 04:07:42 +03:00
|
|
|
[~ ~ u.test-core ~]
|
2019-03-21 03:37:05 +03:00
|
|
|
=+ ^- [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
|
2019-03-08 08:15:42 +03:00
|
|
|
=+ $(ufs.afs t.ufs.afs)
|
2019-03-27 04:07:42 +03:00
|
|
|
:^ ?: thru
|
|
|
|
[i.ufs.afs thru-effects]
|
|
|
|
thru-effects
|
|
|
|
(weld events-1 events)
|
|
|
|
cor
|
|
|
|
[[who i.ufs]:afs log]
|
2019-03-21 03:37:05 +03:00
|
|
|
=. test-core `cor
|
2019-03-27 04:07:42 +03:00
|
|
|
=. effect-log (weld log effect-log)
|
2019-03-21 03:37:05 +03:00
|
|
|
=> .(test-core `(unit test-core-state)`test-core)
|
2019-03-08 08:15:42 +03:00
|
|
|
=/ moves-1 (publish-aqua-effects who.afs thru-effects)
|
|
|
|
=^ moves-2 this (run-events lab events)
|
|
|
|
[(weld moves-1 moves-2) this]
|
2019-03-07 10:31:14 +03:00
|
|
|
::
|
|
|
|
:: Subscribe to effects
|
|
|
|
::
|
|
|
|
++ peer-effects
|
|
|
|
|= pax=path
|
|
|
|
^- (quip move _this)
|
|
|
|
?. ?=(~ pax)
|
|
|
|
~& [%ph-bad-peer-effects pax]
|
|
|
|
`this
|
|
|
|
`this
|
2019-03-13 14:50:56 +03:00
|
|
|
::
|
|
|
|
:: Subscription cancelled
|
|
|
|
::
|
|
|
|
++ pull
|
|
|
|
|= pax=path
|
|
|
|
`+>.$
|
2019-02-06 05:21:41 +03:00
|
|
|
--
|