From 2417c95d1603181ec96018b1954ddacde17b9d2c Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 16:58:07 -0500
Subject: [PATCH 1/9] add some utilities for catching errors in dependencies,
 and ignoring bad system names

---
 ci-utils.asd   |  9 +++++++++
 src/utils.lisp | 39 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+)
 create mode 100644 src/utils.lisp

diff --git a/ci-utils.asd b/ci-utils.asd
index c4d1ed9..18b4d32 100644
--- a/ci-utils.asd
+++ b/ci-utils.asd
@@ -36,3 +36,12 @@
   :components ((:file "tests"))
   :perform (test-op (o c) (symbol-call '#:fiveam '#:run! '(:user-tests
                                                            :noncoveralls-tests))))
+
+(defsystem "ci-utils/utils"
+  :description "Extra utilities for CI-Utils roswell scripts"
+  :license "MIT"
+  :depends-on ("ci-utils")
+  :pathname "src"
+  :serial t
+  :components ((:file "utils")))
+
diff --git a/src/utils.lisp b/src/utils.lisp
new file mode 100644
index 0000000..2b06652
--- /dev/null
+++ b/src/utils.lisp
@@ -0,0 +1,39 @@
+(uiop:define-package :ci-utils/utils
+  (:use :cl)
+  (:export #:quickload #:with-fail-on-errors #:without-asdf-bad-system))
+
+(in-package :ci-utils/utils)
+
+(defmacro with-fail-on-errors ((&key (code 123)) &body body)
+  "print a stack trace and then exit with CODE when BODY signals
+  any error"
+  `(handler-bind ((error (lambda (&optional e)
+                           (format t "caught error ~s~%~a~%" e e)
+                           (uiop:print-condition-backtrace
+                            e :stream *standard-output*)
+                           (finish-output)
+                           (uiop:quit ,code))))
+     (progn ,@body)))
+
+(defmacro without-asdf-bad-system (() &body body)
+  "run BODY, with ASDF:BAD-SYSTEM-NAME condition muffled if it exists"
+  `(handler-bind (#+asdf3.2 (asdf:bad-SYSTEM-NAME
+                              (function MUFFLE-WARNING)))
+     (progn ,@body)))
+
+(defun quickload (systems &rest keys
+                  &key (fail-on-error t) (ignore-bad-systems t)
+                  &allow-other-keys)
+  (remf keys :fail-on-error)
+  (remf keys :ignore-bad-systems)
+  (flet ((ibs ()
+           (if ignore-bad-systems
+               (without-asdf-bad-system ()
+                 (apply #'ql:quickload systems keys))
+               (apply #'ql:quickload systems keys))))
+    (if fail-on-error
+        (with-fail-on-errors (:code (if (numberp fail-on-error)
+                                        fail-on-error
+                                        123))
+          (ibs))
+        (ibs))))

From e7c51b5fbe39650bdecbcebf26845d1ae036b9e9 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 16:59:20 -0500
Subject: [PATCH 2/9] add a ros script to run some forms directly if not using
 a testing lib

---
 roswell/run-test-forms.ros | 71 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)
 create mode 100755 roswell/run-test-forms.ros

diff --git a/roswell/run-test-forms.ros b/roswell/run-test-forms.ros
new file mode 100755
index 0000000..6231c2f
--- /dev/null
+++ b/roswell/run-test-forms.ros
@@ -0,0 +1,71 @@
+#!/bin/sh
+#|-*- mode:lisp -*-|#
+#|
+exec ros -Q -- $0 "$@"
+|#
+
+;cmucl crashes with silent on
+(ql:quickload '(:ci-utils/utils) :silent (not (member :cmu *features*)))
+(ci-utils/utils:quickload '(:ci-utils/coveralls :iterate)
+           :silent (not (member :cmu *features*)))
+
+(defpackage :ros.script.run-test-forms
+  (:use :cl :iterate :ci-utils/utils))
+(in-package :ros.script.run-test-forms)
+
+
+(defun show-help ()
+  (format t "~
+Usage: run-test-forms [options] <forms>
+Evaluates FORMS, exiting with code 0 if all FORMS returns non-NIL, 1 if any
+returns NIL, or 2 when one ERRORs. Any requires systems should be expliicitly
+loaded with -l or --quickload option. If loading dependencies ERRORs, exit
+with code 3.
+
+If the COVERALLS environemenal variable is present and non-empty, coverage will
+be measured and reported to COVERALLS on platforms supported by CI-Utils.
+Additionally, the environmental variable COVERAGE_EXCLUDED is read as a colon
+seperated list of paths to exclude from measuring coverage, in addition to those
+specified as arguments.
+
+Note that currently the systems in the project root are loaded with
+COVERALLS is enable.  This behavior is not to be relied on and may change in
+the future, so instead use the `--quicklisp`/`-l` flag.
+Options
+--help|-h                     - prints this help message
+--quickload|-l <sytem>        - lists an additional system to load
+--coverage-exclude|-e <file>  - lists a path to excluded from the coverage
+                                measurement
+~%")
+  (uiop:quit 4))
+
+
+(defun main (&rest argv)
+  (when (> 1 (length argv))
+    (show-help))
+  (with-fail-on-errors (:code 5)
+    (iter (generate arg-list in argv)
+      (for arg = (next arg-list))
+      (cond
+        ((or (string= "--help" arg) (string= "-h" arg))
+         (show-help))
+        ((or (string= "--quickload" arg) (string= "-l" arg))
+         (collect (next arg-list) into loaded-systems))
+        ((or (string= "--coverage-exclude" arg) (string= "-e" arg))
+         (collect (next arg-list) into excluded))
+        (t
+         (collect arg into forms)))
+      ;;evaluate tests here with `loaded-systems`, `excluded`, and `tests` in scope
+      (finally
+       (when loaded-systems
+         (quickload loaded-systems :fail-on-error 3))
+       (setf excluded (nconc excluded (ci-utils/coveralls:coverage-excluded)))
+       (ci-utils/coveralls:with-coveralls excluded
+         (unless
+          (loop for form in forms
+                do (format t "evaluating ~s~% =  " form)
+                always (let ((r (with-fail-on-errors (:code 2)
+                                  (eval (read-from-string form)))))
+                         (format t " ~s~%" r)
+                         r))
+           (uiop:quit 1)))))))

From 0ecd920590d286b185ddd0afe0cf650ecafcbb4e Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 18:38:22 -0500
Subject: [PATCH 3/9] add (github actions) tests for run-test-forms

---
 .github/workflows/ci.yml         | 85 ++++++++++++++++++++++++++++++++
 t/ci-utils-test-systems.asd      | 32 ++++++++++++
 t/test-system-compile-error.lisp |  7 +++
 t/test-system-compile-warn.lisp  |  7 +++
 t/test-system-load-error.lisp    |  6 +++
 t/test-system-load-warn.lisp     |  6 +++
 t/test-system.lisp               | 16 ++++++
 7 files changed, 159 insertions(+)
 create mode 100644 t/ci-utils-test-systems.asd
 create mode 100644 t/test-system-compile-error.lisp
 create mode 100644 t/test-system-compile-warn.lisp
 create mode 100644 t/test-system-load-error.lisp
 create mode 100644 t/test-system-load-warn.lisp
 create mode 100644 t/test-system.lisp

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 41d8c38..46829e9 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -20,3 +20,88 @@ jobs:
           curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh
       - name: Run tests
         run: roswell/run-fiveam.ros -l ci-utils/test :github-actions-tests :noncoveralls-tests :base-tests
+
+      - name: Run-test-forms tests
+        # specify shell without -e since we want to check non-0 exits manually
+        shell: bash {0}
+        run: |
+          # put test systems where asdf can find them
+          cp -av t ~/lisp/
+
+          fail=0
+
+          function check () {
+            # $1 = actual, $2 = expected
+            if [ $1 -eq $2 ]
+            then
+              echo -e "\033[0;32mGot $1, expected $2: OK\033[0m"
+            else
+              (( fail++ ))
+              echo -e "\033[0;31mGot $1, expected $2: BAD $fail\033[0m"
+            fi
+          }
+          # should fail
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-nil)"
+          check $? 1
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-x nil)"
+          check $? 1
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-not-x 123)"
+          check $? 1
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-not-x nil)" "(ci-utils-test-system:return-nil)" "(zerop (random 2))"
+          check $? 1
+
+          # should succeed
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-t)"
+          check $? 0
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-x 123)"
+          check $? 0
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-not-x nil)"
+          check $? 0
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-not-x nil)" "(ci-utils-test-system:return-t)" "(not (minusp (random 10)))"
+          check $? 0
+
+          # should error
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(:incomplete-form"
+          check $? 2
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems '(error "error1!")'
+          check $? 2
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems "(ci-utils-test-system:return-not-x nil)" "(ci-utils-test-system:return-x 2)" '(error "error2!")' "(zerop (random 2))"
+          check $? 2
+
+
+          # dependency should error
+          roswell/run-test-forms.ros -l ci-utils-test-systems/compile-error "(ci-utils-test-system:return-t)"
+          check $? 3
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems/load-error "(ci-utils-test-system:return-t)"
+          check $? 3
+
+          roswell/run-test-forms.ros -l ci-utils-test-systems/compile-warn "(ci-utils-test-system:return-t)"
+          check $? 3
+
+          # should succeed?
+          roswell/run-test-forms.ros -l ci-utils-test-systems/load-warn "(ci-utils-test-system:return-t)"
+          check $? 0
+
+
+          echo done...
+
+          if [ $fail -eq 0 ]
+          then
+            echo -e "\033[0;32m$fail failures\033[0m"
+            exit 0
+          else
+            echo -e "\033[0;31m$fail failures\033[0m"
+            exit 1
+          fi
diff --git a/t/ci-utils-test-systems.asd b/t/ci-utils-test-systems.asd
new file mode 100644
index 0000000..f41200b
--- /dev/null
+++ b/t/ci-utils-test-systems.asd
@@ -0,0 +1,32 @@
+;; various systems that load code that errors, warns, etc for making
+;; sure they cause CI tests to fail
+
+(defsystem ci-utils-test-systems
+  :depends-on ()
+  :components ((:file "test-system")))
+
+(defsystem ci-utils-test-systems/compile-error
+  :depends-on (ci-utils-test-systems)
+  :components ((:file "test-system-compile-error")))
+
+(defsystem ci-utils-test-systems/compile-warn
+  :depends-on (ci-utils-test-systems)
+  :components ((:file "test-system-compile-warn")))
+
+(defsystem ci-utils-test-systems/dep-compile-error
+  :depends-on (ci-utils-test-systems/compile-error)
+  :components ())
+
+
+(defsystem ci-utils-test-systems/load-error
+  :depends-on (ci-utils-test-systems)
+  :components ((:file "test-system-load-error")))
+
+(defsystem ci-utils-test-systems/load-warn
+  :depends-on (ci-utils-test-systems)
+  :components ((:file "test-system-load-warn")))
+
+(defsystem ci-utils-test-systems/dep-load-error
+  :depends-on (ci-utils-test-systems/load-error)
+  :components ())
+
diff --git a/t/test-system-compile-error.lisp b/t/test-system-compile-error.lisp
new file mode 100644
index 0000000..82ac9c3
--- /dev/null
+++ b/t/test-system-compile-error.lisp
@@ -0,0 +1,7 @@
+(defpackage :ci-utils-test-system-compile-error
+  (:use :cl))
+(in-package :ci-utils-test-system-compile-error)
+
+(eval-when (:compile-toplevel)
+  (error "compilation failed!"))
+
diff --git a/t/test-system-compile-warn.lisp b/t/test-system-compile-warn.lisp
new file mode 100644
index 0000000..954f7fc
--- /dev/null
+++ b/t/test-system-compile-warn.lisp
@@ -0,0 +1,7 @@
+(defpackage :ci-utils-test-system-compile-warn
+  (:use :cl))
+(in-package :ci-utils-test-system-compile-warn)
+
+(eval-when (:compile-toplevel)
+  (warn "compilation warning!"))
+
diff --git a/t/test-system-load-error.lisp b/t/test-system-load-error.lisp
new file mode 100644
index 0000000..2959966
--- /dev/null
+++ b/t/test-system-load-error.lisp
@@ -0,0 +1,6 @@
+(defpackage :ci-utils-test-system-load-error
+  (:use :cl))
+(in-package :ci-utils-test-system-load-error)
+
+(error "load failed!")
+
diff --git a/t/test-system-load-warn.lisp b/t/test-system-load-warn.lisp
new file mode 100644
index 0000000..4747f03
--- /dev/null
+++ b/t/test-system-load-warn.lisp
@@ -0,0 +1,6 @@
+(defpackage :ci-utils-test-system-load-warn
+  (:use :cl))
+(in-package :ci-utils-test-system-load-warn)
+
+(warn "load-time warning!")
+
diff --git a/t/test-system.lisp b/t/test-system.lisp
new file mode 100644
index 0000000..a90cb86
--- /dev/null
+++ b/t/test-system.lisp
@@ -0,0 +1,16 @@
+(defpackage :ci-utils-test-system
+  (:use :cl)
+  (:export #:return-nil #:return-t #:return-x #:return-not-x))
+(in-package :ci-utils-test-system)
+
+(defun return-nil ()
+  nil)
+
+(defun return-t ()
+  t)
+
+(defun return-x (x)
+  x)
+
+(defun return-not-x (x)
+  (not x))

From f74e3b4df4a911fd4025491d696f35f542b8dd4b Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 22:11:12 -0500
Subject: [PATCH 4/9] adjust formatting of run-test-forms.ros script code and
 output

---
 roswell/run-test-forms.ros | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/roswell/run-test-forms.ros b/roswell/run-test-forms.ros
index 6231c2f..c67aa0f 100755
--- a/roswell/run-test-forms.ros
+++ b/roswell/run-test-forms.ros
@@ -7,7 +7,7 @@ exec ros -Q -- $0 "$@"
 ;cmucl crashes with silent on
 (ql:quickload '(:ci-utils/utils) :silent (not (member :cmu *features*)))
 (ci-utils/utils:quickload '(:ci-utils/coveralls :iterate)
-           :silent (not (member :cmu *features*)))
+                          :silent (not (member :cmu *features*)))
 
 (defpackage :ros.script.run-test-forms
   (:use :cl :iterate :ci-utils/utils))
@@ -61,11 +61,10 @@ Options
          (quickload loaded-systems :fail-on-error 3))
        (setf excluded (nconc excluded (ci-utils/coveralls:coverage-excluded)))
        (ci-utils/coveralls:with-coveralls excluded
-         (unless
-          (loop for form in forms
-                do (format t "evaluating ~s~% =  " form)
-                always (let ((r (with-fail-on-errors (:code 2)
-                                  (eval (read-from-string form)))))
-                         (format t " ~s~%" r)
-                         r))
+         (unless (loop for form in forms
+                       do (format t "~&evaluating ~s~%" form)
+                       always (let ((r (with-fail-on-errors (:code 2)
+                                         (eval (read-from-string form)))))
+                                (format t "~&  returned ~s~%" r)
+                                r))
            (uiop:quit 1)))))))

From 7473fa2eac8c9de380e6dbbe0eee5add18961291 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 22:25:16 -0500
Subject: [PATCH 5/9] testing

---
 t/test-system-compile-warn.lisp | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/t/test-system-compile-warn.lisp b/t/test-system-compile-warn.lisp
index 954f7fc..32274ac 100644
--- a/t/test-system-compile-warn.lisp
+++ b/t/test-system-compile-warn.lisp
@@ -2,6 +2,8 @@
   (:use :cl))
 (in-package :ci-utils-test-system-compile-warn)
 
+(format t "loading~%")
 (eval-when (:compile-toplevel)
+  (format t "compiling~%")
   (warn "compilation warning!"))
 

From 3d4ed96284b54d386ada38533695feedcaf9c1e3 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 22:25:32 -0500
Subject: [PATCH 6/9] add test

---
 .github/workflows/ci.yml    | 8 +++++++-
 t/ci-utils-test-systems.asd | 5 +++++
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 46829e9..ba59fd1 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -81,15 +81,21 @@ jobs:
 
 
           # dependency should error
+          roswell/run-test-forms.ros -l ci-utils-test-systems/dep-error  "(ci-utils-test-system:return-t)"
+          check $? 3
+
           roswell/run-test-forms.ros -l ci-utils-test-systems/compile-error "(ci-utils-test-system:return-t)"
           check $? 3
 
-          roswell/run-test-forms.ros -l ci-utils-test-systems/load-error "(ci-utils-test-system:return-t)"
+          roswell/run-test-forms.ros -l ci-utils-test-systems/dep-compile-error  "(ci-utils-test-system:return-t)"
           check $? 3
 
           roswell/run-test-forms.ros -l ci-utils-test-systems/compile-warn "(ci-utils-test-system:return-t)"
           check $? 3
 
+          roswell/run-test-forms.ros -l ci-utils-test-systems/load-error "(ci-utils-test-system:return-t)"
+          check $? 3
+
           # should succeed?
           roswell/run-test-forms.ros -l ci-utils-test-systems/load-warn "(ci-utils-test-system:return-t)"
           check $? 0
diff --git a/t/ci-utils-test-systems.asd b/t/ci-utils-test-systems.asd
index f41200b..45f5ce8 100644
--- a/t/ci-utils-test-systems.asd
+++ b/t/ci-utils-test-systems.asd
@@ -5,6 +5,11 @@
   :depends-on ()
   :components ((:file "test-system")))
 
+(defsystem ci-utils-test-systems/dep-error
+  :depends-on (ci-utils-test-systems/missing-system)
+  :components (()))
+
+
 (defsystem ci-utils-test-systems/compile-error
   :depends-on (ci-utils-test-systems)
   :components ((:file "test-system-compile-error")))

From 60a1640dcfeb97b3ed31053f59ae81bbdc00b480 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 22:27:28 -0500
Subject: [PATCH 7/9] fix typo

---
 t/ci-utils-test-systems.asd | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/t/ci-utils-test-systems.asd b/t/ci-utils-test-systems.asd
index 45f5ce8..6dbe659 100644
--- a/t/ci-utils-test-systems.asd
+++ b/t/ci-utils-test-systems.asd
@@ -7,7 +7,7 @@
 
 (defsystem ci-utils-test-systems/dep-error
   :depends-on (ci-utils-test-systems/missing-system)
-  :components (()))
+  :components ())
 
 
 (defsystem ci-utils-test-systems/compile-error

From 13fa20e0868ab7bfe1990d703279d08d25d69fc7 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Mon, 27 Apr 2020 22:30:42 -0500
Subject: [PATCH 8/9] should compile/load warnings cause failure? possibly
 optionally?

---
 .github/workflows/ci.yml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index ba59fd1..c8f98d9 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -90,13 +90,13 @@ jobs:
           roswell/run-test-forms.ros -l ci-utils-test-systems/dep-compile-error  "(ci-utils-test-system:return-t)"
           check $? 3
 
-          roswell/run-test-forms.ros -l ci-utils-test-systems/compile-warn "(ci-utils-test-system:return-t)"
-          check $? 3
-
           roswell/run-test-forms.ros -l ci-utils-test-systems/load-error "(ci-utils-test-system:return-t)"
           check $? 3
 
           # should succeed?
+          roswell/run-test-forms.ros -l ci-utils-test-systems/compile-warn "(ci-utils-test-system:return-t)"
+          check $? 0
+
           roswell/run-test-forms.ros -l ci-utils-test-systems/load-warn "(ci-utils-test-system:return-t)"
           check $? 0
 

From 6c8395e57de95f5972e55e106338aa241ec7a15e Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Wed, 23 Sep 2020 16:15:14 -0500
Subject: [PATCH 9/9] ignore errors while printing error and backtrace, so we
 still exit properly

---
 src/utils.lisp | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/utils.lisp b/src/utils.lisp
index 2b06652..771710d 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -4,13 +4,19 @@
 
 (in-package :ci-utils/utils)
 
+
 (defmacro with-fail-on-errors ((&key (code 123)) &body body)
   "print a stack trace and then exit with CODE when BODY signals
   any error"
   `(handler-bind ((error (lambda (&optional e)
-                           (format t "caught error ~s~%~a~%" e e)
-                           (uiop:print-condition-backtrace
-                            e :stream *standard-output*)
+                           (format t "caught error:~%")
+                           ;; make sure we exit properly even if
+                           ;; errors or backtrace can't be printed
+                           (ignore-errors (format t "  ~a~%" e))
+                           (ignore-errors (format t "  ~s~%" e))
+                           (ignore-errors
+                            (uiop:print-condition-backtrace
+                             e :stream *standard-output*))
                            (finish-output)
                            (uiop:quit ,code))))
      (progn ,@body)))