Commit d6d44ac7 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Simplify the perform-with-restarts methods,

hoping to fix a reported double-compilation bug.
parent 3d227ef2
Loading
Loading
Loading
Loading
+1 −1
Original line number Diff line number Diff line
;;; Copyright (c) 2005 - 2007, Michael Goffioul (michael dot goffioul at swing dot be)
;;; Copyright (c) 2008, Juan Jose Garcia Ripoll
;;; Copyright (c) 2008 - 2011, Juan Jose Garcia Ripoll
;;;
;;;   This program is free software; you can redistribute it and/or
;;;   modify it under the terms of the GNU Library General Public
+1 −1
Original line number Diff line number Diff line
@@ -14,7 +14,7 @@
  :licence "MIT"
  :description "Another System Definition Facility"
  :long-description "ASDF builds Common Lisp software organized into defined systems."
  :version "2.017.6" ;; to be automatically updated by bin/bump-revision
  :version "2.017.7" ;; to be automatically updated by bin/bump-revision
  :depends-on ()
  :components
  ((:file "asdf")
+24 −48
Original line number Diff line number Diff line
;;; -*- mode: common-lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.017.6: Another System Definition Facility.
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.017.7: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
@@ -115,7 +115,7 @@
         ;; "2.345.6" would be a development version in the official upstream
         ;; "2.345.0.7" would be your seventh local modification of official release 2.345
         ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
         (asdf-version "2.017.6")
         (asdf-version "2.017.7")
         (existing-asdf (find-class 'component nil))
         (existing-version *asdf-version*)
         (already-there (equal asdf-version existing-version)))
@@ -2167,6 +2167,10 @@ recursive calls to traverse.")
  (declare (ignorable operation c))
  nil)

(defmethod perform-with-restarts (operation component)
  ;;(when *asdf-verbose* (explain operation component)) ; TOO verbose, especially as the default.
  (perform operation component))

(defmethod explain ((operation operation) (component component))
  (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%")
                (operation-description operation component)))
@@ -2193,6 +2197,13 @@ recursive calls to traverse.")
    (assert (length=n-p files 1))
    (first files)))

(defmethod perform-with-restarts ((o compile-op) (c cl-source-file))
  (loop
    (with-simple-restart
        (try-recompiling "Try recompiling ~a"
                         (component-name c))
      (return (perform o c)))))

(defmethod perform :before ((operation compile-op) (c source-file))
   (loop :for file :in (asdf:output-files operation c)
     :for pathname = (if (typep file 'logical-pathname)
@@ -2271,53 +2282,18 @@ recursive calls to traverse.")

(defclass load-op (basic-load-op) ())

(defmethod perform ((o load-op) (c cl-source-file))
  (map () #'load (input-files o c)))

(defmethod perform-with-restarts (operation component)
  ;;(when *asdf-verbose* (explain operation component)) ; TOO verbose, especially as the default.
  (perform operation component))

(defmethod perform-with-restarts ((o load-op) (c cl-source-file))
  (declare (ignorable o))
  (loop :with state = :initial
    :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-sub-operation c o c '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))))))
  (restart-case
      (perform o c)
    (try-recompiling ()
      :report (lambda (s)
                (format s "Recompile ~a and try loading it again"
                        (component-name c)))
      (perform (make-sub-operation c o c 'compile-op) c)
      (perform o c))))

(defmethod perform-with-restarts ((o compile-op) (c cl-source-file))
  (loop :with state = :initial
    :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-with-restarts o 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 ((o load-op) (c cl-source-file))
  (map () #'load (input-files o c)))

(defmethod perform ((operation load-op) (c static-file))
  (declare (ignorable operation c))