Attempt at fixing --self-upgrade.

The option currently only works within the same build environment where
the image was first build, as noted in #133. This is an attempt at
convincing ASDF not to load systems that pgloader depends on in order to
be able to load only the new pgloader definition.

While it looks sound in principle, I failed to have it work in the lab.
Given that previous to this patch nothing works at all, it's not a
regression, let's push it as is makes the code saner.

Also, it looks like asdf::*immutable-systems* is what we want here, but
that's asdf 3.1.x and we're not there yet.

src/hooks.lisp

@@ -29,3 +29,10 @@
 
 #+ccl  (push #'close-foreign-libs *save-exit-functions*)
 #+sbcl (push #'close-foreign-libs sb-ext:*init-hooks*)
+
+;;;
+;;; Register all loaded systems in the image, so that ASDF don't search for
+;;; them again when doing --self-upgrade
+;;;
+(setf pgloader::*self-upgrade-immutable-systems*
+      (remove "pgloader" (asdf:already-loaded-systems) :test #'string=))

src/main.lisp

@@ -115,7 +115,7 @@
 (defvar *self-upgraded-already* nil
   "Keep track if we did reload our own source code already.")
 
-(defun self-upgrade (namestring)
+(defun self-upgrade (namestring &optional debug)
   "Load pgloader sources at PATH-TO-PGLOADER-SOURCES."
   (let ((pgloader-pathname (uiop:directory-exists-p
                             (uiop:parse-unix-namestring namestring))))
@@ -125,15 +125,19 @@
 
     ;; now the real thing
     (handler-case
-        (handler-bind ((condition #'muffle-warning))
+        (handler-bind ((warning #'muffle-warning))
           (let ((asdf:*central-registry* (list* pgloader-pathname
                                                 asdf:*central-registry*)))
             (format t "Self-upgrading from sources at ~s~%"
                     (uiop:native-namestring pgloader-pathname))
             (with-output-to-string (*standard-output*)
-              (asdf:operate 'asdf:load-op :pgloader :verbose nil))))
+              (asdf:load-system :pgloader
+                                :verbose nil
+                                :force-not *self-upgrade-immutable-systems*))))
       (condition (c)
-        (format t "Fatal: ~a~%" c)))))
+        (format t "Fatal: ~a~%" c)
+        (format t "~a~%" *self-upgrade-immutable-systems*)
+        (when debug (invoke-debugger c))))))
 
 (defun parse-summary-filename (summary debug)
   "Return the pathname where to write the summary output."
@@ -179,13 +183,6 @@
                                 with set field cast type encoding before after)
 	  options
 
-        ;; First thing: Self Upgrade?
-        (when self-upgrade
-          (unless *self-upgraded-already*
-            (self-upgrade self-upgrade)
-            (let ((*self-upgraded-already* t))
-              (main argv))))
-
         ;; parse the log thresholds
         (setf *log-min-messages*
               (log-threshold log-min-messages
@@ -199,6 +196,13 @@
               debug   (member *client-min-messages* '(:debug :data))
               quiet   (and (not verbose) (not debug)))
 
+        ;; First thing: Self Upgrade?
+        (when self-upgrade
+          (unless *self-upgraded-already*
+            (self-upgrade self-upgrade debug)
+            (let ((*self-upgraded-already* t))
+              (main argv))))
+
 	;; First care about the root directory where pgloader is supposed to
 	;; output its data logs and reject files
         (let ((root-dir-truename (or (probe-file root-dir)

src/params.lisp

@@ -6,6 +6,7 @@
 (defpackage #:pgloader.params
   (:use #:cl)
   (:export #:*version-string*
+           #:*self-upgrade-immutable-systems*
 	   #:*csv-path-root*
 	   #:*root-dir*
 	   #:*log-filename*
@@ -50,6 +51,9 @@
                (if *release* *minor-version* (git-hash)))
   "pgloader version strings, following Emacs versionning model.")
 
+(defvar *self-upgrade-immutable-systems* nil
+  "Used for --self-upgrade.")
+
 ;;;
 ;;; We need that to setup our default connection parameters
 ;;;