0.8.1.42:
authorChristophe Rhodes <csr21@cam.ac.uk>
Fri, 18 Jul 2003 13:36:39 +0000 (13:36 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Fri, 18 Jul 2003 13:36:39 +0000 (13:36 +0000)
Update to upstream asdf
... now with better restarts and less nonsensical warning texts

contrib/asdf/asdf.lisp
version.lisp-expr

index c8772b5..dc8ff7c 100644 (file)
@@ -1,4 +1,4 @@
-;;; 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 
@@ -251,22 +263,21 @@ and NIL NAME and TYPE components"
 (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)))
@@ -702,14 +713,18 @@ system."))
       ;(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
@@ -798,8 +813,23 @@ system."))
             (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"
@@ -841,7 +871,7 @@ system."))
                                   :pathname
                                   (or ,pathname
                                       (pathname-sans-name+type
-                                       (resolve-symlinks *load-truename*))
+                                       (resolve-symlinks  *load-truename*))
                                       *default-pathname-defaults*)
                                   ',component-options))))))
   
index 73fafe4..6ad7cb7 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.1.41"
+"0.8.1.42"