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

test-utilities: more pathname massaging for Windows.

Add TODO note about run-program.
parent 71a5cfc3
......@@ -380,6 +380,14 @@ It looks like SWANK can be fixed soon, though, so we'll see.
*** rewrote part of deferred warnings support.
Ask him for the code he implemented at Google.
** Ensure all run-program issues on Windows are solved.
*** SBCL cannot do raw CMD.EXE command-lines
*** We don't seem to properly escape CRLF in escape-windows-token,
or maybe it is, but CMD.EXE does the wrong thing in them,
so the semantics depend on whether it's used,
or maybe it's CCL eating them while parsing, or maybe not, etc.
In any case, this requires clarification.
** define-package cannot deal with symbols moving "forward".
*** document that THOU SHALT NOT USE :RECYCLE with packages previously
defined by define-package when building from scratch.
......@@ -15,6 +15,24 @@
:output '(:string :stripped t)))
:ensure-directory t))
(defun simplify-pathname-directory (pathname)
(setf pathname (ensure-pathname pathname))
(when pathname
(make-pathname :defaults pathname :directory (simplify-pathname-directory-component (pathname-directory pathname)))))
(defun simplify-pathname-directory-component (dir)
(setf dir (normalize-pathname-directory-component dir))
:with head = (progn
(unless (and (consp dir) (cdr dir)) (return dir))
(subseq dir 0 1))
:with tail = (rest dir)
:for (next rest) :on tail :do
(unless (equal next ".")
(when (member next '(".." :up) :test 'equal) (setf next :back))
(setf head (merge-pathname-directory-components (list :relative next) head)))
:finally (return head)))
(let ((asdf-directory (truename *asdf-directory*))
(test-directory (truename *test-directory*)))
(labels ((check-cwd (dir)
......@@ -23,8 +41,8 @@
(assert-pathname-equal dir (getcwd-from-run-program)))
(check-true-dpd (dir)
(assert-pathname-equal dir (get-pathname-defaults))
(assert-pathname-equal dir (truename #p"./"))
(assert-pathname-equal dir (truename* #p"./")))
(assert-pathname-equal dir (simplify-pathname-directory (truename #p"./")))
(assert-pathname-equal dir (simplify-pathname-directory (truename* #p"./"))))
(check-file-exists (file &optional true)
(setf file (parse-unix-namestring file))
(if true
......@@ -45,8 +63,10 @@
(assert-pathname-equal true dir)
(setf true dir)))
(assert-pathname-equal true (truename (ensure-directory-pathname file)))
(assert-pathname-equal true (truename* file))
(assert-pathname-equal true (nest #+allegro (ensure-directory-pathname) (probe-file* file :truename t)))
(assert-pathname-equal true (nest #+(and clisp windows) (ensure-directory-pathname)
(truename* file))
(assert-pathname-equal true (nest #+(or allegro (and clisp windows)) (ensure-directory-pathname)
(probe-file* file :truename t)))
(assert-pathname-equal true (if-let (x (probe-file* file))
(ensure-absolute-pathname (ensure-directory-pathname x) 'get-pathname-defaults))))
(check-directory-doesnt-exist (file)
......@@ -78,7 +98,8 @@
(DBG "3" (chdir asdf-directory) (setf *default-pathname-defaults* test-directory))
#-(or abcl genera xcl) ;; on these platforms, chdir changes D-P-D so these tests are not meaningful
#-(or abcl genera xcl ;; on these platforms, chdir changes D-P-D so these tests are not meaningful
(and sbcl os-windows)) ;; SBCL on Windows really hates a relative D-P-D.
;; SBCL hates to get (truename #p"") when D-P-D is itself #p"". See
(DBG "4"
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment