Commit f5bfb0a6 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'master' of github.com:rpgoldman/asdf

parents 50caf4c3 61a7924d

component.lisp

+6 −1
Original line number Diff line number Diff line
@@ -272,11 +272,16 @@ children."))) 


;;;; version-satisfies

(with-upgradability ()

  ;; short-circuit testing of null version specifications.

  ;; this is an all-pass                  

  (defmethod version-satisfies :around ((c t) (version null))

    (declare (ignorable c version))

    t)

  (defmethod version-satisfies ((c component) version)

    (unless (and version (slot-boundp c 'version) (component-version c))

      (when version

        (warn "Requested version ~S but ~S has no version" version c))

      (return-from version-satisfies t))

      (return-from version-satisfies nil))

    (version-satisfies (component-version c) version))



  (defmethod version-satisfies ((cver string) version)

test/test-utilities.script

+8 −3
Original line number Diff line number Diff line
@@ -30,7 +30,7 @@ 
(assert (version-satisfies (asdf-version) (asdf-version)))

(assert (version-satisfies (asdf-version) "3.0"))

(assert (version-satisfies (asdf-version) "2.0"))

(assert (version-satisfies (find-system :test-asdf) "666"))

(assert (not (version-satisfies (find-system :test-asdf) "666")))

(handler-case (version-satisfies (find-system :test-asdf) "666")

  (simple-warning (c)

    (assert (search "Requested version ~S but ~S has no version" (simple-condition-format-control c))))
@@ -39,19 +39,24 @@ 
    (error "version-satisfies must warn when given component without version")))

(assert (version<= "2.0" (asdf-version)))

(assert (not (version-satisfies (asdf-version) "666")))

(DBG "First pathname test.")

(assert-pathnames-equal

 (split-native-pathnames-string (join-namestrings '("foo" "bar")))

 '(#p"foo" #p"bar"))

(DBG "Second pathname test.")

(assert-pathnames-equal

 (split-native-pathnames-string (join-namestrings '("foo" "bar")) :ensure-directory t)

 '(#p"foo/" #p"bar/"))

(DBG "Third pathname test.")

(assert-pathnames-equal

 (split-native-pathnames-string (join-namestrings '("/foo" "/bar")) :want-absolute t)

 '(#p"/foo" #p"/bar"))

(DBG "Fourth pathname test.")

(assert-pathnames-equal

 (split-native-pathnames-string (join-namestrings '("/foo" "/bar"))

                                :want-absolute t :ensure-directory t)

 '(#p"/foo/" #p"/bar/"))

(DBG "Fifth pathname test.")

(assert-equal

 (mapcar 'location-function-p

         '((:function f)

test/test-version.script

+14 −0
Original line number Diff line number Diff line
@@ -13,6 +13,9 @@ 
(DBG "Check that the fallback system bears the current asdf version")

(assert-equal (asdf-version) (component-version *asdf*))



(def-test-system :unversioned-system

  :pathname #.*test-directory*)



(def-test-system :versioned-system-1

  :pathname #.*test-directory*

  :version "1.0")
@@ -39,8 +42,19 @@ 
(defun vtest (name v &optional (true t))

  (or (eq true (version-satisfies (find-system name) v))

      (error "no satisfaction: ~S version ~A not ~A" name v true)))



(vtest :versioned-system-1 "1.0")

(vtest :versioned-system-2 "1.0")

(vtest :versioned-system-3 "2.0" nil)

(vtest :versioned-system-file-form "1.0")

(vtest :versioned-system-file-line "1.0")

;; version UNmatching

(vtest :unversioned-system "1" nil)

(vtest :versioned-system-1 "1.1" nil)

(vtest :versioned-system-2 "1.1" t)

(vtest :versioned-system-2 "1.1.1" nil)

(vtest :versioned-system-2 "1.2" nil)

(vtest :versioned-system-3 "1.2")

(vtest :versioned-system-3 "1.1")

(vtest :versioned-system-3 "1.1.1")