From e8f02dea90888ad50f7dfb0c3a92c556387ea235 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sun, 9 Jun 2013 12:18:45 -0400 Subject: [PATCH] 3.0.1.5: Move TRAVERSE to backward-interface. Tweak convenience method generation. --- action.lisp | 25 ++++---- asdf.asd | 2 +- backward-interface.lisp | 18 +++++- header.lisp | 2 +- interface.lisp | 3 +- operate.lisp | 2 +- plan.lisp | 16 +---- test/test-asdf.script | 2 +- test/test-module-excessive-depend.script | 4 +- test/test-nested-components-1.asd | 13 ---- test/test-nested-components.script | 76 ++++++------------------ upgrade.lisp | 4 +- version.lisp-expr | 2 +- 13 files changed, 58 insertions(+), 111 deletions(-) diff --git a/action.lisp b/action.lisp index 0c975f7e..311c3f40 100644 --- a/action.lisp +++ b/action.lisp @@ -44,16 +44,20 @@ (keyp (equal (last formals) '(&key))) (formals-no-key (if keyp (butlast formals) formals)) (len (length formals-no-key)) - (prefix (subseq formals 0 (- len 2))) - (operation (nth (- len 2) formals)) - (component (nth (- len 1) formals)) + (operation 'operation) + (component 'component) + (opix (position operation formals)) + (coix (position component formals)) + (prefix (subseq formals 0 opix)) + (suffix (subseq formals (1+ coix) len)) (more-args (when keyp `(&rest ,rest &key &allow-other-keys)))) + (assert (and (integerp opix) (integerp coix) (= coix (1+ opix)))) (flet ((next-method (o c) (if keyp - `(apply ',function ,@prefix ,o ,c ,rest) - `(,function ,@prefix ,o ,c)))) + `(apply ',function ,@prefix ,o ,c ,@suffix ,rest) + `(,function ,@prefix ,o ,c ,@suffix)))) `(progn - (defmethod ,function (,@prefix (,operation symbol) ,component ,@more-args) + (defmethod ,function (,@prefix (,operation symbol) component ,@suffix ,@more-args) (if ,operation ,(next-method (if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck. @@ -61,14 +65,13 @@ `(make-operation ,operation)) `(or (find-component () ,component) ,if-no-component)) ,if-no-operation)) - (defmethod ,function (,@prefix (,operation operation) ,component ,@more-args) + (defmethod ,function (,@prefix (,operation operation) ,component ,@suffix ,@more-args) (if (typep ,component 'component) (error "No defined method for ~S on ~/asdf-action:format-action/" ',function (cons ,operation ,component)) - (let ((,found (find-component () ,component))) - (if ,found - ,(next-method operation found) - ,if-no-component))))))))) + (if-let (,found (find-component () ,component)) + ,(next-method operation found) + ,if-no-component)))))))) ;;;; self-description diff --git a/asdf.asd b/asdf.asd index 67b445cb..f363af23 100644 --- a/asdf.asd +++ b/asdf.asd @@ -74,7 +74,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.0.1.4" ;; to be automatically updated by make bump-version + :version "3.0.1.5" ;; 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. diff --git a/backward-interface.lisp b/backward-interface.lisp index 98d94a3c..6ecf0147 100644 --- a/backward-interface.lisp +++ b/backward-interface.lisp @@ -5,11 +5,11 @@ (:recycle :asdf/backward-interface :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/operation :asdf/action - :asdf/lisp-action :asdf/operate :asdf/output-translations) + :asdf/lisp-action :asdf/plan :asdf/operate :asdf/output-translations) (:export #:*asdf-verbose* #:operation-error #:compile-error #:compile-failed #:compile-warned - #:error-component #:error-operation + #:error-component #:error-operation #:traverse #:component-load-dependencies #:enable-asdf-binary-locations-compatibility #:operation-forced @@ -62,7 +62,19 @@ We recommend you use ASDF:SYSTEM-SOURCE-FILE instead for a mostly compatible replacement that we're supporting, or even ASDF:SYSTEM-SOURCE-DIRECTORY or ASDF:SYSTEM-RELATIVE-PATHNAME if that's whay you mean." ;;) - (system-source-file x))) + (system-source-file x)) + + (defgeneric* (traverse) (operation component &key &allow-other-keys) + (:documentation + "Generate and return a plan for performing OPERATION on COMPONENT. + +The plan returned is a list of dotted-pairs. Each pair is the CONS +of ASDF operation object and a COMPONENT object. The pairs will be +processed in order by OPERATE.")) + (define-convenience-action-methods traverse (operation component &key)) + + (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys) + (plan-actions (apply 'make-plan plan-class o c keys)))) ;;;; ASDF-Binary-Locations compatibility diff --git a/header.lisp b/header.lisp index 2b59d8f6..f6e001c7 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 3.0.1.4: Another System Definition Facility. +;;; This is ASDF 3.0.1.5: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/interface.lisp b/interface.lisp index 61f404cd..7fb3afd2 100644 --- a/interface.lisp +++ b/interface.lisp @@ -19,7 +19,7 @@ ;; TODO: automatically generate interface with reexport? (:export #:defsystem #:find-system #:locate-system #:coerce-name - #:oos #:operate #:traverse #:perform-plan #:sequential-plan + #:oos #:operate #:make-plan #:perform-plan #:sequential-plan #:system-definition-pathname #:with-system-definitions #:search-for-system-definition #:find-component #:component-find-path #:compile-system #:load-system #:load-systems @@ -75,6 +75,7 @@ #:module-components ; backward-compatibility #:operation-on-warnings #:operation-on-failure ; backward-compatibility #:component-property ; backward-compatibility + #:traverse ; backward-compatibility #:system-description #:system-long-description diff --git a/operate.lisp b/operate.lisp index 8bd54ea8..09be3924 100644 --- a/operate.lisp +++ b/operate.lisp @@ -89,7 +89,7 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: &rest keys &key plan-class &allow-other-keys) (let ((plan (apply 'make-plan plan-class operation component keys))) (apply 'perform-plan plan keys) - (values operation (plan-actions plan) plan))) + (values operation plan))) (defun oos (operation component &rest args &key &allow-other-keys) (apply 'operate operation component args)) diff --git a/plan.lisp b/plan.lisp index 7b7caa75..cf6c915b 100644 --- a/plan.lisp +++ b/plan.lisp @@ -20,7 +20,7 @@ #:visit-dependencies #:compute-action-stamp #:traverse-action #:circular-dependency #:circular-dependency-actions #:call-while-visiting-action #:while-visiting-action - #:make-plan #:traverse #:plan-actions #:perform-plan #:plan-operates-on-p + #:make-plan #:plan-actions #:perform-plan #:plan-operates-on-p #:planned-p #:index #:forced #:forced-not #:total-action-count #:planned-action-count #:planned-output-action-count #:visited-actions #:visiting-action-set #:visiting-action-list #:plan-actions-r @@ -365,15 +365,6 @@ the action of OPERATION on COMPONENT in the PLAN")) "Generate and return a plan for performing OPERATION on COMPONENT.")) (define-convenience-action-methods make-plan (plan-class operation component &key)) - (defgeneric* (traverse) (operation component &key &allow-other-keys) - (:documentation - "Generate and return a plan for performing OPERATION on COMPONENT. - -The plan returned is a list of dotted-pairs. Each pair is the CONS -of ASDF operation object and a COMPONENT object. The pairs will be -processed in order by OPERATE.")) - (define-convenience-action-methods traverse (operation component &key)) - (defgeneric perform-plan (plan &key)) (defgeneric plan-operates-on-p (plan component)) @@ -386,9 +377,6 @@ processed in order by OPERATE.")) (traverse-action plan o c t) plan)) - (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys) - (plan-actions (apply 'make-plan plan-class o c keys))) - (defmethod perform-plan :around ((plan t) &key) (let ((*package* *package*) (*readtable* *readtable*)) @@ -436,7 +424,7 @@ processed in order by OPERATE.")) (traverse-action plan o c t)) (plan-actions plan))) - (define-convenience-action-methods traverse-sub-actions (o c &key)) + (define-convenience-action-methods traverse-sub-actions (operation component &key)) (defmethod traverse-sub-actions ((operation operation) (component component) &rest keys &key &allow-other-keys) (apply 'traverse-actions (direct-dependencies operation component) :system (component-system component) keys)) diff --git a/test/test-asdf.script b/test/test-asdf.script index f5cd6e1a..5c64500c 100644 --- a/test/test-asdf.script +++ b/test/test-asdf.script @@ -1,6 +1,6 @@ (load-system "test-asdf/test-module-depend") -(defparameter *plan* (traverse 'load-op "test-asdf/test-module-depend")) +(defparameter *plan* (make-plan () 'load-op "test-asdf/test-module-depend")) (DBG :foo *plan* (component-depends-on 'compile-op '("test-asdf/test-module-depend" "quux" "file3mod" "file3")) (asdf::component-if-feature (find-component "test-asdf/test-module-depend" '("quux" "file3mod" "file3")))) diff --git a/test/test-module-excessive-depend.script b/test/test-module-excessive-depend.script index 1a71858f..5976ef74 100644 --- a/test/test-module-excessive-depend.script +++ b/test/test-module-excessive-depend.script @@ -1,7 +1,5 @@ ;;; -*- Lisp -*- - - ;;;--------------------------------------------------------------------------- ;;; Here's what we are trying to test. Let us say we have a system X that ;;; contains a file, "file1" and a module, "quux" that depends on file 1. In @@ -76,7 +74,7 @@ #|(format t "~%Operation plan is:~%")(pprint plan)(terpri)|# (when (loop :for (o . c) :in plan :thereis (and (eq c file3c) (typep o 'asdf:compile-op))) (error "Excessive operations on file3-only system. Bad propagation of dependencies.")) -(asdf:operate 'asdf:load-op 'test-module-excessive-depend) +(operate 'load-op 'test-module-excessive-depend) (assert (>= (file-write-date file1) before)) (assert (>= (file-write-date file2) before)) (unless (= (file-write-date file3) diff --git a/test/test-nested-components-1.asd b/test/test-nested-components-1.asd index 79a8df3e..d0930b0d 100644 --- a/test/test-nested-components-1.asd +++ b/test/test-nested-components-1.asd @@ -1,12 +1,5 @@ ;;; -*- Mode: common-lisp; Syntax: Common-Lisp; -*- -(in-package :common-lisp-user) - -(defpackage #:test-nested-components.system - (:use #:common-lisp #:asdf)) - -(in-package :test-nested-components.system) - (defsystem test-nested-components-a :components ((:module "nested-components" @@ -27,9 +20,3 @@ :pathname "preflight-checks" :components ((:file "preflight"))) - -#| -newer traverse always fails -older traverse fails when db-agraph-preflight is evaluated, ok - when loaded or compiled -|# diff --git a/test/test-nested-components.script b/test/test-nested-components.script index 933fd9e7..fc793c90 100644 --- a/test/test-nested-components.script +++ b/test/test-nested-components.script @@ -2,66 +2,24 @@ ;;; check that added nesting via modules doesn't confuse ASDF - - - -(progn - (setf asdf:*central-registry* nil) - (load "test-nested-components-1.asd") - (print - (list - :a - (asdf::traverse (make-instance 'asdf:compile-op) - (asdf:find-system 'test-nested-components-a)) - (asdf::traverse (make-instance 'asdf:compile-op) - (asdf:find-system 'test-nested-components-b)) - :x - (asdf::traverse (make-instance 'asdf:compile-op) - (asdf:find-system 'db-agraph-preflight)) - (asdf::traverse (make-instance 'asdf:compile-op) - (asdf:find-system 'db-agraph-preflight-2)) - )) - -#| - - (asdf:oos 'asdf:compile-op 'test-nested-components-a) - (asdf:oos 'asdf:compile-op 'test-nested-components-b) - - (print - (list - (asdf::traverse (make-instance 'asdf:load-op) - (asdf:find-system 'test-nested-components-a)) - (asdf::traverse (make-instance 'asdf:load-op) - (asdf:find-system 'test-nested-components-b)))) - -|# - -) - - - - +(setf *central-registry* nil) +(load "test-nested-components-1.asd") + +(print + (list + :a + (traverse 'compile-op 'test-nested-components-a) + (traverse 'compile-op 'test-nested-components-b) + :x + (traverse 'compile-op 'db-agraph-preflight) + (traverse 'compile-op 'db-agraph-preflight-2))) #| -(((#<ASDF:COMPILE-OP NIL {11DEB619}> - . #<ASDF:CL-SOURCE-FILE "preflight" {11B7B951}>) - (#<ASDF:COMPILE-OP NIL {11DEB619}> - . #<ASDF:MODULE "preflight-checks" {11B799A9}>) - (#<ASDF:COMPILE-OP NIL {11DEB619}> - . #<ASDF:SYSTEM "test-nested-components-a" {11AEDD59}>) - (#<ASDF:LOAD-OP NIL {11D04FE9}> - . #<ASDF:CL-SOURCE-FILE "preflight" {11B7B951}>) - (#<ASDF:LOAD-OP NIL {11D04FE9}> - . #<ASDF:MODULE "preflight-checks" {11B799A9}>) - (#<ASDF:LOAD-OP NIL {11D04FE9}> - . #<ASDF:SYSTEM "test-nested-components-a" {11AEDD59}>)) +(oos 'compile-op 'test-nested-components-a) +(oos 'compile-op 'test-nested-components-b) - ((#<ASDF:COMPILE-OP NIL {11E4D9B1}> - . #<ASDF:CL-SOURCE-FILE "preflight" {11C94B89}>) - (#<ASDF:COMPILE-OP NIL {11E4D9B1}> - . #<ASDF:SYSTEM "test-nested-components-b" {11C92819}>) - (#<ASDF:LOAD-OP NIL {11E4A911}> - . #<ASDF:CL-SOURCE-FILE "preflight" {11C94B89}>) - (#<ASDF:LOAD-OP NIL {11E4A911}> - . #<ASDF:SYSTEM "test-nested-components-b" {11C92819}>))) +(print + (list + (traverse 'load-op 'test-nested-components-a) + (traverse 'load-op 'test-nested-components-b))) |# diff --git a/upgrade.lisp b/upgrade.lisp index 700746f9..cc679491 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.0.1.4") + (asdf-version "3.0.1.5") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -70,7 +70,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO #:find-component ;; find-component #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action #:component-depends-on #:operation-done-p #:component-depends-on - #:traverse ;; plan + #:traverse ;; backward-interface #:operate ;; operate #:parse-component-form ;; defsystem #:apply-output-translations ;; output-translations diff --git a/version.lisp-expr b/version.lisp-expr index b61ff923..5888e601 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"3.0.1.4" +"3.0.1.5" -- GitLab