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

io.files.unique: some cleanup.

locals-and-roots
John Benediktsson 2016-03-18 16:54:02 -07:00
parent 6f9ff8813e
commit e36727db23
2 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/io/files/unique/unique-tests.factor
View File

@ -1,6 +1,7 @@
USING: accessors continuations io.directories io.encodings.ascii USING: accessors io.directories io.directories.hierarchy
io.files io.files.info io.files.unique io.pathnames kernel io.encodings.ascii io.files io.files.info io.files.temp
namespaces sequences strings tools.test ; io.files.unique io.pathnames kernel namespaces sequences strings
tools.test ;
IN: io.files.unique.tests IN: io.files.unique.tests
{ 123 } [ { 123 } [
@ -12,13 +13,6 @@ IN: io.files.unique.tests
] with-temp-directory ] with-temp-directory
] unit-test ] unit-test
{ t } [
[
[ current-directory get file-info directory? ]
cleanup-unique-directory
] with-temp-directory
] unit-test
{ t } [ { t } [
[ [
current-directory get current-directory get
@ -39,7 +33,8 @@ IN: io.files.unique.tests
{ t } [ { t } [
[ [
[ ] with-unique-directory >boolean [ ] with-unique-directory
[ exists? ] [ delete-tree ] bi
] with-temp-directory ] with-temp-directory
] unit-test ] unit-test

10
basis/io/files/unique/unique.factor
View File

@ -32,10 +32,9 @@ PRIVATE>
: unique-file ( prefix suffix -- path ) : unique-file ( prefix suffix -- path )
'[ '[
current-directory get _ _ random-file-name glue
_ _ random-file-name glue append-path
dup touch-unique-file dup touch-unique-file
] unique-retries get retry ; ] unique-retries get retry absolute-path ;
:: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- ) :: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- )
prefix suffix unique-file :> path prefix suffix unique-file :> path
@ -43,10 +42,9 @@ PRIVATE>
: unique-directory ( -- path ) : unique-directory ( -- path )
[ [
current-directory get random-file-name
random-file-name append-path
dup make-directory dup make-directory
] unique-retries get retry ; ] unique-retries get retry absolute-path ;
:: with-unique-directory ( quot -- path ) :: with-unique-directory ( quot -- path )
unique-directory :> path unique-directory :> path