builder: more refactoring
Eduardo Cavazos
parent
c97e13a236
commit
ca4fc74b1f
|
|
@ -0,0 +1,46 @@
|
|||
|
||||
USING: io.files io.launcher io.encodings.utf8 prettyprint
|
||||
builder.util builder.common builder.child builder.release
|
||||
builder.report builder.email builder.cleanup ;
|
||||
|
||||
IN: builder.build
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: create-build-dir ( -- )
|
||||
datestamp >stamp
|
||||
build-dir make-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: enter-build-dir ( -- ) build-dir set-current-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: clone-builds-factor ( -- )
|
||||
{ "git" "clone" builds/factor } to-strings try-process ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: record-id ( -- )
|
||||
"factor"
|
||||
[ git-id "../git-id" utf8 [ . ] with-file-writer ]
|
||||
with-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: build ( -- )
|
||||
reset-status
|
||||
create-build-dir
|
||||
enter-build-dir
|
||||
clone-builds-factor
|
||||
record-id
|
||||
build-child
|
||||
release
|
||||
report
|
||||
email-report
|
||||
cleanup ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
MAIN: build
|
||||
|
|
@ -1,259 +1,21 @@
|
|||
|
||||
USING: kernel namespaces sequences splitting system combinators continuations
|
||||
parser io io.files io.launcher io.sockets prettyprint threads
|
||||
bootstrap.image benchmark vars bake smtp builder.util accessors
|
||||
debugger io.encodings.utf8
|
||||
calendar
|
||||
tools.test
|
||||
USING: kernel debugger io.files threads calendar
|
||||
builder.common
|
||||
builder.benchmark
|
||||
builder.release ;
|
||||
builder.updates
|
||||
builder.build ;
|
||||
|
||||
IN: builder
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: cd ( path -- ) set-current-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: builds/factor ( -- path ) builds "factor" append-path ;
|
||||
: build-dir ( -- path ) builds stamp> append-path ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: prepare-build-machine ( -- )
|
||||
builds make-directory
|
||||
builds
|
||||
[
|
||||
{ "git" "clone" "git://factorcode.org/git/factor.git" } try-process
|
||||
]
|
||||
with-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: builds-check ( -- ) builds exists? not [ prepare-build-machine ] when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: git-clone ( -- desc ) { "git" "clone" "../factor" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: enter-build-dir ( -- )
|
||||
datestamp >stamp
|
||||
builds cd
|
||||
stamp> make-directory
|
||||
stamp> cd ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: git-id ( -- id )
|
||||
{ "git" "show" } utf8 <process-stream>
|
||||
[ readln ] with-stream " " split second ;
|
||||
|
||||
: record-git-id ( -- ) git-id "../git-id" utf8 [ . ] with-file-writer ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: gnu-make ( -- string )
|
||||
os { freebsd openbsd netbsd } member?
|
||||
[ "gmake" ]
|
||||
[ "make" ]
|
||||
if ;
|
||||
|
||||
: do-make-clean ( -- ) { gnu-make "clean" } to-strings try-process ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: make-vm ( -- desc )
|
||||
<process>
|
||||
{ gnu-make } to-strings >>command
|
||||
"../compile-log" >>stdout
|
||||
+stdout+ >>stderr ;
|
||||
|
||||
: do-make-vm ( -- )
|
||||
make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: copy-image ( -- )
|
||||
builds/factor my-boot-image-name append-path ".." copy-file-into
|
||||
builds/factor my-boot-image-name append-path "." copy-file-into ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: bootstrap-cmd ( -- cmd )
|
||||
{ "./factor" { "-i=" my-boot-image-name } "-no-user-init" } to-strings ;
|
||||
|
||||
: bootstrap ( -- desc )
|
||||
<process>
|
||||
bootstrap-cmd >>command
|
||||
+closed+ >>stdin
|
||||
"../boot-log" >>stdout
|
||||
+stdout+ >>stderr
|
||||
60 minutes >>timeout ;
|
||||
|
||||
: do-bootstrap ( -- )
|
||||
bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail ;
|
||||
|
||||
: builder-test-cmd ( -- cmd )
|
||||
{ "./factor" "-run=builder.test" } to-strings ;
|
||||
|
||||
: builder-test ( -- desc )
|
||||
<process>
|
||||
builder-test-cmd >>command
|
||||
+closed+ >>stdin
|
||||
"../test-log" >>stdout
|
||||
+stdout+ >>stderr
|
||||
240 minutes >>timeout ;
|
||||
|
||||
: do-builder-test ( -- )
|
||||
builder-test [ "Test error" print "../test-log" 100 cat-n ] run-or-bail ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: build-status
|
||||
|
||||
: (build) ( -- )
|
||||
|
||||
builds-check
|
||||
|
||||
build-status off
|
||||
|
||||
enter-build-dir
|
||||
|
||||
"report" utf8
|
||||
[
|
||||
"Build machine: " write host-name print
|
||||
"CPU: " write cpu .
|
||||
"OS: " write os .
|
||||
"Build directory: " write current-directory get print
|
||||
|
||||
git-clone [ "git clone failed" print ] run-or-bail
|
||||
|
||||
"factor"
|
||||
[
|
||||
record-git-id
|
||||
do-make-clean
|
||||
do-make-vm
|
||||
copy-image
|
||||
do-bootstrap
|
||||
do-builder-test
|
||||
]
|
||||
with-directory
|
||||
|
||||
"test-log" delete-file
|
||||
|
||||
"git id: " write "git-id" eval-file print nl
|
||||
|
||||
"Boot time: " write "boot-time" eval-file milli-seconds>time print
|
||||
"Load time: " write "load-time" eval-file milli-seconds>time print
|
||||
"Test time: " write "test-time" eval-file milli-seconds>time print nl
|
||||
|
||||
"Did not pass load-everything: " print "load-everything-vocabs" cat
|
||||
|
||||
"Did not pass test-all: " print "test-all-vocabs" cat
|
||||
"test-failures" cat
|
||||
|
||||
"help-lint results:" print "help-lint" cat
|
||||
|
||||
"Benchmarks: " print "benchmarks" eval-file benchmarks.
|
||||
|
||||
nl
|
||||
|
||||
show-benchmark-deltas
|
||||
|
||||
"benchmarks" ".." copy-file-into
|
||||
|
||||
release
|
||||
]
|
||||
with-file-writer
|
||||
|
||||
build-status on ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: builder-from
|
||||
|
||||
SYMBOL: builder-recipients
|
||||
|
||||
: tag-subject ( str -- str ) { "builder@" host-name* ": " , } bake to-string ;
|
||||
|
||||
: subject ( -- str ) build-status get [ "report" ] [ "error" ] if tag-subject ;
|
||||
|
||||
: send-builder-email ( -- )
|
||||
<email>
|
||||
builder-from get >>from
|
||||
builder-recipients get >>to
|
||||
subject >>subject
|
||||
"./report" file>string >>body
|
||||
send-email ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: compress-image ( -- ) { "bzip2" my-boot-image-name } to-strings try-process ;
|
||||
|
||||
! : build ( -- )
|
||||
! [ (build) ] try
|
||||
! builds cd stamp> cd
|
||||
! [ send-builder-email ] try
|
||||
! { "rm" "-rf" "factor" } [ ] run-or-bail
|
||||
! [ compress-image ] try ;
|
||||
|
||||
: build ( -- )
|
||||
[
|
||||
(build)
|
||||
build-dir
|
||||
[
|
||||
{ "rm" "-rf" "factor" } try-process
|
||||
compress-image
|
||||
]
|
||||
with-directory
|
||||
]
|
||||
try
|
||||
send-builder-email ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USE: bootstrap.image.download
|
||||
|
||||
: git-pull ( -- desc )
|
||||
{
|
||||
"git"
|
||||
"pull"
|
||||
"--no-summary"
|
||||
"git://factorcode.org/git/factor.git"
|
||||
"master"
|
||||
} ;
|
||||
|
||||
: updates-available? ( -- ? )
|
||||
git-id
|
||||
git-pull try-process
|
||||
git-id
|
||||
= not ;
|
||||
|
||||
: new-image-available? ( -- ? )
|
||||
my-boot-image-name need-new-image?
|
||||
[ download-my-image t ]
|
||||
[ f ]
|
||||
if ;
|
||||
|
||||
: build-loop ( -- )
|
||||
builds-check
|
||||
[
|
||||
builds/factor
|
||||
[
|
||||
updates-available? new-image-available? or
|
||||
[ build ]
|
||||
when
|
||||
]
|
||||
with-directory
|
||||
builds/factor set-current-directory
|
||||
new-code-available? [ build ] when
|
||||
]
|
||||
try
|
||||
5 minutes sleep
|
||||
build-loop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
MAIN: build-loop
|
||||
MAIN: build-loop
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
|
||||
USING: namespaces debugger io.files io.launcher accessors bootstrap.image
|
||||
calendar builder.util builder.common ;
|
||||
|
||||
IN: builder.child
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: make-clean ( -- ) { gnu-make "clean" } to-strings try-process ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: make-vm ( -- )
|
||||
<process>
|
||||
gnu-make >>command
|
||||
"../compile-log" >>stdout
|
||||
+stdout+ >>stderr
|
||||
try-process ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: builds-factor-image ( -- img ) builds/factor my-boot-image-name append-path ;
|
||||
|
||||
: copy-image ( -- )
|
||||
builds-factor-image ".." copy-file-into
|
||||
builds-factor-image "." copy-file-into ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: boot-cmd ( -- cmd )
|
||||
{ "./factor" { "-i=" my-boot-image-name } "-no-user-init" } to-strings ;
|
||||
|
||||
: boot ( -- )
|
||||
<process>
|
||||
boot-cmd >>command
|
||||
+closed+ >>stdin
|
||||
"../boot-log" >>stdout
|
||||
+stdout+ >>stderr
|
||||
60 minutes >>timeout
|
||||
try-process ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: test-cmd ( -- cmd ) { "./factor" "-run=builder.test" } ;
|
||||
|
||||
: test ( -- )
|
||||
<process>
|
||||
test-cmd >>command
|
||||
+closed+ >>stdin
|
||||
"../test-log" >>stdout
|
||||
+stdout+ >>stderr
|
||||
240 minutes >>timeout
|
||||
try-process ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: (build-child) ( -- )
|
||||
make-clean
|
||||
make-vm status-vm on
|
||||
copy-image
|
||||
boot status-boot on
|
||||
test status-test on
|
||||
status on ;
|
||||
|
||||
! : build-child ( -- ) "factor" [ (build-child) ] with-directory ;
|
||||
|
||||
: build-child ( -- )
|
||||
"factor" set-current-directory
|
||||
[ (build-child) ] try
|
||||
".." set-current-directory ;
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
|
||||
USING: kernel namespaces io.files io.launcher bootstrap.image
|
||||
builder.util builder.common ;
|
||||
|
||||
IN: builder.cleanup
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: builder-debug
|
||||
|
||||
: compress-image ( -- ) { "bzip2" my-boot-image-name } to-strings try-process ;
|
||||
|
||||
: delete-child-factor ( -- )
|
||||
build-dir [ { "rm" "-rf" "factor" } try-process ] with-directory ;
|
||||
|
||||
: cleanup ( -- )
|
||||
builder-debug get f =
|
||||
[
|
||||
"test-log" delete-file
|
||||
delete-child-factor
|
||||
compress-image
|
||||
]
|
||||
when ;
|
||||
|
||||
|
|
@ -1,5 +1,7 @@
|
|||
|
||||
USING: kernel namespaces io.files sequences vars ;
|
||||
USING: kernel namespaces sequences splitting
|
||||
io io.files io.launcher io.encodings.utf8 prettyprint
|
||||
vars builder.util ;
|
||||
|
||||
IN: builder.common
|
||||
|
||||
|
|
@ -16,4 +18,47 @@ SYMBOL: builds-dir
|
|||
|
||||
VAR: stamp
|
||||
|
||||
SYMBOL: upload-to-factorcode
|
||||
: builds/factor ( -- path ) builds "factor" append-path ;
|
||||
: build-dir ( -- path ) builds stamp> append-path ;
|
||||
|
||||
: create-build-dir ( -- )
|
||||
datestamp >stamp
|
||||
build-dir make-directory ;
|
||||
|
||||
: enter-build-dir ( -- ) build-dir set-current-directory ;
|
||||
|
||||
: clone-builds-factor ( -- )
|
||||
{ "git" "clone" builds/factor } to-strings try-process ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: prepare-build-machine ( -- )
|
||||
builds make-directory
|
||||
builds
|
||||
[ { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ]
|
||||
with-directory ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: builds-check ( -- ) builds exists? not [ prepare-build-machine ] when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: status-vm
|
||||
SYMBOL: status-boot
|
||||
SYMBOL: status-test
|
||||
SYMBOL: status-build
|
||||
SYMBOL: status-release
|
||||
SYMBOL: status
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: reset-status ( -- )
|
||||
{ status-vm status-boot status-test status-build status-release status }
|
||||
[ off ]
|
||||
each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: upload-to-factorcode
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,22 @@
|
|||
|
||||
USING: kernel namespaces accessors smtp builder.util builder.common ;
|
||||
|
||||
IN: builder.email
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: builder-from
|
||||
SYMBOL: builder-recipients
|
||||
|
||||
: subject-status ( -- str ) status get [ "report" ] [ "error" ] if ;
|
||||
|
||||
: subject ( -- str ) { "builder@" host-name* ": " subject-status } to-string ;
|
||||
|
||||
: email-report ( -- )
|
||||
<email>
|
||||
builder-from get >>from
|
||||
builder-recipients get >>to
|
||||
subject >>subject
|
||||
"report" file>string >>body
|
||||
send-email ;
|
||||
|
||||
|
|
@ -36,5 +36,5 @@ IN: builder.release.branch
|
|||
|
||||
: update-clean-branch ( -- )
|
||||
upload-to-factorcode get
|
||||
[ update-clean-branch ]
|
||||
[ (update-clean-branch) ]
|
||||
when ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
USING: kernel system namespaces sequences splitting combinators
|
||||
USING: kernel debugger system namespaces sequences splitting combinators
|
||||
io io.files io.launcher prettyprint bootstrap.image
|
||||
bake combinators.cleave
|
||||
builder.util
|
||||
|
|
@ -18,9 +18,10 @@ IN: builder.release
|
|||
tidy
|
||||
make-archive
|
||||
upload
|
||||
save-archive ;
|
||||
save-archive
|
||||
status-release on ;
|
||||
|
||||
: clean-build? ( -- ? )
|
||||
{ "load-everything-vocabs" "test-all-vocabs" } [ eval-file empty? ] all? ;
|
||||
|
||||
: release ( -- ) clean-build? [ (release) ] when ;
|
||||
: release ( -- ) [ clean-build? [ (release) ] when ] try ;
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
|
||||
USING: kernel namespaces debugger system io io.files io.sockets
|
||||
io.encodings.utf8 prettyprint benchmark
|
||||
builder.util builder.common ;
|
||||
|
||||
IN: builder.report
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: (report) ( -- )
|
||||
|
||||
"Build machine: " write host-name print
|
||||
"CPU: " write cpu .
|
||||
"OS: " write os .
|
||||
"Build directory: " write build-dir print
|
||||
"git id: " write "git-id" eval-file print nl
|
||||
|
||||
status-vm get f = [ "compile-log" cat "vm compile error" throw ] when
|
||||
status-boot get f = [ "boot-log" cat "Boot error" throw ] when
|
||||
status-test get f = [ "test-log" 100 cat-n "Test error" throw ] when
|
||||
|
||||
"Boot time: " write "boot-time" eval-file milli-seconds>time print
|
||||
"Load time: " write "load-time" eval-file milli-seconds>time print
|
||||
"Test time: " write "test-time" eval-file milli-seconds>time print nl
|
||||
|
||||
"Did not pass load-everything: " print "load-everything-vocabs" cat
|
||||
|
||||
"Did not pass test-all: " print "test-all-vocabs" cat
|
||||
"test-failures" cat
|
||||
|
||||
"help-lint results:" print "help-lint" cat
|
||||
|
||||
"Benchmarks: " print "benchmarks" eval-file benchmarks. ;
|
||||
|
||||
: report ( -- ) "report" utf8 [ [ (report) ] try ] with-file-writer ;
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
|
||||
USING: kernel io.launcher bootstrap.image bootstrap.image.download
|
||||
builder.util builder.common ;
|
||||
|
||||
IN: builder.updates
|
||||
|
||||
: git-pull-cmd ( -- cmd )
|
||||
{
|
||||
"git"
|
||||
"pull"
|
||||
"--no-summary"
|
||||
"git://factorcode.org/git/factor.git"
|
||||
"master"
|
||||
} ;
|
||||
|
||||
: updates-available? ( -- ? )
|
||||
git-id
|
||||
git-pull-cmd try-process
|
||||
git-id
|
||||
= not ;
|
||||
|
||||
: new-image-available? ( -- ? )
|
||||
my-boot-image-name need-new-image?
|
||||
[ download-my-image t ]
|
||||
[ f ]
|
||||
if ;
|
||||
|
||||
: new-code-available? ( -- ? )
|
||||
updates-available?
|
||||
new-image-available?
|
||||
or ;
|
||||
|
|
@ -25,11 +25,11 @@ DEFER: to-strings
|
|||
: to-string ( obj -- str )
|
||||
dup class
|
||||
{
|
||||
{ string [ ] }
|
||||
{ quotation [ call ] }
|
||||
{ word [ execute ] }
|
||||
{ fixnum [ number>string ] }
|
||||
{ array [ to-strings concat ] }
|
||||
{ \ string [ ] }
|
||||
{ \ quotation [ call ] }
|
||||
{ \ word [ execute ] }
|
||||
{ \ fixnum [ number>string ] }
|
||||
{ \ array [ to-strings concat ] }
|
||||
}
|
||||
case ;
|
||||
|
||||
|
|
@ -97,4 +97,15 @@ USE: prettyprint
|
|||
|
||||
: cpu- ( -- cpu ) cpu unparse "." split "-" join ;
|
||||
|
||||
: platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ;
|
||||
: platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: gnu-make ( -- string )
|
||||
os { freebsd openbsd netbsd } member? [ "gmake" ] [ "make" ] if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: git-id ( -- id )
|
||||
{ "git" "show" } utf8 <process-stream> [ readln ] with-stream
|
||||
" " split second ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue