From: Nikodemus S. <de...@us...> - 2009-05-18 20:38:49
|
Update of /cvsroot/sbcl/sbcl/contrib/sb-simple-streams In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv17888/contrib/sb-simple-streams Modified Files: file.lisp impl.lisp internal.lisp iodefs.lisp Log Message: 1.0.28.59: give UNIX-NAMESTRING the chop Use PROBE-FILE and NATIVE-NAMESTRING instead as appropriate. Index: file.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/file.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- file.lisp 6 Sep 2006 20:27:10 -0000 1.6 +++ file.lisp 18 May 2009 20:38:44 -0000 1.7 @@ -267,6 +267,6 @@ (let ((pathname (getf options :filename))) (with-stream-class (probe-simple-stream stream) (add-stream-instance-flags stream :simple) - (when (sb-unix:unix-access (sb-int:unix-namestring pathname nil) sb-unix:f_ok) + (when (sb-unix:unix-access (file-namestring pathname) sb-unix:f_ok) (setf (sm pathname stream) pathname) t)))) Index: impl.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/impl.lisp,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- impl.lisp 16 Feb 2009 21:27:27 -0000 1.13 +++ impl.lisp 18 May 2009 20:38:44 -0000 1.14 @@ -126,7 +126,7 @@ (if (typep stream 'file-simple-stream) (with-stream-class (file-simple-stream stream) (setf (sm pathname stream) new-name) - (setf (sm filename stream) (sb-int:unix-namestring new-name nil)) + (setf (sm filename stream) (file-namestring new-name)) t) nil)) @@ -1097,7 +1097,7 @@ (cond (new-name (setf (sb-impl::fd-stream-pathname stream) new-name) (setf (sb-impl::fd-stream-file stream) - (sb-int:unix-namestring new-name nil)) + (file-namestring new-name)) t) (t (sb-impl::fd-stream-pathname stream)))))) Index: internal.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/internal.lisp,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- internal.lisp 6 Aug 2007 11:50:47 -0000 1.15 +++ internal.lisp 18 May 2009 20:38:44 -0000 1.16 @@ -473,11 +473,14 @@ (:io (values t t sb-unix:o_rdwr)) (:probe (values t nil sb-unix:o_rdonly))) (declare (type sb-int:index mask)) - (let ((name (cond ((sb-int:unix-namestring pathname input)) - ((and input (eq if-does-not-exist :create)) - (sb-int:unix-namestring pathname nil)) - ((and (eq direction :io) (not if-does-not-exist-given)) - (sb-int:unix-namestring pathname nil))))) + (let* ((phys (sb-int:physicalize-pathname (merge-pathnames pathname))) + (true (probe-file phys)) + (name (cond (true + (sb-ext:native-namestring true :as-file t)) + ((or (not input) + (and input (eq if-does-not-exist :create)) + (and (eq direction :io) (not if-does-not-exist-given))) + (sb-ext:native-namestring phys :as-file t))))) ;; Process if-exists argument if we are doing any output. (cond (output (unless if-exists-given Index: iodefs.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/iodefs.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- iodefs.lisp 14 Jul 2005 16:30:09 -0000 1.3 +++ iodefs.lisp 18 May 2009 20:38:44 -0000 1.4 @@ -14,6 +14,9 @@ (in-package "SB-SIMPLE-STREAMS") +(defun file-namestring (pathname) + (sb-ext:native-namestring (sb-int:physicalize-pathname pathnane) :as-file t)) + (defmacro def-stream-class (name superclasses slots &rest options) `(defclass ,name ,superclasses ,slots ,@options)) |