Commit 1e3471c6 authored by Robert Goldman's avatar Robert Goldman
Browse files

Enforce use of MAKE-OPERATION.

Check for and reject attempts to directly invoke MAKE-INSTANCE on
OPERATION classes.
Add a test for the error condition.
Squashed commit of the ENFORCE-MAKE-OPERATION branch.
parent 0bfc7d5f
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
(:recycle :asdf/action :asdf) (:recycle :asdf/action :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade (:use :uiop/common-lisp :uiop :asdf/upgrade
:asdf/component :asdf/system #:asdf/cache :asdf/find-system :asdf/find-component :asdf/operation) :asdf/component :asdf/system #:asdf/cache :asdf/find-system :asdf/find-component :asdf/operation)
(:import-from :asdf/operation #:check-operation-constructor)
(:export (:export
#:action #:define-convenience-action-methods #:action #:define-convenience-action-methods
#:action-description #:action-description
...@@ -232,6 +233,7 @@ dependencies."))) ...@@ -232,6 +233,7 @@ dependencies.")))
(:documentation "Error condition related to definition of incorrect OPERATION objects.")) (:documentation "Error condition related to definition of incorrect OPERATION objects."))
(defmethod initialize-instance :before ((o operation) &key) (defmethod initialize-instance :before ((o operation) &key)
(check-operation-constructor)
(unless (typep o '(or downward-operation upward-operation sideway-operation (unless (typep o '(or downward-operation upward-operation sideway-operation
selfward-operation non-propagating-operation)) selfward-operation non-propagating-operation))
(warn 'operation-definition-warning (warn 'operation-definition-warning
......
...@@ -40,6 +40,13 @@ and support for them may be discontinued at any moment. ...@@ -40,6 +40,13 @@ and support for them may be discontinued at any moment.
(unless (slot-boundp o 'original-initargs) (unless (slot-boundp o 'original-initargs)
(setf (operation-original-initargs o) initargs))) (setf (operation-original-initargs o) initargs)))
(defvar *in-make-operation* nil)
(defun check-operation-constructor ()
"Enforce that OPERATION instances must be created with MAKE-OPERATION."
(unless *in-make-operation*
(sysdef-error "OPERATION instances must only be created through MAKE-OPERATION.")))
(defmethod print-object ((o operation) stream) (defmethod print-object ((o operation) stream)
(print-unreadable-object (o stream :type t :identity nil) (print-unreadable-object (o stream :type t :identity nil)
(ignore-errors (ignore-errors
...@@ -58,7 +65,8 @@ All operation instances MUST be created through this function. ...@@ -58,7 +65,8 @@ All operation instances MUST be created through this function.
Use of INITARGS is for backward compatibility and may be discontinued at any time." Use of INITARGS is for backward compatibility and may be discontinued at any time."
(let ((class (coerce-class operation-class (let ((class (coerce-class operation-class
:package :asdf/interface :super 'operation :error 'sysdef-error))) :package :asdf/interface :super 'operation :error 'sysdef-error))
(*in-make-operation* t))
(ensure-gethash (cons class initargs) *operations* (ensure-gethash (cons class initargs) *operations*
(list* 'make-instance class initargs)))) (list* 'make-instance class initargs))))
......
...@@ -75,4 +75,8 @@ ...@@ -75,4 +75,8 @@
(operate 'trivial-operation 'test-asdf/test-module-depend) (operate 'trivial-operation 'test-asdf/test-module-depend)
;;; this test intended to catch a bug in operate :around method in operate.lisp, ;;; this test intended to catch a bug in operate :around method in operate.lisp,
;;; thanks to Jan Moringen [2014/08/10:rpg] ;;; thanks to Jan Moringen [2014/08/10:rpg]
(operate (make-instance 'trivial-operation) 'test-asdf/test-module-depend) (operate (make-operation 'trivial-operation) 'test-asdf/test-module-depend)
;;; operations should only be made by MAKE-OPERATION, and now we enforce this.
(signals system-definition-error
(make-instance 'load-op))
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