steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-02-12 00:51:46 -06:00
parent b321d5a33d 27fb2270f0
commit ea553f9ed4
2 changed files with 53 additions and 105 deletions
extra/builder

124
extra/builder/builder.factor
View File

@ -1,5 +1,5 @@
USING: kernel io io.files io.launcher io.sockets hashtables math threads
USING: kernel parser io io.files io.launcher io.sockets hashtables math threads
system continuations namespaces sequences splitting math.parser
prettyprint tools.time calendar bake vars http.client
combinators bootstrap.image bootstrap.image.download
@ -133,7 +133,7 @@ VAR: stamp
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SYMBOL: build-status
SYMBOL: build-status
! : build ( -- )
@ -167,24 +167,47 @@ VAR: stamp
SYMBOL: report
: >>>report ( quot -- ) report get swap with-stream* ;
: file>>>report ( file -- ) [ <file-reader> contents write ] curry >>>report ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run-or-report ( desc quot -- )
[ [ try-process ] curry ]
[ [ >>>report throw ] curry ]
bi*
recover ;
: run-or-report-file ( desc quot file -- )
[ [ try-process ] curry ]
[ [ >>>report ] curry ]
[ [ file>>>report throw ] curry ]
tri*
compose
recover ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: ms>minutes ( ms -- minutes ) 1000.0 / 60 / ;
: bootstrap-minutes ( -- )
"../bootstrap-time" <file-reader> contents eval ms>minutes unparse ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: (build) ( -- )
enter-build-dir
"report" <file-writer> report set
report get [ "Build machine: " write host-name write nl ] with-stream*
report get [ "Build directory: " write cwd write nl ] with-stream*
[ git-clone try-process ]
[
report get
[ "Builder fatal error: git clone failed" write nl ]
with-stream*
throw
]
recover
"Build machine: " write host-name write nl
"Build directory: " write cwd write nl
] >>>report
git-clone [ "Builder fatal error: git clone failed" write nl ] run-or-report
"factor" cd
@ -192,82 +215,33 @@ SYMBOL: report
make-clean run-process drop
[ make-vm try-process ]
[
report get
[
"Builder fatal error: vm compile error" write nl
"../compile-log" <file-reader> contents write
]
with-stream*
throw
]
recover
make-vm
[ "Builder fatal error: vm compile error" write nl ]
"../compile-log"
run-or-report-file
[ my-arch download-image ]
[
report get
[ "Builder fatal error: image download" write nl ]
with-stream*
throw
]
[ [ "Builder fatal error: image download" write nl ] >>>report throw ]
recover
[ bootstrap try-process ]
[
report get
[
"Bootstrap error" write nl
"../boot-log" <file-reader> contents write
]
with-stream*
throw
]
recover
bootstrap [ "Bootstrap error" write nl ] "../boot-log" run-or-report-file
[ builder-test try-process ]
[
report get
[
"Builder test error" write nl
"../load-everything-log" exists?
[ "../load-everything-log" <file-reader> contents write nl ]
when
"../test-all-log" exists?
[ "../test-all-log" <file-reader> contents write nl ]
when
]
with-stream*
throw
]
recover
builder-test [ "Builder test error" write nl ] run-or-report
report get
[
"Bootstrap time: " write
"../bootstrap-time" <file-reader> contents write nl
]
with-stream*
[ "Bootstrap time: " write bootstrap-minutes write " minutes" write nl ]
>>>report
"../load-everything-vocabs" exists?
[
report get
[
"Did not pass load-everything: " write nl
"../load-everything-vocabs" <file-reader> contents write nl
]
with-stream*
[ "Did not pass load-everything: " write nl ] >>>report
"../load-everything-vocabs" file>>>report
]
when
"../test-all-vocabs" exists?
[
report get
[
"Did not pass test-all: " write nl
"../test-all-vocabs" <file-reader> contents write nl
]
with-stream*
[ "Did not pass test-all: " write nl ] >>>report
"../test-all-vocabs" file>>>report
]
when ;

34
extra/builder/test/test.factor
View File

@ -15,45 +15,19 @@ IN: builder.test
[ bootstrap-time get . ]
with-stream ;
: try-everything* ( -- vocabs ) try-everything [ first vocab-link-name ] map ;
! : do-load ( -- )
! [ try-everything* ] "../load-everything-time" log-runtime
! dup empty?
! [ drop ]
! [ "../load-everything-log" log-object ]
! if ;
: do-load ( -- )
[
"../load-everything-log" <file-writer>
[ try-everything* ]
with-stream
] "../load-everything-time" log-runtime
[ try-everything keys ] "../load-everything-time" log-runtime
dup empty?
[ drop ]
[ "../load-everything-vocabs" log-object ]
if
"../load-everything-log" delete-file ;
! : do-tests ( -- )
! run-all-tests keys
! dup empty?
! [ drop ]
! [ "../failing-tests" log-object ]
! if ;
if ;
: do-tests ( -- )
[
"../test-all-log" <file-writer>
[ run-all-tests keys ]
with-stream
] "../test-all-time" log-runtime
[ run-all-tests keys ] "../test-all-time" log-runtime
dup empty?
[ drop ]
[ "../test-all-vocabs" log-object ]
if
"../test-all-log" delete-file ;
if ;
: do-all ( -- )
record-bootstrap-time