From 138d150da21fc693badb2fcd328c6439589eea0f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 4 Jul 2018 18:35:24 -0500 Subject: [PATCH] zealot: Add a second CI type system to compete with mason. This is for testing PRs against changed vocabs. --- extra/zealot/authors.txt | 1 + extra/zealot/factor/authors.txt | 1 + extra/zealot/factor/factor.factor | 170 ++++++++++++++++++++++++++++++ extra/zealot/zealot.factor | 77 ++++++++++++++ 4 files changed, 249 insertions(+) create mode 100644 extra/zealot/authors.txt create mode 100644 extra/zealot/factor/authors.txt create mode 100644 extra/zealot/factor/factor.factor create mode 100644 extra/zealot/zealot.factor diff --git a/extra/zealot/authors.txt b/extra/zealot/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/zealot/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/zealot/factor/authors.txt b/extra/zealot/factor/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/zealot/factor/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/zealot/factor/factor.factor b/extra/zealot/factor/factor.factor new file mode 100644 index 0000000000..0fdaffcfb7 --- /dev/null +++ b/extra/zealot/factor/factor.factor @@ -0,0 +1,170 @@ +! Copyright (C) 2017 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays bootstrap.image calendar cli.git +combinators concurrency.combinators formatting fry http.client +io io.directories io.launcher io.pathnames kernel math.parser +memory modern.paths namespaces parser.notes prettyprint +sequences sequences.extras system system-info threads tools.test +tools.test.private vocabs vocabs.hierarchy +vocabs.hierarchy.private vocabs.loader zealot ; +IN: zealot.factor + +: download-boot-checksums ( path branch -- ) + '[ _ "http://downloads.factorcode.org/images/%s/checksums.txt" sprintf download ] with-directory ; + +: download-boot-image ( path branch image-name -- ) + '[ _ _ "http://downloads.factorcode.org/images/%s/%s" sprintf download ] with-directory ; + +: download-my-boot-image ( path branch -- ) + my-boot-image-name download-boot-image ; + +HOOK: compile-factor-command os ( -- array ) +M: unix compile-factor-command ( -- array ) + { "make" "-j" } cpus number>string suffix ; +M: windows compile-factor-command ( -- array ) + { "nmake" "/f" "NMakefile" "x86-64" } ; + +HOOK: factor-path os ( -- path ) +M: unix factor-path "./factor" ; +M: windows factor-path "./factor.com" ; + +: compile-factor ( path -- ) + [ + + compile-factor-command >>command + "./compile-log" >>stdout + +stdout+ >>stderr + +new-group+ >>group + try-process + ] with-directory ; + +: bootstrap-factor ( path -- ) + [ + + factor-path "-i=" my-boot-image-name append "-no-user-init" 3array >>command + +closed+ >>stdin + "./bootstrap-log" >>stdout + +stdout+ >>stderr + 30 minutes >>timeout + +new-group+ >>group + try-process + ] with-directory ; + +! Meant to run in the child process +: with-child-options ( quot -- ) + f parser-quiet? set-global + f restartable-tests? set-global + f long-unit-tests-enabled? set-global + call ; inline + +: zealot-load-and-save ( vocabs path -- ) + dup "load-and-save to " prepend print flush yield + '[ + [ load ] each _ save-image + ] with-child-options ; + +: zealot-load-basis ( -- ) basis-vocabs "factor.image.basis" zealot-load-and-save ; +: zealot-load-extra ( -- ) extra-vocabs "factor.image.extra" zealot-load-and-save ; + +! like ``"" load`` -- only platform-friendly vocabs +: zealot-vocabs-from-root ( root -- seq ) "" vocabs-to-load [ vocab-name ] map ; +: zealot-all-vocabs ( -- seq ) vocab-roots get [ zealot-vocabs-from-root ] map-concat ; +: zealot-core-vocabs ( -- seq ) "resource:core" zealot-vocabs-from-root ; +: zealot-basis-vocabs ( -- seq ) "resource:basis" zealot-vocabs-from-root ; +: zealot-extra-vocabs ( -- seq ) "resource:extra" zealot-vocabs-from-root ; + +: zealot-load-all ( -- ) zealot-all-vocabs "factor.image.all" zealot-load-and-save ; + +: zealot-load-command ( command log-path -- process ) + + swap >>stdout + swap >>command + +closed+ >>stdin + +stdout+ >>stderr + 60 minutes >>timeout + +new-group+ >>group ; + +: zealot-load-basis-command ( -- process ) + factor-path "-e=USE: zealot.factor zealot-load-basis" 2array + "./load-basis-log" zealot-load-command ; + +: zealot-load-extra-command ( -- process ) + factor-path "-e=USE: zealot.factor zealot-load-extra" 2array + "./load-extra-log" zealot-load-command ; + +: zealot-load-commands ( path -- ) + [ + zealot-load-basis-command + zealot-load-extra-command 2array + [ try-process ] parallel-each + ] with-directory ; + +: zealot-test-command ( command log-path -- process ) + + swap >>stdout + swap >>command + +closed+ >>stdin + +stdout+ >>stderr + 60 minutes >>timeout + +new-group+ >>group ; + +: zealot-load-and-test ( vocabs -- ) + '[ + _ [ [ load ] each ] [ test-vocabs ] bi + ] with-child-options ; + +: load-and-test-command ( i -- command ) + [ + factor-path + "-i=factor.image" + ] dip + [ + "-e=USING: zealot.factor tools.test grouping.extras formatting ; [ %d all-zealot-vocabs 32 n-groups nth zealot-load-and-test ] with-child-options" + sprintf 3array + ] [ "./test-%d-log" sprintf ] bi + + + swap >>stdout + swap >>command + +closed+ >>stdin + +stdout+ >>stderr + 60 minutes >>timeout + +new-group+ >>group ; + +: zealot-test-commands ( path -- ) + [ + 32 [ + load-and-test-command + ] map [ try-process ] parallel-each + ] with-directory ; + +: zealot-test-commands-old ( path -- ) + [ + factor-path "-i=factor.image" "-e=USE: zealot.factor USE: tools.test [ zealot-core-vocabs test-vocabs ] with-child-options" 3array + "./test-core-log" zealot-test-command + + factor-path "-i=factor.image.basis" "-e=USE: zealot.factor USE: tools.test [ zealot-basis-vocabs test-vocabs ] with-child-options" 3array + "./test-basis-log" zealot-test-command + + factor-path "-i=factor.image.extra" "-e=USE: zealot.factor USE: tools.test [ zealot-extra-vocabs test-vocabs ] with-child-options" 3array + "./test-extra-log" zealot-test-command 3array + + [ try-process ] parallel-each + ] with-directory ; + +: build-new-factor ( branch -- ) + "factor" "factor" zealot-github-ensure drop + + [ "factor" "factor" zealot-github-clone-paths nip ] dip + over . flush yield + { + [ drop "factor" "factor" zealot-github-add-build-remote drop ] + [ drop [ git-fetch-all* ] with-directory drop ] + [ zealot-build-checkout-branch drop ] + [ "ZEALOT DOWNLOADING BOOT IMAGE" print flush download-my-boot-image ] + [ "ZEALOT DOWNLOADING CHECKSUMS" print flush download-boot-checksums ] + [ "ZEALOT COMPILING" print flush drop compile-factor ] + [ "ZEALOT BOOTSTRAPPING" print flush drop bootstrap-factor ] + [ "ZEALOT LOADING ROOTS" print flush drop zealot-load-commands ] + [ "ZEALOT TESTING ROOTS" print flush drop zealot-test-commands ] + } 2cleave ; diff --git a/extra/zealot/zealot.factor b/extra/zealot/zealot.factor new file mode 100644 index 0000000000..9fcd173768 --- /dev/null +++ b/extra/zealot/zealot.factor @@ -0,0 +1,77 @@ +! Copyright (C) 2017 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: cli.git combinators fry io.directories io.files.info +io.pathnames kernel sequences uuid web-services.github ; +IN: zealot + +: default-zealot-directory ( chunk -- path ) [ home ".zealot" ] dip 3append-path ; +: default-zealot-source-directory ( -- path ) "source" default-zealot-directory ; +: default-zealot-builds-directory ( -- path ) "builds" default-zealot-directory ; + +: zealot-source-directory ( chunk -- path ) [ default-zealot-source-directory ] dip append-path ; +: zealot-builds-directory ( chunk -- path ) [ default-zealot-builds-directory ] dip append-path ; + +: with-default-zealot-source-directory ( chunk quot -- ) + [ default-zealot-source-directory ] dip with-ensure-directory ; inline + +: with-default-zealot-builds-directory ( chunk quot -- ) + [ default-zealot-builds-directory ] dip with-ensure-directory ; inline + +: with-zealot-source-directory ( chunk quot -- ) + [ zealot-source-directory ] dip with-ensure-directory ; inline + +: with-zealot-builds-directory ( chunk quot -- ) + [ zealot-builds-directory ] dip with-ensure-directory ; inline + + +: with-zealot-github-directory ( quot -- ) + [ "github" ] dip with-zealot-source-directory ; inline + +: with-zealot-github-project-directory ( user project quot -- ) + [ "github" ] 3dip [ 3append-path ] dip with-zealot-source-directory ; inline + +: zealot-github-clone ( user project -- process ) + '[ _ _ 2dup "/" glue github-git-clone-as ] with-zealot-github-directory ; inline + +: zealot-github-source-path ( user project -- path ) + [ "github" ] 2dip 3append-path zealot-source-directory ; + +: zealot-github-builds-path ( user project -- path ) + [ "github" ] 2dip 3append-path uuid1 append-path zealot-builds-directory ; + +: zealot-github-fetch-all ( user project -- process ) + [ git-fetch-all* ] with-zealot-github-project-directory ; + +: zealot-github-fetch-tags ( user project -- process ) + [ git-fetch-tags* ] with-zealot-github-project-directory ; + +: zealot-github-pull ( user project -- process ) + [ git-pull* ] with-zealot-github-project-directory ; + +: zealot-github-exists-locally? ( user project -- ? ) + zealot-github-source-path ?file-info >boolean ; + +: zealot-github-ensure ( user project -- process ) + 2dup zealot-github-exists-locally? [ + { + [ zealot-github-fetch-all drop ] + [ zealot-github-fetch-tags drop ] + [ zealot-github-pull ] + } 2cleave + ] [ + zealot-github-clone + ] if ; + +: zealot-github-set-build-remote ( path user project -- process ) + '[ "origin" _ _ github-ssh-uri git-change-remote* ] with-directory ; + +: zealot-github-add-build-remote ( path user project -- process ) + '[ "github" _ _ github-ssh-uri git-remote-add* ] with-directory ; + +: zealot-github-clone-paths ( user project -- process builds-path ) + [ zealot-github-source-path ] + [ zealot-github-builds-path ] 2bi + [ git-clone-as ] keep ; + +: zealot-build-checkout-branch ( path branch -- process ) + '[ _ git-checkout-existing-branch* ] with-directory ;