From 9ea17b5c476bc495c17f13d9280db0836c9fbbc1 Mon Sep 17 00:00:00 2001 From: Gary King <gwking@metabang.com> Date: Sat, 3 May 2008 21:51:28 +0000 Subject: [PATCH] Added around methods for perform loading and compiling cl-source-files. These add a simple-restart to retry the operation. --- asdf.lisp | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 63 insertions(+), 2 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 30acae09..482da242 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1,4 +1,4 @@ -;;; This is asdf: Another System Definition Facility. $Revision: 1.115 $ +;;; This is asdf: Another System Definition Facility. $Revision: 1.116 $ ;;; ;;; Feedback, bug reports, and patches are all welcome: please mail to ;;; <cclan-list@lists.sf.net>. But note first that the canonical @@ -116,7 +116,7 @@ (in-package #:asdf) -(defvar *asdf-revision* (let* ((v "$Revision: 1.115 $") +(defvar *asdf-revision* (let* ((v "$Revision: 1.116 $") (colon (or (position #\: v) -1)) (dot (position #\. v))) (and v colon dot @@ -797,6 +797,26 @@ the head of the tree")) #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c))) #+:broken-fasl-loader (list (component-pathname c))) +(defmethod perform :around ((o compile-op) (c cl-source-file)) + (let ((state :initial)) + (loop until (or (eq state :success) + (eq state :failure)) do + (case state + (:recompiled + (setf state :failure) + (call-next-method) + (setf state :success)) + (:failed-compile + (setf state :recompiled) + (perform (make-instance 'asdf:compile-op) c)) + (t + (with-simple-restart + (:try-recompiling "Try recompiling ~a" + (component-name c)) + (setf state :failed-compile) + (call-next-method) + (setf state :success))))))) + (defmethod perform ((operation compile-op) (c static-file)) nil) @@ -816,8 +836,49 @@ the head of the tree")) (defmethod perform ((o load-op) (c cl-source-file)) (mapcar #'load (input-files o c))) +(defmethod perform :around ((o load-op) (c cl-source-file)) + (let ((state :initial)) + (loop until (or (eq state :success) + (eq state :failure)) do + (case state + (:recompiled + (setf state :failure) + (call-next-method) + (setf state :success)) + (:failed-load + (setf state :recompiled) + (perform (make-instance 'asdf:compile-op) c)) + (t + (with-simple-restart + (:try-recompiling "Recompile ~a and try loading it again" + (component-name c)) + (setf state :failed-load) + (call-next-method) + (setf state :success))))))) + +(defmethod perform :around ((o compile-op) (c cl-source-file)) + (let ((state :initial)) + (loop until (or (eq state :success) + (eq state :failure)) do + (case state + (:recompiled + (setf state :failure) + (call-next-method) + (setf state :success)) + (:failed-compile + (setf state :recompiled) + (perform (make-instance 'asdf:compile-op) c)) + (t + (with-simple-restart + (:try-recompiling "Try recompiling ~a" + (component-name c)) + (setf state :failed-compile) + (call-next-method) + (setf state :success))))))) + (defmethod perform ((operation load-op) (c static-file)) nil) + (defmethod operation-done-p ((operation load-op) (c static-file)) t) -- GitLab