Fix unit-test for ABCL

Also fix some style errors
s-expressionists · May 20, 2024 · 7c38e15 · 7c38e15
1 parent 0a39a14
commit 7c38e15
Show file tree

Hide file tree

Showing 5 changed files with 22 additions and 15 deletions.
diff --git a/code/extrinsic/unit-test/utilities.lisp b/code/extrinsic/unit-test/utilities.lisp
@@ -3,6 +3,8 @@
 (defun format-eval (&rest args)
   (apply #'invistra-extrinsic:format args))
 
+(defun rti (x) x)
+
 (defmacro my-with-standard-io-syntax (&body body)
   `(let ((*print-array* t)
          (*print-base* 10)
@@ -27,7 +29,7 @@
           ,expected
           ,form))
     (macrolet ((fmt (destination control-string &rest args)
-                 `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                 `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
       (is equal
           ,expected
           ,form))))
@@ -41,7 +43,7 @@
              ,expected
              ,form))
        (macrolet ((fmt (destination control-string &rest args)
-                    `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                    `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
          (is equal
              ,expected
              ,form)))))
@@ -54,7 +56,7 @@
                      ,form)
                    condition)
      (fail (macrolet ((fmt (destination control-string &rest args)
-                        `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                        `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
              ,form))))
 
 (defmacro define-argument-fail-test (name form)
@@ -64,5 +66,5 @@
                                 `(invistra-extrinsic:format ,destination ,control-string ,@args)))
                      ,form))
      (fail (macrolet ((fmt (destination control-string &rest args)
-                        `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                        `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
              ,form))))
diff --git a/code/interface.lisp b/code/interface.lisp
@@ -4,6 +4,7 @@
   (intern (string name) package))
 
 (defmacro define-interface ((client-var client-class &optional intrinsic) &body body)
+  (declare (ignore client-class))
   (let* ((intrinsic-pkg (if intrinsic (find-package '#:common-lisp) *package*))
          (format-func (ensure-symbol '#:format intrinsic-pkg))
          (initialize-func (ensure-symbol '#:initialize-invistra)))

diff --git a/code/pretty-printer-operations.lisp b/code/pretty-printer-operations.lisp
@@ -294,7 +294,6 @@
       (setf (function-name directive) (intern symbol-name package)))))
 
 (defmethod interpret-item (client (directive call-function-directive) &optional parameters)
-  (declare (ignore client))
   (apply (coerce-function-designator client (function-name directive))
          *destination*
          (pop-argument)
@@ -303,7 +302,6 @@
          parameters))
 
 (defmethod compile-item (client (directive call-function-directive) &optional parameters)
-  (declare (ignore client))
   `((funcall (coerce-function-designator ,(incless:client-form client) ',(function-name directive))
              *destination*
              (pop-argument)

diff --git a/code/printer-operations.lisp b/code/printer-operations.lisp
@@ -29,6 +29,7 @@
                "()"
                (with-output-to-string (stream)
                  (incless:write-object client arg stream)))
+           *destination*
            (at-sign-p directive) parameters)))
 
 (defmethod compile-item (client (directive a-directive) &optional parameters)
@@ -64,7 +65,8 @@
                       "()"
                       (with-output-to-string (stream)
                         (incless:write-object ,(incless:client-form client) arg stream)))
-                  ,at-sign-p ,@parameters))))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))
             (t
              `((let ((*print-escape* nil)
                      (*print-readably* nil))
@@ -73,7 +75,8 @@
                     (incless:write-object ,(incless:client-form client)
                                           (pop-argument)
                                           stream))
-                  ,at-sign-p ,@parameters))))))))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -99,6 +102,7 @@
                "()"
                (with-output-to-string (stream)
                  (incless:write-object client arg stream)))
+           *destination*
            (at-sign-p directive) parameters)))
 
 (defmethod compile-item (client (directive s-directive) &optional parameters)
@@ -131,15 +135,17 @@
                       "()"
                       (with-output-to-string (stream)
                         (incless:write-object ,(incless:client-form client) arg stream)))
-                  ,at-sign-p ,@parameters))))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))
             (t
              `((let ((*print-escape* t))
                  (write-string-with-padding
                   (with-output-to-string (stream)
                     (incless:write-object ,(incless:client-form client)
                                           (pop-argument)
                                           stream))
-                  ,at-sign-p ,@parameters))))))))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;

diff --git a/code/utilities.lisp b/code/utilities.lisp
@@ -98,12 +98,12 @@
             (t
              (write-char char (target stream)))))))
 
-(defun write-string-with-padding (string pad-left-p mincol colinc minpad padchar)
+(defun write-string-with-padding (string stream pad-left-p mincol colinc minpad padchar)
   (let ((pad-length (max minpad (* colinc (ceiling (- mincol (length string)) colinc)))))
     (if pad-left-p
         (loop repeat pad-length
-              finally (write-string string *destination*)
-              do (write-char padchar *destination*))
+              finally (write-string string stream)
+              do (write-char padchar stream))
         (loop repeat pad-length
-                initially (write-string string *destination*)
-              do (write-char padchar *destination*)))))
+                initially (write-string string stream)
+              do (write-char padchar stream)))))