Of course, I forgot to attach the patch. Here it is.
If you think it's satisfactory, I can push.
Hopefully, the added test will convince you that it is all working.
—♯ƒ • François-René ÐVB Rideau •Reflection&Cybernethics• http://fare.tunes.org
To converse at the distance of the Indes by means of sympathetic contrivances
may be as natural to future times as to us is a literary correspondence.
— Joseph Glanvill, 1661
On Thu, Mar 13, 2014 at 7:11 PM, Faré <fah...@gmail.com> wrote:
> On Thu, Mar 13, 2014 at 4:24 PM, Robert P. Goldman <rpgold...@sift.info>
> wrote:
>> For the record, it's not that I'm objecting to the build-operation idea.
>> I'm sorry if you got that idea, and felt that you had to spend a lot of
>> time convincing me!
>>
>> My concern was a much more limited one: that the word "build" doesn't
>> properly convey what is going to happen.
>>
> Well, ASDF itself has long been described as a build system or build tool
> (including in our ILC 2010 article), just like make, ant, etc.
> See also Wikipedia pages for each of these.
> What do these programs do? They build.
> I don't love the word, but I don't know a better one.
>
>> I believe that the operation is "prepare the direct object system for me
>> to use it."
>>
> Here are some suggestion:
>
> prepare (shorthand: p)
> update (shorthand: u)
> build (shorthand: b)
> build-and-update (shorthand: bu)
> build-and-maintain (shorthand: bnm, or |bnm,|, which perfectly fits
> the asdf keyboard pattern)
> build-operation or build-op (shorthand: bo, or bop)
> default-operation (shorthand: do, shadowing cl:do, or dop)
> operate 'build-op (shorthand: op, or ob)
> operate-default (shorthand: od)
> ok (shorthand: o)
> ensure-component-is-built-and-update-current-image-for-component
> (shorthand: ecibaucifc)
>
> If we pick the latter, we have utterly failed the user.
> Actually, I already have failed the user by naming the function build-system,
> which is too long a name, and deceiving because it's not just for systems:
> you can (build-system '("system" "module" "component")) to build a
> targetted component.
> Since obviously no one is using it yet, I propose we remove it from 3.1.
>
>> I don't think "build" is the right word for this, but I am happy to see
>> some sort of "do the default operation," as long as we can come up with
>> a name that conveys the meaning to the user.
>>
>> I think "build" in its normal sense has a connotation much closer to the
>> things that bundle-op or save-image-op would do.
>>
> I don't think it's right, only that it's the rightest available so far.
>
> PS: here is a second patch on top of the former one, that makes string
> designators for operations, so that :build-operation "foo::op" works.
> Added a suitable test for defsystem-depends-on to the test suite.
> Without this feature, build-op is much less useful.
>
> —♯ƒ • François-René ÐVB Rideau •Reflection&Cybernethics• http://fare.tunes.org
> The Party will yield power when and only when it is in the best interest of
> its members. Don't fight the Party: buy It with the profits of Liberty.
From 64c4cb5134d61d9640ff3e37118cc059ff033089 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tu...@google.com>
Date: Thu, 13 Mar 2014 18:55:17 -0400
Subject: [PATCH 2/2] Accept strings as OPERATION class designators, read in
package ASDF. Refactor COMPONENT class designators to use the same general
method. As a substrate, goodbye uiop/utility:find-class*, hello
uiop/utility:coerce-class.
In the operate upgrade handler, assume there is
no uninterning and renaming packages away anymore going forward.
Add tests for strings as class designators using defsystem-depends-on.
---
action.lisp | 5 ++++-
asdf.asd | 2 +-
operate.lisp | 28 +++++++++++++---------------
operation.lisp | 10 +++++++---
parse-defsystem.lisp | 24 ++++++++----------------
test/l-file.lisp | 10 ++++++++++
test/l-operation.lisp | 12 ++++++++++++
test/test-defsystem-depends-on.script | 30 ++++++++++++++++++++++++++++++
test/test-extension.l | 0
uiop/utility.lisp | 30 +++++++++++++++++++++++++-----
10 files changed, 110 insertions(+), 41 deletions(-)
create mode 100644 test/l-file.lisp
create mode 100644 test/l-operation.lisp
create mode 100644 test/test-defsystem-depends-on.script
create mode 100644 test/test-extension.l
diff --git a/action.lisp b/action.lisp
index 93da2ee..76106f8 100644
--- a/action.lisp
+++ b/action.lisp
@@ -66,7 +66,10 @@
`(apply ',function ,@prefix ,o ,c ,@suffix ,rest)
`(,function ,@prefix ,o ,c ,@suffix))))
`(progn
- (defmethod ,function (,@prefix (,operation symbol) component ,@suffix ,@more-args)
+ (defmethod ,function (,@prefix (,operation string) ,component ,@suffix ,@more-args)
+ (let ((,component (find-component () ,component))) ;; do it first, for defsystem-depends-on
+ ,(next-method `(safe-read-from-string ,operation :package :asdf/interface) component)))
+ (defmethod ,function (,@prefix (,operation symbol) ,component ,@suffix ,@more-args)
(if ,operation
,(next-method
(if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck.
diff --git a/asdf.asd b/asdf.asd
index 5e3ca5e..9bd9977 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -49,7 +49,7 @@
(:file "cache" :depends-on ("upgrade"))
(:file "find-system" :depends-on ("system" "cache"))
(:file "find-component" :depends-on ("find-system"))
- (:file "operation" :depends-on ("upgrade"))
+ (:file "operation" :depends-on ("find-system"))
(:file "action" :depends-on ("find-component" "operation"))
(:file "lisp-action" :depends-on ("action"))
(:file "plan" :depends-on ("lisp-action"))
diff --git a/operate.lisp b/operate.lisp
index 1fc00a5..5aa4692 100644
--- a/operate.lisp
+++ b/operate.lisp
@@ -55,11 +55,13 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(on-failure *compile-file-failure-behaviour*) &allow-other-keys)
(let* ((systems-being-operated *systems-being-operated*)
(*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal)))
- (operation-name (reify-symbol (etypecase operation
- (operation (type-of operation))
- (symbol operation))))
- (operation-initargs (operation-original-initargs operation))
- (component-path (typecase component
+ (operation-remaker ;; how to remake the operation after ASDF was upgraded (if it was)
+ (etypecase operation
+ (operation (let ((name (type-of operation))
+ (initargs (operation-original-initargs operation)))
+ #'(lambda () (make-operation name :original-initargs initargs initargs))))
+ ((or symbol string) (constantly operation))))
+ (component-path (typecase component ;; to remake the component after ASDF upgrade
(component (component-find-path component))
(t component))))
;; Before we operate on any system, make sure ASDF is up-to-date,
@@ -69,11 +71,7 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
;; If we were upgraded, restart OPERATE the hardest of ways, for
;; its function may have been redefined, its symbol uninterned, its package deleted.
(return-from operate
- (apply (find-symbol* 'operate :asdf)
- (apply (find-symbol* 'make-operation :asdf)
- (unreify-symbol operation-name)
- :original-initargs operation-initargs operation-initargs)
- component-path keys))))
+ (apply 'operate (funcall operation-remaker) component-path keys))))
;; Setup proper bindings around any operate call.
(with-system-definitions ()
(let* ((*verbose-out* (and verbose *standard-output*))
@@ -114,15 +112,15 @@ for how to load or compile stuff")
(defclass build-op (non-propagating-operation) ()
(:documentation "Since ASDF3, BUILD-OP is the recommended 'master' operation,
-to operate by default on a system or component.
-Its meaning is configurable via the :BUILD-OPERATION option of a component,
-which is typically the name of a specific operation to which to delegate the build,
-and may be NIL, which designates the *LOAD-SYSTEM-OPERATION*
+to operate by default on a system or component, via the function BUILD.
+Its meaning is configurable via the :BUILD-OPERATION option of a component.
+which typically specifies the name of a specific operation to which to delegate the build,
+as a symbol or as a string later read as a symbol (after loading the defsystem-depends-on);
+if NIL is specified (the default), BUILD-OP falls back to the *LOAD-SYSTEM-OPERATION*
that will load the system in the current image, and its typically LOAD-OP."))
(defmethod component-depends-on ((o build-op) (c component))
`((,(or (component-build-operation c) *load-system-operation*) ,c)))
-
(defun build (system &rest keys)
"The recommended way to interact with ASDF3.1 is via (ASDF:BUILD :FOO).
It will build system FOO using the operation BUILD-OP,
diff --git a/operation.lisp b/operation.lisp
index 9521bcc..a192a95 100644
--- a/operation.lisp
+++ b/operation.lisp
@@ -3,7 +3,7 @@
(uiop/package:define-package :asdf/operation
(:recycle :asdf/operation :asdf/action :asdf) ;; asdf/action for FEATURE pre 2.31.5.
- (:use :uiop/common-lisp :uiop :asdf/upgrade)
+ (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system)
(:export
#:operation
#:operation-original-initargs #:original-initargs ;; backward-compatibility only. DO NOT USE.
@@ -42,8 +42,10 @@
(defparameter* *operations* (make-hash-table :test 'equal))
(defun make-operation (operation-class &rest initargs)
- (ensure-gethash (cons operation-class initargs) *operations*
- (list* 'make-instance operation-class initargs)))
+ (let ((class (coerce-class operation-class
+ :package :asdf/interface :super 'operation :error 'sysdef-error)))
+ (ensure-gethash (cons class initargs) *operations*
+ (list* 'make-instance class initargs))))
(defgeneric find-operation (context spec)
(:documentation "Find an operation by resolving the SPEC in the CONTEXT"))
@@ -52,6 +54,8 @@
(defmethod find-operation (context (spec symbol))
(when spec ;; NIL designates itself, i.e. absence of operation
(apply 'make-operation spec (operation-original-initargs context))))
+ (defmethod find-operation (context (spec string))
+ (apply 'make-operation spec (operation-original-initargs context)))
(defmethod operation-original-initargs ((context symbol))
(declare (ignorable context))
nil))
diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp
index 2cf2b02..fed65fa 100644
--- a/parse-defsystem.lisp
+++ b/parse-defsystem.lisp
@@ -48,22 +48,14 @@
(defvar *default-component-class* 'cl-source-file)
(defun class-for-type (parent type)
- (or (loop :for symbol :in (list
- type
- (find-symbol* type *package* nil)
- (find-symbol* type :asdf/interface nil)
- (and (stringp type) (safe-read-from-string type :package :asdf/interface)))
- :for class = (and symbol (symbolp symbol) (find-class* symbol nil))
- :when (and class
- (#-cormanlisp subtypep #+cormanlisp cl::subclassp
- class (find-class* 'component)))
- :return class)
- (and (eq type :file)
- (find-class*
- (or (loop :for p = parent :then (component-parent p) :while p
- :thereis (module-default-component-class p))
- *default-component-class*) nil))
- (sysdef-error "don't recognize component type ~A" type))))
+ (or (coerce-class type :package :asdf/interface :super 'component :error nil)
+ (and (eq type :file)
+ (coerce-class
+ (or (loop :for p = parent :then (component-parent p) :while p
+ :thereis (module-default-component-class p))
+ *default-component-class*)
+ :package :asdf/interface :super 'component :error nil))
+ (sysdef-error "don't recognize component type ~S" type))))
;;; Check inputs
diff --git a/test/l-file.lisp b/test/l-file.lisp
new file mode 100644
index 0000000..2e39c99
--- /dev/null
+++ b/test/l-file.lisp
@@ -0,0 +1,10 @@
+(defpackage :l-file
+ (:use :asdf :uiop :cl) ;; asdf/package-system dependencies
+ (:export #:cl-source-file.l))
+
+(in-package :l-file)
+
+(defclass cl-source-file.l (cl-source-file)
+ ((type :initform "l")))
+
+(defclass asdf::cl-source-file.l (cl-source-file.cl) ())
diff --git a/test/l-operation.lisp b/test/l-operation.lisp
new file mode 100644
index 0000000..b901756
--- /dev/null
+++ b/test/l-operation.lisp
@@ -0,0 +1,12 @@
+(cl:defpackage :l-operation
+ (:use :asdf :uiop :cl) ;; asdf/package-system dependencies
+ (:export #:op #:*x*))
+
+(cl:in-package :l-operation)
+
+(defparameter *x* 0)
+
+(defclass op (load-op) ())
+
+(defmethod perform :after ((o op) (c t))
+ (incf *x*))
diff --git a/test/test-defsystem-depends-on.script b/test/test-defsystem-depends-on.script
new file mode 100644
index 0000000..9a60ad9
--- /dev/null
+++ b/test/test-defsystem-depends-on.script
@@ -0,0 +1,30 @@
+;;-*- Lisp -*-
+
+(def-test-system test-defsystem-depends-on-1
+ :defsystem-depends-on (test-asdf/l-file)
+ :default-component-class "l-file:cl-source-file.l"
+ :components
+ ((:cl-source-file.l "file1" :type "lisp")
+ (:cl-source-file "file2" :depends-on ("file1"))
+ (:file "test-extension")))
+
+(load-system :test-defsystem-depends-on-1)
+
+(def-test-system test-defsystem-depends-on-2
+ :defsystem-depends-on (test-asdf/l-operation)
+ :build-operation "l-operation:op"
+ :components
+ ((:file "file3")))
+
+(assert-equal 0 l-operation:*x*)
+
+(build :test-defsystem-depends-on-2)
+
+(assert-equal 2 l-operation:*x*) ;; perform called twice, on file and on system.
+
+(def-test-system test-defsystem-depends-on-3
+ :defsystem-depends-on (test-asdf/l-operation)
+ :build-operation "does-not-exist"
+ :components ((:file "file3")))
+
+(signals asdf::formatted-system-definition-error (build :test-defsystem-depends-on-3))
diff --git a/test/test-extension.l b/test/test-extension.l
new file mode 100644
index 0000000..e69de29
diff --git a/uiop/utility.lisp b/uiop/utility.lisp
index 230c0c7..c8fa387 100644
--- a/uiop/utility.lisp
+++ b/uiop/utility.lisp
@@ -24,7 +24,7 @@
#:base-string-p #:strings-common-element-type #:reduce/strcat #:strcat ;; strings
#:first-char #:last-char #:split-string #:stripln #:+cr+ #:+lf+ #:+crlf+
#:string-prefix-p #:string-enclosed-p #:string-suffix-p
- #:find-class* ;; CLOS
+ #:coerce-class ;; CLOS
#:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps
#:earlier-stamp #:stamps-earliest #:earliest-stamp
#:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f
@@ -333,10 +333,30 @@ the two results passed to STRCAT always reconstitute the original string"
;;; CLOS
(with-upgradability ()
- (defun find-class* (x &optional (errorp t) environment)
- (etypecase x
- ((or standard-class built-in-class) x)
- (symbol (find-class x errorp environment)))))
+ (defun coerce-class (class &key (package :cl) (super t) (error 'error))
+ "Coerce CLASS to a class that is subclass of SUPER if specified,
+or invoke ERROR handler as per CALL-FUNCTION.
+
+A keyword designates the name a symbol, which when found in PACKAGE, designates a class.
+A string is read as a symbol while in PACKAGE, the symbol designates a class.
+
+A class object designates itself.
+NIL designates itself (no class).
+A symbol otherwise designates a class by name."
+ (let* ((normalized
+ (typecase class
+ (keyword (find-symbol* class package nil))
+ (string (symbol-call :uiop :safe-read-from-string class :package package))
+ (t class)))
+ (found
+ (etypecase normalized
+ ((or standard-class built-in-class) normalized)
+ ((or null keyword) nil)
+ (symbol (find-class normalized nil nil)))))
+ (or (and found
+ (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super))
+ found)
+ (call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super)))))
;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity
--
1.9.0.279.gdc9e3eb
