diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 41d8c38..c8f98d9 100644 --- a/.github/workflows/ci.yml +++ b/.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 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/roswell/run-test-forms.ros b/roswell/run-test-forms.ros new file mode 100755 index 0000000..c67aa0f --- /dev/null +++ b/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] +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 - lists an additional system to load +--coverage-exclude|-e - 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))))))) diff --git a/src/utils.lisp b/src/utils.lisp new file mode 100644 index 0000000..771710d --- /dev/null +++ b/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)))) diff --git a/t/ci-utils-test-systems.asd b/t/ci-utils-test-systems.asd new file mode 100644 index 0000000..6dbe659 --- /dev/null +++ b/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 ()) + 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..32274ac --- /dev/null +++ b/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!")) + 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))