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

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

db4
John Benediktsson 2008-09-16 14:10:21 -07:00
parent ed0d31eaef 47f5706147
commit 85d35c9caf
28 changed files with 845 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/io/unix/linux/monitors/monitors-tests.factor
View File

@ -10,6 +10,7 @@ threads calendar prettyprint destructors io.timeouts ;
! Non-recursive
[ ] [ "monitor-test-self" temp-file f <monitor> "m" set ] unit-test
[ ] [ 3 seconds "m" get set-timeout ] unit-test
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test
@ -22,6 +23,7 @@ threads calendar prettyprint destructors io.timeouts ;
! Recursive
[ ] [ "monitor-test-self" temp-file t <monitor> "m" set ] unit-test
[ ] [ 3 seconds "m" get set-timeout ] unit-test
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test

2
extra/mason/authors.txt Normal file
View File

@ -0,0 +1,2 @@
Eduardo Cavazos
Slava Pestov

5
extra/mason/build/build-tests.factor Normal file
View File

@ -0,0 +1,5 @@
USING: mason.build tools.test sequences ;
IN: mason.build.tests
{ create-build-dir enter-build-dir clone-builds-factor record-id }
[ must-infer ] each

30
extra/mason/build/build.factor Normal file
View File

@ -0,0 +1,30 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files io.launcher io.encodings.utf8 prettyprint arrays
calendar namespaces mason.common mason.child
mason.release mason.report mason.email mason.cleanup ;
IN: mason.build
: create-build-dir ( -- )
now datestamp stamp set
build-dir make-directory ;
: enter-build-dir ( -- ) build-dir set-current-directory ;
: clone-builds-factor ( -- )
"git" "clone" builds/factor 3array try-process ;
: record-id ( -- )
"factor" [ git-id ] with-directory "git-id" to-file ;
: build ( -- )
create-build-dir
enter-build-dir
clone-builds-factor
record-id
build-child
release
email-report
cleanup ;
MAIN: build

34
extra/mason/child/child-tests.factor Normal file
View File

@ -0,0 +1,34 @@
IN: mason.child.tests
USING: mason.child mason.config tools.test namespaces ;
[ { "make" "clean" "winnt-x86-32" } ] [
[
"winnt" target-os set
"x86.32" target-cpu set
make-cmd
] with-scope
] unit-test
[ { "make" "clean" "macosx-x86-32" } ] [
[
"macosx" target-os set
"x86.32" target-cpu set
make-cmd
] with-scope
] unit-test
[ { "gmake" "clean" "netbsd-ppc" } ] [
[
"netbsd" target-os set
"ppc" target-cpu set
make-cmd
] with-scope
] unit-test
[ { "./factor" "-i=boot.macosx-ppc.image" "-no-user-init" } ] [
[
"macosx" target-os set
"ppc" target-cpu set
boot-cmd
] with-scope
] unit-test

80
extra/mason/child/child.factor Normal file
View File

@ -0,0 +1,80 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make debugger sequences io.files
io.launcher arrays accessors calendar continuations
combinators.short-circuit mason.common mason.report mason.platform ;
IN: mason.child
: make-cmd ( -- args )
[ gnu-make , "clean" , platform , ] { } make ;
: make-vm ( -- )
"factor" [
<process>
make-cmd >>command
"../compile-log" >>stdout
+stdout+ >>stderr
try-process
] with-directory ;
: builds-factor-image ( -- img )
builds/factor boot-image-name append-path ;
: copy-image ( -- )
builds-factor-image "." copy-file-into
builds-factor-image "factor" copy-file-into ;
: boot-cmd ( -- cmd )
"./factor"
"-i=" boot-image-name append
"-no-user-init"
3array ;
: boot ( -- )
"factor" [
<process>
boot-cmd >>command
+closed+ >>stdin
"../boot-log" >>stdout
+stdout+ >>stderr
1 hours >>timeout
try-process
] with-directory ;
: test-cmd ( -- cmd ) { "./factor" "-run=mason.test" } ;
: test ( -- )
"factor" [
<process>
test-cmd >>command
+closed+ >>stdin
"../test-log" >>stdout
+stdout+ >>stderr
4 hours >>timeout
try-process
] with-directory ;
: return-with ( obj -- ) return-continuation get continue-with ;
: build-clean? ( -- ? )
{
[ load-everything-vocabs-file eval-file empty? ]
[ test-all-vocabs-file eval-file empty? ]
[ help-lint-vocabs-file eval-file empty? ]
} 0&& ;
: build-child ( -- )
[
return-continuation set
copy-image
[ make-vm ] [ compile-failed-report status-error return-with ] recover
[ boot ] [ boot-failed-report status-error return-with ] recover
[ test ] [ test-failed-report status-error return-with ] recover
successful-report
build-clean? status-clean status-dirty ? return-with
] callcc1
status set ;

4
extra/mason/cleanup/cleanup-tests.factor Normal file
View File

@ -0,0 +1,4 @@
USING: tools.test mason.cleanup ;
IN: mason.cleanup.tests
\ cleanup must-infer

22
extra/mason/cleanup/cleanup.factor Normal file
View File

@ -0,0 +1,22 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces arrays continuations io.files io.launcher
mason.common mason.platform mason.config ;
IN: mason.cleanup
: compress-image ( -- )
"bzip2" boot-image-name 2array try-process ;
: compress-test-log ( -- )
"test-log" exists? [
{ "bzip2" "test-log" } try-process
] when ;
: cleanup ( -- )
builder-debug get [
build-dir [
compress-image
compress-test-log
"factor" delete-tree
] with-directory
] unless ;

34
extra/mason/common/common-tests.factor Normal file
View File

@ -0,0 +1,34 @@
IN: mason.common.tests
USING: prettyprint mason.common mason.config
namespaces calendar tools.test io.files io.encodings.utf8 ;
[ "00:01:01" ] [ 61000 milli-seconds>time ] unit-test
[ "/home/bobby/builds/factor" ] [
[
"/home/bobby/builds" builds-dir set
builds/factor
] with-scope
] unit-test
[ "/home/bobby/builds/2008-09-11-12-23" ] [
[
"/home/bobby/builds" builds-dir set
T{ timestamp
{ year 2008 }
{ month 9 }
{ day 11 }
{ hour 12 }
{ minute 23 }
} datestamp stamp set
build-dir
] with-scope
] unit-test
[ ] [ "empty-test" temp-file utf8 [ ] with-file-writer ] unit-test
[ "empty-test" temp-file eval-file ] must-fail
[ ] [ "eval-file-test" temp-file utf8 [ { 1 2 3 } . ] with-file-writer ] unit-test
[ { 1 2 3 } ] [ "eval-file-test" temp-file eval-file ] unit-test

81
extra/mason/common/common.factor Normal file
View File

@ -0,0 +1,81 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces sequences splitting system accessors
math.functions make io io.files io.launcher io.encodings.utf8
prettyprint combinators.short-circuit parser combinators
calendar calendar.format arrays mason.config ;
IN: mason.common
: short-running-process ( command -- )
#! Give network operations at most 15 minutes to complete.
<process>
swap >>command
15 minutes >>timeout
try-process ;
: eval-file ( file -- obj )
dup utf8 file-lines parse-fresh
[ "Empty file: " swap append throw ] [ nip first ] if-empty ;
: cat ( file -- ) utf8 file-contents print ;
: cat-n ( file n -- ) [ utf8 file-lines ] dip short tail* [ print ] each ;
: to-file ( object file -- ) utf8 [ . ] with-file-writer ;
: datestamp ( timestamp -- string )
[
{
[ year>> , ]
[ month>> , ]
[ day>> , ]
[ hour>> , ]
[ minute>> , ]
} cleave
] { } make [ pad-00 ] map "-" join ;
: milli-seconds>time ( n -- string )
millis>timestamp
[ hour>> ] [ minute>> ] [ second>> floor ] tri 3array
[ pad-00 ] map ":" join ;
SYMBOL: stamp
: builds/factor ( -- path ) builds-dir get "factor" append-path ;
: build-dir ( -- path ) builds-dir get stamp get append-path ;
: prepare-build-machine ( -- )
builds-dir get make-directories
builds-dir get
[ { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ]
with-directory ;
: git-id ( -- id )
{ "git" "show" } utf8 <process-reader> [ readln ] with-input-stream
" " split second ;
: ?prepare-build-machine ( -- )
builds/factor exists? [ prepare-build-machine ] unless ;
: load-everything-vocabs-file "load-everything-vocabs" ;
: load-everything-errors-file "load-everything-errors" ;
: test-all-vocabs-file "test-all-vocabs" ;
: test-all-errors-file "test-all-errors" ;
: help-lint-vocabs-file "help-lint-vocabs" ;
: help-lint-errors-file "help-lint-errors" ;
: boot-time-file "boot-time" ;
: load-time-file "load-time" ;
: test-time-file "test-time" ;
: help-lint-time-file "help-lint-time" ;
: benchmark-time-file "benchmark-time" ;
: benchmarks-file "benchmarks" ;
SYMBOL: status
SYMBOL: status-error ! didn't bootstrap, or crashed
SYMBOL: status-dirty ! bootstrapped but not all tests passed
SYMBOL: status-clean ! everything good

66
extra/mason/config/config.factor Normal file
View File

@ -0,0 +1,66 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: system io.files namespaces kernel accessors ;
IN: mason.config
! (Optional) Location for build directories
SYMBOL: builds-dir
builds-dir get-global [
home "builds" append-path builds-dir set-global
] unless
! Who sends build reports.
SYMBOL: builder-from
! Who receives build reports.
SYMBOL: builder-recipients
! (Optional) CPU architecture to build for.
SYMBOL: target-cpu
target-cpu get-global [
cpu name>> target-cpu set-global
] unless
! (Optional) OS to build for.
SYMBOL: target-os
target-os get-global [
os name>> target-os set-global
] unless
! Keep test-log around?
SYMBOL: builder-debug
! Boolean. Do we release binaries and update the clean branch?
SYMBOL: upload-to-factorcode
! The below are only needed if upload-to-factorcode is true.
! Host with clean git repo.
SYMBOL: branch-host
! Username to log in.
SYMBOL: branch-username
! Directory with git repo.
SYMBOL: branch-directory
! Host to upload clean image to.
SYMBOL: image-host
! Username to log in.
SYMBOL: image-username
! Directory with clean images.
SYMBOL: image-directory
! Host to upload binary package to.
SYMBOL: upload-host
! Username to log in.
SYMBOL: upload-username
! Directory with binary packages.
SYMBOL: upload-directory

11
extra/mason/email/email-tests.factor Normal file
View File

@ -0,0 +1,11 @@
IN: mason.email.tests
USING: mason.email mason.common mason.config namespaces tools.test ;
[ "mason on linux-x86-64: error" ] [
[
"linux" target-os set
"x86.64" target-cpu set
status-error status set
subject prefix-subject
] with-scope
] unit-test

35
extra/mason/email/email.factor Normal file
View File

@ -0,0 +1,35 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces accessors combinators make smtp
debugger prettyprint io io.streams.string io.encodings.utf8
io.files io.sockets
mason.common mason.platform mason.config ;
IN: mason.email
: prefix-subject ( str -- str' )
[ "mason on " % platform % ": " % % ] "" make ;
: email-status ( body subject -- )
<email>
builder-from get >>from
builder-recipients get >>to
swap prefix-subject >>subject
swap >>body
send-email ;
: subject ( -- str )
status get {
{ status-clean [ "clean" ] }
{ status-dirty [ "dirty" ] }
{ status-error [ "error" ] }
} case ;
: email-report ( -- )
"report" utf8 file-contents subject email-status ;
: email-error ( error callstack -- )
[
"Fatal error on " write host-name print nl
[ error. ] [ callstack. ] bi*
] with-string-writer "fatal error"
email-status ;

30
extra/mason/mason.factor Normal file
View File

@ -0,0 +1,30 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel debugger io io.files threads debugger continuations
namespaces accessors calendar mason.common mason.updates
mason.build mason.email ;
IN: mason
: build-loop-error ( error -- )
error-continuation get call>> email-error ;
: build-loop-fatal ( error -- )
"FATAL BUILDER ERROR:" print
error. flush ;
: build-loop ( -- )
?prepare-build-machine
[
[
builds/factor set-current-directory
new-code-available? [ build ] when
] [
build-loop-error
] recover
] [
build-loop-fatal
] recover
5 minutes sleep
build-loop ;
MAIN: build-loop

19
extra/mason/platform/platform.factor Normal file
View File

@ -0,0 +1,19 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel system accessors namespaces splitting sequences make
mason.config ;
IN: mason.platform
: platform ( -- string )
target-os get "-" target-cpu get "." split "-" join 3append ;
: gnu-make ( -- string )
target-os get { "freebsd" "openbsd" "netbsd" } member? "gmake" "make" ? ;
: boot-image-name ( -- string )
[
"boot." %
target-cpu get "ppc" = [ target-os get % "-" % ] when
target-cpu get %
".image" %
] "" make ;

47
extra/mason/release/archive/archive.factor Normal file
View File

@ -0,0 +1,47 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel combinators sequences make namespaces io.files
io.launcher prettyprint arrays
mason.common mason.platform mason.config ;
IN: mason.release.archive
: base-name ( -- string )
[ "factor-" % platform % "-" % stamp get % ] "" make ;
: extension ( -- extension )
target-os get {
{ "winnt" [ ".zip" ] }
{ "macosx" [ ".dmg" ] }
[ drop ".tar.gz" ]
} case ;
: archive-name ( -- string ) base-name extension append ;
: make-windows-archive ( -- )
[ "zip" , "-r" , archive-name , "factor" , ] { } make try-process ;
: make-macosx-archive ( -- )
{ "mkdir" "dmg-root" } try-process
{ "cp" "-R" "factor" "dmg-root" } try-process
{ "hdiutil" "create"
"-srcfolder" "dmg-root"
"-fs" "HFS+"
"-volname" "factor" }
archive-name suffix try-process
"dmg-root" delete-tree ;
: make-unix-archive ( -- )
[ "tar" , "-cvzf" , archive-name , "factor" , ] { } make try-process ;
: make-archive ( -- )
target-os get {
{ "winnt" [ make-windows-archive ] }
{ "macosx" [ make-macosx-archive ] }
[ drop make-unix-archive ]
} case ;
: releases ( -- path )
builds-dir get "releases" append-path dup make-directories ;
: save-archive ( -- )
archive-name releases move-file-into ;

24
extra/mason/release/branch/branch-tests.factor Normal file
View File

@ -0,0 +1,24 @@
IN: mason.release.branch.tests
USING: mason.release.branch mason.config tools.test namespaces ;
[ { "git" "push" "joe@blah.com:/my/git" "master:clean-linux-x86-32" } ] [
[
"joe" branch-username set
"blah.com" branch-host set
"/my/git" branch-directory set
"linux" target-os set
"x86.32" target-cpu set
push-to-clean-branch-cmd
] with-scope
] unit-test
[ { "scp" "boot.x86.64.image" "joe@blah.com:/stuff/clean/netbsd-x86-64" } ] [
[
"joe" image-username set
"blah.com" image-host set
"/stuff/clean" image-directory set
"netbsd" target-os set
"x86.64" target-cpu set
upload-clean-image-cmd
] with-scope
] unit-test

48
extra/mason/release/branch/branch.factor Normal file
View File

@ -0,0 +1,48 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces sequences prettyprint io.files
io.launcher make
mason.common mason.platform mason.config ;
IN: mason.release.branch
: branch-name ( -- string ) "clean-" platform append ;
: refspec ( -- string ) "master:" branch-name append ;
: push-to-clean-branch-cmd ( -- args )
[
"git" , "push" ,
[
branch-username get % "@" %
branch-host get % ":" %
branch-directory get %
] "" make ,
refspec ,
] { } make ;
: push-to-clean-branch ( -- )
push-to-clean-branch-cmd short-running-process ;
: upload-clean-image-cmd ( -- args )
[
"scp" ,
boot-image-name ,
[
image-username get % "@" %
image-host get % ":" %
image-directory get % "/" %
platform %
] "" make ,
] { } make ;
: upload-clean-image ( -- )
upload-clean-image-cmd short-running-process ;
: (update-clean-branch) ( -- )
"factor" [
push-to-clean-branch
upload-clean-image
] with-directory ;
: update-clean-branch ( -- )
upload-to-factorcode get [ (update-clean-branch) ] when ;

16
extra/mason/release/release.factor Normal file
View File

@ -0,0 +1,16 @@
! Copyright (C) 2008 Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel debugger namespaces sequences splitting
combinators io io.files io.launcher prettyprint bootstrap.image
mason.common mason.release.branch mason.release.tidy
mason.release.archive mason.release.upload ;
IN: mason.release
: (release) ( -- )
update-clean-branch
tidy
make-archive
upload
save-archive ;
: release ( -- ) status get status-clean eq? [ (release) ] when ;

2
extra/mason/release/tidy/tidy-tests.factor Normal file
View File

@ -0,0 +1,2 @@
IN: mason.release.tidy.tests
USING: mason.release.tidy tools.test ;

33
extra/mason/release/tidy/tidy.factor Normal file
View File

@ -0,0 +1,33 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces continuations debugger sequences fry
io.files io.launcher mason.common mason.platform
mason.config ;
IN: mason.release.tidy
: common-files ( -- seq )
{
"boot.x86.32.image"
"boot.x86.64.image"
"boot.macosx-ppc.image"
"boot.linux-ppc.image"
"vm"
"temp"
"logs"
".git"
".gitignore"
"Makefile"
"unmaintained"
"unfinished"
"build-support"
} ;
: remove-common-files ( -- )
common-files [ delete-tree ] each ;
: remove-factor-app ( -- )
target-os get "macosx" =
[ "Factor.app" delete-tree ] unless ;
: tidy ( -- )
"factor" [ remove-factor-app remove-common-files ] with-directory ;

38
extra/mason/release/upload/upload-tests.factor Normal file
View File

@ -0,0 +1,38 @@
IN: mason.release.upload.tests
USING: mason.release.upload mason.common mason.config
mason.common namespaces calendar tools.test ;
[
{
"scp"
"factor-linux-ppc-2008-09-11-23-12.tar.gz"
"slava@www.apple.com:/uploads/linux-ppc/factor-linux-ppc-2008-09-11-23-12.tar.gz.incomplete"
}
{
"ssh"
"www.apple.com"
"-l" "slava"
"mv"
"/uploads/linux-ppc/factor-linux-ppc-2008-09-11-23-12.tar.gz.incomplete"
"/uploads/linux-ppc/factor-linux-ppc-2008-09-11-23-12.tar.gz"
}
] [
[
"slava" upload-username set
"www.apple.com" upload-host set
"/uploads" upload-directory set
"linux" target-os set
"ppc" target-cpu set
T{ timestamp
{ year 2008 }
{ month 09 }
{ day 11 }
{ hour 23 }
{ minute 12 }
} datestamp stamp set
upload-command
rename-command
] with-scope
] unit-test
\ upload must-infer

47
extra/mason/release/upload/upload.factor Normal file
View File

@ -0,0 +1,47 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make sequences arrays io io.files
io.launcher mason.common mason.platform
mason.release.archive mason.config ;
IN: mason.release.upload
: remote-location ( -- dest )
upload-directory get "/" platform 3append ;
: remote-archive-name ( -- dest )
remote-location "/" archive-name 3append ;
: temp-archive-name ( -- dest )
remote-archive-name ".incomplete" append ;
: upload-command ( -- args )
"scp"
archive-name
[
upload-username get % "@" %
upload-host get % ":" %
temp-archive-name %
] "" make
3array ;
: rename-command ( -- args )
[
"ssh" ,
upload-host get ,
"-l" ,
upload-username get ,
"mv" ,
temp-archive-name ,
remote-archive-name ,
] { } make ;
: upload-temp-file ( -- )
upload-command short-running-process ;
: rename-temp-file ( -- )
rename-command short-running-process ;
: upload ( -- )
upload-to-factorcode get
[ upload-temp-file rename-temp-file ]
when ;

2
extra/mason/report/report-tests.factor Normal file
View File

@ -0,0 +1,2 @@
IN: mason.report.tests
USING: mason.report tools.test ;

66
extra/mason/report/report.factor Normal file
View File

@ -0,0 +1,66 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces debugger fry io io.files io.sockets
io.encodings.utf8 prettyprint benchmark mason.common
mason.platform mason.config ;
IN: mason.report
: time. ( file -- )
[ write ": " write ] [ eval-file milli-seconds>time print ] bi ;
: common-report ( -- )
"Build machine: " write host-name print
"CPU: " write target-cpu get print
"OS: " write target-os get print
"Build directory: " write build-dir print
"git id: " write "git-id" eval-file print nl ;
: with-report ( quot -- )
[ "report" utf8 ] dip '[ common-report @ ] with-file-writer ;
: compile-failed-report ( error -- )
[
"VM compile failed:" print nl
"compile-log" cat nl
error.
] with-report ;
: boot-failed-report ( error -- )
[
"Bootstrap failed:" print nl
"boot-log" 100 cat-n nl
error.
] with-report ;
: test-failed-report ( error -- )
[
"Tests failed:" print nl
"test-log" 100 cat-n nl
error.
] with-report ;
: successful-report ( -- )
[
boot-time-file time.
load-time-file time.
test-time-file time.
help-lint-time-file time.
benchmark-time-file time.
nl
"Did not pass load-everything:" print
load-everything-vocabs-file cat
load-everything-errors-file cat
"Did not pass test-all:" print
test-all-vocabs-file cat
test-all-errors-file cat
"Did not pass help-lint:" print
help-lint-vocabs-file cat
help-lint-errors-file cat
"Benchmarks:" print
benchmarks-file eval-file benchmarks.
] with-report ;

1
extra/mason/summary.txt Normal file
View File

@ -0,0 +1 @@
Continuous build system for Factor

38
extra/mason/test/test.factor Normal file
View File

@ -0,0 +1,38 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces assocs io.files io.encodings.utf8
prettyprint help.lint benchmark tools.time bootstrap.stage2
tools.test tools.vocabs mason.common ;
IN: mason.test
: do-load ( -- )
try-everything
[ keys load-everything-vocabs-file to-file ]
[ load-everything-errors-file utf8 [ load-failures. ] with-file-writer ]
bi ;
: do-tests ( -- )
run-all-tests
[ keys test-all-vocabs-file to-file ]
[ test-all-errors-file utf8 [ test-failures. ] with-file-writer ]
bi ;
: do-help-lint ( -- )
"" run-help-lint
[ keys help-lint-vocabs-file to-file ]
[ help-lint-errors-file utf8 [ typos. ] with-file-writer ]
bi ;
: do-benchmarks ( -- )
run-benchmarks benchmarks-file to-file ;
: do-all ( -- )
".." [
bootstrap-time get boot-time-file to-file
[ do-load ] benchmark load-time-file to-file
[ do-tests ] benchmark test-time-file to-file
[ do-help-lint ] benchmark help-lint-time-file to-file
[ do-benchmarks ] benchmark benchmark-time-file to-file
] with-directory ;
MAIN: do-all

28
extra/mason/updates/updates.factor Normal file
View File

@ -0,0 +1,28 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel io.launcher bootstrap.image.download
mason.common mason.platform ;
IN: mason.updates
: git-pull-cmd ( -- cmd )
{
"git"
"pull"
"--no-summary"
"git://factorcode.org/git/factor.git"
"master"
} ;
: updates-available? ( -- ? )
git-id
git-pull-cmd short-running-process
git-id
= not ;
: new-image-available? ( -- ? )
boot-image-name need-new-image? [ download-my-image t ] [ f ] if ;
: new-code-available? ( -- ? )
updates-available?
new-image-available?
or ;