diff --git a/test/script-support.lisp b/test/script-support.lisp index 9abe154b71efdf3f14d0c70e1212808ff40fa9ff..3bd6098d9d42c91316efe0382322505385354f6c 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -35,7 +35,7 @@ Some constraints: (declaim (optimize (speed 2) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3) #+(or cmu scl) (c::brevity 2))) -(proclaim '(optimize (speed 2) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3) +(proclaim '(optimize (speed #-gcl 2 #+gcl 0) (safety #-gcl 3 #+gcl 0) #-(or allegro gcl genera) (debug 3) #+(or cmu scl) (c::brevity 2))) (defvar *trace-symbols* diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index 5127d4cfa84a1754df634cdfca21d064a35badd5..4354c44960496ee0e782666498ac22a1d21acee6 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -65,7 +65,8 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" (defun truename* (p) "Nicer variant of TRUENAME that plays well with NIL and avoids logical pathname contexts" ;; avoids both logical-pathname merging and physical resolution issues - (and p (handler-case (with-pathname-defaults () (truename p)) (file-error () nil)))) + (and p (handler-case (with-pathname-defaults () (truename p)) + (#-gcl file-error #+gcl error () nil)))) (defun safe-file-write-date (pathname) "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error." @@ -107,7 +108,7 @@ or the original (parsed) pathname if it is false (the default)." #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring pp)) #-(or cmu (and lispworks unix) sbcl scl) (file-write-date pp) p)))) - #+clisp + #+(or clisp gcl) #.(flet ((probe (probe) `(let ((foundtrue ,probe)) (cond @@ -124,8 +125,11 @@ or the original (parsed) pathname if it is false (the default)." `(if truename ,resolve (and (ignore-errors (,fs p)) p)) - (probe resolve))))) - (file-error () nil))))))) + (probe resolve))) + #+gcl + (probe '(or (probe-file p) + (truename* (ensure-directory-pathname p)))))) + (#-gcl file-error #+gcl error () nil))))))) (defun directory-exists-p (x) "Is X the name of a directory that exists on the filesystem?" @@ -523,7 +527,7 @@ in an atomic way if the implementation allows." (defun delete-file-if-exists (x) "Delete a file X if it already exists" - (when x (handler-case (delete-file x) (file-error () nil)))) + (when x (handler-case (delete-file x) (#-gcl file-error #+gcl error () nil)))) (defun delete-empty-directory (directory-pathname) "Delete an empty directory" diff --git a/uiop/lisp-build.lisp b/uiop/lisp-build.lisp index 154ebc935c63049a228a753a05785961ebc0709f..6370bc1e3abbd8316cc681812af206954a352c9e 100644 --- a/uiop/lisp-build.lisp +++ b/uiop/lisp-build.lisp @@ -591,7 +591,7 @@ possibly in a different process. Otherwise just call THUNK." (defun compile-file-pathname* (input-file &rest keys &key output-file &allow-other-keys) "Variant of COMPILE-FILE-PATHNAME that works well with COMPILE-FILE*" (let* ((keys - (remove-plist-keys `(#+(and allegro (not (version>= 8 2))) :external-format + (remove-plist-keys `(#+(or (and allegro (not (version>= 8 2))) gcl) :external-format ,@(unless output-file '(:output-file))) keys))) (if (absolute-pathname-p output-file) ;; what cfp should be doing, w/ mp* instead of mp @@ -629,7 +629,7 @@ it will filter them appropriately." 'compile-file* output-file object-file) (rotatef output-file object-file)) (let* ((keywords (remove-plist-keys - `(:output-file :compile-check :warnings-file + `(:output-file :compile-check :warnings-file #+gcl :external-format #+clisp :lib-file #+(or ecl mkcl) :object-file) keys)) (output-file (or output-file