Reorg test systems

.github/workflows/test.yml

@@ -42,10 +42,10 @@ jobs:
       run: |
         make-rc
         asdf-add
-    - name: Run Regression Tests
+    - name: Run Unit Tests
       run: |
-        lisp -i ${{ matrix.lisp }} -e "(ql:quickload :inravina/test)" -e "(defparameter cl-user::*exit-on-test-failures* t)" -e "(asdf:test-system :inravina)"
+        lisp -i ${{ matrix.lisp }} -e "(ql:quickload :inravina-extrinsic/unit-test)" -e "(defparameter cl-user::*exit-on-test-failures* t)" -e "(asdf:test-system :inravina)"
     - name: Run ANSI Tests
       run: |
-        lisp -i ${{ matrix.lisp }} -e "(ql:quickload :inravina-extrinsic/test)" -e "(inravina-extrinsic/test:ansi-test :exit t)"
+        lisp -i ${{ matrix.lisp }} -e "(ql:quickload :inravina-extrinsic/ansi-test)" -e "(inravina-extrinsic/ansi-test:test :exit t)"
 

code/extrinsic/ansi-test/packages.lisp

@@ -0,0 +1,5 @@
+(cl:in-package #:common-lisp-user)
+
+(defpackage #:inravina-extrinsic/ansi-test
+  (:use #:common-lisp)
+  (:export #:test))

code/extrinsic/test/ansi-test.lisp → code/extrinsic/ansi-test/test.lisp

@@ -1,4 +1,4 @@
-(in-package #:inravina-extrinsic/test)
+(in-package #:inravina-extrinsic/ansi-test)
 
 (defvar *extrinsic-symbols*
   '(incless-extrinsic:pprint
@@ -31,8 +31,8 @@
     "PPRINT"
     "SET-PPRINT-DISPATCH."))
 
-(defun ansi-test (&rest args)
-  (let ((system (asdf:find-system :inravina-extrinsic/test)))
+(defun test (&rest args)
+  (let ((system (asdf:find-system :inravina-extrinsic/ansi-test)))
     (apply #'ansi-test-harness:ansi-test
            :directory (merge-pathnames
                        (make-pathname :directory '(:relative

code/extrinsic/unit-test/packages.lisp

@@ -0,0 +1,4 @@
+(defpackage #:inravina-extrinsic/unit-test
+  (:use #:common-lisp #:parachute)
+  (:export))
+

code/extrinsic/unit-test/pprint-logical-block.lisp

@@ -0,0 +1,77 @@
+(in-package #:inravina-extrinsic/unit-test)
+
+(define-test pprint-logical-block.1
+  (is equal
+      "ZA
+ZB
+ZC[D
+Z  E
+ZF]"
+      (with-env (stream)
+        (inravina-extrinsic:pprint-logical-block (stream nil :per-line-prefix "Z")
+          (write-string "A " stream)
+          (inravina-extrinsic:pprint-newline :mandatory stream)
+          (write-string "B
+C" stream)
+          (inravina-extrinsic:pprint-logical-block (stream nil :prefix "[" :suffix "]")
+            (write-string "D " stream)
+            (inravina-extrinsic:pprint-newline :mandatory stream)
+            (write-string "E
+F" stream))))))
+
+
+(define-test pprint-logical-block.1
+  (is equal
+      "a .."
+      (with-env (stream :lines 1)
+        (inravina-extrinsic:pprint-logical-block (stream nil :prefix "a
+(" :suffix ")")
+          (write-string "wibble" stream)
+          (inravina-extrinsic:pprint-newline :mandatory stream)
+          (write-string "bar" stream)))))
+
+(define-test pprint-logical-block.2
+  (is equal
+      "a
+(wibble ..)"
+      (with-env (stream :lines 2)
+        (inravina-extrinsic:pprint-logical-block (stream nil :prefix "a
+(" :suffix ")")
+          (write-string "wibble" stream)
+          (inravina-extrinsic:pprint-newline :mandatory stream)
+          (write-string "bar" stream)))))
+
+(define-test pprint-logical-block.3
+  (is equal
+      "za .."
+      (with-env (stream :lines 1)
+        (inravina-extrinsic:pprint-logical-block (stream nil :per-line-prefix "z")
+          (inravina-extrinsic:pprint-logical-block (stream nil :prefix "a
+(" :suffix ")")
+            (write-string "wibble" stream)
+            (inravina-extrinsic:pprint-newline :mandatory stream)
+            (write-string "bar" stream))))))
+
+(define-test pprint-logical-block.4
+  (is equal
+      "za
+z(wibble ..)"
+      (with-env (stream :lines 2)
+        (inravina-extrinsic:pprint-logical-block (stream nil :per-line-prefix "z")
+          (inravina-extrinsic:pprint-logical-block (stream nil :prefix "a
+(" :suffix ")")
+            (write-string "wibble" stream)
+            (inravina-extrinsic:pprint-newline :mandatory stream)
+            (write-string "bar" stream))))))
+
+(define-test pprint-logical-block.5
+  (is equal
+      "[a
+(wibble ..)]"
+      (with-env (stream :lines 2)
+        (inravina-extrinsic:pprint-logical-block (stream nil :prefix "[" :suffix "]")
+          (inravina-extrinsic:pprint-logical-block (stream nil :prefix "a
+(" :suffix ")")
+            (write-string "wibble" stream)
+            (inravina-extrinsic:pprint-newline :mandatory stream)
+            (write-string "bar" stream))))))

code/extrinsic/unit-test/utilities.lisp

@@ -0,0 +1,22 @@
+(in-package #:inravina-extrinsic/unit-test)
+
+(defmacro with-env ((stream
+                     &key (array t) (base 10) (case :upcase) circle
+                          (escape t) (gensym t) level length lines
+                          miser-width (pretty t) readably right-margin)
+                    &body body)
+  `(let ((*print-array* ,array)
+         (*print-base* ,base)
+         (*print-case* ,case)
+         (*print-circle* ,circle)
+         (*print-escape* ,escape)
+         (*print-gensym* ,gensym)
+         (*print-level* ,level)
+         (*print-length* ,length)
+         (*print-lines* ,lines)
+         (*print-miser-width* ,miser-width)
+         (*print-pretty* ,pretty)
+         (*print-readably* ,readably)
+         (*print-right-margin* ,right-margin))
+     (with-output-to-string (,stream)
+       ,@body)))

code/pretty-stream.lisp

@@ -829,7 +829,9 @@
   (loop with start = 0
         for pos = (position #\newline text :start start)
         unless pos
-          collect (subseq text start)
+          collect (if (zerop start)
+                      text
+                      (subseq text start))
           and do (loop-finish)
         collect (subseq text start pos)
         append newline

inravina-extrinsic.asd

@@ -6,26 +6,41 @@
   :license "MIT"
   :depends-on ("incless-extrinsic"
                "inravina")
-  :in-order-to ((asdf:test-op (asdf:test-op #:inravina-extrinsic/test)))
+  :in-order-to ((asdf:test-op (asdf:test-op #:inravina-extrinsic/ansi-test)))
   :components ((:module "code"
                 :pathname "code/extrinsic/"
                 :serial t
                 :components ((:file "packages")
                              (:file "print")))))
 
-(asdf:defsystem "inravina-extrinsic/test"
-  :description "Extrinsic testing interface to Inravina."
+(asdf:defsystem "inravina-extrinsic/unit-test"
+  :description "Unit testing suite for Inravina."
+  :author "Tarn W. Burton"
+  :license "MIT"
+  :depends-on ("alexandria"
+               "inravina-extrinsic"
+               "parachute")
+  :perform (asdf:test-op (op c) (uiop:symbol-call :parachute :test :inravina-extrinsic/unit-test))
+  :components ((:module code
+                :pathname "code/extrinsic/unit-test/"
+                :serial t
+                :components ((:file "packages")
+                             (:file "utilities")
+                             (:file "pprint-logical-block")))))
+
+(asdf:defsystem "inravina-extrinsic/ansi-test"
+  :description "ANSI testing suite to Inravina."
   :license "MIT"
   :author "Tarn W. Burton"
   :homepage "https://github.com/s-expressionists/Inravina"
   :bug-tracker "https://github.com/s-expressionists/Inravina/issues"
   :depends-on ("inravina-extrinsic"
                "ansi-test-harness")
   :perform (asdf:test-op (op c)
-             (symbol-call :inravina-extrinsic/test :test))
+             (symbol-call :inravina-extrinsic/ansi-test :test))
   :components ((:module code
-                :pathname "code/extrinsic/test/"
+                :pathname "code/extrinsic/ansi-test/"
                 :serial t
                 :components ((:file "packages")
-                             (:file "ansi-test")
+                             (:file "test")
                              (:static-file "expected-failures.sexp")))))