#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp(ql:quickload '(trivial-backtrace)
                           :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)))


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

    (unwind-protect
         (handler-bind
             ((error (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 (uiop:slurp-stream-forms *standard-input*))
                  (result
                    (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: