1 ! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel namespaces sequences splitting system accessors
4 math.functions make io io.files io.pathnames io.directories
5 io.directories.hierarchy io.launcher io.encodings.utf8 prettyprint
6 combinators.short-circuit parser combinators calendar
7 calendar.format arrays mason.config locals debugger fry
8 continuations strings io.sockets ;
11 : short-host-name ( -- string )
12 host-name "." split1 drop ;
14 SYMBOL: current-git-id
16 : short-running-process ( command -- )
17 #! Give network operations and shell commands at most
18 #! 15 minutes to complete, to catch hangs.
19 >process 15 minutes >>timeout try-output-process ;
21 HOOK: really-delete-tree os ( path -- )
23 M: windows really-delete-tree
24 #! Workaround: Cygwin GIT creates read-only files for
26 [ { "chmod" "ug+rw" "-R" } swap absolute-path suffix short-running-process ]
30 M: unix really-delete-tree delete-tree ;
33 '[ drop @ f ] attempt-all drop ; inline
35 :: upload-safely ( local username host remote -- )
36 [let* | temp [ remote ".incomplete" append ]
37 scp-remote [ { username "@" host ":" temp } concat ]
38 scp [ scp-command get ]
39 ssh [ ssh-command get ] |
40 5 [ { scp local scp-remote } short-running-process ] retry
41 5 [ { ssh host "-l" username "mv" temp remote } short-running-process ] retry
44 : eval-file ( file -- obj )
45 dup utf8 file-lines parse-fresh
46 [ "Empty file: " swap append throw ] [ nip first ] if-empty ;
48 : to-file ( object file -- ) utf8 [ . ] with-file-writer ;
50 : datestamp ( timestamp -- string )
59 ] { } make [ pad-00 ] map "-" join ;
61 : milli-seconds>time ( n -- string )
63 [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array
64 [ pad-00 ] map ":" join ;
68 : builds/factor ( -- path ) builds-dir get "factor" append-path ;
69 : build-dir ( -- path ) builds-dir get stamp get append-path ;
71 : prepare-build-machine ( -- )
72 builds-dir get make-directories
74 [ { "git" "clone" "git://factorcode.org/git/factor.git" } try-output-process ]
78 { "git" "show" } utf8 [ lines ] with-process-reader
79 first " " split second ;
81 : ?prepare-build-machine ( -- )
82 builds/factor exists? [ prepare-build-machine ] unless ;
84 CONSTANT: load-all-vocabs-file "load-everything-vocabs"
85 CONSTANT: load-all-errors-file "load-everything-errors"
87 CONSTANT: test-all-vocabs-file "test-all-vocabs"
88 CONSTANT: test-all-errors-file "test-all-errors"
90 CONSTANT: help-lint-vocabs-file "help-lint-vocabs"
91 CONSTANT: help-lint-errors-file "help-lint-errors"
93 CONSTANT: compiler-errors-file "compiler-errors"
94 CONSTANT: compiler-error-messages-file "compiler-error-messages"
96 CONSTANT: boot-time-file "boot-time"
97 CONSTANT: load-time-file "load-time"
98 CONSTANT: test-time-file "test-time"
99 CONSTANT: help-lint-time-file "help-lint-time"
100 CONSTANT: benchmark-time-file "benchmark-time"
101 CONSTANT: html-help-time-file "html-help-time"
103 CONSTANT: benchmarks-file "benchmarks"
104 CONSTANT: benchmark-error-messages-file "benchmark-error-messages"
105 CONSTANT: benchmark-error-vocabs-file "benchmark-error-vocabs"
107 SYMBOL: status-error ! didn't bootstrap, or crashed
108 SYMBOL: status-dirty ! bootstrapped but not all tests passed
109 SYMBOL: status-clean ! everything good