Update extrinsic tests

s-expressionists · Jan 17, 2024 · 1804c22 · 1804c22
1 parent 92b31f4
commit 1804c22
Show file tree

Hide file tree

Showing 9 changed files with 60 additions and 120 deletions.
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
@@ -48,4 +48,4 @@ jobs:
         asdf-add
     - name: Run ANSI Tests
       run: |
-        lisp -i ${{ matrix.lisp }} -e "(ql:quickload :incless-extrinsic/test)" -e "(asdf:test-system :incless-extrinsic)"
+        lisp -i ${{ matrix.lisp }} -e "(ql:quickload :incless-extrinsic/test)" -e "(incless-extrinsic/test:test :exit t)"
diff --git a/incless-extrinsic.asd b/incless-extrinsic.asd
@@ -21,19 +21,13 @@
   :description "ANSI Test system for Inravina"
   :license "MIT"
   :author "Tarn W. Burton"
-  :depends-on ("alexandria"
+  :depends-on ("ansi-test-harness"
                "invistra-extrinsic")
   :perform (test-op (op c)
              (symbol-call :incless-extrinsic/test :test))
   :components ((:module "code"
                 :pathname "src/extrinsic/test/"
                 :serial t
                 :components ((:file "packages")
-                             (:file "test")))
-               (:module "expected-failures"
-                :pathname "src/extrinsic/test/expected-failures"
-                :components ((:static-file "default.sexp")
-                             (:static-file "abcl.sexp")
-                             (:static-file "clasp.sexp")
-                             (:static-file "ecl.sexp")
-                             (:static-file "sbcl.sexp")))))
+                             (:file "test")
+                             (:static-file "expected-failures.sexp")))))
diff --git a/src/extrinsic/test/expected-failures.sexp b/src/extrinsic/test/expected-failures.sexp
@@ -0,0 +1,18 @@
+#+(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
+
+#+sbcl PRINT.BACKQUOTE.RANDOM.1
+#+sbcl PRINT.BACKQUOTE.RANDOM.2
+#+sbcl PRINT.BACKQUOTE.RANDOM.3
+#+sbcl PRINT.BACKQUOTE.RANDOM.4
+#+sbcl PRINT.BACKQUOTE.RANDOM.5
+#+sbcl PRINT.BACKQUOTE.RANDOM.10
+#+sbcl PRINT.BACKQUOTE.RANDOM.11
+#+sbcl PRINT.BACKQUOTE.RANDOM.13
+#+sbcl PRINT.BACKQUOTE.RANDOM.14
+
+#+(or abcl clasp ecl sbcl) FORMAT.E.26
+#+clasp PRINT.DOUBLE-FLOAT.RANDOM
+#+clasp PRINT.LONG-FLOAT.RANDOM
diff --git a/src/extrinsic/test/expected-failures/abcl.sexp b/src/extrinsic/test/expected-failures/abcl.sexp
diff --git a/src/extrinsic/test/expected-failures/clasp.sexp b/src/extrinsic/test/expected-failures/clasp.sexp
diff --git a/src/extrinsic/test/expected-failures/default.sexp b/src/extrinsic/test/expected-failures/default.sexp
diff --git a/src/extrinsic/test/expected-failures/ecl.sexp b/src/extrinsic/test/expected-failures/ecl.sexp
diff --git a/src/extrinsic/test/expected-failures/sbcl.sexp b/src/extrinsic/test/expected-failures/sbcl.sexp
diff --git a/src/extrinsic/test/test.lisp b/src/extrinsic/test/test.lisp
@@ -1,41 +1,5 @@
 (in-package #:incless-extrinsic/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")
-
 (defvar *tests*
   '("COPY-PPRINT-DISPATCH."
     "FORMAT."
@@ -73,53 +37,41 @@
     "WRITE."
     "WRITE-TO-STRING."))
 
-(defun test (&rest args &key skip-sync &allow-other-keys)
-  (let* ((system (asdf:find-system :incless-extrinsic/test))
-         (expected-failures (asdf:component-pathname (asdf:find-component system '("expected-failures"
-                                                                                   #+abcl "abcl.sexp"
-                                                                                   #+clasp "clasp.sexp"
-                                                                                   #+ecl "ecl.sexp"
-                                                                                   #+sbcl "sbcl.sexp"
-                                                                                   #-(or abcl clasp ecl sbcl)
-                                                                                   "default.sexp"))))
-         (*default-pathname-defaults* (merge-pathnames (make-pathname :directory '(:relative "dependencies" "ansi-test"))
-                                                       (asdf:component-pathname system)))
-         (cl-user::*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)))
-    (declare (special cl-user::*extrinsic-symbols*))
-    (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 (member (symbol-name name) *tests*
-                      :test (lambda (name prefix)
-                              (alexandria:starts-with-subseq prefix name)))
-        (uiop:symbol-call :regression-test :rem-test name)))
-    (uiop:symbol-call :regression-test :do-tests :exit t :expected-failures expected-failures)))
+(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 :incless-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)))