Merge 6c8395e into c71d028

.github/workflows/ci.yml

@@ -20,3 +20,94 @@ 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/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/dep-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
+
+          # 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
+
+
+          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

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")))
+

roswell/run-test-forms.ros

@@ -0,0 +1,70 @@
+#!/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 "~&  returned ~s~%" r)
+                                r))
+           (uiop:quit 1)))))))

src/utils.lisp

@@ -0,0 +1,45 @@
+(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:~%")
+                           ;; 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)))
+
+(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))))

t/ci-utils-test-systems.asd

@@ -0,0 +1,37 @@
+;; 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/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")))
+
+(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 ())
+

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!"))
+

t/test-system-compile-warn.lisp

@@ -0,0 +1,9 @@
+(defpackage :ci-utils-test-system-compile-warn
+  (:use :cl))
+(in-package :ci-utils-test-system-compile-warn)
+
+(format t "loading~%")
+(eval-when (:compile-toplevel)
+  (format t "compiling~%")
+  (warn "compilation warning!"))
+

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!")
+

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!")
+

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))