From 0bb3228063aa360c8b3e526a1c79c87537bb14c5 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Bj=C3=B6rn=20Lindqvist?= Date: Wed, 23 Mar 2016 15:25:32 +0100 Subject: [PATCH] unix: fixed read-symbolic-link (#1074) + tests --- basis/io/files/unix/unix-tests.factor | 10 ++++++---- basis/unix/unix.factor | 20 +++++++++++--------- 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/basis/io/files/unix/unix-tests.factor b/basis/io/files/unix/unix-tests.factor index 5fb143c5e0..d816561dec 100644 --- a/basis/io/files/unix/unix-tests.factor +++ b/basis/io/files/unix/unix-tests.factor @@ -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 diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 4364fd40d0..7c61cd531f 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -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 3dup swap [ readlink ] unix-system-call + pick dupd < [ head >string 2nip ] [ + 2nip 2 * (read-symbolic-link) + ] if ; + : read-symbolic-link ( path -- path ) - PATH_MAX [ - underlying>> PATH_MAX - [ readlink ] unix-system-call - ] keep swap >>length >string ; + 4096 (read-symbolic-link) ; : unlink-file ( path -- ) [ unlink ] unix-system-call drop ; -- 2.34.1