From 3334b3c095edd02c5c45f84a4f61194e097a389f Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Mon, 21 Jan 2013 16:25:59 -0500 Subject: [PATCH] Fix tests that compare pathnames that are pathname-equal but not equal (!) --- test/script-support.lisp | 42 +++++++++++++++++++++++++++++ test/test-concatenate-source.script | 20 +++++++------- 2 files changed, 52 insertions(+), 10 deletions(-) diff --git a/test/script-support.lisp b/test/script-support.lisp index 859953d3..e0851c81 100644 --- 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 e1c8260e..0f43195a 100644 --- 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) -- GitLab