From eeefcaa98e1234edeb46b1aa92b0fd13c7b614f5 Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Thu, 11 Aug 2022 17:06:27 +0200
Subject: [PATCH] SBCL compiler notes should not be fatal to pgloader. (#1411)

* SBCL compiler notes should not be fatal to pgloader.

The compile function returns warnings-p and failure-p values, use that to
decide if the code could be compiled, and only signal a condition when it
has been fatal to compiling the code at run-time.

The SBCL compiler is getting smarter at removing unreachable code, and it
looks like pgloader is producing some unreachable code from parsing the user
provided commands.

* Let's make the code look like actual lisp code now.

* Another fix.

* Improve condition handling and simplify processing of compile values.

We don't need to react to any condition signaled from inside pgloader, only
to errors and serious-conditions (an error is a serious-condition). With
that, we can just ignore the compiler warnings and style notes.

* Fix the handler-bind to only consider serious-conditions too.

* Capture compiler output as log it as a debug level message.

* Fix previous attempt.

* Improve capturing of the compiler output (include summary).

* Actually call the new compile function in all places.

Co-authored-by: Dimitri Fontaine <dimitri@citusdata.com>
---
 src/api.lisp  | 30 +++++++++++++++++++++++++++---
 src/main.lisp | 21 +++++++++++----------
 2 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/src/api.lisp b/src/api.lisp
index 9a5b040..44e652c 100644
--- a/src/api.lisp
+++ b/src/api.lisp
@@ -157,12 +157,12 @@ Parameters here are meant to be already parsed, see parse-cli-optargs."
             (typecase source
               (function (list source))
 
-              (list     (list (compile nil source)))
+              (list     (list (compile-lisp-command source)))
 
-              (pathname (mapcar (lambda (expr) (compile nil expr))
+              (pathname (mapcar #'compile-lisp-command
                                 (parse-commands-from-file source)))
 
-              (t        (mapcar (lambda (expr) (compile nil expr))
+              (t        (mapcar #'compile-lisp-command
                                 (if (probe-file source)
                                     (parse-commands-from-file source)
                                     (parse-commands source)))))))
@@ -172,6 +172,30 @@ Parameters here are meant to be already parsed, see parse-cli-optargs."
          :do (when flush-summary
                (flush-summary :reset t))))))
 
+(defun compile-lisp-command (source)
+  "SOURCE must be lisp source code, a list form."
+  (let (function warnings-p failure-p notes)
+    ;; capture the compiler notes and warnings
+    (setf notes
+          (with-output-to-string (stream)
+            (let ((*standard-output* stream)
+                  (*error-output* stream)
+                  (*trace-output* stream))
+              (with-compilation-unit (:override t)
+                (setf (values function warnings-p failure-p)
+                      (compile nil source))))))
+
+    ;; log the captured compiler output at the DEBUG level
+    (when (and notes (string/= notes ""))
+      (let ((pp-source (with-output-to-string (s) (pprint source s))))
+        (log-message :debug "While compiling:~%~a~%~a" pp-source notes)))
+
+    ;; and signal an error if we failed to compile our lisp code
+    (cond
+      (failure-p   (error "Failed to compile code: ~a~%~a" source notes))
+      (warnings-p  function)
+      (t           function))))
+
 
 ;;;
 ;;; Main API to use from outside of pgloader.
diff --git a/src/main.lisp b/src/main.lisp
index 8d63e35..24020ed 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -315,15 +315,16 @@
                 ;; meaningful backtrace to the user in case of unexpected
                 ;; conditions being signaled.
                 (handler-bind
-                    (((and condition (not (or monitor-error
-                                              cli-parsing-error
-                                              source-definition-error
-                                              regression-test-error)))
-                      #'(lambda (condition)
-                          (format *error-output* "KABOOM!~%")
-                          (format *error-output* "FATAL error: ~a~%~a~%~%"
-                                  condition
-                                  (print-backtrace condition debug)))))
+                    (((and serious-condition (not (or monitor-error
+                                                      cli-parsing-error
+                                                      source-definition-error
+                                                      regression-test-error)))
+                       #'(lambda (condition)
+                           (format *error-output* "KABOOM!~%")
+                           (format *error-output* "~a: ~a~%~a~%~%"
+                                   (class-name (class-of condition))
+                                   condition
+                                   (print-backtrace condition debug)))))
 
                   (with-monitor ()
                     ;; tell the user where to look for interesting things
@@ -385,7 +386,7 @@
                 (format *error-output* "~a~%" c)
                 (uiop:quit +os-code-error+))
 
-              (condition (c)
+              (serious-condition (c)
                 (format *error-output* "~%What I am doing here?~%~%")
                 (format *error-output* "~a~%~%" c)
                 (uiop:quit +os-code-error+)))))