feat: Add test command

Author: jcs090218

.github/workflows/local.yml

@@ -0,0 +1,71 @@
+name: Local
+
+on:
+  push:
+    branches:
+      - master
+    paths:
+      - '**.yml'
+      - lisp/**
+      - cmds/**
+      - src/**
+      - scripts/**
+      - test/**
+      - '**.asd'
+  pull_request:
+    branches:
+      - master
+    paths-ignore:
+    - '**.md'
+  workflow_dispatch:
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
+
+jobs:
+  test:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        os: [ubuntu-latest, macos-latest, windows-latest]
+
+    steps:
+    - name: Setup SBCL (Ubuntu)
+      if: runner.os == 'Linux'
+      run: |
+        sudo apt-get update
+        sudo apt-get install sbcl
+
+    - name: Setup SBCL (macOS)
+      if: runner.os == 'macOS'
+      run: |
+        /bin/bash -c "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/HEAD/install.sh)"
+        brew install sbcl
+
+    - name: Setup SBCL (Windows)
+      if: runner.os == 'Windows'
+      uses: crazy-max/ghaction-chocolatey@v3
+      with:
+        args: install sbcl
+
+    - uses: actions/checkout@v4
+
+    - name: Install Quicklisp
+      run: |
+        make install-ql
+
+    - name: Prepare Qob (Unix)
+      if: matrix.os == 'ubuntu-latest' || matrix.os == 'macos-latest'
+      run: |
+        chmod -R 777 ./
+        .github/scripts/setup-qob
+
+    - name: Prepare Qob (Windows)
+      if: matrix.os == 'windows-latest'
+      run: .github/scripts/setup-qob.ps1
+
+    - name: Testing...
+      run: |
+        make command-global

Makefile

@@ -24,3 +24,6 @@ install-ql: download-ql
 
 command-global:
 	./test/commands/global/run.sh
+
+command-local:
+	./test/commands/local/run.sh

cmds/core/test.lisp

@@ -0,0 +1,32 @@
+;;;; cmds/core/test.lisp --- Run system tests
+
+;;; Commentary
+;;
+;; The `test' command definition.
+;;
+
+;;; Code
+
+(defpackage qob-cli/test
+  (:use cl)
+  (:export command))
+
+(in-package :qob-cli/test)
+
+(defun options ()
+  "Options for `test' command."
+  (list ))
+
+(defun handler (cmd)
+  "Handler for `test' command."
+  (qob-cli:call-script "core/test" cmd))
+
+(defun command ()
+  "The `test' command."
+  (clingon:make-command
+   :name "test"
+   :description "Run system tests"
+   :options (options)
+   :handler #'handler))
+
+;;; End of cmds/core/test.lisp

cmds/qob.lisp

@@ -71,6 +71,7 @@
                    ,(qob-cli/load:command)
                    ,(qob-cli/locate:command)
                    ,(qob-cli/status:command)
+                   ,(qob-cli/test:command)
                    ,(qob-cli/uninstall:command))))
 
 ;;; End of cmds/qob.lisp

docs/content/Getting-Started/Commands-and-options/_index.en.md

@@ -170,6 +170,14 @@ List out all installed dists.
 $ qob [GLOBAL-OPTIONS] dists
 ```
 
+## 🔍 qob install-dists
+
+Install dists.
+
+```sh
+$ qob [GLOBAL-OPTIONS] install-dists [NAMES..]
+```
+
 ## 🔍 qob search
 
 Search systems from archives.

docs/content/Getting-Started/Commands-and-options/_index.zh-tw.md

@@ -169,6 +169,14 @@ $ qob [GLOBAL-OPTIONS] eval [FORM] 。
 $ qob [GLOBAL-OPTIONS] dists
 ```
 
+## 🔍 qob install-dists
+
+安裝 dists.
+
+```sh
+$ qob [GLOBAL-OPTIONS] install-dists [NAMES..]
+```
+
 ## 🔍 qob search
 
 從歸檔中搜尋系統。

lisp/_prepare.lisp

@@ -479,8 +479,14 @@ to actually set up the systems."
           (asdf:primary-system-name (car asd)))
         qob-loaded-asds))
 
+(defun qob-primary-test-system-name ()
+  "Return the primary test system name."
+  (let* ((name (qob-primary-system-name))
+         (name (concatenate 'string name "/tests")))
+    name))
+
 (defun qob-primary-system-entry ()
-  "Return the primary system."
+  "Return the primary system entry."
   (let ((name (qob-primary-system-name)))
     ;; NOTE: Not sure why function `assoc' isn't working here;
     ;; use some and return the value instead.
@@ -489,11 +495,26 @@ to actually set up the systems."
               asd))
           qob-loaded-asds)))
 
+(defun qob-primary-test-system-entry ()
+  "Return the primary test system entry."
+  (let ((name (qob-primary-test-system-name)))
+    ;; NOTE: Not sure why function `assoc' isn't working here;
+    ;; use some and return the value instead.
+    (some (lambda (asd)
+            (when (equal (car asd) name)
+              asd))
+          qob-loaded-asds)))
+
 (defun qob-primary-system ()
   "Return the primary system."
   (let ((name (qob-primary-system-name)))
     (asdf:find-system name)))
 
+(defun qob-primary-test-system ()
+  "Return the primary test system."
+  (let ((name (qob-primary-test-system-name)))
+    (asdf:find-system name)))
+
 ;; NOTE: Use this as project root?
 (defun qob-primary-root ()
   "Return the primary system path."

lisp/core/test.lisp

@@ -0,0 +1,27 @@
+;;;; lisp/core/test.lisp --- Run system tests
+
+;;; Commentary
+;;
+;; Command use to run system tests,
+;;
+;;   $ qob test [names..]
+;;
+
+;;; Code
+
+(qob-start
+ (let ((names (qob-args))
+       (primary-test-system (qob-primary-test-system-entry)))
+   (cond
+     ;; If specified system(s).
+     (names
+      (dolist (name names)
+        (asdf:test-system name)))
+     ;; Print primary system.
+     (primary-test-system
+      (asdf:test-system (car primary-test-system)))
+     ;; Print help.
+     (t
+      (qob-help "core/test")))))
+
+;;; End of lisp/core/test.lisp

lisp/help/core/test

@@ -0,0 +1,4 @@
+
+💡 You need to specify the systems you want to test:
+
+   $ qob test <system-1> <system-2> ...

lisp/shared.lisp

@@ -10,77 +10,79 @@
 
 (defun qob-install-systems (names)
   "Install systems by NAMES."
-  (let* ((silent-p (not (qob-reach-verbosity-p 'debug)))
-         (total (length names))
-         (count 1)
-         (installed 0)
-         (skipped 0))
-    (qob-msg "Installing ~A system~A... " total (qob--sinr total "" "s"))
-    (qob-msg "")
-    (dolist (name names)
-      (let* ((system (ql-dist:find-system name))
-             (installed-system (ignore-errors (asdf:find-system name)))
-             (version (or (and installed-system
-                               (asdf:component-version installed-system))
-                          ;;(slot-value system 'ql-dist:version)
-                          "0"))
-             (install-p))
-        (cond (installed-system
-               (qob-msg "  - [~A/~A] Skipping ~A (~A)... already installed ✗"
-                        count total
-                        (qob-ansi-green name)
-                        (qob-ansi-yellow version))
-               (incf skipped))
-              (t
-               (qob-with-progress
-                (qob-format "  - [~A/~A] Installing ~A (~A)... "
-                            count total
-                            (qob-ansi-green name)
-                            (qob-ansi-yellow version))
-                (qob-with-verbosity
-                 'debug
-                 (setq install-p
-                       (ignore-errors (ql:quickload name :silent silent-p))))
-                (if install-p "done ✓" "skipped ✗"))
-               (when install-p
-                 (incf installed)))))
-      (incf count))
-    (qob-msg "")
-    (qob-info "(Total of ~A system~A installed; ~A skipped)" installed
-              (qob--sinr installed "" "s")
-              skipped)))
+  (when names
+    (let* ((silent-p (not (qob-reach-verbosity-p 'debug)))
+           (total (length names))
+           (count 1)
+           (installed 0)
+           (skipped 0))
+      (qob-msg "Installing ~A system~A... " total (qob--sinr total "" "s"))
+      (qob-msg "")
+      (dolist (name names)
+        (let* ((system (ql-dist:find-system name))
+               (installed-system (ignore-errors (asdf:find-system name)))
+               (version (or (and installed-system
+                                 (asdf:component-version installed-system))
+                            ;;(slot-value system 'ql-dist:version)
+                            "0"))
+               (install-p))
+          (cond (installed-system
+                 (qob-msg "  - [~A/~A] Skipping ~A (~A)... already installed ✗"
+                          count total
+                          (qob-ansi-green name)
+                          (qob-ansi-yellow version))
+                 (incf skipped))
+                (t
+                 (qob-with-progress
+                  (qob-format "  - [~A/~A] Installing ~A (~A)... "
+                              count total
+                              (qob-ansi-green name)
+                              (qob-ansi-yellow version))
+                  (qob-with-verbosity
+                   'debug
+                   (setq install-p
+                         (ignore-errors (ql:quickload name :silent silent-p))))
+                  (if install-p "done ✓" "skipped ✗"))
+                 (when install-p
+                   (incf installed)))))
+        (incf count))
+      (qob-msg "")
+      (qob-info "(Total of ~A system~A installed; ~A skipped)" installed
+                (qob--sinr installed "" "s")
+                skipped))))
 
 (defun qob-uninstall-systems (names)
   "Uninstall systesm by NAMES."
-  (let* ((total (length names))
-         (count 1)
-         (installed 0)
-         (skipped 0))
-    (qob-msg "Uninstalling ~A system~A... " total (qob--sinr total "" "s"))
-    (qob-msg "")
-    (dolist (name names)
-      (let* ((installed-system (ignore-errors (asdf:find-system name)))
-             (version (or (and installed-system
-                               (asdf:component-version installed-system))
-                          "0")))
-        (cond ((null installed-system)
-               (qob-msg "  - [~A/~A] Skipping ~A (~A)... not installed ✗"
-                        count total
-                        (qob-ansi-green name)
-                        (qob-ansi-yellow version))
-               (incf skipped))
-              (t
-               (qob-with-progress
-                (qob-format "  - [~A/~A] Uninstalling ~A (~A)... "
-                            count total
-                            (qob-ansi-green name)
-                            (qob-ansi-yellow version))
-                (qob-with-verbosity 'debug (ql:uninstall name))
-                "done ✓")
-               (incf installed))))
-      (incf count))
-    (qob-msg "")
-    (qob-info "(Total of ~A system~A uninstalled; ~A skipped)" installed
-              (qob--sinr installed "" "s") skipped)))
+  (when names
+    (let* ((total (length names))
+           (count 1)
+           (installed 0)
+           (skipped 0))
+      (qob-msg "Uninstalling ~A system~A... " total (qob--sinr total "" "s"))
+      (qob-msg "")
+      (dolist (name names)
+        (let* ((installed-system (ignore-errors (asdf:find-system name)))
+               (version (or (and installed-system
+                                 (asdf:component-version installed-system))
+                            "0")))
+          (cond ((null installed-system)
+                 (qob-msg "  - [~A/~A] Skipping ~A (~A)... not installed ✗"
+                          count total
+                          (qob-ansi-green name)
+                          (qob-ansi-yellow version))
+                 (incf skipped))
+                (t
+                 (qob-with-progress
+                  (qob-format "  - [~A/~A] Uninstalling ~A (~A)... "
+                              count total
+                              (qob-ansi-green name)
+                              (qob-ansi-yellow version))
+                  (qob-with-verbosity 'debug (ql:uninstall name))
+                  "done ✓")
+                 (incf installed))))
+        (incf count))
+      (qob-msg "")
+      (qob-info "(Total of ~A system~A uninstalled; ~A skipped)" installed
+                (qob--sinr installed "" "s") skipped))))
 
 ;;; End of lisp/shared.lisp