1.0.14.12: export SB-POSIX:MKSTEMP, add SB-POSIX:MKTEMP and SB-POSIX:MKDTEMP

 * Remove the alien struct consing from the calls -- just use the SAP
   directly.

 * Automagic unsupportedness handling for platforms that miss any of
   these.

 * Rudimentary tests.

 * #-win32 for now.

diff --git a/NEWS b/NEWS
index 54bd730..bc52ee2 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@ changes in sbcl-1.0.15 relative to sbcl-1.0.14:
   * enhancement: untracing a whole package using (UNTRACE "FOO") is
     now supported, and tracing a whole package using (TRACE "FOO") now
     traces SETF-functions as well.
+  * enhancement: implement SB-POSIX:MKTEMP and SB-POSIX:MKDTEMP.
+  * bug fix: export SB-POSIX:MKSTEMP.
   * bug fix: SORT was not interrupt safe.
   * bug fix: XREF accounts for the last node of each basic-block as
     well.

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 541c3c9..5704d3f 100644 (file)
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -81,6 +81,14 @@
   (let ((errno (get-errno)))
     (error (elt *errno-table* errno) :errno errno)))
 
+(defun unsupported-error (lisp-name c-name)
+  (error "~S is unsupported by SBCL on this platform due to lack of ~A()."
+         lisp-name c-name))
+
+(defun unsupported-warning (lisp-name c-name)
+  (warn "~S is unsupported by SBCL on this platform due to lack of ~A()."
+        lisp-name c-name))
+
 ;; Note that we inherit from SIMPLE-FILE-ERROR first, to get its
 ;; error reporting, rather than SYSCALL-ERROR's.
 (define-condition file-syscall-error
@@ -221,26 +229,47 @@
   (define-call "sync" void never-fails)
   (define-call ("truncate" :options :largefile)
       int minusp (pathname filename) (length off-t))
-  ;; FIXME: Windows does have _mktemp, which has a slightlty different
-  ;; interface
-  (defun mkstemp (template)
-    ;; we are emulating sb-alien's charset conversion for strings
-    ;; here, to accommodate for the call-by-reference nature of
-    ;; mkstemp's template strings.
-    (let ((arg (sb-ext:string-to-octets
-                (filename template)
-                :external-format sb-alien::*default-c-string-external-format*)))
-      (sb-sys:with-pinned-objects (arg)
-        (let ((result (alien-funcall (extern-alien "mkstemp"
-                                                   (function int c-string))
-                                     (sap-alien (sb-alien::vector-sap arg)
-                                                (* char)))))
-          (when (minusp result)
-            (syscall-error))
-          (values result
-                  (sb-ext:octets-to-string
-                   arg
-                   :external-format sb-alien::*default-c-string-external-format*))))))
+  #-win32
+  (macrolet ((def-mk*temp (lisp-name c-name result-type errorp dirp values)
+               (declare (ignore dirp))
+               (if (sb-sys:find-foreign-symbol-address c-name)
+                   `(progn
+                      (defun ,lisp-name (template)
+                        (let* ((external-format sb-alien::*default-c-string-external-format*)
+                               (arg (sb-ext:string-to-octets
+                                     (filename template)
+                                     :external-format external-format)))
+                          (sb-sys:with-pinned-objects (arg)
+                            ;; accommodate for the call-by-reference
+                            ;; nature of mks/dtemp's template strings.
+                            (let ((result (alien-funcall (extern-alien ,c-name
+                                                                       (function ,result-type system-area-pointer))
+                                                         (sb-alien::vector-sap arg))))
+                              (when (,errorp result)
+                                (syscall-error))
+                              ;; FIXME: We'd rather return pathnames, but other
+                              ;; SB-POSIX functions like this return strings...
+                              (let ((pathname (sb-ext:octets-to-string
+                                               arg :external-format external-format)))
+                                ,(if values
+                                     '(values result pathname)
+                                     'pathname))))))
+                      (export ',lisp-name))
+                   `(progn
+                      (defun ,lisp-name (template)
+                        (declare (ignore template))
+                        (unsupported-error ',lisp-name ,c-name))
+                      (define-compiler-macro ,lisp-name (&whole form template)
+                        (declare (ignore template))
+                        (unsupported-warning ',lisp-name ,c-name)
+                        form)
+                      (export ',lisp-name)))))
+    (def-mk*temp mktemp "mktemp" (* char) null-alien nil nil)
+    ;; FIXME: Windows does have _mktemp, which has a slightly different
+    ;; interface
+    (def-mk*temp mkstemp "mkstemp" int minusp nil t)
+    ;; FIXME: What about Windows?
+    (def-mk*temp mkdtemp "mkdtemp" (* char) null-alien t nil))
   (define-call-internally ioctl-without-arg "ioctl" int minusp
                           (fd file-descriptor) (cmd int))
   (define-call-internally ioctl-with-int-arg "ioctl" int minusp

diff --git a/contrib/sb-posix/macros.lisp b/contrib/sb-posix/macros.lisp
index 018ff62..2e15e10 100644 (file)
--- a/contrib/sb-posix/macros.lisp
+++ b/contrib/sb-posix/macros.lisp
@@ -2,7 +2,8 @@
 
 (define-designator filename c-string
   (pathname
-   (sb-ext:native-namestring (translate-logical-pathname filename)))
+   (sb-ext:native-namestring (translate-logical-pathname filename)
+                             :as-file t))
   (string filename))
 
 (define-designator file-descriptor (integer 32)

diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index 98687c2..71f218c 100644 (file)
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -684,3 +684,44 @@
     ;; FIXME: something saner, please
     (equal (sb-unix::posix-getcwd) (sb-posix:getcwd))
   t)
+
+#-win32
+(deftest mkstemp.1
+    (multiple-value-bind (fd temp)
+        (sb-posix:mkstemp (make-pathname
+                           :name "mkstemp-1"
+                           :type "XXX"
+                           :defaults *test-directory*))
+      (let ((pathname (sb-ext:parse-native-namestring temp)))
+        (unwind-protect
+             (values (integerp fd) (pathname-name pathname))
+          (delete-file temp))))
+  t "mkstemp-1")
+
+#-win32
+(deftest mkdtemp.1
+    (let ((pathname
+           (sb-ext:parse-native-namestring
+            (sb-posix:mkdtemp (make-pathname
+                               :name "mkdtemp-1"
+                               :type "XXX"
+                               :defaults *test-directory*))
+            nil
+            *default-pathname-defaults*
+            :as-directory t)))
+      (unwind-protect
+           (values (let* ((xxx (car (last (pathname-directory pathname))))
+                          (p (position #\. xxx)))
+                     (and p (subseq xxx 0 p)))
+                   (pathname-name pathname)
+                   (pathname-type pathname))
+        (sb-posix:rmdir pathname)))
+  "mkdtemp-1" nil nil)
+
+#-win32
+(deftest mktemp.1
+    (let ((pathname (sb-ext:parse-native-namestring
+                     (sb-posix:mktemp #p"mktemp.XXX"))))
+      (values (equal "mktemp" (pathname-name pathname))
+              (not (equal "XXX" (pathname-type pathname)))))
+  t t)

diff --git a/version.lisp-expr b/version.lisp-expr
index da95f3c..58cf8a0 100644 (file)
--- 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.14.11"
+"1.0.14.12"