mirror of
https://github.com/urbit/shrub.git
synced 2024-12-14 20:02:51 +03:00
Add a fora test case.
This adds three test cases and fixes which exercise what we think is going wrong in the "five-oh-fora" situation.
This commit is contained in:
Elliot Glaysher
parent
ee18157026
commit
4a62502074
@ -21,11 +21,14 @@
|
|||||||
test-pinned-in-live
|
test-pinned-in-live
|
||||||
test-live-build-that-blocks
|
test-live-build-that-blocks
|
||||||
test-live-and-once
|
test-live-and-once
|
||||||
|
test-live-two-deep
|
||||||
test-slim
|
test-slim
|
||||||
test-ride
|
test-ride
|
||||||
test-ride-scry-succeed
|
test-ride-scry-succeed
|
||||||
test-ride-scry-fail
|
test-ride-scry-fail
|
||||||
test-ride-scry-block
|
test-ride-scry-block
|
||||||
|
test-ride-scry-promote
|
||||||
|
test-five-oh-fora
|
||||||
==
|
==
|
||||||
++ test-is-schematic-live
|
++ test-is-schematic-live
|
||||||
~& %test-is-schematic-live
|
~& %test-is-schematic-live
|
||||||
@ -529,6 +532,63 @@
|
|||||||
:- state-by-ship.+>+<.ford
|
:- state-by-ship.+>+<.ford
|
||||||
(my [~nul *ford-state:ford-turbo]~)
|
(my [~nul *ford-state:ford-turbo]~)
|
||||||
::
|
::
|
||||||
|
++ test-live-two-deep
|
||||||
|
~& %test-live-two-deep
|
||||||
|
::
|
||||||
|
=/ scry-42 (scry-succeed ~1234.5.6 [%noun !>(42)])
|
||||||
|
=/ scry-43 (scry-succeed ~1234.5.7 [%noun !>(43)])
|
||||||
|
::
|
||||||
|
=/ ford (ford-turbo now=~1234.5.6 eny=0xdead.beef scry=scry-42)
|
||||||
|
::
|
||||||
|
=^ moves ford
|
||||||
|
%- call:ford
|
||||||
|
:* duct=~ type=~ %make ~nul
|
||||||
|
[%same [%scry %c care=%x rail=[[~nul %desk] /bar/foo]]]
|
||||||
|
==
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- moves
|
||||||
|
:~ :* duct=~ %give %made ~1234.5.6 %complete %result
|
||||||
|
%same %result [%scry %noun !>(42)]
|
||||||
|
==
|
||||||
|
:* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk
|
||||||
|
`[%mult [%da ~1234.5.6] (sy [%x /foo/bar]~)]
|
||||||
|
== ==
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.7 eny=0xbeef.dead scry=scry-43)
|
||||||
|
=^ moves2 ford
|
||||||
|
%- take:ford
|
||||||
|
:* wire=/~nul/clay-sub/~nul/desk duct=~
|
||||||
|
^= wrapped-sign ^- (hypo sign:ford) :- *type
|
||||||
|
[%c %wris [%da ~1234.5.7] (sy [%x /foo/bar]~)]
|
||||||
|
==
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- moves2
|
||||||
|
:~ :* duct=~ %give %made ~1234.5.7 %complete %result
|
||||||
|
%same %result [%scry %noun !>(43)]
|
||||||
|
==
|
||||||
|
:* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk
|
||||||
|
`[%mult [%da ~1234.5.7] (sy [%x /foo/bar]~)]
|
||||||
|
== ==
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.8 eny=0xbeef.dead scry=scry-is-forbidden)
|
||||||
|
=^ moves3 ford
|
||||||
|
(call:ford [duct=~ type=~ %kill ~nul])
|
||||||
|
::
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- moves3
|
||||||
|
:~ :* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk ~
|
||||||
|
== ==
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- state-by-ship.+>+<.ford
|
||||||
|
(my [~nul *ford-state:ford-turbo]~)
|
||||||
|
::
|
||||||
++ test-slim
|
++ test-slim
|
||||||
~& %test-slim
|
~& %test-slim
|
||||||
::
|
::
|
||||||
@ -711,10 +771,238 @@
|
|||||||
:- state-by-ship.+>+<.ford
|
:- state-by-ship.+>+<.ford
|
||||||
(my [~nul *ford-state:ford-turbo]~)
|
(my [~nul *ford-state:ford-turbo]~)
|
||||||
::
|
::
|
||||||
|
++ test-ride-scry-promote
|
||||||
|
~& %test-ride-scry-promote
|
||||||
|
::
|
||||||
|
=/ scry-type=type [%atom %tas ~]
|
||||||
|
::
|
||||||
|
=/ scry-results=(map [term beam] cage)
|
||||||
|
%- my :~
|
||||||
|
:- [%cx [[~nul %desk %da ~1234.5.6] /bar/foo]]
|
||||||
|
[%noun scry-type %it-doesnt-matter]
|
||||||
|
::
|
||||||
|
:- [%cx [[~nul %desk %da ~1234.5.7] /bar/foo]]
|
||||||
|
[%noun scry-type %changed]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
=/ scry (scry-with-results scry-results)
|
||||||
|
=/ ford (ford-turbo now=~1234.5.6 eny=0xdead.beef scry=scry)
|
||||||
|
::
|
||||||
|
=/ formula=hoon (ream '`@tas`%constant')
|
||||||
|
=/ subject-schematic=schematic:ford [%scry %c %x [~nul %desk] /bar/foo]
|
||||||
|
::
|
||||||
|
=/ ride=schematic:ford [%ride formula subject-schematic]
|
||||||
|
::
|
||||||
|
=^ moves ford (call:ford [duct=~[/ride] type=~ %make ~nul ride])
|
||||||
|
::
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- moves
|
||||||
|
:~ :* duct=~[/ride] %give %made ~1234.5.6 %complete
|
||||||
|
[%result [%ride scry-type %constant]]
|
||||||
|
==
|
||||||
|
:* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk
|
||||||
|
`[%mult [%da ~1234.5.6] (sy [%x /foo/bar] ~)]
|
||||||
|
== ==
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.7 eny=0xbeef.dead scry=scry)
|
||||||
|
::
|
||||||
|
=^ moves2 ford
|
||||||
|
%- take:ford
|
||||||
|
:* wire=/~nul/clay-sub/~nul/desk duct=~
|
||||||
|
^= wrapped-sign ^- (hypo sign:ford) :- *type
|
||||||
|
[%c %wris [%da ~1234.5.7] (sy [%x /foo/bar]~)]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- moves2
|
||||||
|
:~ :* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk
|
||||||
|
`[%mult [%da ~1234.5.7] (sy [%x /foo/bar] ~)]
|
||||||
|
== ==
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.8 eny=0xbeef.dead scry=scry-is-forbidden)
|
||||||
|
=^ moves3 ford
|
||||||
|
(call:ford [duct=~[/ride] type=~ %kill ~nul])
|
||||||
|
::
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- moves3
|
||||||
|
:~ :* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk ~
|
||||||
|
== ==
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- state-by-ship.+>+<.ford
|
||||||
|
(my [~nul *ford-state:ford-turbo]~)
|
||||||
|
::
|
||||||
|
++ test-five-oh-fora
|
||||||
|
~& %test-five-oh-fora
|
||||||
|
::
|
||||||
|
=/ scry-results=(map [term beam] cage)
|
||||||
|
%- my :~
|
||||||
|
:- [%cx [[~nul %desk %da ~1234.5.6] /a/posts]]
|
||||||
|
[%noun !>([title='post-a' contents="post-a-contents"])]
|
||||||
|
::
|
||||||
|
:- [%cx [[~nul %desk %da ~1234.5.6] /b/posts]]
|
||||||
|
[%noun !>([title='post-b' contents="post-b-contents"])]
|
||||||
|
::
|
||||||
|
:- [%cx [[~nul %desk %da ~1234.5.8] /a/posts]]
|
||||||
|
[%noun !>([title='post-a' contents="post-a-contents-changed"])]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
=/ scry (scry-with-results scry-results)
|
||||||
|
=/ ford (ford-turbo now=~1234.5.6 eny=0xdead.beef scry=scry)
|
||||||
|
::
|
||||||
|
=/ post-a=schematic:ford [%scry [%c %x [~nul %desk] /a/posts]]
|
||||||
|
=/ title-a=schematic:ford [%ride (ream '!: title') post-a]
|
||||||
|
::
|
||||||
|
=/ post-b=schematic:ford [%scry [%c %x [~nul %desk] /b/posts]]
|
||||||
|
=/ title-b=schematic:ford [%ride (ream '!: title') post-b]
|
||||||
|
::
|
||||||
|
=/ sidebar=schematic:ford [title-a title-b]
|
||||||
|
::
|
||||||
|
=/ rendered-a=schematic:ford [post-a sidebar]
|
||||||
|
=/ rendered-b=schematic:ford [post-b sidebar]
|
||||||
|
:: first, ask ford to build rendered-a
|
||||||
|
::
|
||||||
|
=^ moves ford (call:ford [duct=~[/post-a] type=~ %make ~nul rendered-a])
|
||||||
|
::
|
||||||
|
?> ?=([^ ^ ~] moves)
|
||||||
|
%+ welp
|
||||||
|
%- check-post-made :*
|
||||||
|
move=i.moves
|
||||||
|
duct=~[/post-a]
|
||||||
|
date=~1234.5.6
|
||||||
|
title='post-a'
|
||||||
|
contents="post-a-contents"
|
||||||
|
==
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- i.t.moves
|
||||||
|
:* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk
|
||||||
|
`[%mult [%da ~1234.5.6] (sy [%x /posts/a] [%x /posts/b] ~)]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.7 eny=0xbeef.dead scry=scry)
|
||||||
|
::
|
||||||
|
=^ moves2 ford (call:ford [duct=~[/post-b] type=~ %make ~nul rendered-b])
|
||||||
|
::
|
||||||
|
?> ?=([^ ~] moves2)
|
||||||
|
%+ welp
|
||||||
|
%- check-post-made :*
|
||||||
|
move=i.moves2
|
||||||
|
duct=~[/post-b]
|
||||||
|
date=~1234.5.7
|
||||||
|
title='post-b'
|
||||||
|
contents="post-b-contents"
|
||||||
|
==
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.8 eny=0xbeef.dead scry=scry)
|
||||||
|
::
|
||||||
|
=^ moves3 ford
|
||||||
|
%- take:ford
|
||||||
|
:* wire=/~nul/clay-sub/~nul/desk duct=~
|
||||||
|
^= wrapped-sign ^- (hypo sign:ford) :- *type
|
||||||
|
[%c %wris [%da ~1234.5.8] (sy [%x /posts/a]~)]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
?> ?=([^ ^ ~] moves3)
|
||||||
|
%+ welp
|
||||||
|
%- check-post-made :*
|
||||||
|
move=i.moves3
|
||||||
|
duct=~[/post-a]
|
||||||
|
date=~1234.5.8
|
||||||
|
title='post-a'
|
||||||
|
contents="post-a-contents-changed"
|
||||||
|
==
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.9 eny=0xbeef.dead scry=scry-is-forbidden)
|
||||||
|
::
|
||||||
|
=^ moves4 ford (call:ford [duct=~[/post-b] type=~ %kill ~nul])
|
||||||
|
::
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
[moves4 ~]
|
||||||
|
::
|
||||||
|
=. ford (ford now=~1234.5.10 eny=0xbeef.dead scry=scry-is-forbidden)
|
||||||
|
::
|
||||||
|
=^ moves5 ford (call:ford [duct=~[/post-a] type=~ %kill ~nul])
|
||||||
|
::
|
||||||
|
%+ welp
|
||||||
|
%- expect-eq !>
|
||||||
|
:- moves5
|
||||||
|
:~ :* duct=~ %pass wire=/~nul/clay-sub/~nul/desk
|
||||||
|
%c %warp [~nul ~nul] %desk ~
|
||||||
|
== ==
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- state-by-ship.+>+<.ford
|
||||||
|
(my [~nul *ford-state:ford-turbo]~)
|
||||||
|
::
|
||||||
:: |utilities: helper arms
|
:: |utilities: helper arms
|
||||||
::
|
::
|
||||||
::+| utilities
|
::+| utilities
|
||||||
|
++ check-post-made
|
||||||
|
|= $: move=move:ford-turbo
|
||||||
|
=duct
|
||||||
|
date=@da
|
||||||
|
title=@tas
|
||||||
|
contents=tape
|
||||||
|
==
|
||||||
|
^- wall
|
||||||
::
|
::
|
||||||
|
?> ?=([* %give %made @da %complete %result ^ *] move)
|
||||||
|
=/ result result.p.card.move
|
||||||
|
?> ?=([%result %scry %noun type-a=* @tas *] head.result)
|
||||||
|
?> ?=([%result ^ *] tail.result)
|
||||||
|
?> ?=([%result %ride type-title-a=* %post-a] head.tail.result)
|
||||||
|
?> ?=([%result %ride type-title-b=* %post-b] tail.tail.result)
|
||||||
|
::
|
||||||
|
;: welp
|
||||||
|
%- expect-eq !>
|
||||||
|
[duct.move duct]
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
[date.p.card.move date]
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- head.result(p.q.cage *type)
|
||||||
|
[%result %scry %noun *type [title=title contents=contents]]
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- (~(nest ut p.q.cage.head.result) | -:!>([title='' contents=""]))
|
||||||
|
&
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- head.tail.result(p.vase *type)
|
||||||
|
[%result %ride *type 'post-a']
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- (~(nest ut p.vase.head.tail.result) | -:!>(''))
|
||||||
|
&
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- tail.tail.result(p.vase *type)
|
||||||
|
[%result %ride *type 'post-b']
|
||||||
|
::
|
||||||
|
%- expect-eq !>
|
||||||
|
:- (~(nest ut p.vase.tail.tail.result) | -:!>(''))
|
||||||
|
&
|
||||||
|
==
|
||||||
|
::
|
||||||
|
:: +scry-with-results
|
||||||
|
++ scry-with-results
|
||||||
|
|= results=(map [=term =beam] cage)
|
||||||
|
|= [* (unit (set monk)) =term =beam]
|
||||||
|
^- (unit (unit cage))
|
||||||
|
::
|
||||||
|
~| scry-with-results+[term=term beam=beam]
|
||||||
|
::
|
||||||
|
[~ ~ (~(got by results) [term beam])]
|
||||||
:: +scry-succeed: produces a scry function with a known request and answer
|
:: +scry-succeed: produces a scry function with a known request and answer
|
||||||
::
|
::
|
||||||
++ scry-succeed
|
++ scry-succeed
|
||||||
@ -759,4 +1047,5 @@
|
|||||||
::
|
::
|
||||||
~| scry-is-forbidden+[beam+beam term+term]
|
~| scry-is-forbidden+[beam+beam term+term]
|
||||||
!!
|
!!
|
||||||
|
|
||||||
--
|
--
|
||||||
|
|||||||
@ -792,6 +792,9 @@
|
|||||||
:: next-builds: builds to perform in the next iteration
|
:: next-builds: builds to perform in the next iteration
|
||||||
::
|
::
|
||||||
next-builds=(set build)
|
next-builds=(set build)
|
||||||
|
:: candidate-builds: builds which might go into next-builds.
|
||||||
|
::
|
||||||
|
candidate-builds=(list build)
|
||||||
:: blocked builds: mappings between blocked and blocking builds
|
:: blocked builds: mappings between blocked and blocking builds
|
||||||
::
|
::
|
||||||
$= blocked-builds
|
$= blocked-builds
|
||||||
@ -948,24 +951,32 @@
|
|||||||
--
|
--
|
||||||
=, format
|
=, format
|
||||||
|%
|
|%
|
||||||
:: +build-to-tank: convert :build to a printable format
|
:: +build-to-tape: convert :build to a printable format
|
||||||
::
|
::
|
||||||
++ build-to-tank
|
++ build-to-tape
|
||||||
|= =build
|
|= =build
|
||||||
^- tank
|
^- tape
|
||||||
::
|
::
|
||||||
=+ [date schematic]=build
|
=/ enclose |=(tape "[{+<}]")
|
||||||
|
=/ date=@da date.build
|
||||||
|
=/ schematic=schematic schematic.build
|
||||||
::
|
::
|
||||||
:- %leaf
|
%- enclose
|
||||||
%+ weld (trip (scot %da date))
|
%+ welp (trip (scot %da date))
|
||||||
%+ weld " "
|
%+ welp " "
|
||||||
::
|
::
|
||||||
%- trip
|
|
||||||
?+ -.schematic
|
?+ -.schematic
|
||||||
-.schematic
|
(trip -.schematic)
|
||||||
::
|
::
|
||||||
%$ %literal
|
%$
|
||||||
^ %autocons
|
"literal"
|
||||||
|
::
|
||||||
|
^
|
||||||
|
%- enclose
|
||||||
|
;:(welp $(build [date head.schematic]) " " $(build [date tail.schematic]))
|
||||||
|
::
|
||||||
|
%scry
|
||||||
|
(spud (en-beam (extract-beam dependency.schematic ~)))
|
||||||
==
|
==
|
||||||
:: +unify-jugs: make a new jug, unifying sets for all keys
|
:: +unify-jugs: make a new jug, unifying sets for all keys
|
||||||
::
|
::
|
||||||
@ -1122,6 +1133,25 @@
|
|||||||
%vale cage.result
|
%vale cage.result
|
||||||
%volt cage.result
|
%volt cage.result
|
||||||
==
|
==
|
||||||
|
:: +build-results-equal: check if two build results are the same value
|
||||||
|
::
|
||||||
|
:: We must perform a bidirectional nest check on the types because types
|
||||||
|
:: aren't guaranteed to be equal; this isn't a problem because the result
|
||||||
|
:: can be used equivalently.
|
||||||
|
::
|
||||||
|
++ build-results-equal
|
||||||
|
|= [old=build-result new=build-result]
|
||||||
|
^- ?
|
||||||
|
::
|
||||||
|
=+ old-cage=(result-to-cage old)
|
||||||
|
=+ new-cage=(result-to-cage new)
|
||||||
|
::
|
||||||
|
?& =(p.old-cage p.new-cage)
|
||||||
|
=(q.q.old-cage q.q.new-cage)
|
||||||
|
(~(nest ut p.q.old-cage) | p.q.new-cage)
|
||||||
|
(~(nest ut p.q.new-cage) | p.q.old-cage)
|
||||||
|
==
|
||||||
|
|
||||||
:: +date-from-schematic: finds the latest pin date from this schematic tree.
|
:: +date-from-schematic: finds the latest pin date from this schematic tree.
|
||||||
::
|
::
|
||||||
++ date-from-schematic
|
++ date-from-schematic
|
||||||
@ -1329,7 +1359,7 @@
|
|||||||
(~(put ju dependency-updates) date dependency)
|
(~(put ju dependency-updates) date dependency)
|
||||||
:: rebuild dependency builds at the new date
|
:: rebuild dependency builds at the new date
|
||||||
::
|
::
|
||||||
%- execute
|
%- execute-loop
|
||||||
%- sy
|
%- sy
|
||||||
%+ turn dependencies
|
%+ turn dependencies
|
||||||
|=(=dependency `build`[date [%scry dependency]])
|
|=(=dependency `build`[date [%scry dependency]])
|
||||||
@ -1394,7 +1424,10 @@
|
|||||||
::
|
::
|
||||||
=/ sub-builds (~(get ju sub-builds.components.state) i.builds)
|
=/ sub-builds (~(get ju sub-builds.components.state) i.builds)
|
||||||
::
|
::
|
||||||
$(builds (welp t.builds ~(tap in sub-builds)))
|
=/ new-builds=(list ^build)
|
||||||
|
(drop (~(find-next by-schematic builds-by-schematic.state) i.builds))
|
||||||
|
::
|
||||||
|
$(builds :(welp t.builds ~(tap in sub-builds) new-builds))
|
||||||
::
|
::
|
||||||
:: remove mapping from :duct to :build
|
:: remove mapping from :duct to :build
|
||||||
::
|
::
|
||||||
@ -1416,7 +1449,9 @@
|
|||||||
::
|
::
|
||||||
=. ..execute (execute builds)
|
=. ..execute (execute builds)
|
||||||
::
|
::
|
||||||
?~ next-builds.state
|
?: ?& ?=(~ next-builds.state)
|
||||||
|
?=(~ candidate-builds.state)
|
||||||
|
==
|
||||||
..execute
|
..execute
|
||||||
::
|
::
|
||||||
$(builds ~)
|
$(builds ~)
|
||||||
@ -1431,45 +1466,60 @@
|
|||||||
++ execute
|
++ execute
|
||||||
|= builds=(set build)
|
|= builds=(set build)
|
||||||
^+ ..execute
|
^+ ..execute
|
||||||
|
:: builds that we know we aren't going to be able to run this event
|
||||||
|
::
|
||||||
|
=| rejected-builds=(set build)
|
||||||
::
|
::
|
||||||
|^ ^+ ..execute
|
|^ ^+ ..execute
|
||||||
::
|
::
|
||||||
=^ gathered-builds ..execute (gather builds)
|
=. candidate-builds.state
|
||||||
|
(weld candidate-builds.state ~(tap in builds))
|
||||||
::
|
::
|
||||||
=/ state-diffs=(list state-diff) (turn gathered-builds make)
|
=. ..$ gather
|
||||||
|
::
|
||||||
|
=/ state-diffs=(list state-diff)
|
||||||
|
(turn ~(tap in next-builds.state) make)
|
||||||
|
::
|
||||||
|
=. next-builds.state ~
|
||||||
::
|
::
|
||||||
(reduce state-diffs)
|
(reduce state-diffs)
|
||||||
:: +gather: collect builds to be run in a batch: wraps +gather-internal
|
:: +gather: collect builds to be run in a batch: wraps +gather-internal
|
||||||
::
|
::
|
||||||
++ gather
|
++ gather
|
||||||
|= builds=(set build)
|
^+ ..$
|
||||||
^- [(list build) _..execute]
|
|-
|
||||||
:: enqueue :next-builds into the set of builds we may run
|
|
||||||
::
|
::
|
||||||
=/ unified (~(uni in next-builds.state) builds)
|
?~ candidate-builds.state
|
||||||
=. next-builds.state ~
|
..^$
|
||||||
::
|
::
|
||||||
=^ gathered ..execute (gather-internal ~(tap in unified))
|
=/ next i.candidate-builds.state
|
||||||
=* gathered-builds -.gathered
|
=> .(candidate-builds.state t.candidate-builds.state)
|
||||||
:: convert to set and back to de-duplicate
|
|
||||||
::
|
::
|
||||||
[~(tap in (sy gathered-builds)) ..execute]
|
$(..^$ (gather-build next))
|
||||||
:: +gather-internal: collect builds to be run in a batch
|
|
||||||
|
:: +gather-build: looks at a single candidate build
|
||||||
::
|
::
|
||||||
++ gather-internal
|
:: This gate inspects a single build. It might move it to :next-builds,
|
||||||
=| gathered=(list build)
|
:: or promote it using an old build. It also might add this builds
|
||||||
=/ can-promote=? &
|
:: sub-builds to :candidate-builds. Or it might move itself to
|
||||||
|
:: :rejected-builds, which means we know it can't be run this pass
|
||||||
|
:: through the event loop.
|
||||||
::
|
::
|
||||||
|= builds=(list build)
|
++ gather-build
|
||||||
^+ [[gathered can-promote] ..execute]
|
|= =build
|
||||||
::
|
^+ ..^$
|
||||||
?~ builds
|
|
||||||
[[gathered can-promote] ..execute]
|
|
||||||
::
|
|
||||||
=/ build=build i.builds
|
|
||||||
:: normalize :date.build for a %pin schematic
|
:: normalize :date.build for a %pin schematic
|
||||||
::
|
::
|
||||||
=? date.build ?=(%pin -.schematic.build) date.schematic.build
|
=? date.build ?=(%pin -.schematic.build) date.schematic.build
|
||||||
|
:: check if we've already rejected this build for this event
|
||||||
|
::
|
||||||
|
?: (~(has in rejected-builds) build)
|
||||||
|
..^$
|
||||||
|
:: if we already have a result for this build, don't rerun the build
|
||||||
|
::
|
||||||
|
=^ current-result results.state (access-cache build)
|
||||||
|
?: ?=([~ %result *] current-result)
|
||||||
|
..^$
|
||||||
:: place :build in :state if it isn't already there
|
:: place :build in :state if it isn't already there
|
||||||
::
|
::
|
||||||
=: builds-by-date.state
|
=: builds-by-date.state
|
||||||
@ -1485,7 +1535,7 @@
|
|||||||
:: if no previous builds exist, we need to run :build
|
:: if no previous builds exist, we need to run :build
|
||||||
::
|
::
|
||||||
?~ old-build
|
?~ old-build
|
||||||
$(builds t.builds, can-promote |, gathered [build gathered])
|
..^$(next-builds.state (~(put in next-builds.state) build))
|
||||||
:: copy :old-build's live listeners
|
:: copy :old-build's live listeners
|
||||||
::
|
::
|
||||||
=/ old-live-listeners=(list listener)
|
=/ old-live-listeners=(list listener)
|
||||||
@ -1500,92 +1550,92 @@
|
|||||||
%_ state
|
%_ state
|
||||||
listeners
|
listeners
|
||||||
(~(put ju listeners.state) build listener)
|
(~(put ju listeners.state) build listener)
|
||||||
::
|
|
||||||
builds-by-listener
|
|
||||||
(~(put by builds-by-listener.state) duct.listener [build &])
|
|
||||||
==
|
==
|
||||||
:: if any dependencies have changed, we need to rebuild :build
|
:: if any dependencies have changed, we need to rebuild :build
|
||||||
::
|
::
|
||||||
?: (dependencies-changed build)
|
?: (dependencies-changed build)
|
||||||
$(builds t.builds, can-promote |, gathered [build gathered])
|
..^$(next-builds.state (~(put in next-builds.state) build))
|
||||||
:: if we don't have :u.old-build's result cached, we need to run :build
|
:: if we don't have :u.old-build's result cached, we need to run :build
|
||||||
::
|
::
|
||||||
=^ old-cache-line results.state (access-cache u.old-build)
|
=^ old-cache-line results.state (access-cache u.old-build)
|
||||||
?~ old-cache-line
|
?~ old-cache-line
|
||||||
$(builds t.builds, can-promote |, gathered [build gathered])
|
..^$(next-builds.state (~(put in next-builds.state) build))
|
||||||
:: if :u.old-build's result has been wiped, we need to run :build
|
:: if :u.old-build's result has been wiped, we need to run :build
|
||||||
::
|
::
|
||||||
?: ?=(%tombstone -.u.old-cache-line)
|
?: ?=(%tombstone -.u.old-cache-line)
|
||||||
$(builds t.builds, can-promote |, gathered [build gathered])
|
..^$(next-builds.state (~(put in next-builds.state) build))
|
||||||
:: old-subs: sub-builds of :u.old-build
|
:: old-subs: sub-builds of :u.old-build
|
||||||
::
|
::
|
||||||
=/ old-subs=(list ^build)
|
=/ old-subs-original=(list ^build)
|
||||||
~(tap in (fall (~(get by sub-builds.components.state) u.old-build) ~))
|
~(tap in (fall (~(get by sub-builds.components.state) u.old-build) ~))
|
||||||
|
:: copy to avoid the tmi problem
|
||||||
|
::
|
||||||
|
=/ old-subs old-subs-original
|
||||||
:: if :u.old-build had no sub-builds, promote it
|
:: if :u.old-build had no sub-builds, promote it
|
||||||
::
|
::
|
||||||
?~ old-subs
|
?~ old-subs-original
|
||||||
=^ wiped-rebuild ..execute (promote-build u.old-build date.build)
|
=^ wiped-rebuild ..execute (promote-build u.old-build date.build)
|
||||||
?~ wiped-rebuild
|
=? next-builds.state
|
||||||
$(builds t.builds, can-promote &)
|
?=(^ wiped-rebuild)
|
||||||
|
(~(put in next-builds.state) u.wiped-rebuild)
|
||||||
::
|
::
|
||||||
$(builds t.builds, can-promote &, gathered [u.wiped-rebuild gathered])
|
=^ unblocked-clients state (mark-as-done build)
|
||||||
:: tmi problem
|
=. candidate-builds.state
|
||||||
|
(welp unblocked-clients candidate-builds.state)
|
||||||
::
|
::
|
||||||
=> .(old-subs `(list ^build)`old-subs)
|
..^$
|
||||||
:: recursively check if :old-subs can be promoted or gathered
|
|
||||||
::
|
::
|
||||||
=. ..gather-internal
|
=/ new-subs (turn old-subs |=(^build +<(date date.build)))
|
||||||
|
:: link all :new-subs to :build in :components.state
|
||||||
::
|
::
|
||||||
|- ^+ ..gather-internal
|
=. state
|
||||||
?~ old-subs ..gather-internal
|
%+ roll new-subs
|
||||||
::
|
::
|
||||||
=/ old-sub=^build i.old-subs
|
|= [new-sub=^build state=_state]
|
||||||
=/ new-sub=^build old-sub(date date.build)
|
|
||||||
::
|
::
|
||||||
=^ old-sub-result results.state (access-cache old-sub)
|
%_ state
|
||||||
?~ old-sub-result
|
sub-builds.components
|
||||||
$(old-subs t.old-subs, can-promote |, gathered [new-sub gathered])
|
(~(put ju sub-builds.components.state) build new-sub)
|
||||||
::
|
::
|
||||||
?: ?=(%tombstone -.u.old-sub-result)
|
client-builds.components
|
||||||
$(old-subs t.old-subs, can-promote |, gathered [new-sub gathered])
|
(~(put ju client-builds.components.state) new-sub build)
|
||||||
::
|
|
||||||
=^ new-sub-result results.state (access-cache new-sub)
|
|
||||||
?~ new-sub-result
|
|
||||||
=^ sub-gathered ..execute (gather-internal ~[new-sub])
|
|
||||||
=+ [sub-gathered-builds sub-can-promote]=sub-gathered
|
|
||||||
::
|
|
||||||
?> =(sub-can-promote (~(has by new.rebuilds.state) old-sub))
|
|
||||||
::
|
|
||||||
%_ $
|
|
||||||
old-subs t.old-subs
|
|
||||||
can-promote &(can-promote sub-can-promote)
|
|
||||||
gathered (welp sub-gathered-builds gathered)
|
|
||||||
==
|
==
|
||||||
:: if the rebuild has been wiped, we need to rerun it
|
:: if all subs are in old.rebuilds.state, promote ourselves
|
||||||
::
|
|
||||||
:: Note: It might make sense to check if :old-sub and :new-sub
|
|
||||||
:: are linked in :rebuilds.state, in case one is a tombstone,
|
|
||||||
:: in which case we could copy the other result.
|
|
||||||
::
|
|
||||||
?: ?=(%tombstone -.u.new-sub-result)
|
|
||||||
$(old-subs t.old-subs, can-promote |, gathered [new-sub gathered])
|
|
||||||
::
|
|
||||||
?: =(build-result.u.new-sub-result build-result.u.old-sub-result)
|
|
||||||
$(old-subs t.old-subs)
|
|
||||||
::
|
|
||||||
$(old-subs t.old-subs, can-promote |, gathered [new-sub gathered])
|
|
||||||
::
|
|
||||||
?: can-promote
|
|
||||||
:: no sub-builds changed, so we can promote the old build
|
|
||||||
::
|
::
|
||||||
|
?: (levy new-subs ~(has in old.rebuilds.state))
|
||||||
=^ wiped-rebuild ..execute (promote-build u.old-build date.build)
|
=^ wiped-rebuild ..execute (promote-build u.old-build date.build)
|
||||||
?~ wiped-rebuild
|
=? next-builds.state
|
||||||
$(builds t.builds)
|
?=(^ wiped-rebuild)
|
||||||
|
(~(put in next-builds.state) u.wiped-rebuild)
|
||||||
::
|
::
|
||||||
$(builds t.builds, gathered [u.wiped-rebuild gathered])
|
=^ unblocked-clients state (mark-as-done build)
|
||||||
:: some sub-builds changed, so :build needs to be rerun
|
=. candidate-builds.state
|
||||||
|
(welp unblocked-clients candidate-builds.state)
|
||||||
::
|
::
|
||||||
$(builds t.builds, gathered [build gathered])
|
..^$
|
||||||
|
:: all new-subs have results, some are not rebuilds
|
||||||
|
::
|
||||||
|
?: (levy new-subs is-build-cached)
|
||||||
|
::
|
||||||
|
..^$(next-builds.state (~(put in next-builds.state) build))
|
||||||
|
:: otherwise, not all new subs have results.
|
||||||
|
::
|
||||||
|
:: If all of our sub-builds finish immediately (i.e. promoted),
|
||||||
|
:: they'll add us back to :candidate-builds.state.
|
||||||
|
::
|
||||||
|
=. blocked-builds.state
|
||||||
|
%+ roll (skip new-subs is-build-cached)
|
||||||
|
|= [new-sub=^build blocked-builds=_blocked-builds.state]
|
||||||
|
::
|
||||||
|
%_ blocked-builds
|
||||||
|
sub-builds
|
||||||
|
(~(put ju sub-builds.blocked-builds) build new-sub)
|
||||||
|
::
|
||||||
|
client-builds
|
||||||
|
(~(put ju client-builds.blocked-builds) new-sub build)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
..^$(candidate-builds.state :(welp new-subs candidate-builds.state))
|
||||||
:: +promote-build: promote result of :build to newer :date
|
:: +promote-build: promote result of :build to newer :date
|
||||||
::
|
::
|
||||||
:: Also promotes live listeners, links the two builds in :rebuilds.state,
|
:: Also promotes live listeners, links the two builds in :rebuilds.state,
|
||||||
@ -1606,6 +1656,24 @@
|
|||||||
::
|
::
|
||||||
=. rebuilds.state (link-rebuilds old-build new-build)
|
=. rebuilds.state (link-rebuilds old-build new-build)
|
||||||
::
|
::
|
||||||
|
?> (~(has ju builds-by-date.state) date.new-build schematic.new-build)
|
||||||
|
::
|
||||||
|
=. components.state
|
||||||
|
%+ roll
|
||||||
|
=- ~(tap in (fall - ~))
|
||||||
|
(~(get by sub-builds.components.state) old-build)
|
||||||
|
::
|
||||||
|
|= [old-sub=build components=_components.state]
|
||||||
|
::
|
||||||
|
=/ new-sub=build old-sub(date date)
|
||||||
|
%_ components
|
||||||
|
sub-builds
|
||||||
|
(~(put ju sub-builds.components) new-build new-sub)
|
||||||
|
::
|
||||||
|
client-builds
|
||||||
|
(~(put ju client-builds.components) new-sub new-build)
|
||||||
|
==
|
||||||
|
::
|
||||||
=. state (promote-live-listeners old-build new-build)
|
=. state (promote-live-listeners old-build new-build)
|
||||||
::
|
::
|
||||||
=. ..execute (send-mades new-build (root-once-listeners new-build))
|
=. ..execute (send-mades new-build (root-once-listeners new-build))
|
||||||
@ -1694,6 +1762,12 @@
|
|||||||
::
|
::
|
||||||
(~(put by latest-by-disc.state) disc date.build.made)
|
(~(put by latest-by-disc.state) disc date.build.made)
|
||||||
==
|
==
|
||||||
|
:: clear the components
|
||||||
|
::
|
||||||
|
:: TODO: We'll need something like this when we implement %alts,
|
||||||
|
:: but as written, this breaks test-ride-scry-block.
|
||||||
|
::
|
||||||
|
::=. components.state (unlink-sub-builds build.made)
|
||||||
:: process :sub-builds.made
|
:: process :sub-builds.made
|
||||||
::
|
::
|
||||||
=. state
|
=. state
|
||||||
@ -1733,6 +1807,8 @@
|
|||||||
?- -.result.made
|
?- -.result.made
|
||||||
%build-result
|
%build-result
|
||||||
::
|
::
|
||||||
|
?> (~(has ju builds-by-date.state) date.build.made schematic.build.made)
|
||||||
|
::
|
||||||
=. results.state
|
=. results.state
|
||||||
%+ ~(put by results.state) build.made
|
%+ ~(put by results.state) build.made
|
||||||
[%result last-accessed=now build-result.result.made]
|
[%result last-accessed=now build-result.result.made]
|
||||||
@ -1741,27 +1817,8 @@
|
|||||||
=- ~(tap in (fall - ~))
|
=- ~(tap in (fall - ~))
|
||||||
(~(get by client-builds.blocked-builds.state) build.made)
|
(~(get by client-builds.blocked-builds.state) build.made)
|
||||||
::
|
::
|
||||||
=. blocked-builds.state
|
=^ unblocked-clients state (mark-as-done build.made)
|
||||||
%+ roll client-builds
|
=. next-builds.state (~(gas in next-builds.state) unblocked-clients)
|
||||||
::
|
|
||||||
|= [client=build blocked-builds=_blocked-builds.state]
|
|
||||||
::
|
|
||||||
%_ blocked-builds
|
|
||||||
sub-builds
|
|
||||||
(~(del ju sub-builds.blocked-builds) client build.made)
|
|
||||||
::
|
|
||||||
client-builds
|
|
||||||
(~(del ju client-builds.blocked-builds) build.made client)
|
|
||||||
==
|
|
||||||
::
|
|
||||||
=. next-builds.state
|
|
||||||
%+ roll client-builds
|
|
||||||
::
|
|
||||||
|= [client=build next-builds=_next-builds.state]
|
|
||||||
::
|
|
||||||
?: (is-build-blocked client)
|
|
||||||
next-builds
|
|
||||||
(~(put in next-builds) client)
|
|
||||||
::
|
::
|
||||||
=/ previous-build
|
=/ previous-build
|
||||||
(~(find-previous by-schematic builds-by-schematic.state) build.made)
|
(~(find-previous by-schematic builds-by-schematic.state) build.made)
|
||||||
@ -1781,7 +1838,9 @@
|
|||||||
::
|
::
|
||||||
=/ same-result=?
|
=/ same-result=?
|
||||||
?& ?=([~ %result *] previous-result)
|
?& ?=([~ %result *] previous-result)
|
||||||
=(build-result.result.made build-result.u.previous-result)
|
%+ build-results-equal
|
||||||
|
build-result.result.made
|
||||||
|
build-result.u.previous-result
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
=? rebuilds.state
|
=? rebuilds.state
|
||||||
@ -1793,6 +1852,47 @@
|
|||||||
=? ..execute
|
=? ..execute
|
||||||
!same-result
|
!same-result
|
||||||
(send-mades build.made (root-live-listeners build.made))
|
(send-mades build.made (root-live-listeners build.made))
|
||||||
|
:: rerun any old clients, updated to the current time
|
||||||
|
::
|
||||||
|
=? state
|
||||||
|
&(!same-result ?=(^ previous-build))
|
||||||
|
::
|
||||||
|
=/ clients-to-rebuild=(list build)
|
||||||
|
%+ turn
|
||||||
|
%+ weld
|
||||||
|
=- ~(tap in (fall - ~))
|
||||||
|
(~(get by client-builds.components.state) u.previous-build)
|
||||||
|
::
|
||||||
|
=/ older-build (~(get by old.rebuilds.state) u.previous-build)
|
||||||
|
?~ older-build
|
||||||
|
~
|
||||||
|
::
|
||||||
|
=- ~(tap in (fall - ~))
|
||||||
|
(~(get by client-builds.components.state) u.older-build)
|
||||||
|
::
|
||||||
|
|= old-client=build
|
||||||
|
old-client(date date.build.made)
|
||||||
|
::
|
||||||
|
%+ roll clients-to-rebuild
|
||||||
|
|= [client=build state=_state]
|
||||||
|
::
|
||||||
|
%_ state
|
||||||
|
::
|
||||||
|
next-builds
|
||||||
|
(~(put in next-builds.state) client)
|
||||||
|
::
|
||||||
|
client-builds.components
|
||||||
|
(~(put ju client-builds.components.state) build.made client)
|
||||||
|
::
|
||||||
|
sub-builds.components
|
||||||
|
(~(put ju sub-builds.components.state) client build.made)
|
||||||
|
::
|
||||||
|
builds-by-date
|
||||||
|
(~(put ju builds-by-date.state) date.client schematic.client)
|
||||||
|
::
|
||||||
|
builds-by-schematic
|
||||||
|
(~(put by-schematic builds-by-schematic.state) client)
|
||||||
|
==
|
||||||
::
|
::
|
||||||
=? ..execute
|
=? ..execute
|
||||||
?=(^ previous-build)
|
?=(^ previous-build)
|
||||||
@ -1851,8 +1951,8 @@
|
|||||||
client-builds.blocked-builds
|
client-builds.blocked-builds
|
||||||
(~(put ju client-builds.blocked-builds.state) block build.made)
|
(~(put ju client-builds.blocked-builds.state) block build.made)
|
||||||
::
|
::
|
||||||
next-builds
|
candidate-builds
|
||||||
(~(put in next-builds.state) block)
|
[block candidate-builds.state]
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
$(state-diffs t.state-diffs)
|
$(state-diffs t.state-diffs)
|
||||||
@ -1903,20 +2003,6 @@
|
|||||||
++ make
|
++ make
|
||||||
|= =build
|
|= =build
|
||||||
^- state-diff
|
^- state-diff
|
||||||
:: ^- $: :: result: result of running a build
|
|
||||||
:: ::
|
|
||||||
:: $= result
|
|
||||||
:: $% :: %build-result: the build completed
|
|
||||||
:: ::
|
|
||||||
:: [%build-result =build-result]
|
|
||||||
:: :: %blocks: :build is waiting on other builds or a dependency
|
|
||||||
:: ::
|
|
||||||
:: [%blocks builds=(list ^build)]
|
|
||||||
:: ==
|
|
||||||
:: :: possibly mutated version of the +per-event core
|
|
||||||
:: ::
|
|
||||||
:: _this
|
|
||||||
:: ==
|
|
||||||
:: accessed-builds: builds accessed/depended on during this run.
|
:: accessed-builds: builds accessed/depended on during this run.
|
||||||
::
|
::
|
||||||
=| accessed-builds=(list ^build)
|
=| accessed-builds=(list ^build)
|
||||||
@ -2178,10 +2264,12 @@
|
|||||||
=/ sub-build=^build [date.build kid]
|
=/ sub-build=^build [date.build kid]
|
||||||
::
|
::
|
||||||
=. accessed-builds [sub-build accessed-builds]
|
=. accessed-builds [sub-build accessed-builds]
|
||||||
|
:: +access-cache will mutate :results.state
|
||||||
::
|
::
|
||||||
:: TODO: we don't (and don't want to) propagate results.state.
|
:: It's okay to ignore this because the accessed-builds get gathered
|
||||||
|
:: and merged during the +reduce step.
|
||||||
::
|
::
|
||||||
=^ maybe-cache-line results.state (access-cache sub-build)
|
=/ maybe-cache-line -:(access-cache sub-build)
|
||||||
?~ maybe-cache-line
|
?~ maybe-cache-line
|
||||||
[~ accessed-builds]
|
[~ accessed-builds]
|
||||||
::
|
::
|
||||||
@ -2247,10 +2335,43 @@
|
|||||||
:: if :local-result does not nest in :type, produce an error
|
:: if :local-result does not nest in :type, produce an error
|
||||||
::
|
::
|
||||||
?. -:(nets:wa type `^type`p.q.local-cage)
|
?. -:(nets:wa type `^type`p.q.local-cage)
|
||||||
~& [%scry-nest-fail term=term beam=beam]
|
|
||||||
[~ ~]
|
[~ ~]
|
||||||
::
|
::
|
||||||
[~ ~ `(cask)`local-cage]
|
[~ ~ `(cask)`local-cage]
|
||||||
|
:: +mark-as-done: store :build as complete and produce any unblocked clients
|
||||||
|
::
|
||||||
|
:: We may not know about these unblocked clients, so we register them in
|
||||||
|
:: the state.
|
||||||
|
::
|
||||||
|
++ mark-as-done
|
||||||
|
|= =build
|
||||||
|
^- [(list ^build) _state]
|
||||||
|
::
|
||||||
|
=/ client-builds=(list ^build)
|
||||||
|
~(tap in (fall (~(get by client-builds.blocked-builds.state) build) ~))
|
||||||
|
::
|
||||||
|
=. blocked-builds.state
|
||||||
|
%+ roll client-builds
|
||||||
|
::
|
||||||
|
|= [client=^build blocked-builds=_blocked-builds.state]
|
||||||
|
::
|
||||||
|
%_ blocked-builds
|
||||||
|
sub-builds
|
||||||
|
(~(del ju sub-builds.blocked-builds) client build)
|
||||||
|
::
|
||||||
|
client-builds
|
||||||
|
(~(del ju client-builds.blocked-builds) build client)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
:_ state
|
||||||
|
::
|
||||||
|
%+ roll client-builds
|
||||||
|
::
|
||||||
|
|= [client=^build next-builds=(list ^build)]
|
||||||
|
::
|
||||||
|
?: (is-build-blocked client)
|
||||||
|
next-builds
|
||||||
|
[client next-builds]
|
||||||
:: +send-mades: send one %made move for :build per listener in :listeners
|
:: +send-mades: send one %made move for :build per listener in :listeners
|
||||||
::
|
::
|
||||||
++ send-mades
|
++ send-mades
|
||||||
@ -2270,6 +2391,27 @@
|
|||||||
%made date.build %complete build-result.u.result
|
%made date.build %complete build-result.u.result
|
||||||
==
|
==
|
||||||
==
|
==
|
||||||
|
:: +unlink-sub-builds
|
||||||
|
::
|
||||||
|
++ unlink-sub-builds
|
||||||
|
|= =build
|
||||||
|
^+ components.state
|
||||||
|
::
|
||||||
|
=/ kids=(list ^build)
|
||||||
|
~(tap in (~(get ju sub-builds.components.state) build))
|
||||||
|
|
||||||
|
%_ components.state
|
||||||
|
:: remove the mapping from :build to its sub-builds
|
||||||
|
::
|
||||||
|
sub-builds
|
||||||
|
(~(del by sub-builds.components.state) build)
|
||||||
|
:: for each +build in :kids, remove :build from its clients
|
||||||
|
::
|
||||||
|
client-builds
|
||||||
|
%+ roll kids
|
||||||
|
|= [kid=^build clients=_client-builds.components.state]
|
||||||
|
(~(del ju clients) kid build)
|
||||||
|
==
|
||||||
:: +promote-live-listeners: move live listeners from :old to :new
|
:: +promote-live-listeners: move live listeners from :old to :new
|
||||||
::
|
::
|
||||||
++ promote-live-listeners
|
++ promote-live-listeners
|
||||||
@ -2293,21 +2435,22 @@
|
|||||||
listeners
|
listeners
|
||||||
=- (~(put ju -) new listener)
|
=- (~(put ju -) new listener)
|
||||||
(~(del ju listeners.state) old listener)
|
(~(del ju listeners.state) old listener)
|
||||||
::
|
|
||||||
builds-by-listener
|
|
||||||
(~(put by builds-by-listener.state) duct.listener [new &])
|
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
%+ roll ~(tap in (fall (~(get by root-builds.state) old) ~))
|
%+ roll ~(tap in (fall (~(get by root-builds.state) old) ~))
|
||||||
|= [=listener state=_state]
|
|= [=listener state=_state]
|
||||||
::
|
::
|
||||||
=? root-builds.state
|
?. (is-listener-live listener)
|
||||||
(is-listener-live listener)
|
state
|
||||||
|
%_ state
|
||||||
::
|
::
|
||||||
|
root-builds
|
||||||
=- (~(put ju -) new listener)
|
=- (~(put ju -) new listener)
|
||||||
(~(del ju root-builds.state) old listener)
|
(~(del ju root-builds.state) old listener)
|
||||||
::
|
::
|
||||||
state
|
builds-by-listener
|
||||||
|
(~(put by builds-by-listener.state) duct.listener [new &])
|
||||||
|
==
|
||||||
:: +root-live-listeners: live listeners for which :build is the root build
|
:: +root-live-listeners: live listeners for which :build is the root build
|
||||||
::
|
::
|
||||||
++ root-live-listeners
|
++ root-live-listeners
|
||||||
@ -2341,6 +2484,12 @@
|
|||||||
?. ?=(%scry -.schematic.build)
|
?. ?=(%scry -.schematic.build)
|
||||||
|
|
|
|
||||||
(~(has by blocks.state) dependency.schematic.build build)
|
(~(has by blocks.state) dependency.schematic.build build)
|
||||||
|
:: +is-build-cached:
|
||||||
|
::
|
||||||
|
++ is-build-cached
|
||||||
|
|= =build
|
||||||
|
^- ?
|
||||||
|
?=([~ %result *] (~(get by results.state) build))
|
||||||
:: +is-build-live: whether this is a live or a once build
|
:: +is-build-live: whether this is a live or a once build
|
||||||
::
|
::
|
||||||
++ is-build-live
|
++ is-build-live
|
||||||
@ -2400,8 +2549,6 @@
|
|||||||
:: accounting, and runs +cleanup on completed once builds and
|
:: accounting, and runs +cleanup on completed once builds and
|
||||||
:: stale live builds.
|
:: stale live builds.
|
||||||
::
|
::
|
||||||
:: TODO: needs rework to support live builds
|
|
||||||
::
|
|
||||||
++ finalize
|
++ finalize
|
||||||
^- [(list move) ford-state]
|
^- [(list move) ford-state]
|
||||||
:: once we're done, +flop :moves to put them in chronological order
|
:: once we're done, +flop :moves to put them in chronological order
|
||||||
@ -2492,6 +2639,10 @@
|
|||||||
++ cleanup
|
++ cleanup
|
||||||
|= =build
|
|= =build
|
||||||
^+ this
|
^+ this
|
||||||
|
:: does this build even exist?!
|
||||||
|
::
|
||||||
|
?. (~(has ju builds-by-date.state) date.build schematic.build)
|
||||||
|
this
|
||||||
::
|
::
|
||||||
:: if something depends on this build, no-op and return
|
:: if something depends on this build, no-op and return
|
||||||
::
|
::
|
||||||
@ -2499,6 +2650,12 @@
|
|||||||
(~(has by old.rebuilds.state) build)
|
(~(has by old.rebuilds.state) build)
|
||||||
(~(has by listeners.state) build)
|
(~(has by listeners.state) build)
|
||||||
==
|
==
|
||||||
|
:: ~& :* %cleanup-no-op
|
||||||
|
:: build=(build-to-tape build)
|
||||||
|
:: has-client-builds=(~(has by client-builds.components.state) build)
|
||||||
|
:: has-old-rebuilds=(~(has by old.rebuilds.state) build)
|
||||||
|
:: listeners=(~(get by listeners.state) build)
|
||||||
|
:: ==
|
||||||
this
|
this
|
||||||
:: remove :build from :state, starting with its cache line
|
:: remove :build from :state, starting with its cache line
|
||||||
::
|
::
|
||||||
@ -2548,7 +2705,7 @@
|
|||||||
^- ?
|
^- ?
|
||||||
=/ other-build [date schematic.build]
|
=/ other-build [date schematic.build]
|
||||||
=/ listeners=(set listener)
|
=/ listeners=(set listener)
|
||||||
(fall (~(get by root-builds.state) other-build) ~)
|
(fall (~(get by listeners.state) other-build) ~)
|
||||||
::
|
::
|
||||||
(lien ~(tap in listeners) is-listener-live)
|
(lien ~(tap in listeners) is-listener-live)
|
||||||
::
|
::
|
||||||
@ -2563,23 +2720,15 @@
|
|||||||
::
|
::
|
||||||
=/ kids=(list ^build)
|
=/ kids=(list ^build)
|
||||||
~(tap in (~(get ju sub-builds.components.state) build))
|
~(tap in (~(get ju sub-builds.components.state) build))
|
||||||
:: remove the mapping from :build to its sub-builds
|
|
||||||
::
|
::
|
||||||
=. sub-builds.components.state
|
=. components.state (unlink-sub-builds build)
|
||||||
(~(del by sub-builds.components.state) build)
|
|
||||||
:: for each +build in :kids, remove :build from its clients
|
|
||||||
::
|
|
||||||
=. client-builds.components.state
|
|
||||||
%+ roll kids
|
|
||||||
|= [kid=^build clients=_client-builds.components.state]
|
|
||||||
(~(del ju clients) kid build)
|
|
||||||
:: if there is a newer rebuild of :build, delete the linkage
|
:: if there is a newer rebuild of :build, delete the linkage
|
||||||
::
|
::
|
||||||
=/ rebuild (~(get by new.rebuilds.state) build)
|
=/ rebuild (~(get by new.rebuilds.state) build)
|
||||||
=? rebuilds.state ?=(^ rebuild)
|
=? rebuilds.state ?=(^ rebuild)
|
||||||
%_ rebuilds.state
|
%_ rebuilds.state
|
||||||
new (~(del by new.rebuilds.state) build)
|
new (~(del by new.rebuilds.state) build)
|
||||||
old (~(del by old.rebuilds.state) build)
|
old (~(del by old.rebuilds.state) u.rebuild)
|
||||||
==
|
==
|
||||||
:: recurse on :kids
|
:: recurse on :kids
|
||||||
::
|
::
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user