Changeset 15384

Timestamp:

09/26/20 07:32:04 (3 years ago)

Author:

Mark Evenson

Message:

quicklisp-abcl: remove all Quicklisp fasls on failure

Emit more verbosity to the stream designated by CL:*LOAD-VERBOSE*.

TODO: find a reproducible failing test case to ensure we have fixed
this.

Location:

trunk/abcl/contrib/quicklisp

Files:

• quicklisp-abcl.asd (modified) (1 diff)
• quicklisp-abcl.lisp (modified) (2 diffs)

trunk/abcl/contrib/quicklisp/quicklisp-abcl.asd

@@ -1 +1 @@
 ;;;; -*- Mode: LISP -*-
 (defsystem quicklisp-abcl
-  :description "Load Quicklisp from the network if it isn't already installed."
-  :long-name "<urn:abcl.org/release/1.5.0/contrib/quicklisp-abcl#>"
-  :version "0.5.1"
-  :components ((:file "quicklisp-abcl")))
+  :description "Load Quicklisp, installing from network if necessary."
+  :long-name "<urn:abcl.org/release/1.8.0/contrib/quicklisp-abcl#>"
+  :version "0.6.0"
+  :components ((:file "quicklisp-abcl"))
+  :perform (load-op :after (o c)
+             (uiop:symbol-call :quicklisp-abcl 'ensure-installation)))
+
+
 
 

trunk/abcl/contrib/quicklisp/quicklisp-abcl.lisp

@@ -5 +5 @@
   (:use :cl
         :asdf)
-  (:export :*quicklisp-parent-dir*))
+  (:export
+   #:quicklisp/boot/fasls
+   #:ensure-installation
+   #:*quicklisp-parent-dir*))
 
 (in-package :quicklisp-abcl)
+
+;;;;
+;;;;  1. (ABCL) Download setup.lisp if necessary from the network,
+;;;;     running the Quicklisp setup routine 
+;;;;
+;;;;  2.  Ensure that we cache the and use the fasl for
+;;;;        (merge-pathnames "setup.lisp" *quicklisp-parent-dir*
+;;;;
 
 (defvar *quicklisp-parent-dir* (user-homedir-pathname)
   "Pathname reference to the parent directory of the local Quicklisp installation")
 
-(defmethod asdf:perform ((o asdf:load-op) (c (eql (asdf:find-system :quicklisp-abcl))))
+(defun quicklisp/boot/fasls (&key (remove nil))
+  "Enumerate all Quicklisp fasls, including the one we shim for the loader"
+  ;;; TODO: ensure that this works for other implementations
+    (let* ((setup-base
+             (merge-pathnames "quicklisp/setup" *quicklisp-parent-dir*))
+           (setup-source
+             (make-pathname :defaults setup-base :type "lisp"))
+           (setup-fasl
+             (make-pathname :defaults setup-base :type "abcl"))
+           (asdf-output-root
+             (when (ignore-errors (asdf:find-system :quicklisp))
+               (asdf:apply-output-translations
+                (asdf:system-source-directory (asdf:find-system :quicklisp))))))
+      (let ((all-fasls (list setup-fasl
+                             (when asdf-output-root
+                               (directory 
+                                (merge-pathnames "**/*" asdf-output-root))))))
+        (when remove
+          (format *load-verbose* "~&;;quicklisp-abcl: deleting ~{~a ~}~%" all-fasls)
+          (mapcar #'delete-file all-fasls))
+        (values all-fasls
+                setup-base setup-source setup-fasl))))
+
+;;; After we have loaded this system, ensure Quicklisp is loaded
+(defun ensure-installation ()
   (when (find :quicklisp *features*)
-    (return-from asdf:perform))
-  (let* ((setup-base
-          (merge-pathnames "quicklisp/setup" 
-                           *quicklisp-parent-dir*))
-         (setup-source
-          (probe-file (make-pathname :defaults setup-base
-                                     :type "lisp")))
-         (setup-fasl
-          (probe-file (make-pathname :defaults setup-base
-                                     :type "abcl"))))
-    (if setup-source
-           ;;; First try loading the Quicklisp setup as a compiled fasl if it exists
-        (if setup-fasl
+    (return-from ensure-installation))
+  (multiple-value-bind (fasls
+                        setup-base setup-source setup-fasl)
+      (quicklisp/boot/fasls)
+    (if (probe-file setup-source)
+        ;; First try loading the Quicklisp setup as a compiled fasl if it exists
+        (if (probe-file setup-fasl)
             (handler-case
                 (load setup-fasl)
               ;; The fasl may be invalid (i.e. between abcl versions); if so, load source, and recompile
               (error (e)
-                (declare (ignore e))
+                (format *load-verbose* "~&Failed to load Quicklisp setup fasl ~%~t~a~%because:~%~t~a~%" setup-fasl e)
                 (when setup-source
+                  (format *load-verbose* "Removing Quicklisp setup fasl and recompiling...")
+                  (quicklisp/boot/fasls :remove t)
                   (load setup-source)
-                  (compile-file setup-source))))
-            ;; compilation only succeeds after QUICKLISP has been loaded fully
-            (when setup-source
+                  (compile-file setup-source :output-file setup-fasl))))
+            ;; compilation only succeeds after Quicklisp has been fully loaded 
+            (when (probe-file setup-source)
               (load setup-source)
-              (compile-file setup-source)))
+              (compile-file setup-source :output-file setup-fasl)))
           ;;; Otherwise download Quicklisp and run its installation sequence
         (progn 
@@ -47 +78 @@
               (load "http://beta.quicklisp.org/quicklisp.lisp")))
           (uiop:symbol-call :quicklisp-quickstart '#:install
-                            :path (merge-pathnames "quicklisp/" *quicklisp-parent-dir*))))))
+                            :path (merge-pathnames "quicklisp/"
+                                                   *quicklisp-parent-dir*))))))
 
+