Commit 002eb570 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.108: tweak locate-system after previous change. Fix some tests.

parent 98127ec8
......@@ -15,7 +15,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.107" ;; to be automatically updated by bin/bump-revision
:version "2.26.108" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf))))
......
......@@ -283,13 +283,9 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(pathname (ensure-pathname (resolve-symlinks* pathname) :want-absolute t))
(foundp (and (or found-system pathname previous) t)))
(check-type found (or null pathname system))
(when foundp
(when (and pathname found-system)
(setf (system-source-file found-system) pathname))
(when (and previous (not (pathname-equal (system-source-file previous) pathname)))
(setf (system-source-file previous) pathname)
(setf previous-time nil))
(values foundp found-system pathname previous previous-time))))
(values foundp found-system pathname previous previous-time)))
(asdf-debug)
(defmethod find-system ((name string) &optional (error-p t))
(with-system-definitions ()
......@@ -297,7 +293,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(restart-case
(multiple-value-bind (foundp found-system pathname previous previous-time)
(locate-system name)
(declare (ignore foundp))
(assert (eq foundp (and (or found-system pathname) t)))
(when (and found-system (not previous))
(register-system found-system))
(when (and pathname
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.107: Another System Definition Facility.
;;; This is ASDF 2.26.108: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -48,7 +48,7 @@
#:add-pathname-suffix #:tmpize-pathname
#:call-with-staging-pathname #:with-staging-pathname
;; physical pathnames
#:physical-pathname-p #:sane-physical-pathname #:root-pathname
#:logical-pathname-p #:physical-pathname-p #:sane-physical-pathname #:root-pathname
;; Windows shortcut support
#:read-null-terminated-string #:read-little-endian
#:parse-file-location-info #:parse-windows-shortcut
......
(defpackage :test-asdf-system
(:use :cl :asdf :asdf/driver))
(in-package :test-asdf-system)
(defsystem :test-asdf/test9-1
:version "1.1"
:components ((:file "file2"))
:depends-on ((:version :test-asdf/test9-2 "2.0")))
(defsystem :test-asdf/test9-2
:version "1.0"
:components ((:file "file1")))
(defsystem :test-asdf/test9-3
:depends-on ((:version :test-asdf/test9-2 "1.0")))
......@@ -4,10 +4,24 @@
#+gcl (trace load compile-file asdf:perform asdf::perform-plan)
(with-test ()
(setf asdf:*central-registry* (list (asdf::subpathname *test-directory* "xach-foo-1/")))
(asdf:load-system "foo")
(assert (symbol-value (find-symbol (string :loaded) :first-version)))
(setf asdf:*central-registry* (list (asdf::subpathname *test-directory* "xach-foo-2/")))
(asdf:load-system "foo")
(assert (symbol-value (find-symbol (string :loaded) :second-version)))
(assert (eql 42 (funcall (find-symbol (string :wtf) :second-version)))))
(let ((foo :test-asdf-location-change))
(DBG "load foo. Should load from xach-foo-1/")
(setf *central-registry* (list (subpathname *test-directory* "xach-foo-1/")))
(load-system foo)
(let ((foo1 (find-system foo))
(loaded (find-symbol* :loaded :first-version)))
(assert-equal (symbol-value loaded) t)
(DBG "load foo again. Should not do anything -- already loaded")
(setf (symbol-value loaded) :test-that-we-dont-reload)
(load-system foo)
(assert-equal (symbol-value loaded) :test-that-we-dont-reload)
(assert (not (find-package :second-version)))
(DBG "Now, change registry so foo is found from xach-foo-2/")
(setf *central-registry* (list (subpathname *test-directory* "xach-foo-2/")))
(DBG "load foo yet again. It should see the pathname has changed and load it anew")
(load-system foo)
(let ((foo2 (find-system foo)))
(assert (eq foo1 foo2)) ;; the object should be the same
(assert (symbol-value (find-symbol* :loaded :second-version)))
(assert-equal 42 (symbol-call :second-version :wtf))))))
......@@ -6,16 +6,11 @@
(load-asdf)
(with-test ()
(setf asdf:*central-registry* nil)
(load (merge-pathnames "test9-1.asd"))
(load (merge-pathnames "test9-2.asd"))
(handler-case
(asdf:oos 'asdf:load-op 'test9-1)
(asdf:missing-component-of-version (c)
(format t "got missing-component-of-version as expected: - ~%~A~%" c))
(:no-error (c)
(declare (ignore c))
(error "should have failed, oops"))))
(handler-case
(load-test-system :test-asdf/test9-1)
(asdf:missing-component-of-version (c)
(format t "got missing-component-of-version as expected: - ~%~A~%" c))
(:no-error (c)
(declare (ignore c))
(error "should have failed, oops")))
(load-test-system :test-asdf/test9-3)) ; positive case, to make sure.
;;;; foo.asd
(asdf:defsystem #:foo
(asdf:defsystem #:test-asdf-location-change
:serial t
:components ((:file "a")))
;;;; foo.asd
(asdf:defsystem #:foo
(asdf:defsystem #:test-asdf-location-change
:serial t
:components ((:file "a")
(:file "b")))
......@@ -45,7 +45,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.107")
(asdf-version "2.26.108")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment