Merge branch 'master' of git://factorcode.org/git/factor
commit
545a49a12e
|
@ -1,8 +1,9 @@
|
|||
|
||||
USING: kernel io io.files io.launcher hashtables
|
||||
USING: kernel io io.files io.launcher io.sockets hashtables
|
||||
system continuations namespaces sequences splitting math.parser
|
||||
prettyprint tools.time calendar bake vars http.client
|
||||
combinators bootstrap.image bootstrap.image.download ;
|
||||
combinators bootstrap.image bootstrap.image.download
|
||||
combinators.cleave ;
|
||||
|
||||
IN: builder
|
||||
|
||||
|
@ -29,16 +30,32 @@ IN: builder
|
|||
|
||||
SYMBOL: builder-recipients
|
||||
|
||||
: tag-subject ( str -- str ) `{ "builder@" ,[ host-name ] ": " , } concat ;
|
||||
|
||||
: email-string ( subject -- )
|
||||
`{ "mutt" "-s" ,[ tag-subject ] %[ builder-recipients get ] }
|
||||
[ ] with-process-stream drop ;
|
||||
|
||||
: email-file ( subject file -- )
|
||||
`{
|
||||
{ +stdin+ , }
|
||||
{ +arguments+ { "mutt" "-s" , %[ builder-recipients get ] } }
|
||||
{ +arguments+
|
||||
{ "mutt" "-s" ,[ tag-subject ] %[ builder-recipients get ] } }
|
||||
}
|
||||
>hashtable run-process drop ;
|
||||
|
||||
: email-string ( subject -- )
|
||||
`{ "mutt" "-s" , %[ builder-recipients get ] }
|
||||
[ ] with-process-stream drop ;
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: run-or-notify ( desc message -- )
|
||||
[ [ try-process ] curry ]
|
||||
[ [ email-string throw ] curry ]
|
||||
bi*
|
||||
recover ;
|
||||
|
||||
: run-or-send-file ( desc message file -- )
|
||||
>r >r [ try-process ] curry
|
||||
r> r> [ email-string throw ] 2curry
|
||||
recover ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
@ -59,71 +76,44 @@ VAR: stamp
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: build-status
|
||||
|
||||
: build ( -- )
|
||||
|
||||
"running" build-status set-global
|
||||
|
||||
datestamp >stamp
|
||||
|
||||
"/builds/factor" cd
|
||||
|
||||
: git-pull ( -- desc )
|
||||
{
|
||||
"git"
|
||||
"pull"
|
||||
"--no-summary"
|
||||
"git://factorcode.org/git/factor.git"
|
||||
"master"
|
||||
}
|
||||
run-process process-status
|
||||
0 =
|
||||
[ ]
|
||||
[
|
||||
"builder: git pull" email-string
|
||||
"builder: git pull" throw
|
||||
]
|
||||
if
|
||||
} ;
|
||||
|
||||
{
|
||||
"git" "pull" "--no-summary"
|
||||
"http://dharmatech.onigirihouse.com/factor.git" "master"
|
||||
} run-process drop
|
||||
: git-clone ( -- desc ) { "git" "clone" "../factor" } ;
|
||||
|
||||
"/builds/" stamp> append make-directory
|
||||
"/builds/" stamp> append cd
|
||||
|
||||
{ "git" "clone" "../factor" } run-process drop
|
||||
|
||||
"factor" cd
|
||||
: enter-build-dir ( -- )
|
||||
datestamp >stamp
|
||||
"/builds" cd
|
||||
stamp> make-directory
|
||||
stamp> cd ;
|
||||
|
||||
: record-git-id ( -- )
|
||||
{ "git" "show" } <process-stream> [ readln ] with-stream " " split second
|
||||
"../git-id" log-object
|
||||
"../git-id" log-object ;
|
||||
|
||||
{ "make" "clean" } run-process drop
|
||||
|
||||
! "vm" build-status set-global
|
||||
: make-clean ( -- desc ) { "make" "clean" } ;
|
||||
|
||||
: make-vm ( -- )
|
||||
`{
|
||||
{ +arguments+ { "make" ,[ target ] } }
|
||||
{ +stdout+ "../compile-log" }
|
||||
{ +stderr+ +stdout+ }
|
||||
}
|
||||
>hashtable run-process process-status
|
||||
0 =
|
||||
[ ]
|
||||
[
|
||||
"builder: vm compile" "../compile-log" email-file
|
||||
"builder: vm compile" throw
|
||||
] if
|
||||
>hashtable ;
|
||||
|
||||
: retrieve-boot-image ( -- )
|
||||
[ my-arch download-image ]
|
||||
[ ]
|
||||
[ "builder: image download" email-string ]
|
||||
cleanup
|
||||
|
||||
! "bootstrap" build-status set-global
|
||||
cleanup ;
|
||||
|
||||
: bootstrap ( -- desc )
|
||||
`{
|
||||
{ +arguments+ {
|
||||
,[ factor-binary ]
|
||||
|
@ -133,17 +123,39 @@ SYMBOL: build-status
|
|||
{ +stdout+ "../boot-log" }
|
||||
{ +stderr+ +stdout+ }
|
||||
}
|
||||
>hashtable [ run-process ] "../boot-time" log-runtime process-status
|
||||
0 =
|
||||
[ ]
|
||||
[
|
||||
"builder: bootstrap" "../boot-log" email-file
|
||||
"builder: bootstrap" throw
|
||||
] if
|
||||
>hashtable ;
|
||||
|
||||
! "test" build-status set-global
|
||||
: builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
`{ ,[ factor-binary ] "-run=builder.test" } run-process drop
|
||||
SYMBOL: build-status
|
||||
|
||||
: build ( -- )
|
||||
|
||||
"running" build-status set-global
|
||||
|
||||
"/builds/factor" cd
|
||||
|
||||
git-pull "git pull error" run-or-notify
|
||||
|
||||
enter-build-dir
|
||||
|
||||
git-clone "git clone error" run-or-notify
|
||||
|
||||
"factor" cd
|
||||
|
||||
record-git-id
|
||||
|
||||
make-clean "make clean error" run-or-notify
|
||||
|
||||
make-vm "vm compile error" "../compile-log" run-or-send-file
|
||||
|
||||
retrieve-boot-image
|
||||
|
||||
bootstrap "bootstrap error" "../boot-log" run-or-send-file
|
||||
|
||||
builder-test "builder.test fatal error" run-or-notify
|
||||
|
||||
"../load-everything-log" exists?
|
||||
[ "builder: load-everything" "../load-everything-log" email-file ]
|
||||
|
@ -153,9 +165,7 @@ SYMBOL: build-status
|
|||
[ "builder: failing tests" "../failing-tests" email-file ]
|
||||
when
|
||||
|
||||
! "ready" build-status set-global
|
||||
|
||||
;
|
||||
"ready" build-status set-global ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
@ -49,7 +49,7 @@ MEMO: 'arguments' ( -- parser )
|
|||
|
||||
: redirect ( obj mode fd -- )
|
||||
{
|
||||
{ [ pick not ] [ 3drop ] }
|
||||
{ [ pick not ] [ 2nip F_SETFL 0 fcntl io-error ] }
|
||||
{ [ pick +closed+ eq? ] [ close 2drop ] }
|
||||
{ [ pick string? ] [ (redirect) ] }
|
||||
} cond ;
|
||||
|
|
Loading…
Reference in New Issue