Commit d0abd362 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Some fixes for CLISP on Windows 

Fix PROBE-FILE*, make the (executable) image suffix .exe on Windows.
parent 405e2b37

bundle.lisp

+1 −1
Original line number Diff line number Diff line
@@ -159,7 +159,7 @@ itself.")) ;; operation on a system and its dependencies 
      #+(or clasp ecl)

      ((member :dll :lib :shared-library :static-library :program :object :program)

       (compile-file-type :type bundle-type))

      ((member :image) #-allegro "image" #+allegro "dxl")

      ((member :image) (or #+allegro "dxl" #+(and clisp os-windows) "exe" "image"))

      ((member :dll :shared-library) (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll")))

      ((member :lib :static-library) (os-cond ((os-unix-p) "a")

                                              ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib"))))

uiop/filesystem.lisp

+54 −53
Original line number Diff line number Diff line
@@ -87,10 +87,12 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" 
probes the filesystem for a file or directory with given pathname.

If it exists, return its truename is ENSURE-PATHNAME is true,

or the original (parsed) pathname if it is false (the default)."

    (with-pathname-defaults () ;; avoids logical-pathname issues on some implementations

    (etypecase p

      (null nil)

        (string (probe-file* (parse-namestring p) :truename truename))

      (string

       ;; avoid logical-pathname issues on some implementations

       (let ((pn (with-pathname-defaults () (parse-namestring p))))

	 (probe-file* pn :truename truename)))

      (pathname

       (and (not (wild-pathname-p p))

	    (handler-case
@@ -112,22 +114,21 @@ or the original (parsed) pathname if it is false (the default)." 
			   (subpathname p (car (last (pathname-directory p)))))))

		       (:directory (ensure-directory-pathname p)))))

		 #+clisp

                   #.(flet ((probe (probe)

                              `(let ((foundtrue ,probe))

                                 (cond

                                   (truename foundtrue)

                                   (foundtrue p)))))

                       (let* ((fs (or #-os-windows (find-symbol* '#:file-stat :posix nil)))

                              (pp (find-symbol* '#:probe-pathname :ext nil))

                              (resolve (if pp

		 #.(let* ((fs (or #-os-windows (find-symbol* '#:file-stat :posix nil)))

			  (pp (find-symbol* '#:probe-pathname :ext nil)))

		       `(if truename

			  ,(if pp

			     `(ignore-errors (,pp p))

			     '(or (truename* p)

                                             (truename* (ignore-errors (ensure-directory-pathname p)))))))

                         (if fs

                             `(if truename

                                  ,resolve

                                  (and (ignore-errors (,fs p)) p))

                             (probe resolve))))

			       (truename* (ignore-errors (ensure-directory-pathname p)))))

			  ,(cond

			     (fs `(and (ignore-errors (,fs p)) p))

			     (pp `(ignore-errors (nth-value 1 (,pp p))))

			     (t '(if-let (q (ensure-absolute-pathname p

					     :defaults 'get-pathname-defaults :on-error nil))

				  (or (and (truename* q) q)

				   (if-let (d (ignore-errors (ensure-directory-pathname q)))

				     (and (truename* d) d))))))))

		 #-(or allegro clisp gcl)

		 (if truename

		   (probe-file p)
@@ -139,7 +140,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)))))

                (file-error () nil)))))))

	      (file-error () nil))))))



  (defun directory-exists-p (x)

    "Is X the name of a directory that exists on the filesystem?"