]> gitweb.factorcode.org Git - factor.git/commitdiff
unix: fixed read-symbolic-link (#1074) + tests
authorBjörn Lindqvist <bjourne@gmail.com>
Wed, 23 Mar 2016 14:25:32 +0000 (15:25 +0100)
committerBjörn Lindqvist <bjourne@gmail.com>
Wed, 23 Mar 2016 15:15:30 +0000 (16:15 +0100)
basis/io/files/unix/unix-tests.factor
basis/unix/unix.factor

index 5fb143c5e0991841a6aa94b80110b03c7cf59240..d816561decf5ccd4b32d47b7753be6bad34cc5da 100644 (file)
@@ -1,7 +1,7 @@
 USING: accessors arrays calendar continuations grouping io.directories
 io.files.info io.files.info.unix io.files.temp io.files.unix
 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
 
 { "/usr/libexec/" } [ "/usr/libexec/awk/" parent-directory ] unit-test
@@ -164,6 +164,8 @@ prepare-test-file
 { f } [ 0 other-execute? ] unit-test
 
 ! (cwd)
-{ t } [
-    1 (cwd) string?
-] unit-test
+{ t } [ 1 (cwd) string? ] unit-test
+
+os linux? [
+    { t } [ "/proc/self/exe" read-symbolic-link string? ] unit-test
+] when
index 4364fd40d0e618cc76bb15c14dd01aa7a311cccb..7c61cd531fe15a2eaab522c3ba1feaeb5a5381b0 100644 (file)
@@ -1,11 +1,10 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! Copyright (C) 2008 Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.syntax byte-vectors
-classes.struct combinators.short-circuit combinators.smart
-generalizations kernel libc locals math sequences
-sequences.generalizations strings system unix.ffi vocabs.loader
-;
+USING: accessors alien.c-types alien.syntax byte-arrays classes.struct
+combinators.short-circuit combinators.smart generalizations kernel
+libc locals math sequences sequences.generalizations strings system
+unix.ffi vocabs.loader ;
 IN: unix
 
 ERROR: unix-system-call-error args errno message word ;
@@ -79,11 +78,14 @@ M: unix open-file [ open ] unix-system-call ;
         swap >>actime
         [ 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 )
-    PATH_MAX <byte-vector> [
-        underlying>> PATH_MAX
-        [ readlink ] unix-system-call
-    ] keep swap >>length >string ;
+    4096 (read-symbolic-link) ;
 
 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;