diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index c23b0da..1d45bf5 100644 --- a/.github/workflows/test.yml +++ b/.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)" diff --git a/code/extrinsic/test/expected-failures.sexp b/code/extrinsic/ansi-test/expected-failures.sexp similarity index 100% rename from code/extrinsic/test/expected-failures.sexp rename to code/extrinsic/ansi-test/expected-failures.sexp diff --git a/code/extrinsic/ansi-test/packages.lisp b/code/extrinsic/ansi-test/packages.lisp new file mode 100644 index 0000000..dfebee0 --- /dev/null +++ b/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)) diff --git a/code/extrinsic/test/ansi-test.lisp b/code/extrinsic/ansi-test/test.lisp similarity index 92% rename from code/extrinsic/test/ansi-test.lisp rename to code/extrinsic/ansi-test/test.lisp index 7e07661..37d3a18 100644 --- a/code/extrinsic/test/ansi-test.lisp +++ b/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 diff --git a/code/extrinsic/test/packages.lisp b/code/extrinsic/test/packages.lisp deleted file mode 100644 index 170f958..0000000 --- a/code/extrinsic/test/packages.lisp +++ /dev/null @@ -1,5 +0,0 @@ -(cl:in-package #:common-lisp-user) - -(defpackage #:inravina-extrinsic/test - (:use #:common-lisp) - (:export #:ansi-test)) diff --git a/code/extrinsic/unit-test/packages.lisp b/code/extrinsic/unit-test/packages.lisp new file mode 100644 index 0000000..6463328 --- /dev/null +++ b/code/extrinsic/unit-test/packages.lisp @@ -0,0 +1,4 @@ +(defpackage #:inravina-extrinsic/unit-test + (:use #:common-lisp #:parachute) + (:export)) + diff --git a/code/extrinsic/unit-test/pprint-logical-block.lisp b/code/extrinsic/unit-test/pprint-logical-block.lisp new file mode 100644 index 0000000..4c53020 --- /dev/null +++ b/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)))))) diff --git a/code/extrinsic/unit-test/utilities.lisp b/code/extrinsic/unit-test/utilities.lisp new file mode 100644 index 0000000..c387fc4 --- /dev/null +++ b/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))) diff --git a/code/pretty-stream.lisp b/code/pretty-stream.lisp index a9dc56d..50655aa 100644 --- a/code/pretty-stream.lisp +++ b/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 diff --git a/inravina-extrinsic.asd b/inravina-extrinsic.asd index 1b4352a..75d2412 100644 --- a/inravina-extrinsic.asd +++ b/inravina-extrinsic.asd @@ -6,15 +6,30 @@ :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" @@ -22,10 +37,10 @@ :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")))))