Remove really-delete-tree in favor of setting the file attributes to normal

on Windows deletes.
db4
Doug Coleman 2011-10-19 02:32:30 -07:00
parent 5608178389
commit feeea08023
5 changed files with 6 additions and 20 deletions

View File

@ -19,6 +19,6 @@ IN: mason.cleanup
build-dir [ build-dir [
compress-image compress-image
compress-test-log compress-test-log
"factor" really-delete-tree "factor" delete-tree
] with-directory ] with-directory
] unless ; ] unless ;

View File

@ -23,20 +23,6 @@ SYMBOL: current-git-id
#! 30 minutes to complete, to catch hangs. #! 30 minutes to complete, to catch hangs.
>process 30 minutes >>timeout try-output-process ; >process 30 minutes >>timeout try-output-process ;
HOOK: (really-delete-tree) os ( path -- )
M: windows (really-delete-tree)
#! Workaround: Cygwin GIT creates read-only files for
#! some reason.
[ { "chmod" "ug+rw" "-R" } swap absolute-path suffix short-running-process ]
[ delete-tree ]
bi ;
M: unix (really-delete-tree) delete-tree ;
: really-delete-tree ( path -- )
dup exists? [ (really-delete-tree) ] [ drop ] if ;
: retry ( n quot -- ) : retry ( n quot -- )
[ iota ] dip [ iota ] dip
'[ drop @ f ] attempt-all drop ; inline '[ drop @ f ] attempt-all drop ; inline

View File

@ -3,7 +3,7 @@
USING: accessors combinators.short-circuit continuations USING: accessors combinators.short-circuit continuations
debugger io io.directories io.encodings.utf8 io.files debugger io io.directories io.encodings.utf8 io.files
io.launcher io.sockets io.streams.string kernel mason.common io.launcher io.sockets io.streams.string kernel mason.common
mason.email sequences splitting ; mason.email sequences splitting io.directories.hierarchy ;
IN: mason.git IN: mason.git
: git-id ( -- id ) : git-id ( -- id )
@ -42,7 +42,7 @@ IN: mason.git
: git-repo-corrupted ( error -- ) : git-repo-corrupted ( error -- )
repo-corrupted-body "corrupted repo" email-fatal repo-corrupted-body "corrupted repo" email-fatal
"factor" really-delete-tree "factor" delete-tree
git-clone ; git-clone ;
: git-pull-failed ( error -- ) : git-pull-failed ( error -- )
@ -84,7 +84,7 @@ IN: mason.git
: git-repo-dirty ( files -- ) : git-repo-dirty ( files -- )
repo-dirty-body "dirty repo" email-fatal repo-dirty-body "dirty repo" email-fatal
"factor" really-delete-tree "factor" delete-tree
git-clone ; git-clone ;
PRIVATE> PRIVATE>

View File

@ -28,7 +28,7 @@ IN: mason.release.archive
"dmg-root" make-directory "dmg-root" make-directory
"factor" "dmg-root" copy-tree-into "factor" "dmg-root" copy-tree-into
"factor" "dmg-root" make-disk-image "factor" "dmg-root" make-disk-image
"dmg-root" really-delete-tree ; "dmg-root" delete-tree ;
:: make-unix-archive ( archive-name -- ) :: make-unix-archive ( archive-name -- )
{ "tar" "-cvzf" archive-name "factor" } short-running-process ; { "tar" "-cvzf" archive-name "factor" } short-running-process ;

View File

@ -15,5 +15,5 @@ IN: mason.release.tidy
"factor" [ "factor" [
useless-files useless-files
[ exists? ] filter [ exists? ] filter
[ really-delete-tree ] each [ delete-tree ] each
] with-directory ; ] with-directory ;