run-tests.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp
  (ql:quickload "trivial-backtrace"
                :silent t)
  #+(or sbcl ccl)
  (ql:quickload "cl-coveralls"
                :silent t))

(declaim (optimize (debug 3) (safety 3)
                   (speed 0) (space 0)))

(defpackage :ros.script.run-tests
  (:use :cl))
(in-package :ros.script.run-tests)


(defparameter *test-system-name-templates*
  '("~A-test"
    "~A-tests"
    "~A/test"
    "~A/tests"
    "~A"))


(defun guess-test-system-name (primary-system-name)
  (check-type primary-system-name string)
  (loop for template in *test-system-name-templates*
        for system-name = (format nil template
                                  primary-system-name)
        for asd-file = (format nil "~A.asd"
                               system-name)
        when (probe-file asd-file)
          do (return system-name)))


(defun run-tests (primary-system-name)
  "Default tests runner searches appropriate system's name and calls ASDF:TEST-SYSTEM.

   If ASDF:TEST-SYSTEM does not signal error condition, test run considered successful.

   Before call to the ASDF:TEST-SYSTEM we do QL:QUICKLOAD, to be sure that all dependencies
   are downloaded."
  (check-type primary-system-name string)

  (let ((test-system-name
          (guess-test-system-name primary-system-name)))
    (ql:quickload test-system-name
                  :silent t)
    ;; ASDF:TEST-SYSTEM always returns T
    (asdf:test-system test-system-name)))


(defmacro with-coveralls ((&key exclude) &body body)
  #+(or sbcl ccl)
  `(cl-coveralls:with-coveralls (:exclude ,exclude)
     ,@body)
  #-(or sbcl ccl)
  `(progn
     ,@body))


(defun main (&rest args)
  (let ((system (first args)))
    (format t "::group::Running tests for ASDF system ~S~%"
            (or system
                ""))

    ;; Without this random state initialization
    ;; subsequent runs of the script will generate the same
    ;; "random" temprorary directory for coverage data:
    (setf *random-state*
          (make-random-state t))

    (unwind-protect
         (handler-bind
             ((serious-condition
                (lambda (condition)
                  (trivial-backtrace:print-backtrace condition)
                  (uiop:quit 3))))
           (when (or (null system)
                     (string= system ""))
             (format *error-output*
                     "Please specify ASDF system as a first argument.~%")
             (uiop:quit 1))
           
           (let* ((user-script (unless (interactive-stream-p *standard-input*)
                                 (uiop:slurp-stream-forms *standard-input*)))
                  (coveralls-repo-token
                    (let* ((value (uiop:getenv "COVERALLS_REPO_TOKEN"))
                           ;; Sometimes user might want to use multiline
                           ;; YAML format to make expression more readable.
                           ;; In this case the value might contain hanging
                           ;; spaces and new-lines.
                           (value (string-trim '(#\Newline #\Space) value)))
                      (cond
                        ((or (null value)
                             ;; When using GH Actions expressions like:
                             ;; ${{ matrix.lisp == 'sbcl-bin' && secrets.github_token }}
                             ;; the value will be 'false' for any lisp other than 'sbcl-bin'
                             (string-equal value "false")
                             (string-equal value ""))
                         nil)
                        (t value))))
                  (result
                    (progn
                      (when coveralls-repo-token
                        ;; This will enable data collection
                        ;; inside with-coveralls:
                        (setf (uiop:getenv "COVERALLS")
                              "1")
                        ;; And we set this value back in its stripped form:
                        (setf (uiop:getenv "COVERALLS_REPO_TOKEN")
                              coveralls-repo-token))

                      (with-coveralls (:exclude (list ".qlot/"))
                        (cond
                          (user-script
                           (loop with form-results
                                 for form in user-script
                                 do (setf form-results
                                          (eval form))
                                 finally (return form-results)))
                          ;; default tests runner
                          (t
                           (run-tests system)))))))
             (unless result
               (uiop:quit 2))))
      (format t "~&::endgroup::~%"))))


;;; vim: set ft=lisp lisp: