-;;; This is asdf: Another System Definition Facility. 1.75
+;;; This is asdf: Another System Definition Facility. 1.77
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical
#:component-depends-on
+ #:system-description
+ #:system-long-description
+ #:system-author
+ #:system-maintainer
+ #:system-license
+
#:operation-on-warnings
#:operation-on-failure
;#:*component-parent-pathname*
+ #:*system-definition-search-functions*
#:*central-registry* ; variables
#:*compile-file-warnings-behaviour*
#:*compile-file-failure-behaviour*
+ #:*asdf-revision*
#:operation-error #:compile-failed #:compile-warned #:compile-error
#:system-definition-error
#:missing-component
#:missing-dependency
#:circular-dependency ; errors
+
+ #:retry
+ #:accept ; restarts
+
)
(:use :cl))
(in-package #:asdf)
-(defvar *asdf-revision* (let* ((v "1.75")
+(defvar *asdf-revision* (let* ((v "1.77")
(colon (or (position #\: v) -1))
(dot (position #\. v)))
(and v colon dot
(defgeneric component-property (component property))
(defmethod component-property ((c component) property)
- (cdr (assoc property (slot-value c 'properties))))
+ (cdr (assoc property (slot-value c 'properties) :test #'equal)))
(defgeneric (setf component-property) (new-value component property))
(defmethod (setf component-property) (new-value (c component) property)
- (let ((a (assoc property (slot-value c 'properties))))
+ (let ((a (assoc property (slot-value c 'properties) :test #'equal)))
(if a
(setf (cdr a) new-value)
(setf (slot-value c 'properties)
(acons property new-value (slot-value c 'properties))))))
-
-
(defclass system (module)
((description :accessor system-description :initarg :description)
- (long-description :accessor long-description :initarg :long-description)
+ (long-description
+ :accessor system-long-description :initarg :long-description)
(author :accessor system-author :initarg :author)
(maintainer :accessor system-maintainer :initarg :maintainer)
(licence :accessor system-licence :initarg :licence)))
;(declare (ignore output))
(when warnings-p
(case (operation-on-warnings operation)
- (:warn (warn "COMPILE-FILE warned while performing ~A on ~A"
- c operation))
+ (:warn (warn
+ (formatter "~@<COMPILE-FILE warned while ~
+ performing ~A on ~A.~@:>")
+ operation c))
(:error (error 'compile-warned :component c :operation operation))
(:ignore nil)))
(when failure-p
(case (operation-on-failure operation)
- (:warn (warn "COMPILE-FILE failed while performing ~A on ~A"
- c operation))
+ (:warn (warn
+ (formatter "~@<COMPILE-FILE failed while ~
+ performing ~A on ~A.~@:>")
+ operation c))
(:error (error 'compile-failed :component c :operation operation))
(:ignore nil)))
(unless output
(restart-case
(progn (perform op component)
(return))
- (retry-component ())
- (skip-component () (return))))))))
+ (retry ()
+ :report
+ (lambda (s)
+ (format s
+ (formatter "~@<Retry performing ~S on ~S.~@:>")
+ op component)))
+ (accept ()
+ :report
+ (lambda (s)
+ (format s
+ (formatter "~@<Continue, treating ~S on ~S as ~
+ having been successful.~@:>")
+ op component))
+ (setf (gethash (type-of op)
+ (component-operation-times component))
+ (get-universal-time))
+ (return))))))))
(defun oos (&rest args)
"Alias of OPERATE function"
:pathname
(or ,pathname
(pathname-sans-name+type
- (resolve-symlinks *load-truename*))
+ (resolve-symlinks *load-truename*))
*default-pathname-defaults*)
',component-options))))))