0.9.18.44:

	Patch from Zach Beane for sb-posix support for time, utime and
	utimes.

diff --git a/NEWS b/NEWS
index eaf7403..ec9d5f4 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -11,7 +11,9 @@ changes in sbcl-0.9.19 (1.0.0?) relative to sbcl-0.9.18:
   * improvement: writes to CLOS instance slots are type-checked in code
     compiled with (SAFETY 3)
   * improvement: floating-point exception handling should work on all
-    POSIX platforms (thanks to NIIMI Satoshi)  
+    POSIX platforms (thanks to NIIMI Satoshi)
+  * improvement: SB-POSIX supports time(2), utime(2) and utimes(2)
+    (thanks to Zach Beane)
   * bug fix: compiler bug triggered by a (non-standard) VALUES
     declaration in a LET* was fixed. (reported by Kaersten Poeck)
   * bug fix: file compiler no longer confuses validated and already

diff --git a/contrib/sb-posix/TODO b/contrib/sb-posix/TODO
index f28b5d5..0261a5a 100644 (file)
--- a/contrib/sb-posix/TODO
+++ b/contrib/sb-posix/TODO
@@ -28,8 +28,8 @@ settimeofday sgetmask shmat shmctl shmdt shmget shmop shutdown
 sigaction sigaltstack sigblock siggetmask sigmask signal sigpause
 sigpending sigprocmask sigreturn sigsetmask sigsuspend sigvec socket
 socketcall socketpair ssetmask statfs stime stty swapoff swapon
-syscalls sysctl sysfs sysinfo syslog time times
-ulimit umount uname ustat utime utimes vfork vhangup wait3
+syscalls sysctl sysfs sysinfo syslog times
+ulimit umount uname ustat vfork vhangup wait3
 wait4 write writev
 
 4) In the spec but not implemented: 

diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp
index a040eba..cf5c767 100644 (file)
--- a/contrib/sb-posix/constants.lisp
+++ b/contrib/sb-posix/constants.lisp
@@ -6,6 +6,7 @@
 (#||#
  "sys/types.h"
  "sys/stat.h"
+ #-win32 "utime.h"
  #-win32 "sys/socket.h"
  #-win32 "sys/un.h"
  #-win32 "netinet/in.h"
@@ -349,6 +350,18 @@
               (tcflag-t lflag "tcflag_t" "c_lflag")
               ((array cc-t) cc "cc_t" "c_cc")))
 
+ ;; utime(), utimes()
+ #-win32
+ (:structure alien-utimbuf
+             ("struct utimbuf"
+              (time-t actime "time_t" "actime")
+              (time-t modtime "time_t" "modtime")))
+ #-win32
+ (:structure alien-timeval
+             ("struct timeval"
+              (long sec "long" "tv_sec")
+              (long usec "long" "tv_usec")))
+
  (:integer veof "VEOF" nil t)
  (:integer veol "VEOL" nil t)
  (:integer verase "VERASE" nil t)

diff --git a/contrib/sb-posix/defpackage.lisp b/contrib/sb-posix/defpackage.lisp
index 6fc71ca..bf507d5 100644 (file)
--- a/contrib/sb-posix/defpackage.lisp
+++ b/contrib/sb-posix/defpackage.lisp
@@ -1,5 +1,5 @@
 (defpackage :sb-posix (:use #:sb-alien #:cl)
-  (:shadow close open ftruncate truncate)
+  (:shadow close open ftruncate truncate time)
   (:export #:syscall-error #:syscall-errno
 
            ;; grovel structure accessors

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index f5cb4fb..a5c7ace 100644 (file)
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -445,6 +445,59 @@
                                  (function speed-t (* alien-termios)))
                     a-termios))))
 
+
+#-win32
+(progn
+  (export 'time :sb-posix)
+  (defun time ()
+    (let ((result (alien-funcall (extern-alien "time"
+                                               (function time-t (* time-t)))
+                                 nil)))
+      (if (minusp result)
+          (syscall-error)
+          result)))
+  (export 'utime :sb-posix)
+  (defun utime (filename &optional access-time modification-time)
+    (let ((fun (extern-alien "utime" (function int c-string
+                                               (* alien-utimbuf))))
+          (name (filename filename)))
+      (if (not (and access-time modification-time))
+          (alien-funcall fun name nil)
+          (with-alien ((utimbuf (struct alien-utimbuf)))
+            (setf (slot utimbuf 'actime) (or access-time 0)
+                  (slot utimbuf 'modtime) (or modification-time 0))
+            (let ((result (alien-funcall fun name (alien-sap utimbuf))))
+              (if (minusp result)
+                  (syscall-error)
+                  result))))))
+  (export 'utimes :sb-posix)
+  (defun utimes (filename &optional access-time modification-time)
+    (flet ((seconds-and-useconds (time)
+             (multiple-value-bind (integer fractional)
+                 (cl:truncate time)
+               (values integer (cl:truncate (* fractional 1000000)))))
+           (maybe-syscall-error (value)
+             (if (minusp value)
+                 (syscall-error)
+                 value)))
+      (let ((fun (extern-alien "utimes" (function int c-string
+                                                  (* (array alien-timeval 2)))))
+            (name (filename filename)))
+        (if (not (and access-time modification-time))
+            (maybe-syscall-error (alien-funcall fun name nil))
+            (with-alien ((buf (array alien-timeval 2)))
+              (let ((actime (deref buf 0))
+                    (modtime (deref buf 1)))
+                (setf (values (slot actime 'sec)
+                              (slot actime 'usec))
+                      (seconds-and-useconds (or access-time 0))
+                      (values (slot modtime 'sec)
+                              (slot modtime 'usec))
+                      (seconds-and-useconds (or modification-time 0)))
+                (maybe-syscall-error (alien-funcall fun name
+                                                    (alien-sap buf))))))))))
+
+
 ;;; environment
 
 (export 'getenv :sb-posix)

diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index 4e6e6c9..c228642 100644 (file)
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -461,3 +461,46 @@
         (setf termios (sb-posix:tcgetattr 0))
         (= new (sb-posix:cfgetospeed termios))))
   t)
+
+
+#-win32
+(deftest time.1
+    (plusp (sb-posix:time))
+  t)
+
+#-win32
+(deftest utime.1
+    (let ((file (merge-pathnames #p"utime.1" *test-directory*))
+          (atime (random (1- (expt 2 31))))
+          (mtime (random (1- (expt 2 31)))))
+      (with-open-file (stream file
+                       :direction :output
+                       :if-exists :supersede
+                       :if-does-not-exist :create)
+        (princ "Hello, utime" stream))
+      (sb-posix:utime file atime mtime)
+      (let* ((stat (sb-posix:stat file)))
+        (delete-file file)
+        (list (= (sb-posix:stat-atime stat) atime)
+              (= (sb-posix:stat-mtime stat) mtime))))
+  (t t))
+
+#-win32
+(deftest utimes.1
+    (let ((file (merge-pathnames #p"utimes.1" *test-directory*))
+          (atime (random (1- (expt 2 31))))
+          (mtime (random (1- (expt 2 31)))))
+      (with-open-file (stream file
+                       :direction :output
+                       :if-exists :supersede
+                       :if-does-not-exist :create)
+        (princ "Hello, utimes" stream))
+      (sb-posix:utime file atime mtime)
+      (let* ((stat (sb-posix:stat file)))
+        (delete-file file)
+        (list (= (sb-posix:stat-atime stat) atime)
+              (= (sb-posix:stat-mtime stat) mtime))))
+  (t t))
+
+
+

diff --git a/version.lisp-expr b/version.lisp-expr
index 225ea6c..4305478 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".)
-"0.9.18.43"
+"0.9.18.44"