Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Didier Verna
asdf
Commits
3334b3c0
Commit
3334b3c0
authored
Jan 21, 2013
by
Francois-Rene Rideau
Browse files
Fix tests that compare pathnames that are pathname-equal but not equal (!)
parent
9d5f5148
Changes
2
Hide whitespace changes
Inline
Side-by-side
test/script-support.lisp
View file @
3334b3c0
...
...
@@ -447,6 +447,48 @@ is bound, write a message and exit on an error. If
(
defun
in-plan-p
(
plan
x
)
(
member
x
plan
:key
(
asym
:action-path
)
:test
'equal
))
;;; Helpful for debugging
(
defun
pathname-components
(
p
)
(
when
p
(
let
((
p
(
pathname
p
)))
(
list
:host
(
pathname-host
p
)
:device
(
pathname-device
p
)
:directory
(
pathname-directory
p
)
:name
(
pathname-name
p
)
:type
(
pathname-type
p
)
:version
(
pathname-version
p
)))))
(
defun
assert-pathname-equal-helper
(
qx
x
qy
y
)
(
cond
((
equal
x
y
)
(
format
t
"~S and ~S both evaluate to same path:~% ~S~%"
qx
qy
x
))
((
acall
:pathname-equal
x
y
)
(
format
t
"These two expressions yield pathname-equal yet not equal path~% ~S~%"
x
)
(
format
t
"the first expression ~S yields this:~% ~S~%"
qx
(
pathname-components
x
))
(
format
t
"the other expression ~S yields that:~% ~S~%"
qy
(
pathname-components
y
)))
(
t
(
format
t
"These two expressions yield paths that are not pathname-equal~%"
)
(
format
t
"the first expression ~S yields this:~% ~S~% ~S~%"
qx
x
(
pathname-components
x
))
(
format
t
"the other expression ~S yields that:~% ~S~% ~S~%"
qy
y
(
pathname-components
y
)))))
(
defmacro
assert-pathname-equal
(
x
y
)
`
(
assert-pathname-equal-helper
',x
,
x
',y
,
y
))
(
defun
assert-length-equal-helper
(
qx
qy
x
y
)
(
unless
(
=
(
length
x
)
(
length
y
))
(
format
t
"These two expressions yield sequences of unequal length~%"
)
(
format
t
"The first, ~S, has value ~S of length ~S~%"
qx
x
(
length
x
))
(
format
t
"The other, ~S, has value ~S of length ~S~%"
qy
y
(
length
y
))))
(
defun
assert-pathnames-equal-helper
(
qx
x
qy
y
)
(
assert-length-equal-helper
qx
x
qy
y
)
(
loop
:for
n
:from
0
:for
qpx
=
`
(
nth
,
n
,
qx
)
:for
qpy
=
`
(
nth
,
n
,
qy
)
:for
px
:in
x
:for
py
:in
y
:do
(
assert-pathname-equal-helper
qpx
px
qpy
py
)))
(
defmacro
assert-pathnames-equal
(
x
y
)
`
(
assert-pathnames-equal-helper
',x
,
x
',y
,
y
))
;; These are shorthands for interactive debugging of test scripts:
(
!a
...
...
test/test-concatenate-source.script
View file @
3334b3c0
...
...
@@ -15,21 +15,21 @@
(defparameter mlccso (make-operation 'monolithic-load-compiled-concatenated-source-op))
(defparameter sys (find-system :test-concatenate-source))
(assert (operation-monolithic-p mcso))
(assert-equal ;; on CLISP, we get un-equal pathnames with same namestrings. Sigh.
(princ-to-string (input-files mcso sys))
(princ-to-string (loop :for n :in '(3 1 2)
:collect (test-source (format nil "file~D.lisp" n)))))
(assert-equal
(assert-pathnames-equal
(input-files mcso sys)
(loop :for n :in '(3 1 2) :collect (test-source (format nil "file~D.lisp" n))))
(assert-pathname-equal
(output-file mcso sys)
(apply-output-translations
(resolve-output "asdf/test/test-concatenate-source.all-systems.lisp")))
(assert-equal
(assert-
pathname-
equal
(output-files mcso sys)
(input-files mccso sys))
(assert-equal ;; on ECL, we get un-equal pathnames.
(princ-to-string (output-file mccso sys))
(princ-to-string (test-fasl "test-concatenate-source.all-systems.lisp")))
(assert-equal
;; on ECL, we get un-equal pathnames.
(assert-pathname-equal
(output-file mccso sys)
(test-fasl "test-concatenate-source.all-systems.lisp"))
(assert-pathname-equal
(output-files mccso sys)
(input-files mlccso sys))
(operate 'monolithic-load-compiled-concatenated-source-op sys)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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