From fb83c88a23fa786168740f868d5cee8f5d49f564 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sat, 16 Nov 2013 01:56:17 -0500 Subject: [PATCH] Fix getcwd on GCL. Also lower the random limit for with-temporary-file on GCL. --- test/test-system-pathnames.script | 1 + uiop/os.lisp | 3 +-- uiop/stream.lisp | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/test-system-pathnames.script b/test/test-system-pathnames.script index f66cf57b..740005ec 100644 --- a/test/test-system-pathnames.script +++ b/test/test-system-pathnames.script @@ -2,6 +2,7 @@ (defsystem :test-system-pathnames :pathname "sources/level1" + :source-file nil :components ((:file "file1") (:file "file2" :pathname "level2/file2") diff --git a/uiop/os.lisp b/uiop/os.lisp index 20294283..3cd59810 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -255,8 +255,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (strcat (nth-value 1 (unix:unix-current-directory)) "/")) #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return? #+ecl (ext:getcwd) - #+gcl (parse-namestring ;; this is a joke. Isn't there a better way? - (first (symbol-call :uiop :run-program '("/bin/pwd") :output :lines))) + #+gcl (let ((*default-pathname-defaults* #p"")) (truename #p"")) #+genera *default-pathname-defaults* ;; on a Lisp OS, it *is* canonical! #+lispworks (system:current-directory) #+mkcl (mk-ext:getcwd) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index 96ede3a9..a2cf2323 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -557,7 +557,7 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e :with prefix = (namestring (ensure-absolute-pathname (or prefix "tmp") (or directory #'temporary-directory))) :with results = () - :for counter :from (random (expt 36 #-gcl 8 #+gcl 6)) + :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for pathname = (pathname (format nil "~A~36R~@[~A~]~@[.~A~]" prefix counter suffix type)) :for okp = nil :do ;; TODO: on Unix, do something about umask -- GitLab