From 2f7247334e943ec49374e0670820e2d198b25f94 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 28 Feb 2008 16:37:04 -0600 Subject: [PATCH 1/9] fix with-directory and write unit test --- core/io/files/files-tests.factor | 2 ++ core/io/files/files.factor | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 92e148a854..f804d7c5ac 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -121,3 +121,5 @@ USING: tools.test io.files io threads kernel continuations ; [ ] [ "copy-destination" temp-file delete-tree ] unit-test [ ] [ "copy-tree-test" temp-file delete-tree ] unit-test + +[ t ] [ cwd "core" resource-path [ ] with-directory cwd = ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 85f0621443..55eee65bbf 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -70,7 +70,7 @@ HOOK: cd io-backend ( path -- ) HOOK: cwd io-backend ( -- path ) : with-directory ( path quot -- ) - swap cd cwd [ cd ] curry [ ] cleanup ; inline + cwd [ cd ] curry rot cd [ ] cleanup ; inline ! Creating directories HOOK: make-directory io-backend ( path -- ) @@ -209,4 +209,4 @@ HOOK: io-backend ( path -- stream ) { [ winnt? ] [ "USERPROFILE" os-env ] } { [ wince? ] [ "" resource-path ] } { [ unix? ] [ "HOME" os-env ] } - } cond ; \ No newline at end of file + } cond ; From 2753b2442af438446b971115f94220a99184c0ea Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 28 Feb 2008 16:37:27 -0600 Subject: [PATCH 2/9] fix io.files.temporary for windows --- extra/io/files/temporary/backend/backend.factor | 2 +- extra/io/files/temporary/temporary.factor | 10 +++------- extra/io/windows/files/temporary/temporary.factor | 6 ++++-- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/extra/io/files/temporary/backend/backend.factor b/extra/io/files/temporary/backend/backend.factor index 0fe4068621..5c6900b3d2 100644 --- a/extra/io/files/temporary/backend/backend.factor +++ b/extra/io/files/temporary/backend/backend.factor @@ -1,5 +1,5 @@ USING: io.backend ; IN: io.files.temporary.backend -HOOK: (temporary-file) io-backend ( path prefix suffix -- stream path ) +HOOK: (temporary-file) io-backend ( path -- stream path ) HOOK: temporary-path io-backend ( -- path ) diff --git a/extra/io/files/temporary/temporary.factor b/extra/io/files/temporary/temporary.factor index d46ddff8c6..5c5e72e83f 100644 --- a/extra/io/files/temporary/temporary.factor +++ b/extra/io/files/temporary/temporary.factor @@ -2,18 +2,14 @@ USING: kernel math math.bitfields combinators.lib math.parser random sequences sequences.lib continuations namespaces io.files io.backend io.nonblocking io arrays io.files.temporary.backend system combinators vocabs.loader ; -USE: tools.walker IN: io.files.temporary -: random-letter ( -- ch ) - 26 random { CHAR: a CHAR: A } random + ; +: random-letter ( -- ch ) 26 random { CHAR: a CHAR: A } random + ; : random-ch ( -- ch ) - { t f } random - [ 10 random CHAR: 0 + ] [ random-letter ] if ; + { t f } random [ 10 random CHAR: 0 + ] [ random-letter ] if ; -: random-name ( n -- string ) - [ drop random-ch ] "" map-as ; +: random-name ( n -- string ) [ drop random-ch ] "" map-as ; : ( prefix suffix -- path duplex-stream ) temporary-path -rot diff --git a/extra/io/windows/files/temporary/temporary.factor b/extra/io/windows/files/temporary/temporary.factor index d96ff49e15..426cab367b 100644 --- a/extra/io/windows/files/temporary/temporary.factor +++ b/extra/io/windows/files/temporary/temporary.factor @@ -1,8 +1,10 @@ -USING: kernel system ; +USING: io.files.temporary.backend io.nonblocking io.windows +kernel system windows.kernel32 ; + IN: io.windows.files.temporary M: windows-io (temporary-file) ( path -- stream ) - GENERIC_WRITE CREATE_NEW 0 open-file 0 ; + GENERIC_WRITE CREATE_NEW 0 open-file 0 ; M: windows-io temporary-path ( -- path ) "TEMP" os-env ; From a318a80b991e2a44ecff2f1d4a942114d2eb83da Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 29 Feb 2008 18:04:44 -0600 Subject: [PATCH 3/9] fix using --- extra/io/windows/files/unique/unique.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor index ae06090488..dd0341162b 100644 --- a/extra/io/windows/files/unique/unique.factor +++ b/extra/io/windows/files/unique/unique.factor @@ -1,4 +1,5 @@ -USING: kernel system io.files.unique.backend ; +USING: kernel system io.files.unique.backend +windows.kernel32 io.windows io.nonblocking ; IN: io.windows.files.unique M: windows-io (make-unique-file) ( path -- stream ) From 316a8ad1ae6e07bcf4f766b72a3591135e308d9c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 29 Feb 2008 18:20:45 -0600 Subject: [PATCH 4/9] fix io.files.unique --- extra/io/windows/files/unique/unique.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/windows/files/unique/unique.factor b/extra/io/windows/files/unique/unique.factor index dd0341162b..0823c3f0f3 100644 --- a/extra/io/windows/files/unique/unique.factor +++ b/extra/io/windows/files/unique/unique.factor @@ -3,7 +3,7 @@ windows.kernel32 io.windows io.nonblocking ; IN: io.windows.files.unique M: windows-io (make-unique-file) ( path -- stream ) - GENERIC_WRITE CREATE_NEW 0 open-file 0 ; + GENERIC_WRITE CREATE_NEW 0 open-file 0 ; M: windows-io temporary-path ( -- path ) "TEMP" os-env ; From c5f5e0a61a9a33d5bbd8a0191d7c8c4405073dfb Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 1 Mar 2008 02:58:29 -0600 Subject: [PATCH 5/9] io.files: rename the *-to words to *-into --- core/io/files/files-docs.factor | 28 ++++++++++++++-------------- core/io/files/files.factor | 22 +++++++++++----------- 2 files changed, 25 insertions(+), 25 deletions(-) diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index b8cf747106..9dc178ee57 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -57,8 +57,8 @@ ARTICLE: "delete-move-copy" "Deleting, moving, copying files" "The operations for moving and copying files come in three flavors:" { $list { "A word named " { $snippet { $emphasis "operation" } } " which takes a source and destination path." } - { "A word named " { $snippet { $emphasis "operation" } "-to" } " which takes a source path and destination directory. The destination file will be stored in the destination directory and will have the same file name as the source path." } - { "A word named " { $snippet { $emphasis "operation" } "s-to" } " which takes a sequence of source paths and destination directory." } + { "A word named " { $snippet { $emphasis "operation" } "-into" } " which takes a source path and destination directory. The destination file will be stored in the destination directory and will have the same file name as the source path." } + { "A word named " { $snippet { $emphasis "operation" } "s-into" } " which takes a sequence of source paths and destination directory." } } "Since both of the above lists apply to copying files, that this means that there are a total of six variations on copying a file." $nl @@ -68,16 +68,16 @@ $nl { $subsection delete-tree } "Moving files:" { $subsection move-file } -{ $subsection move-file-to } -{ $subsection move-files-to } +{ $subsection move-file-into } +{ $subsection move-files-into } "Copying files:" { $subsection copy-file } -{ $subsection copy-file-to } -{ $subsection copy-files-to } +{ $subsection copy-file-into } +{ $subsection copy-files-into } "Copying directory trees recursively:" { $subsection copy-tree } -{ $subsection copy-tree-to } -{ $subsection copy-trees-to } +{ $subsection copy-tree-into } +{ $subsection copy-trees-into } "On most operating systems, files can only be moved within the same file system. To move files between file systems, use " { $link copy-file } " followed by " { $link delete-file } " on the old name." ; ARTICLE: "io.files" "Basic file operations" @@ -267,12 +267,12 @@ HELP: move-file { $description "Moves or renames a file." } { $errors "Throws an error if the file does not exist or if the move operation fails." } ; -HELP: move-file-to +HELP: move-file-into { $values { "from" "a pathname string" } { "to" "a directory pathname string" } } { $description "Moves a file to another directory without renaming it." } { $errors "Throws an error if the file does not exist or if the move operation fails." } ; -HELP: move-files-to +HELP: move-files-into { $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } } { $description "Moves a set of files to another directory." } { $errors "Throws an error if the file does not exist or if the move operation fails." } ; @@ -283,12 +283,12 @@ HELP: copy-file { $notes "This operation attempts to preserve the original file's attributes, however not all attributes may be preserved." } { $errors "Throws an error if the file does not exist or if the copy operation fails." } ; -HELP: copy-file-to +HELP: copy-file-into { $values { "from" "a pathname string" } { "to" "a directory pathname string" } } { $description "Copies a file to another directory." } { $errors "Throws an error if the file does not exist or if the copy operation fails." } ; -HELP: copy-files-to +HELP: copy-files-into { $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } } { $description "Copies a set of files to another directory." } { $errors "Throws an error if the file does not exist or if the copy operation fails." } ; @@ -299,12 +299,12 @@ HELP: copy-tree { $notes "This operation attempts to preserve original file attributes, however not all attributes may be preserved." } { $errors "Throws an error if the copy operation fails." } ; -HELP: copy-tree-to +HELP: copy-tree-into { $values { "from" "a pathname string" } { "to" "a directory pathname string" } } { $description "Copies a directory tree to another directory, recursively." } { $errors "Throws an error if the copy operation fails." } ; -HELP: copy-trees-to +HELP: copy-trees-into { $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } } { $description "Copies a set of directory trees to another directory, recursively." } { $errors "Throws an error if the copy operation fails." } ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 28f23b0de5..b51d767069 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -137,37 +137,37 @@ HOOK: delete-directory io-backend ( path -- ) ! Moving and renaming files HOOK: move-file io-backend ( from to -- ) -: move-file-to ( from to -- ) +: move-file-into ( from to -- ) to-directory move-file ; -: move-files-to ( files to -- ) - [ move-file-to ] curry each ; +: move-files-into ( files to -- ) + [ move-file-into ] curry each ; ! Copying files HOOK: copy-file io-backend ( from to -- ) -: copy-file-to ( from to -- ) +: copy-file-into ( from to -- ) to-directory copy-file ; -: copy-files-to ( files to -- ) - [ copy-file-to ] curry each ; +: copy-files-into ( files to -- ) + [ copy-file-into ] curry each ; -DEFER: copy-tree-to +DEFER: copy-tree-into : copy-tree ( from to -- ) over directory? [ >r dup directory swap r> [ - >r swap first path+ r> copy-tree-to + >r swap first path+ r> copy-tree-into ] 2curry each ] [ copy-file ] if ; -: copy-tree-to ( from to -- ) +: copy-tree-into ( from to -- ) to-directory copy-tree ; -: copy-trees-to ( files to -- ) - [ copy-tree-to ] curry each ; +: copy-trees-into ( files to -- ) + [ copy-tree-into ] curry each ; ! Special paths : resource-path ( path -- newpath ) From b1a9ba88068f68434d0a210f8872618c05fbe341 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 1 Mar 2008 03:01:51 -0600 Subject: [PATCH 6/9] builder.release: refactor and cleanup --- extra/builder/release/release.factor | 95 +++++++++++----------------- 1 file changed, 37 insertions(+), 58 deletions(-) diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor index c65241d922..849d1a54a3 100644 --- a/extra/builder/release/release.factor +++ b/extra/builder/release/release.factor @@ -1,12 +1,17 @@ -USING: kernel namespaces sequences combinators io.files io.launcher +USING: kernel system namespaces sequences splitting combinators + io.files io.launcher bake combinators.cleave builder.common builder.util ; IN: builder.release ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: releases ( -- path ) builds "/releases" append dup make-directory ; +: releases ( -- path ) + builds "releases" path+ + dup exists? not + [ dup make-directory ] + when ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -34,8 +39,6 @@ IN: builder.release ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -USING: system sequences splitting ; - : cpu- ( -- cpu ) cpu "." split "-" join ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -57,70 +60,46 @@ USING: system sequences splitting ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: move-file ( source destination -- ) - swap { "mv" , , } bake run-process drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: linux-release ( -- ) - - "factor" cd - - { "rm" "-rf" "Factor.app" } run-process drop - - { "rm" "-rf" common-files } to-strings run-process drop - - ".." cd - - { "tar" "-cvzf" archive-name "factor" } to-strings run-process drop - - archive-name releases move-file ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: windows-release ( -- ) - - "factor" cd - - { "rm" "-rf" "Factor.app" } run-process drop - - { "rm" "-rf" common-files } to-strings run-process drop - - ".." cd - - { "zip" "-r" archive-name "factor" } to-strings run-process drop - - archive-name releases move-file ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: macosx-release ( -- ) - - "factor" cd - - { "rm" "-rf" common-files } to-strings run-process drop - - ".." cd +: windows-archive-cmd ( -- cmd ) { "zip" "-r" archive-name "factor" } ; +: macosx-archive-cmd ( -- cmd ) { "hdiutil" "create" "-srcfolder" "factor" "-fs" "HFS+" "-volname" "factor" - archive-name } - to-strings run-process drop + archive-name } ; - archive-name releases move-file ; +: unix-archive-cmd ( -- cmd ) { "tar" "-cvzf" archive-name "factor" } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: archive-cmd ( -- cmd ) + { + { [ windows? ] [ windows-archive-cmd ] } + { [ macosx? ] [ macosx-archive-cmd ] } + { [ unix? ] [ unix-archive-cmd ] } + } + cond ; + +: make-archive ( -- ) archive-cmd to-strings try-process ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: remove-common-files ( -- ) + { "rm" "-rf" common-files } to-strings try-process ; + +: remove-factor-app ( -- ) + macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ; + : release ( -- ) - os - { - { "linux" [ linux-release ] } - { "winnt" [ windows-release ] } - { "macosx" [ macosx-release ] } - } - case ; + "factor" + [ + remove-factor-app + remove-common-files + ] + with-directory + make-archive + archive-name releases move-file-into ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From c3fd171547dfc70edde49072d811f7a61ba53037 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 1 Mar 2008 04:14:37 -0600 Subject: [PATCH 7/9] bootstrap.image.upload: destination is configurable fix cwd dependency --- extra/bootstrap/image/upload/upload.factor | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor index 1fa8ee4f41..110547d963 100755 --- a/extra/bootstrap/image/upload/upload.factor +++ b/extra/bootstrap/image/upload/upload.factor @@ -4,7 +4,12 @@ IN: bootstrap.image.upload USING: http.client crypto.md5 splitting assocs kernel io.files bootstrap.image sequences io namespaces io.launcher math ; -: destination "slava@factorcode.org:www/images/latest/" ; +SYMBOL: upload-images-destination + +: destination ( -- dest ) + upload-images-destination get + "slava@/var/www/factorcode.org/w/images/latest/" + or ; : checksums "checksums.txt" temp-file ; @@ -23,6 +28,8 @@ bootstrap.image sequences io namespaces io.launcher math ; ] { } make try-process ; : new-images ( -- ) - make-images compute-checksums upload-images ; + "" resource-path + [ make-images compute-checksums upload-images ] + with-directory ; MAIN: new-images From 29ef99663939d7b661ce04f48d2fcc22a9f67019 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 1 Mar 2008 07:11:44 -0600 Subject: [PATCH 8/9] Move time related items from unix to unix.time --- extra/calendar/unix/unix.factor | 4 +++- extra/io/unix/files/files.factor | 4 ++-- extra/unix/time/time.factor | 32 ++++++++++++++++++++++++++++++++ extra/unix/unix.factor | 26 -------------------------- 4 files changed, 37 insertions(+), 29 deletions(-) create mode 100644 extra/unix/time/time.factor diff --git a/extra/calendar/unix/unix.factor b/extra/calendar/unix/unix.factor index 4e1833af06..30e22c487b 100644 --- a/extra/calendar/unix/unix.factor +++ b/extra/calendar/unix/unix.factor @@ -1,5 +1,7 @@ + USING: alien alien.c-types arrays calendar.backend -kernel structs math unix namespaces ; + kernel structs math unix.time namespaces ; + IN: calendar.unix TUPLE: unix-calendar ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index a5a4e64c03..db3cf674c7 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.nonblocking io.unix.backend io.files io - unix unix.stat kernel math continuations math.bitfields byte-arrays - alien combinators combinators.cleave calendar ; + unix unix.stat unix.time kernel math continuations math.bitfields + byte-arrays alien combinators combinators.cleave calendar ; IN: io.unix.files diff --git a/extra/unix/time/time.factor b/extra/unix/time/time.factor new file mode 100644 index 0000000000..460631d9ea --- /dev/null +++ b/extra/unix/time/time.factor @@ -0,0 +1,32 @@ + +USING: kernel alien.syntax alien.c-types math ; + +IN: unix.time + +TYPEDEF: uint time_t + +C-STRUCT: tm + { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?) + { "int" "min" } ! Minutes: 0-59 + { "int" "hour" } ! Hours since midnight: 0-23 + { "int" "mday" } ! Day of the month: 1-31 + { "int" "mon" } ! Months *since* january: 0-11 + { "int" "year" } ! Years since 1900 + { "int" "wday" } ! Days since Sunday (0-6) + { "int" "yday" } ! Days since Jan. 1: 0-365 + { "int" "isdst" } ! +1 Daylight Savings Time, 0 No DST, + { "long" "gmtoff" } ! Seconds: 0-59 (K&R says 0-61?) + { "char*" "zone" } ; + +C-STRUCT: timespec + { "time_t" "sec" } + { "long" "nsec" } ; + +: make-timespec ( ms -- timespec ) + 1000 /mod 1000000 * + "timespec" + [ set-timespec-nsec ] keep + [ set-timespec-sec ] keep ; + +FUNCTION: time_t time ( time_t* t ) ; +FUNCTION: tm* localtime ( time_t* clock ) ; \ No newline at end of file diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index f83120a96f..9cc8552f98 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -8,32 +8,8 @@ IN: unix TYPEDEF: uint in_addr_t TYPEDEF: uint socklen_t -TYPEDEF: uint time_t TYPEDEF: ulong size_t -C-STRUCT: tm - { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?) - { "int" "min" } ! Minutes: 0-59 - { "int" "hour" } ! Hours since midnight: 0-23 - { "int" "mday" } ! Day of the month: 1-31 - { "int" "mon" } ! Months *since* january: 0-11 - { "int" "year" } ! Years since 1900 - { "int" "wday" } ! Days since Sunday (0-6) - { "int" "yday" } ! Days since Jan. 1: 0-365 - { "int" "isdst" } ! +1 Daylight Savings Time, 0 No DST, - { "long" "gmtoff" } ! Seconds: 0-59 (K&R says 0-61?) - { "char*" "zone" } ; - -C-STRUCT: timespec - { "time_t" "sec" } - { "long" "nsec" } ; - -: make-timespec ( ms -- timespec ) - 1000 /mod 1000000 * - "timespec" - [ set-timespec-nsec ] keep - [ set-timespec-sec ] keep ; - : PROT_NONE 0 ; inline : PROT_READ 1 ; inline : PROT_WRITE 2 ; inline @@ -89,7 +65,6 @@ FUNCTION: ushort htons ( ushort n ) ; FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ; FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ; FUNCTION: int listen ( int s, int backlog ) ; -FUNCTION: tm* localtime ( time_t* clock ) ; FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ; FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ; FUNCTION: int munmap ( void* addr, size_t len ) ; @@ -117,7 +92,6 @@ FUNCTION: int setuid ( uid_t uid ) ; FUNCTION: int socket ( int domain, int type, int protocol ) ; FUNCTION: char* strerror ( int errno ) ; FUNCTION: int system ( char* command ) ; -FUNCTION: time_t time ( time_t* t ) ; FUNCTION: int unlink ( char* path ) ; FUNCTION: int utimes ( char* path, timeval[2] times ) ; From e5c567c7395599d00ecb7bf63886823fbc81cf74 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 1 Mar 2008 07:13:22 -0600 Subject: [PATCH 9/9] builder: refactoring --- extra/builder/builder.factor | 94 ++++++++++++++++++------------------ 1 file changed, 46 insertions(+), 48 deletions(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 2b51f8603e..0d5f4292b7 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -39,29 +39,27 @@ IN: builder : record-git-id ( -- ) git-id "../git-id" [ . ] with-file-writer ; -: make-clean ( -- desc ) { "make" "clean" } ; +: do-make-clean ( -- desc ) { "make" "clean" } try-process ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ; +! : target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ; : make-vm ( -- desc ) - { "make" target } to-strings >>arguments - "../compile-log" >>stdout - +stdout+ >>stderr + { "make" } >>arguments + "../compile-log" >>stdout + +stdout+ >>stderr >desc ; +: do-make-vm ( -- ) + make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : copy-image ( -- ) - "../../factor/" my-boot-image-name append - "../" my-boot-image-name append - copy-file - - "../../factor/" my-boot-image-name append - my-boot-image-name - copy-file ; + builds "factor" path+ my-boot-image-name path+ ".." copy-file-into + builds "factor" path+ my-boot-image-name path+ "." copy-file-into ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -77,6 +75,9 @@ IN: builder 20 minutes >>timeout >desc ; +: do-bootstrap ( -- ) + bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail ; + : builder-test-cmd ( -- cmd ) { "./factor" "-run=builder.test" } to-strings ; @@ -89,6 +90,9 @@ IN: builder 45 minutes >>timeout >desc ; +: do-builder-test ( -- ) + builder-test [ "Test error" print "../test-log" 100 cat-n ] run-or-bail ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SYMBOL: build-status @@ -101,52 +105,46 @@ SYMBOL: build-status enter-build-dir - "report" [ + "report" + [ + "Build machine: " write host-name print + "CPU: " write cpu print + "OS: " write os print + "Build directory: " write cwd print nl - "Build machine: " write host-name print - "CPU: " write cpu print - "OS: " write os print - "Build directory: " write cwd print nl + git-clone [ "git clone failed" print ] run-or-bail - 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 - "factor" cd + "test-log" delete-file - record-git-id + "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 - make-clean run-process drop + "Did not pass load-everything: " print "load-everything-vocabs" cat + "Did not pass test-all: " print "test-all-vocabs" cat - make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail + "Benchmarks: " print "benchmarks" eval-file benchmarks. - copy-image + nl - bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail + show-benchmark-deltas - builder-test [ "Test error" print "../test-log" 100 cat-n ] run-or-bail + "benchmarks" ".." copy-file-into - "../test-log" delete-file - - "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 - - "Benchmarks: " print - "../benchmarks" [ stdio get contents eval ] with-file-reader benchmarks. - - nl - - show-benchmark-deltas - - "../benchmarks" "../../benchmarks" copy-file - - ".." cd - - maybe-release - - ] with-file-writer + maybe-release + ] + with-file-writer build-status on ;