Fix tests that compare pathnames that are pathname-equal but not equal (!)

diff --git a/test/script-support.lisp b/test/script-support.lisp
index 859953d..e0851c8 100644 (file)
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -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

diff --git a/test/test-concatenate-source.script b/test/test-concatenate-source.script
index e1c8260..0f43195 100644 (file)
--- a/test/test-concatenate-source.script
+++ b/test/test-concatenate-source.script
@@ -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)