add unit tests and fix lots of words for normalize-pathname
parent
2c5f9ce6ca
commit
d8fc446622
|
@ -7,6 +7,56 @@ io.encodings.utf8 ;
|
|||
[ ] [ "blahblah" temp-file make-directory ] unit-test
|
||||
[ t ] [ "blahblah" temp-file directory? ] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ temp-directory "loldir" append-path delete-directory ] ignore-errors
|
||||
temp-directory [
|
||||
"loldir" make-directory
|
||||
] with-directory
|
||||
temp-directory "loldir" append-path exists?
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
[ temp-directory "loldir" append-path delete-directory ] ignore-errors
|
||||
temp-directory [
|
||||
"loldir" make-directory
|
||||
"loldir" delete-directory
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "file1 contents" ] [
|
||||
[ temp-directory "loldir" append-path delete-directory ] ignore-errors
|
||||
temp-directory [
|
||||
"file1 contents" "file1" utf8 set-file-contents
|
||||
"file1" "file2" copy-file
|
||||
"file2" utf8 file-contents
|
||||
] with-directory
|
||||
"file1" temp-file delete-file
|
||||
"file2" temp-file delete-file
|
||||
] unit-test
|
||||
|
||||
[ "file3 contents" ] [
|
||||
temp-directory [
|
||||
"file3 contents" "file3" utf8 set-file-contents
|
||||
"file3" "file4" move-file
|
||||
"file4" utf8 file-contents
|
||||
] with-directory
|
||||
"file4" temp-file delete-file
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
temp-directory [
|
||||
"file5" touch-file
|
||||
"file5" delete-file
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
temp-directory [
|
||||
"file6" touch-file
|
||||
"file6" link-info drop
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "passwd" ] [ "/etc/passwd" file-name ] unit-test
|
||||
[ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test
|
||||
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
|
||||
|
|
|
@ -7,11 +7,11 @@ calendar io.encodings.binary ;
|
|||
|
||||
IN: io.unix.files
|
||||
|
||||
M: unix-io cwd
|
||||
M: unix-io cwd ( -- path )
|
||||
MAXPATHLEN [ <byte-array> ] [ ] bi getcwd
|
||||
[ (io-error) ] unless* ;
|
||||
|
||||
M: unix-io cd
|
||||
M: unix-io cd ( path -- )
|
||||
chdir io-error ;
|
||||
|
||||
: read-flags O_RDONLY ; inline
|
||||
|
@ -39,25 +39,26 @@ M: unix-io (file-writer) ( path -- stream )
|
|||
M: unix-io (file-appender) ( path -- stream )
|
||||
open-append <writer> ;
|
||||
|
||||
: touch-mode
|
||||
: touch-mode ( -- n )
|
||||
{ O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
|
||||
|
||||
M: unix-io touch-file ( path -- )
|
||||
normalize-pathname
|
||||
touch-mode file-mode open
|
||||
dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
|
||||
close ;
|
||||
|
||||
M: unix-io move-file ( from to -- )
|
||||
rename io-error ;
|
||||
[ normalize-pathname ] 2apply rename io-error ;
|
||||
|
||||
M: unix-io delete-file ( path -- )
|
||||
unlink io-error ;
|
||||
normalize-pathname unlink io-error ;
|
||||
|
||||
M: unix-io make-directory ( path -- )
|
||||
OCT: 777 mkdir io-error ;
|
||||
normalize-pathname OCT: 777 mkdir io-error ;
|
||||
|
||||
M: unix-io delete-directory ( path -- )
|
||||
rmdir io-error ;
|
||||
normalize-pathname rmdir io-error ;
|
||||
|
||||
: (copy-file) ( from to -- )
|
||||
dup parent-directory make-directories
|
||||
|
@ -68,8 +69,9 @@ M: unix-io delete-directory ( path -- )
|
|||
] with-disposal ;
|
||||
|
||||
M: unix-io copy-file ( from to -- )
|
||||
[ normalize-pathname ] 2apply
|
||||
[ (copy-file) ]
|
||||
[ swap file-info file-info-permissions chmod io-error ]
|
||||
[ swap file-info file-info-permissions chmod io-error ]
|
||||
2bi ;
|
||||
|
||||
: stat>type ( stat -- type )
|
||||
|
|
Loading…
Reference in New Issue