0.9.2.12:

[sbcl.git] / src / code / unix.lisp

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 7da7e55..c5e6ee1 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -91,6 +91,19 @@
 
 (defmacro int-syscall ((name &rest arg-types) &rest args)
   `(syscall (,name ,@arg-types) (values result 0) ,@args))
+
+(defmacro with-restarted-syscall ((&optional (value (gensym))
+                                             (errno (gensym)))
+                                  syscall-form &rest body)
+  #!+sb-doc
+  "Evaluate BODY with VALUE and ERRNO bound to the return values of
+SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
+  `(let (,value ,errno)
+     (loop (multiple-value-setq (,value ,errno)
+             ,syscall-form)
+        (unless (eql ,errno sb!unix:eintr)
+          (return (values ,value ,errno))))
+     ,@body))
 \f
 ;;;; hacking the Unix environment
 
@@ -831,10 +844,16 @@ previous timer after the body has finished executing"
 (defun unix-resolve-links (pathname)
   (declare (type simple-base-string pathname))
   (aver (not (relative-unix-pathname? pathname)))
+  ;; KLUDGE: readlink and lstat are unreliable if given symlinks
+  ;; ending in slashes -- fix the issue here instead of waiting for
+  ;; libc to change...
+  (let ((len (length pathname)))
+    (when (and (plusp len) (eql #\/ (schar pathname (1- len))))
+      (setf pathname (subseq pathname 0 (1- len)))))
   (/noshow "entering UNIX-RESOLVE-LINKS")
   (loop with previous-pathnames = nil do
-       (/noshow pathname previous-pathnames)
-       (let ((link (unix-readlink pathname)))
+       (/noshow pathname previous-pathnames)
+       (let ((link (unix-readlink pathname)))
          (/noshow link)
          ;; Unlike the old CMU CL code, we handle a broken symlink by
          ;; returning the link itself. That way, CL:TRUENAME on a