Changeset 15384


Ignore:
Timestamp:
09/26/20 07:32:04 (16 months 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:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/contrib/quicklisp/quicklisp-abcl.asd

    r15008 r15384  
    11;;;; -*- Mode: LISP -*-
    22(defsystem quicklisp-abcl
    3   :description "Load Quicklisp from the network if it isn't already installed."
    4   :long-name "<urn:abcl.org/release/1.5.0/contrib/quicklisp-abcl#>"
    5   :version "0.5.1"
    6   :components ((:file "quicklisp-abcl")))
     3  :description "Load Quicklisp, installing from network if necessary."
     4  :long-name "<urn:abcl.org/release/1.8.0/contrib/quicklisp-abcl#>"
     5  :version "0.6.0"
     6  :components ((:file "quicklisp-abcl"))
     7  :perform (load-op :after (o c)
     8             (uiop:symbol-call :quicklisp-abcl 'ensure-installation)))
     9
     10
    711
    812
  • trunk/abcl/contrib/quicklisp/quicklisp-abcl.lisp

    r15008 r15384  
    55  (:use :cl
    66        :asdf)
    7   (:export :*quicklisp-parent-dir*))
     7  (:export
     8   #:quicklisp/boot/fasls
     9   #:ensure-installation
     10   #:*quicklisp-parent-dir*))
    811
    912(in-package :quicklisp-abcl)
     13
     14;;;;
     15;;;;  1. (ABCL) Download setup.lisp if necessary from the network,
     16;;;;     running the Quicklisp setup routine
     17;;;;
     18;;;;  2.  Ensure that we cache the and use the fasl for
     19;;;;        (merge-pathnames "setup.lisp" *quicklisp-parent-dir*
     20;;;;
    1021
    1122(defvar *quicklisp-parent-dir* (user-homedir-pathname)
    1223  "Pathname reference to the parent directory of the local Quicklisp installation")
    1324
    14 (defmethod asdf:perform ((o asdf:load-op) (c (eql (asdf:find-system :quicklisp-abcl))))
     25(defun quicklisp/boot/fasls (&key (remove nil))
     26  "Enumerate all Quicklisp fasls, including the one we shim for the loader"
     27  ;;; TODO: ensure that this works for other implementations
     28    (let* ((setup-base
     29             (merge-pathnames "quicklisp/setup" *quicklisp-parent-dir*))
     30           (setup-source
     31             (make-pathname :defaults setup-base :type "lisp"))
     32           (setup-fasl
     33             (make-pathname :defaults setup-base :type "abcl"))
     34           (asdf-output-root
     35             (when (ignore-errors (asdf:find-system :quicklisp))
     36               (asdf:apply-output-translations
     37                (asdf:system-source-directory (asdf:find-system :quicklisp))))))
     38      (let ((all-fasls (list setup-fasl
     39                             (when asdf-output-root
     40                               (directory
     41                                (merge-pathnames "**/*" asdf-output-root))))))
     42        (when remove
     43          (format *load-verbose* "~&;;quicklisp-abcl: deleting ~{~a ~}~%" all-fasls)
     44          (mapcar #'delete-file all-fasls))
     45        (values all-fasls
     46                setup-base setup-source setup-fasl))))
     47
     48;;; After we have loaded this system, ensure Quicklisp is loaded
     49(defun ensure-installation ()
    1550  (when (find :quicklisp *features*)
    16     (return-from asdf:perform))
    17   (let* ((setup-base
    18           (merge-pathnames "quicklisp/setup"
    19                            *quicklisp-parent-dir*))
    20          (setup-source
    21           (probe-file (make-pathname :defaults setup-base
    22                                      :type "lisp")))
    23          (setup-fasl
    24           (probe-file (make-pathname :defaults setup-base
    25                                      :type "abcl"))))
    26     (if setup-source
    27            ;;; First try loading the Quicklisp setup as a compiled fasl if it exists
    28         (if setup-fasl
     51    (return-from ensure-installation))
     52  (multiple-value-bind (fasls
     53                        setup-base setup-source setup-fasl)
     54      (quicklisp/boot/fasls)
     55    (if (probe-file setup-source)
     56        ;; First try loading the Quicklisp setup as a compiled fasl if it exists
     57        (if (probe-file setup-fasl)
    2958            (handler-case
    3059                (load setup-fasl)
    3160              ;; The fasl may be invalid (i.e. between abcl versions); if so, load source, and recompile
    3261              (error (e)
    33                 (declare (ignore e))
     62                (format *load-verbose* "~&Failed to load Quicklisp setup fasl ~%~t~a~%because:~%~t~a~%" setup-fasl e)
    3463                (when setup-source
     64                  (format *load-verbose* "Removing Quicklisp setup fasl and recompiling...")
     65                  (quicklisp/boot/fasls :remove t)
    3566                  (load setup-source)
    36                   (compile-file setup-source))))
    37             ;; compilation only succeeds after QUICKLISP has been loaded fully
    38             (when setup-source
     67                  (compile-file setup-source :output-file setup-fasl))))
     68            ;; compilation only succeeds after Quicklisp has been fully loaded
     69            (when (probe-file setup-source)
    3970              (load setup-source)
    40               (compile-file setup-source)))
     71              (compile-file setup-source :output-file setup-fasl)))
    4172          ;;; Otherwise download Quicklisp and run its installation sequence
    4273        (progn
     
    4778              (load "http://beta.quicklisp.org/quicklisp.lisp")))
    4879          (uiop:symbol-call :quicklisp-quickstart '#:install
    49                             :path (merge-pathnames "quicklisp/" *quicklisp-parent-dir*))))))
     80                            :path (merge-pathnames "quicklisp/"
     81                                                   *quicklisp-parent-dir*))))))
    5082
     83
Note: See TracChangeset for help on using the changeset viewer.