From: Christophe R. <cr...@us...> - 2003-10-29 12:54:53
|
Update of /cvsroot/sbcl/sbcl/contrib/sb-posix In directory sc8-pr-cvs1:/tmp/cvs-serv25164/contrib/sb-posix Modified Files: macros.lisp posix-tests.lisp Log Message: 0.8.5.14: Be less assertive about LRAs, since perfectly valid instructions can have LRA widetags. (Brian Downing sbcl-devel 2003-10-29) ... minimally-intrusive and minimally-DWIM patch Define and use NATIVE-FILENAME for sb-posix ... also adjust the test not to run RUN-PROGRAM, since we have problems with that :-/ Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/macros.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- macros.lisp 29 Oct 2003 03:37:23 -0000 1.3 +++ macros.lisp 29 Oct 2003 12:54:50 -0000 1.4 @@ -5,10 +5,29 @@ ;;; Unix name is "[foo]", the appropriate CL namestring for it is ;;; "\\[foo]". So, don't call NAMESTRING, instead call a function ;;; that gets us the Unix name +(defun native-filename (pathname) + (let ((directory (pathname-directory pathname)) + (name (pathname-name pathname)) + (type (pathname-type pathname))) + (with-output-to-string (s nil :element-type 'base-char) + (etypecase directory + (string (write-string directory s)) + (list + (when (eq (car directory) :absolute) + (write-char #\/ s)) + (dolist (piece (cdr directory)) + (etypecase piece + (string (write-string piece s) (write-char #\/ s)))))) + (etypecase name + (null) + (string (write-string name s))) + (etypecase type + (null) + (string (write-char #\. s) (write-string type s)))))) (define-designator filename c-string (pathname - (sb-impl::unix-namestring (translate-logical-pathname filename) nil)) + (native-filename (translate-logical-pathname filename))) (string filename)) (define-designator file-descriptor (integer 32) Index: posix-tests.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/posix-tests.lisp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- posix-tests.lisp 29 Oct 2003 03:37:23 -0000 1.2 +++ posix-tests.lisp 29 Oct 2003 12:54:50 -0000 1.3 @@ -208,17 +208,12 @@ ;;; see comment in filename's designator definition, in macros.lisp (deftest filename-designator.1 - (progn - ;; we use run-program to bypass the wildcard quoting in the - ;; highlevel CL functions like OPEN - (sb-ext:run-program "touch" - (list - (format nil "~A/[foo].txt" - (namestring *test-directory*))) - :search t :wait t ) - ;; if this test fails, it will probably be with - ;; "System call error 2 (No such file or directory)" - (let ((*default-pathname-defaults* *test-directory*)) - (sb-posix:unlink (car (directory "*.txt"))))) + (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*)))) + ;; creat() with a string as argument + (sb-posix:creat file 0) + ;; if this test fails, it will probably be with + ;; "System call error 2 (No such file or directory)" + (let ((*default-pathname-defaults* *test-directory*)) + (sb-posix:unlink (car (directory "*.txt"))))) 0) |