X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fasdf%2Fasdf.lisp;h=5f8a599102f5aa099a05d90afd8e8f9ec2c27568;hb=76874d05d623e0001cfcf23d2c74f78295ba6cee;hp=c8772b5af925c7618eddd5bd44330d271cfd67c8;hpb=52632e03f75694e3780851896c3d5ec251f1f46b;p=sbcl.git

diff --git a/contrib/asdf/asdf.lisp b/contrib/asdf/asdf.lisp
index c8772b5..5f8a599 100644
--- a/contrib/asdf/asdf.lisp
+++ b/contrib/asdf/asdf.lisp
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  1.75
+;;; This is asdf: Another System Definition Facility.  1.79
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -72,19 +72,31 @@
 	   
 	   #: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))
 
@@ -94,7 +106,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "1.75")
+(defvar *asdf-revision* (let* ((v "1.79")
 			       (colon (or (position #\: v) -1))
 			       (dot (position #\. v)))
 			  (and v colon dot 
@@ -106,7 +118,7 @@
 (defvar *compile-file-warnings-behaviour* :warn)
 (defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
 
-(defvar *verbose-out* *trace-output*)
+(defvar *verbose-out* nil)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; utility stuff
@@ -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
@@ -788,7 +803,7 @@ system."))
 		    :original-initargs args args))
 	 (*verbose-out*
 	  (if (getf args :verbose t)
-	      *verbose-out*
+	      *trace-output*
 	      (make-broadcast-stream)))
 	 (system (if (typep system 'component) system (find-system system)))
 	 (steps (traverse op system)))
@@ -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))))))
   
@@ -1069,3 +1099,5 @@ output to *verbose-out*.  Returns the shell's exit code."
    *central-registry*)
   
   (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*))
+
+(provide 'asdf)