unix: fixed read-symbolic-link (#1074) + tests

locals-and-roots
Björn Lindqvist 2016-03-23 15:25:32 +01:00
parent 9a531076f0
commit 0bb3228063
2 changed files with 17 additions and 13 deletions

View File

@ -1,7 +1,7 @@
USING: accessors arrays calendar continuations grouping io.directories USING: accessors arrays calendar continuations grouping io.directories
io.files.info io.files.info.unix io.files.temp io.files.unix io.files.info io.files.info.unix io.files.temp io.files.unix
io.pathnames kernel literals math math.bitwise math.functions io.pathnames kernel literals math math.bitwise math.functions
sequences strings tools.test unix.groups unix.users ; sequences strings system tools.test unix unix.groups unix.users ;
IN: io.files.unix.tests IN: io.files.unix.tests
{ "/usr/libexec/" } [ "/usr/libexec/awk/" parent-directory ] unit-test { "/usr/libexec/" } [ "/usr/libexec/awk/" parent-directory ] unit-test
@ -164,6 +164,8 @@ prepare-test-file
{ f } [ 0 other-execute? ] unit-test { f } [ 0 other-execute? ] unit-test
! (cwd) ! (cwd)
{ t } [ { t } [ 1 (cwd) string? ] unit-test
1 (cwd) string?
] unit-test os linux? [
{ t } [ "/proc/self/exe" read-symbolic-link string? ] unit-test
] when

View File

@ -1,11 +1,10 @@
! Copyright (C) 2005, 2010 Slava Pestov. ! Copyright (C) 2005, 2010 Slava Pestov.
! Copyright (C) 2008 Eduardo Cavazos. ! Copyright (C) 2008 Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax byte-vectors USING: accessors alien.c-types alien.syntax byte-arrays classes.struct
classes.struct combinators.short-circuit combinators.smart combinators.short-circuit combinators.smart generalizations kernel
generalizations kernel libc locals math sequences libc locals math sequences sequences.generalizations strings system
sequences.generalizations strings system unix.ffi vocabs.loader unix.ffi vocabs.loader ;
;
IN: unix IN: unix
ERROR: unix-system-call-error args errno message word ; ERROR: unix-system-call-error args errno message word ;
@ -79,11 +78,14 @@ M: unix open-file [ open ] unix-system-call ;
swap >>actime swap >>actime
[ utime ] unix-system-call drop ; [ utime ] unix-system-call drop ;
: (read-symbolic-link) ( path bufsiz -- path' )
dup <byte-array> 3dup swap [ readlink ] unix-system-call
pick dupd < [ head >string 2nip ] [
2nip 2 * (read-symbolic-link)
] if ;
: read-symbolic-link ( path -- path ) : read-symbolic-link ( path -- path )
PATH_MAX <byte-vector> [ 4096 (read-symbolic-link) ;
underlying>> PATH_MAX
[ readlink ] unix-system-call
] keep swap >>length >string ;
: unlink-file ( path -- ) [ unlink ] unix-system-call drop ; : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;