Commit e8f02dea authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

3.0.1.5: Move TRAVERSE to backward-interface. Tweak convenience method generation.

parent 5f73d4d7
......@@ -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
......
......@@ -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.
......
......@@ -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
......
;;; -*- 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>.
......
......@@ -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
......
......@@ -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))
......
......@@ -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))
......
(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"))))
......
;;; -*- 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)
......
;;; -*- 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
|#
......@@ -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)))
|#
......@@ -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
......
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