unix: fixed read-symbolic-link (#1074) + tests
parent
9a531076f0
commit
0bb3228063
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue