From f4e854c34de2f4c0edafef77039b7638be42a0c1 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Thu, 18 Jan 2024 07:33:33 -0500 Subject: [PATCH] Move ansi-test to extrinsic --- .github/workflows/test.yml | 4 +- code/extrinsic/test/ansi-test.lisp | 49 ++++++++++++++++ code/extrinsic/test/expected-failures.sexp | 6 ++ code/extrinsic/test/format.lisp | 2 +- code/extrinsic/test/packages.lisp | 6 +- code/radix-control.lisp | 2 +- code/shim/test/expected-failures/clasp.sexp | 1 - code/shim/test/expected-failures/default.sexp | 0 code/shim/test/expected-failures/ecl.sexp | 1 - code/shim/test/expected-failures/sbcl.sexp | 2 - code/shim/test/packages.lisp | 5 -- code/shim/test/test.lisp | 58 ------------------- invistra-extrinsic.asd | 16 +++-- invistra-shim.asd | 22 ------- 14 files changed, 74 insertions(+), 100 deletions(-) create mode 100644 code/extrinsic/test/ansi-test.lisp create mode 100644 code/extrinsic/test/expected-failures.sexp delete mode 100644 code/shim/test/expected-failures/clasp.sexp delete mode 100644 code/shim/test/expected-failures/default.sexp delete mode 100644 code/shim/test/expected-failures/ecl.sexp delete mode 100644 code/shim/test/expected-failures/sbcl.sexp delete mode 100644 code/shim/test/packages.lisp delete mode 100644 code/shim/test/test.lisp diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 517f6a1..9d7be41 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -47,7 +47,7 @@ jobs: asdf-add - name: Run Regression Tests run: | - lisp -i ${{ matrix.lisp }} -e "(ql:quickload :invistra-extrinsic/test)" -e "(asdf:test-system :invistra-extrinsic)" + lisp -i ${{ matrix.lisp }} -e "(defparameter cl-user::*exit-on-test-failures* t)" -e "(ql:quickload :invistra-extrinsic/test)" -e "(parachute:test :invistra-extrinsic/test/regression)" - name: Run ANSI Tests run: | - lisp -i ${{ matrix.lisp }} -e "(ql:quickload :invistra-shim/test)" -e "(asdf:test-system :invistra-shim)" + lisp -i ${{ matrix.lisp }} -e "(ql:quickload :invistra-extrinsic/test)" -e "(invistra-extrinsic/test/ansi:test :exit t)" diff --git a/code/extrinsic/test/ansi-test.lisp b/code/extrinsic/test/ansi-test.lisp new file mode 100644 index 0000000..53d3361 --- /dev/null +++ b/code/extrinsic/test/ansi-test.lisp @@ -0,0 +1,49 @@ +(in-package #:invistra-extrinsic/test/ansi) + +(defvar *tests* + '("FORMAT." + "FORMATTER.")) + +(defvar *extrinsic-symbols* + '(incless-extrinsic:pprint + incless-extrinsic:prin1 + incless-extrinsic:prin1-to-string + incless-extrinsic:princ + incless-extrinsic:princ-to-string + incless-extrinsic:print + incless-extrinsic:print-object + incless-extrinsic:print-unreadable-object + incless-extrinsic:write + incless-extrinsic:write-to-string + inravina-extrinsic:*print-pprint-dispatch* + inravina-extrinsic:copy-pprint-dispatch + inravina-extrinsic:pprint-dispatch + inravina-extrinsic:pprint-exit-if-list-exhausted + inravina-extrinsic:pprint-fill + inravina-extrinsic:pprint-indent + inravina-extrinsic:pprint-linear + inravina-extrinsic:pprint-logical-block + inravina-extrinsic:pprint-newline + inravina-extrinsic:pprint-pop + inravina-extrinsic:pprint-tab + inravina-extrinsic:pprint-tabular + inravina-extrinsic:set-pprint-dispatch + inravina-extrinsic:with-standard-io-syntax + invistra-extrinsic:format + invistra-extrinsic:formatter)) + +(defun test (&rest args) + (let ((system (asdf:find-system :invistra-extrinsic/test))) + (apply #'ansi-test-harness:ansi-test + :directory (merge-pathnames + (make-pathname :directory '(:relative + "dependencies" + "ansi-test")) + (asdf:component-pathname system)) + :expected-failures (asdf:component-pathname + (asdf:find-component system + '("code" + "expected-failures.sexp"))) + :extrinsic-symbols *extrinsic-symbols* + :tests *tests* + args))) diff --git a/code/extrinsic/test/expected-failures.sexp b/code/extrinsic/test/expected-failures.sexp new file mode 100644 index 0000000..2186af8 --- /dev/null +++ b/code/extrinsic/test/expected-failures.sexp @@ -0,0 +1,6 @@ +#+(or clasp ecl sbcl) :NIL-VECTORS-ARE-STRINGS +#+(or clasp ecl) :ALLOW-NIL-ARRAYS +#+(or clasp ecl) :MAKE-CONDITION-WITH-COMPOUND-NAME +#+(or clasp ecl) :NO-FLOATING-POINT-UNDERFLOW-BY-DEFAULT + +#+(or abcl clasp ecl sbcl) FORMAT.E.26 diff --git a/code/extrinsic/test/format.lisp b/code/extrinsic/test/format.lisp index 186b50a..cf8c6b1 100644 --- a/code/extrinsic/test/format.lisp +++ b/code/extrinsic/test/format.lisp @@ -1,4 +1,4 @@ -(cl:in-package #:invistra-extrinsic/test) +(cl:in-package #:invistra-extrinsic/test/regression) (defun format-eval (&rest args) (apply #'invistra-extrinsic:format args)) diff --git a/code/extrinsic/test/packages.lisp b/code/extrinsic/test/packages.lisp index d60afb2..975a5da 100644 --- a/code/extrinsic/test/packages.lisp +++ b/code/extrinsic/test/packages.lisp @@ -1,4 +1,8 @@ (cl:in-package #:common-lisp-user) -(defpackage #:invistra-extrinsic/test +(defpackage #:invistra-extrinsic/test/regression (:use #:cl #:parachute)) + +(defpackage #:invistra-extrinsic/test/ansi + (:use #:cl) + (:export #:test)) diff --git a/code/radix-control.lisp b/code/radix-control.lisp index 08cbb6e..9c95b96 100644 --- a/code/radix-control.lisp +++ b/code/radix-control.lisp @@ -12,7 +12,7 @@ '((:type integer :default 0) (:type character :default #\Space) (:type character :default #\,) - (:type (integer 1) :default 3))) + (:type integer :default 3))) (defun print-radix-arg (client colon-p at-sign-p radix mincol padchar commachar comma-interval) (let ((argument (consume-next-argument t))) diff --git a/code/shim/test/expected-failures/clasp.sexp b/code/shim/test/expected-failures/clasp.sexp deleted file mode 100644 index c798541..0000000 --- a/code/shim/test/expected-failures/clasp.sexp +++ /dev/null @@ -1 +0,0 @@ -FORMAT.E.26 diff --git a/code/shim/test/expected-failures/default.sexp b/code/shim/test/expected-failures/default.sexp deleted file mode 100644 index e69de29..0000000 diff --git a/code/shim/test/expected-failures/ecl.sexp b/code/shim/test/expected-failures/ecl.sexp deleted file mode 100644 index c798541..0000000 --- a/code/shim/test/expected-failures/ecl.sexp +++ /dev/null @@ -1 +0,0 @@ -FORMAT.E.26 diff --git a/code/shim/test/expected-failures/sbcl.sexp b/code/shim/test/expected-failures/sbcl.sexp deleted file mode 100644 index 3cb67ce..0000000 --- a/code/shim/test/expected-failures/sbcl.sexp +++ /dev/null @@ -1,2 +0,0 @@ -FORMAT.E.2 -FORMAT.E.26 diff --git a/code/shim/test/packages.lisp b/code/shim/test/packages.lisp deleted file mode 100644 index 2cf1cef..0000000 --- a/code/shim/test/packages.lisp +++ /dev/null @@ -1,5 +0,0 @@ -(in-package #:common-lisp-user) - -(defpackage #:invistra-shim/test - (:use #:common-lisp) - (:export #:test)) diff --git a/code/shim/test/test.lisp b/code/shim/test/test.lisp deleted file mode 100644 index 692c6bd..0000000 --- a/code/shim/test/test.lisp +++ /dev/null @@ -1,58 +0,0 @@ -(in-package #:invistra-shim/test) - -(defun check-repo (&key directory repository &allow-other-keys) - (format t "~:[Did not find~;Found~] ~A clone in ~A, assuming everything is okay.~%" - (probe-file directory) repository directory)) - -(defun sync-repo (&key (git "git") clean directory repository branch commit - &allow-other-keys - &aux (exists (probe-file directory))) - (cond ((and exists (not clean)) - (format t "Fetching ~A~%" repository) - (uiop:run-program (list git "fetch" "--quiet") - :output :interactive - :error-output :output - :directory directory)) - (t - (when (and clean exists) - (format t "Removing existing directory ~A~%" directory) - (uiop:delete-directory-tree exists :validate t)) - (format t "Cloning ~A~%" repository) - (uiop:run-program (list git "clone" repository (namestring directory)) - :output :interactive - :error-output :output))) - (when (or commit branch) - (format t "Checking out ~A from ~A~%" (or commit branch) repository) - (uiop:run-program (list git "checkout" "--quiet" (or commit branch)) - :output :interactive - :error-output :output - :directory directory)) - (when (and branch (not commit)) - (format t "Fast forwarding to origin/~A from ~A~%" branch repository) - (uiop:run-program (list git "merge" "--ff-only" (format nil "origin/~A" branch)) - :output :interactive - :error-output :output - :directory directory))) - -(defvar +ansi-test-repository+ "https://gitlab.common-lisp.net/ansi-test/ansi-test.git") - -(defun test (&rest args &key skip-sync &allow-other-keys) - (let* ((system (asdf:find-system :invistra-shim/test)) - (expected-failures (asdf:component-pathname (asdf:find-component system '("expected-failures" - #+clasp "clasp.sexp" - #+ecl "ecl.sexp" - #+sbcl "sbcl.sexp" - #-(or clasp ecl sbcl) - "default.sexp")))) - (*default-pathname-defaults* (merge-pathnames (make-pathname :directory '(:relative "dependencies" "ansi-test")) - (asdf:component-pathname system)))) - (if skip-sync - (check-repo :directory *default-pathname-defaults* :repository +ansi-test-repository+) - (apply #'sync-repo :directory *default-pathname-defaults* :repository +ansi-test-repository+ args)) - (load #P"init.lsp") - (dolist (name (mapcar (lambda (entry) - (uiop:symbol-call :regression-test :name entry)) - (cdr (symbol-value (find-symbol "*ENTRIES*" :regression-test))))) - (unless (alexandria:starts-with-subseq "FORMAT" (symbol-name name)) - (uiop:symbol-call :regression-test :rem-test name))) - (uiop:symbol-call :regression-test :do-tests :exit t :expected-failures expected-failures))) diff --git a/invistra-extrinsic.asd b/invistra-extrinsic.asd index 49d705b..472e639 100644 --- a/invistra-extrinsic.asd +++ b/invistra-extrinsic.asd @@ -21,18 +21,22 @@ (defsystem "invistra-extrinsic/test" :description "Test system for Invistra" :license "BSD" - :author "Robert Strandh" - :maintainer "Robert Strandh" + :author ("Robert Strandh" + "Tarn W. Burton") + :maintainer "Tarn W. Burton" :version (:read-file-form "version.sexp") :homepage "https://github.com/s-expressionists/Invistra" :bug-tracker "https://github.com/s-expressionists/Invistra/issues" :depends-on ("invistra-extrinsic" - "parachute") + "parachute" + "ansi-test-harness") :perform (asdf:test-op (op c) - (defparameter cl-user::*exit-on-test-failures* t) - (uiop:symbol-call :parachute :test :invistra-extrinsic/test)) + (uiop:symbol-call :invistra-extrinsic/test/ansi :test) + (uiop:symbol-call :parachute :test :invistra-extrinsic/test/regression)) :components ((:module code :pathname "code/extrinsic/test/" :serial t :components ((:file "packages") - (:file "format"))))) + (:file "format") + (:file "ansi-test") + (:static-file "expected-failures.sexp"))))) diff --git a/invistra-shim.asd b/invistra-shim.asd index ab215a4..4e9b70a 100644 --- a/invistra-shim.asd +++ b/invistra-shim.asd @@ -13,30 +13,8 @@ "inravina-native" "invistra" "trivial-package-locks") - :in-order-to ((test-op (test-op "invistra-shim/test"))) :components ((:module code :pathname "code/shim/" :serial t :components ((:file "packages") (:file "interface"))))) - -(defsystem "invistra-shim/test" - :description "ANSI Test system for Invistra" - :license "MIT" - :author ("Robert Strandh" - "Tarn W. Burton") - :maintainer "Tarn W. Burton" - :depends-on ("alexandria" "invistra-shim") - :perform (test-op (op c) - (symbol-call :invistra-shim/test :test)) - :components ((:module "code" - :pathname "code/shim/test/" - :serial t - :components ((:file "packages") - (:file "test"))) - (:module "expected-failures" - :pathname "code/shim/test/expected-failures" - :components ((:static-file "default.sexp") - (:static-file "clasp.sexp") - (:static-file "ecl.sexp") - (:static-file "sbcl.sexp")))))