1 ! Copyright (C) 2017 Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs bootstrap.image calendar cli.git
4 combinators combinators.short-circuit concurrency.combinators
5 environment formatting http.download io io.directories
6 io.launcher io.pathnames kernel math.parser memory modern.paths
7 namespaces parser.notes prettyprint regexp.classes sequences
8 sequences.extras sets splitting system system-info threads
9 tools.test tools.test.private vocabs vocabs.hierarchy
10 vocabs.hierarchy.private vocabs.loader vocabs.metadata zealot ;
13 ! XXX: Could check if it's a branch instead with a git command
14 : git-checksum? ( str -- ? )
15 { [ length 40 = ] [ [ hex-digit? ] all? ] } 1&& ;
17 : download-boot-checksum-branch ( path branch -- )
18 '[ _ "https://downloads.factorcode.org/images/%s/checksums.txt" sprintf download drop ] with-directory ;
20 : download-boot-checksum-git-checksum ( path checksum -- )
21 '[ _ "https://downloads.factorcode.org/images/build/checksums.txt.%s" sprintf download drop ] with-directory ;
23 : download-boot-checksums ( path branch/checksum -- )
25 [ download-boot-checksum-git-checksum ]
26 [ download-boot-checksum-branch ] if ;
28 : download-boot-image ( path url -- )
29 '[ _ my-arch-name "boot.%s.image" sprintf download-to drop ] with-directory ;
31 : arch-git-boot-image-path ( arch git-id -- str )
32 "https://downloads.factorcode.org/images/build/boot.%s.image.%s" sprintf ;
34 : download-my-boot-image ( path branch/checksum -- )
36 [ [ my-arch-name ] dip arch-git-boot-image-path ]
37 [ my-boot-image-name "https://downloads.factorcode.org/images/%s/%s" sprintf ] if
40 HOOK: compile-factor-command os ( -- array )
41 M: macosx compile-factor-command ( -- array )
42 { "arch" "-x86_64" "make" "-j" } cpus number>string suffix ;
43 M: unix compile-factor-command ( -- array )
44 { "make" "-j" } cpus number>string suffix ;
45 M: windows compile-factor-command ( -- array )
46 { "nmake" "/f" "NMakefile" "x86-64" } ;
48 HOOK: factor-path os ( -- path )
49 M: unix factor-path "./factor" ;
50 M: windows factor-path "./factor.com" ;
52 : compile-factor ( path -- )
55 compile-factor-command >>command
56 "./compile-log" >>stdout
62 : bootstrap-factor ( path -- )
65 factor-path "-i=" my-boot-image-name append "-no-user-init" 3array
66 os macosx = [ { "arch" "-x86_64" } prepend ] when
69 "./bootstrap-log" >>stdout
76 ! Meant to run in the child process
77 : with-child-options ( quot -- )
78 f parser-quiet? set-global
79 f restartable-tests? set-global
80 f long-unit-tests-enabled? set-global
83 : zealot-load-and-save ( vocabs path -- )
84 dup "load-and-save to " prepend print flush yield
86 [ load ] each _ save-image
87 ] with-child-options ;
89 : zealot-load-basis ( -- ) basis-vocabs "factor.image.basis" zealot-load-and-save ;
90 : zealot-load-extra ( -- ) extra-vocabs "factor.image.extra" zealot-load-and-save ;
92 ! like ``"" load`` -- only platform-friendly vocabs
93 : zealot-vocabs-from-root ( root -- seq ) "" vocabs-to-load [ vocab-name ] map ;
94 : zealot-all-vocabs ( -- seq ) vocab-roots get [ zealot-vocabs-from-root ] map-concat ;
95 : zealot-core-vocabs ( -- seq ) "resource:core" zealot-vocabs-from-root ;
96 : zealot-basis-vocabs ( -- seq ) "resource:basis" zealot-vocabs-from-root ;
97 : zealot-extra-vocabs ( -- seq ) "resource:extra" zealot-vocabs-from-root ;
99 : zealot-load-all ( -- ) zealot-all-vocabs "factor.image.all" zealot-load-and-save ;
101 : zealot-load-command ( command log-path -- process )
108 +new-group+ >>group ;
110 : zealot-load-basis-command ( -- process )
111 factor-path "-e=USE: zealot.factor zealot-load-basis" 2array
112 "./load-basis-log" zealot-load-command ;
114 : zealot-load-extra-command ( -- process )
115 factor-path "-e=USE: zealot.factor zealot-load-extra" 2array
116 "./load-extra-log" zealot-load-command ;
118 : zealot-load-commands ( path -- )
120 zealot-load-basis-command
121 zealot-load-extra-command 2array
122 [ try-process ] parallel-each
125 : zealot-test-command ( command log-path -- process )
132 +new-group+ >>group ;
134 : zealot-load-and-test ( vocabs -- )
136 _ [ [ load ] each ] [ test-vocabs ] bi
137 ] with-child-options ;
139 : load-and-test-command ( i -- command )
145 "-e=USING: zealot.factor tools.test grouping.extras formatting ; [ %d all-zealot-vocabs 32 n-groups nth zealot-load-and-test ] with-child-options"
147 ] [ "./test-%d-log" sprintf ] bi
155 +new-group+ >>group ;
157 : zealot-test-commands ( path -- )
160 load-and-test-command
161 ] map [ try-process ] parallel-each
164 : zealot-test-commands-old ( path -- )
166 factor-path "-i=factor.image" "-e=USE: zealot.factor USE: tools.test [ zealot-core-vocabs test-vocabs ] with-child-options" 3array
167 "./test-core-log" zealot-test-command
169 factor-path "-i=factor.image.basis" "-e=USE: zealot.factor USE: tools.test [ zealot-basis-vocabs test-vocabs ] with-child-options" 3array
170 "./test-basis-log" zealot-test-command
172 factor-path "-i=factor.image.extra" "-e=USE: zealot.factor USE: tools.test [ zealot-extra-vocabs test-vocabs ] with-child-options" 3array
173 "./test-extra-log" zealot-test-command 3array
175 [ try-process ] parallel-each
178 : checkout-new-factor ( branch/checksum -- path branch/checksum )
179 "factor" "factor" zealot-github-ensure drop
181 [ "factor" "factor" zealot-github-clone-paths nip ] dip
182 over <pathname> . flush yield
184 [ drop "factor" "factor" zealot-github-add-build-remote drop ]
185 [ drop [ git-fetch-all* ] with-directory drop ]
186 [ zealot-build-checkout drop ]
190 : bootstrap-new-factor ( path branch/checksum -- path branch/checksum )
192 [ "ZEALOT DOWNLOADING BOOT IMAGE" print flush download-my-boot-image ]
193 [ "ZEALOT DOWNLOADING CHECKSUMS" print flush download-boot-checksums ]
194 [ "ZEALOT COMPILING" print flush drop compile-factor ]
195 [ "ZEALOT BOOTSTRAPPING" print flush drop bootstrap-factor ]
199 : test-new-factor ( path branch/checksum -- )
201 [ "ZEALOT LOADING ROOTS" print flush drop zealot-load-commands ]
202 [ "ZEALOT TESTING ROOTS" print flush drop zealot-test-commands ]
205 : check-new-factor ( path branch/checksum cmd -- out )
206 nip [ factor-path "-i=factor.image" ] dip "-e=%s" sprintf 3array
207 "./test-bisect-log" zealot-test-command
208 '[ _ process-contents ] with-directory ;
210 : build-new-factor ( branch/checksum -- )
211 checkout-new-factor bootstrap-new-factor test-new-factor ;
213 : bisect-new-factor ( branch/checksum cmd -- out )
214 [ checkout-new-factor bootstrap-new-factor ] dip check-new-factor ;
216 : factor-clean-branch ( -- str )
217 os cpu [ name>> ] bi@ { { CHAR: . CHAR: - } } substitute
218 "-" glue "origin/clean-" prepend ;
220 : vocab-path>vocab ( path -- vocab )
221 [ parent-directory ] map
222 [ "/" split1 nip ] map
223 [ path-separator split harvest "." join ] map ;
225 : changed-factor-vocabs ( old-rev new-rev -- vocabs )
228 [ ":" split1 nip ] map
230 ] 2dip git-diff-name-only*
231 [ ".factor" tail? ] filter
232 [ swap [ head? ] with any? ] with filter
233 [ parent-directory ] map
234 [ "/" split1 nip ] map
235 [ path-separator split harvest "." join ] map members ;
237 : changed-factor-vocabs-from-master ( -- vocabs )
238 "HEAD" "origin/master" changed-factor-vocabs ;
240 : changed-factor-vocabs-from-clean ( -- vocabs )
241 "HEAD" factor-clean-branch changed-factor-vocabs ;
243 : testing-a-branch? ( -- ? )
244 "CI_BRANCH" os-env "master" or
247 : reject-unloadable-vocabs ( vocabs -- vocabs' )
248 [ don't-load? ] reject ;
250 ! Test changes from a CI_BRANCH against origin/master
251 ! Test master against last clean build, e.g. origin/clean-linux-x86-64
252 : ci-vocabs-to-test ( -- vocabs )
254 changed-factor-vocabs-from-master
256 changed-factor-vocabs-from-clean
257 ] if reject-unloadable-vocabs ;