Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
b8246985
Commit
b8246985
authored
Jul 07, 2015
by
Francois-Rene Rideau
Browse files
test-utilities: more pathname massaging for Windows.
Add TODO note about run-program.
parent
71a5cfc3
Changes
2
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
b8246985
...
...
@@ -380,6 +380,14 @@ It looks like SWANK can be fixed soon, though, so we'll see.
*** czak@google.com 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.
...
...
test/test-utilities.script
100755 → 100644
View file @
b8246985
...
...
@@ -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))
(loop
: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))
(check-true-dpd-test))
#-(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.
(progn
;; SBCL hates to get (truename #p"") when D-P-D is itself #p"". See https://bugs.launchpad.net/sbcl/+bug/1472414
(DBG "4"
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment