From b5a7a85a588c73297f5c2040bb0e7c94c3971be8 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 2 Jun 2007 13:26:34 +0000
Subject: [PATCH] 1.0.6.16: add SB-POSIX:GETCWD

 * Based on patch by Tassilo Horn.

 * Factor out the growing buffer -logic used by both getcwd() and
   readlink(), and make it not leak memory so easily.
---
 NEWS                              |  1 +
 contrib/sb-posix/interface.lisp   | 57 ++++++++++++++++++++++++++++-----------
 contrib/sb-posix/posix-tests.lisp |  5 ++++
 version.lisp-expr                 |  2 +-
 4 files changed, 48 insertions(+), 17 deletions(-)

diff --git a/NEWS b/NEWS
index 259c9edd0..71803413b 100644
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,7 @@ changes in sbcl-1.0.7 relative to sbcl-1.0.6:
   * enhancement: name of a socket-stream is now "a socket" instead of
     "a constant string".
   * enhancement: SB-POSIX now supports lockf(). (Thanks to Zach Beane.)  
+  * enhancement: SB-POSIX now supports getcwd(). (Thanks to Tassilo Horn.)
   * bug fix: the cache used by the CLOS to store precomputed effective
     methods, slot offsets, and constant return values is now thread and
     interrupt safe.
diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 67c903545..c740dad53 100644
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -247,6 +247,27 @@
   (define-call "setpgid" int minusp (pid pid-t) (pgid pid-t))
   (define-call "setpgrp" int minusp))
 
+(defmacro with-growing-c-string ((buffer size) &body body)
+  (sb-int:with-unique-names (c-string-block)
+    `(block ,c-string-block
+       (let (,buffer)
+         (flet ((,buffer (&optional (size-incl-null))
+                  (when size-incl-null
+                    (setf (sb-sys:sap-ref-8 (sb-alien:alien-sap ,buffer) size-incl-null)
+                          0))
+                  (return-from ,c-string-block
+                    (sb-alien::c-string-to-string
+                     (sb-alien:alien-sap ,buffer)
+                     (sb-impl::default-external-format)
+                     'character))))
+           (loop for ,size = 128 then (* 2 ,size)
+                 do (unwind-protect
+                         (progn
+                           (setf ,buffer (make-alien c-string ,size))
+                           ,@body)
+                      (when ,buffer
+                        (free-alien ,buffer)))))))))
+
 #-win32
 (progn
   (export 'readlink :sb-posix)
@@ -255,22 +276,26 @@
              (alien-funcall
               (extern-alien "readlink" (function int c-string (* t) int))
               path buf length)))
-      (loop for size = 128 then (* 2 size)
-            for buf = (make-alien c-string size)
-            do (unwind-protect
-                    (let ((count (%readlink (filename pathspec) buf size)))
-                      (cond ((minusp count)
-                             (syscall-error))
-                            ((< 0 count size)
-                             (setf (sb-sys:sap-ref-8 (sb-alien:alien-sap buf)
-                                                     count)
-                                   0)
-                             (return
-                               (sb-alien::c-string-to-string
-                                (sb-alien:alien-sap buf)
-                                (sb-impl::default-external-format)
-                                'character)))))
-                 (free-alien buf))))))
+      (with-growing-c-string (buf size)
+        (let ((count (%readlink (filename pathspec) buf size)))
+          (cond ((minusp count)
+                 (syscall-error))
+                ((< 0 count size)
+                 (buf count))))))))
+
+(progn
+  (export 'getcwd :sb-posix)
+  (defun getcwd ()
+    (flet ((%getcwd (buffer size)
+             (alien-funcall
+              (extern-alien "getcwd" (function c-string (* t) int))
+              buffer size)))
+      (with-growing-c-string (buf size)
+        (let ((result (%getcwd buf size)))
+          (cond (result
+                 (buf))
+                ((/= (get-errno) sb-posix:erange)
+                 (syscall-error))))))))
 
 #-win32
 (progn
diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index a0c17b709..dcb58065d 100644
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -624,3 +624,8 @@
             (sb-posix:unlink non-link-pathname))))
     #.sb-posix:enotdir)
   )
+
+(deftest getcwd.1
+    ;; FIXME: something saner, please
+    (equal (sb-unix::posix-getcwd) (sb-posix:getcwd))
+  t)
diff --git a/version.lisp-expr b/version.lisp-expr
index 715b64379..818f8b593 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.6.15"
+"1.0.6.16"
-- 
2.11.4.GIT