Custom tests runner.

.github/actions/setup/action.yml

@@ -5,18 +5,14 @@ inputs:
     description: 'Jinja template for qlfile'
     required: false
     default: 'The Template'
-  lisp-system:
+  asdf-system:
     description: 'ASDF system to install and test'
-    required: false
-    default: ''
+    required: true
   run-tests:
     description: A command to run tests
     required: false
-    default: |
-      qlot exec ros --eval '(asdf:test-system :{{ lisp-system }})' --quit
-
-  custom-code:
-    required: false
+    # default: |
+    #   qlot exec ros --eval '(asdf:test-system :{{ lisp-system }})' --quit
 
 
 runs:
@@ -78,22 +74,12 @@ runs:
     #                (asdf:asdf-version))
     #        (format t "::endgroup::~%"))
 
-    - name: Run a custom Roswell Script
-      shell: ros -Q -- {0} "$@"
+    - name: Run Tests
+      shell: bash
       run: |
-              (progn
-                (ros:ensure-asdf)
-                #+quicklisp
-                (ql:quickload '() :silent t))
-      
-              (defun main (args)
-                 (declare (ignorable args))
-                 (format t "::group::Custom Roswell Script New 2~%")
-                 (let ((custom-code "${{ inputs.custom-code | escape }}"))
-                    (if (string= custom-code "")
-                        (format t "No custom code~%")
-                        (uiop:eval-input custom-code))
-                 (format t "::endgroup::~%")))
+        ${{ github.action_path }}/run-tests.ros ${{ inputs.asdf-system }} <<EOF
+        ${{ inputs.run-tests }}
+        EOF
 
     # - name: Test
     #   shell: bash

.github/actions/setup/run-tests.ros

@@ -0,0 +1,83 @@
+#!/bin/sh
+#|-*- mode:lisp -*-|#
+#|
+exec ros -Q -- $0 "$@"
+|#
+(progn ;;init forms
+  (ros:ensure-asdf)
+  #+quicklisp(ql:quickload '() :silent t)
+  )
+
+(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
+         (progn
+           (when (or (null system)
+                     (string= system ""))
+             (format *error-output*
+                     "Please specify ASDF system as a first argument.~%")
+             (uiop:quit 1))
+      
+           (let* ((user-script (uiop/stream: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:

.github/workflows/install.yml

@@ -65,11 +65,7 @@ jobs:
       - uses: actions/checkout@v1
       - uses: 40ants/cl-info/.github/actions/setup@custom-action
         with:
-          custom-code: |
-            (format t "Now with custom code!~%Lisp: ~A ~A~%ASDF: ~A~%"
-              (lisp-implementation-version)
-              (lisp-implementation-type)
-              (asdf:asdf-version))
+          asdf-system: cl-info
         
       # - name: Start SSH session
       #   uses: luchihoratiu/debug-via-ssh@main

cl-info-test.asd

@@ -1,12 +1,11 @@
 (defsystem cl-info-test
-           :author ""
-           :license ""
-           :class :package-inferred-system
-           :pathname "t"
-           :depends-on (:cl-info
-                        "cl-info-test/core")
-           :description "Test system for cl-info"
+  :author ""
+  :license ""
+  :class :package-inferred-system
+  :pathname "t"
+  :depends-on ("cl-info-test/core")
+  :description "Test system for cl-info"
 
-           :perform (test-op :after (op c)
-                             (symbol-call :rove :run c)
-                             (clear-system c)))
+  :perform (test-op (op c)
+                    (unless (symbol-call :rove :run c)
+                           (error "Tests failed"))))

qlfile

@@ -0,0 +1 @@
+dist ultralisp http://dist.ultralisp.org

qlfile.lock

@@ -2,3 +2,7 @@
  (:class qlot/source/dist:source-dist
   :initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest)
   :version "2021-01-24"))
+("ultralisp" .
+ (:class qlot/source/dist:source-dist
+  :initargs (:distribution "http://dist.ultralisp.org" :%version :latest)
+  :version "20210202153000"))

t/core.lisp

@@ -6,7 +6,11 @@
 (in-package cl-info-test/core)
 
 
+(defun foo (a b)
+  (list a b 3))
+
+
 (deftest test-some-staff
-    (testing "Replace this test with real staff."
-      (assert-that (foo 1 2)
-                   (contains 1 2))))
+  (testing "Replace this test with real staff."
+    (assert-that (foo 1 2)
+                 (contains 1 2))))