From c69a7d2ad9aeaf1d484f8ce088d1b86dfa714cbc Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Thu, 5 Sep 2013 18:15:43 -0400 Subject: [PATCH] Tweak two tests in the hope of making them work on Windows. --- test/test-configuration.script | 21 ++++++++++++++------- test/test-utilities.script | 5 +++-- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/test/test-configuration.script b/test/test-configuration.script index 398b0d7c..18252b38 100644 --- a/test/test-configuration.script +++ b/test/test-configuration.script @@ -1,7 +1,5 @@ ;;; -*- Lisp -*- - - (in-package :asdf) (use-package :asdf-test) #+gcl2.6 (defmacro with-standard-io-syntax (&body body) `(progn ,@body)) @@ -52,6 +50,12 @@ "dir9/dirb/") ; foo9 should /not/ be found -- not under :here :tree :collect (under-tmp-directory dir))) +(defparameter *separator* (inter-directory-separator)) +(defun join-namestrings (namestrings) + (with-output-to-string (s) + (loop :for (n . morep) :on namestrings + :do (format s "~A~@[~C~]" n (and morep *separator*))))) + (defun create-asd-files () (loop :for d :in *tmp-asd-directories* @@ -64,16 +68,19 @@ (format s "(defsystem :foo~D)~%" i)))) (progn - (assert-equal (asdf::parse-output-translations-string "/foo:/bar::/baz:/quux") + (assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/foo" "/bar" "" "/baz" "/quux"))) '(:output-translations ("/foo" "/bar") :inherit-configuration ("/baz" "/quux"))) - (assert-equal (asdf::parse-output-translations-string "/:") + (assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/" ""))) '(:output-translations ("/" nil) :ignore-inherited-configuration)) - (assert-equal (asdf::parse-output-translations-string "/::") + (assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/" "" ""))) '(:output-translations ("/" nil) :inherit-configuration)) - (assert-equal (asdf::parse-output-translations-string "/:/") + (assert-equal (asdf::parse-output-translations-string + (join-namestrings '("/" "/"))) '(:output-translations ("/" "/") :ignore-inherited-configuration)) - (assert-equal (asdf::parse-output-translations-string "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)") '(:output-translations ("/" "/") :ignore-inherited-configuration)) diff --git a/test/test-utilities.script b/test/test-utilities.script index affb1e53..a77f1c35 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -48,10 +48,11 @@ (split-native-pathnames-string "foo:bar" :ensure-directory t) '(#p"foo/" #p"bar/")) (assert-pathnames-equal - (split-native-pathnames-string "/foo:/bar" :want-absolute t) + (split-native-pathnames-string (strcat "/foo" (inter-directory-separator) "/bar") :want-absolute t) '(#p"/foo" #p"/bar")) (assert-pathnames-equal - (split-native-pathnames-string "/foo:/bar" :want-absolute t :ensure-directory t) + (split-native-pathnames-string (strcat "/foo" (inter-directory-separator) "/bar") + :want-absolute t :ensure-directory t) '(#p"/foo/" #p"/bar/")) (assert-equal (mapcar 'location-function-p -- GitLab