Commit 19afd715 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Improve tests on Windows, again.

parent c69a7d2a
Loading
Loading
Loading
Loading
+7 −1
Original line number Original line Diff line number Diff line
@@ -27,7 +27,7 @@ Some constraints:
   #:leave-test #:def-test-system
   #:leave-test #:def-test-system
   #:action-name #:in-plan-p
   #:action-name #:in-plan-p
   #:test-source #:test-fasl #:resolve-output #:output-location
   #:test-source #:test-fasl #:resolve-output #:output-location
   #:quietly))
   #:quietly #:join-namestrings))


(in-package :asdf-test)
(in-package :asdf-test)


@@ -601,6 +601,12 @@ is bound, write a message and exit on an error. If
    (assert (asymval '#:*file1* :test-package))
    (assert (asymval '#:*file1* :test-package))
    (assert (asymval '#:*file3* :test-package))))
    (assert (asymval '#:*file3* :test-package))))


(defun join-namestrings (namestrings)
  (with-output-to-string (s)
    (loop :with separator = (acall :inter-directory-separator)
          :for (n . morep) :on namestrings
          :do (format s "~A~@[~C~]" n (and morep separator)))))

;; These are shorthands for interactive debugging of test scripts:
;; These are shorthands for interactive debugging of test scripts:
(!a
(!a
 common-lisp-user::debug-asdf debug-asdf
 common-lisp-user::debug-asdf debug-asdf
+45 −52
Original line number Original line Diff line number Diff line
@@ -50,12 +50,6 @@
          "dir9/dirb/")                 ; foo9 should /not/ be found -- not under :here :tree
          "dir9/dirb/")                 ; foo9 should /not/ be found -- not under :here :tree
    :collect (under-tmp-directory dir)))
    :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 ()
(defun create-asd-files ()
  (loop
  (loop
    :for d :in *tmp-asd-directories*
    :for d :in *tmp-asd-directories*
@@ -67,55 +61,54 @@
                       :if-does-not-exist :create)
                       :if-does-not-exist :create)
      (format s "(defsystem :foo~D)~%" i))))
      (format s "(defsystem :foo~D)~%" i))))


(progn
(assert-equal (asdf::parse-output-translations-string
 (assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/foo" "/bar" "" "/baz" "/quux")))
                (join-namestrings '("/foo" "/bar" "" "/baz" "/quux")))
              '(:output-translations ("/foo" "/bar") :inherit-configuration
               '(:output-translations ("/foo" "/bar") :inherit-configuration
                ("/baz" "/quux")))
                 ("/baz" "/quux")))
(assert-equal (asdf::parse-output-translations-string
 (assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/" "")))
                (join-namestrings '("/" "")))
              '(:output-translations ("/" nil) :ignore-inherited-configuration))
               '(:output-translations ("/" nil) :ignore-inherited-configuration))
(assert-equal (asdf::parse-output-translations-string
 (assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/" "" "")))
                (join-namestrings '("/" "" "")))
              '(:output-translations ("/" nil) :inherit-configuration))
               '(:output-translations ("/" nil) :inherit-configuration))
(assert-equal (asdf::parse-output-translations-string
 (assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/" "/")))
                (join-namestrings '("/" "/")))
              '(:output-translations ("/" "/") :ignore-inherited-configuration))
               '(:output-translations ("/" "/") :ignore-inherited-configuration))
(assert-equal (asdf::parse-output-translations-string
 (assert-equal (asdf::parse-output-translations-string
               "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)")
                "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)")
              '(:output-translations ("/" "/") :ignore-inherited-configuration))
               '(:output-translations ("/" "/") :ignore-inherited-configuration))


 (create-asd-files)
(create-asd-files)
 (create-conf-files)
(create-conf-files)


 (format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/")))
(format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/")))
 (assert-equal 2 (length (subdirectories (under-tmp-directory "dir2/"))))
(assert-equal 2 (length (subdirectories (under-tmp-directory "dir2/"))))


 (format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/")))
(format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/")))
 (assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/"))))
(assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/"))))


 (initialize-source-registry
(initialize-source-registry
  `(:source-registry (:include ,(under-tmp-directory "conf.d/"))
 `(:source-registry (:include ,(under-tmp-directory "conf.d/"))
                     (:include ,(under-tmp-directory "dir5/"))
                    (:include ,(under-tmp-directory "dir5/"))
                     (:include ,(under-tmp-directory "dir8/"))
                    (:include ,(under-tmp-directory "dir8/"))
                     (:include ,(under-tmp-directory "dir9/dira/"))
                    (:include ,(under-tmp-directory "dir9/dira/"))
                     :ignore-inherited-configuration))
                    :ignore-inherited-configuration))


 (format t "~&Source Registry: ~S~%"
(format t "~&Source Registry: ~S~%"
         asdf::*source-registry*)
        asdf::*source-registry*)
 (assert (find-system :foo0 nil))
(assert (find-system :foo0 nil))
 (assert (find-system :foo1 nil))
(assert (find-system :foo1 nil))
 (assert (find-system :foo2 nil))
(assert (find-system :foo2 nil))
 (assert (find-system :foo3 nil))
(assert (find-system :foo3 nil))
 (assert (find-system :foo4 nil))
(assert (find-system :foo4 nil))
 (assert (not (find-system :foo5 nil)))
(assert (not (find-system :foo5 nil)))
 (assert (find-system :foo6 nil))
(assert (find-system :foo6 nil))
 (assert (find-system :foo7 nil))
(assert (find-system :foo7 nil))
 (assert (find-system :foo8 nil))
(assert (find-system :foo8 nil))
 (assert (not (find-system :foo9 nil)))
(assert (not (find-system :foo9 nil)))


 (format t "~&A: ~S~%B: ~S~%"
(format t "~&A: ~S~%B: ~S~%"
         (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
        (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
         (under-tmp-directory "dir2/bar/baz.lisp"))
        (under-tmp-directory "dir2/bar/baz.lisp"))
 (assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
(assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
               (under-tmp-directory "dir2/bar/baz.lisp")))
              (under-tmp-directory "dir2/bar/baz.lisp"))
+4 −4
Original line number Original line Diff line number Diff line
@@ -42,16 +42,16 @@
(assert
(assert
 (not (version-satisfies (asdf-version) "666")))
 (not (version-satisfies (asdf-version) "666")))
(assert-pathnames-equal
(assert-pathnames-equal
 (split-native-pathnames-string "foo:bar")
 (split-native-pathnames-string (join-namestrings '("foo" "bar")))
 '(#p"foo" #p"bar"))
 '(#p"foo" #p"bar"))
(assert-pathnames-equal
(assert-pathnames-equal
 (split-native-pathnames-string "foo:bar" :ensure-directory t)
 (split-native-pathnames-string (join-namestrings '("foo" "bar")) :ensure-directory t)
 '(#p"foo/" #p"bar/"))
 '(#p"foo/" #p"bar/"))
(assert-pathnames-equal
(assert-pathnames-equal
 (split-native-pathnames-string (strcat "/foo" (inter-directory-separator) "/bar") :want-absolute t)
 (split-native-pathnames-string (join-namestrings '("/foo" "/bar")) :want-absolute t)
 '(#p"/foo" #p"/bar"))
 '(#p"/foo" #p"/bar"))
(assert-pathnames-equal
(assert-pathnames-equal
 (split-native-pathnames-string (strcat "/foo" (inter-directory-separator) "/bar")
 (split-native-pathnames-string (join-namestrings '("/foo" "/bar"))
                                :want-absolute t :ensure-directory t)
                                :want-absolute t :ensure-directory t)
 '(#p"/foo/" #p"/bar/"))
 '(#p"/foo/" #p"/bar/"))
(assert-equal
(assert-equal