Commit 5e4e235b authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.28.4: keep registered ASDF system to avoid double-upgrade. 

Also, allow for unqualified inline-methods. Fixes lp#485393
parent 26e7a4f3

asdf.asd

+1 −1
Original line number Diff line number Diff line
@@ -74,7 +74,7 @@ 
  :licence "MIT"

  :description "Another System Definition Facility"

  :long-description "ASDF builds Common Lisp software organized into defined systems."

  :version "2.28.3" ;; to be automatically updated by make bump-version

  :version "2.28.4" ;; to be automatically updated by make bump-version

  :depends-on ()

  #+asdf3 :encoding #+asdf3 :utf-8

  ;; For most purposes, asdf itself specially counts as a builtin system.

backward-internals.lisp

+11 −6
Original line number Diff line number Diff line
@@ -28,7 +28,6 @@ 
           #'(lambda (m)

               (remove-method (symbol-function name) m))

           (component-inline-methods component)))

    ;; clear methods, then add the new ones

    (component-inline-methods component) nil)



  (defun %define-component-inline-methods (ret rest)
@@ -39,13 +38,19 @@ 
              :for value = (second data)

              :while data

              :when (eq key keyword) :do

                (destructuring-bind (op qual (o c) &body body) value

                (destructuring-bind (op qual? &rest rest) value

                  (multiple-value-bind (qual args-and-body)

                      (if (symbolp qual?)

                          (values (list qual?) rest)

                          (values nil (cons qual? rest)))

                    (destructuring-bind ((o c) &body body) args-and-body

                      (pushnew

                   (eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret)))

                       (eval `(defmethod ,name ,@qual ((,o ,op) (,c (eql ,ret)))

                                ,@body))

                   (component-inline-methods ret)))))))

                       (component-inline-methods ret)))))))))



  (defun %refresh-component-inline-methods (component rest)

    ;; clear methods, then add the new ones

    (%remove-component-inline-methods component)

    (%define-component-inline-methods component rest)))

find-system.lisp

+18 −12
Original line number Diff line number Diff line
@@ -57,18 +57,6 @@ 
    (error 'formatted-system-definition-error :format-control

           format :format-arguments arguments))



  (defvar *defined-systems* (make-hash-table :test 'equal)

    "This is a hash table whose keys are strings, being the

names of the systems, and whose values are pairs, the first

element of which is a universal-time indicating when the

system definition was last updated, and the second element

of which is a system object.")



  (defun clear-defined-systems ()

    (setf *defined-systems* (make-hash-table :test 'equal)))



  (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)



  (defun coerce-name (name)

    (typecase name

      (component (component-name name))
@@ -81,6 +69,13 @@ of which is a system object.") 
    ;; the first of the slash-separated components.

    (first (split-string (coerce-name name) :separator "/")))



  (defvar *defined-systems* (make-hash-table :test 'equal)

    "This is a hash table whose keys are strings, being the

names of the systems, and whose values are pairs, the first

element of which is a universal-time indicating when the

system definition was last updated, and the second element

of which is a system object.")



  (defun system-registered-p (name)

    (gethash (coerce-name name) *defined-systems*))
@@ -99,6 +94,17 @@ of which is a system object.") 
                      (get-file-stamp file))

                    system)))))



  (defun clear-defined-systems ()

    ;; Invalidate all systems but ASDF itself, if registered.

    (let ((asdf (cdr (system-registered-p :asdf))))

      (setf *defined-systems* (make-hash-table :test 'equal))

      (when asdf

        (setf (component-version asdf) *asdf-version*)

        (register-system asdf)))

    (values))



  (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)



  (defun clear-system (name)

    "Clear the entry for a system in the database of systems previously loaded.

Note that this does NOT in any way cause the code of the system to be unloaded."

header.lisp

+1 −1
Original line number Diff line number Diff line 
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-

;;; This is ASDF 2.28.3: Another System Definition Facility.

;;; This is ASDF 2.28.4: Another System Definition Facility.

;;;

;;; Feedback, bug reports, and patches are all welcome:

;;; please mail to <asdf-devel@common-lisp.net>.

test/test-inline-methods.script

+13 −5
Original line number Diff line number Diff line 
(defparameter *a* nil)

;;; -*- Lisp -*-



(defparameter *a* 0)



(def-test-system :foo

  :components

  ((:file "file1" :perform (load-op :before (o c)

                             (setf *a* t)

                             (format t "Method run before ~A~%" (action-description o c))))))

  ((:file "file1"

    :perform (load-op :before (o c)

                      (incf *a*)

                      (format t "Method run before ~A~%" (action-description o c))))

   (:file "file2" :depends-on ("file1")

    :perform (load-op (o c)

                      (incf *a*)

                      (format t "Method run for ~A~%" (action-description o c))

                      (call-next-method)))))



(load-system :foo)



(assert *a*)
 
(assert-equal *a* 2)