Merge branch 'gray-real-column' into 'develop'

Allow real-valued columns in various Gray stream methods

See merge request embeddable-common-lisp/ecl!264

CHANGELOG

@@ -29,6 +29,9 @@
 
 * Pending changes since 21.2.1
 ** Enhancements
+- Allow real-valued columns in Gray stream method stream-line-column and
+  stream-advance-to-column. Use floor where needed to prevent breaking
+  existing code which depends on sys:file-column.
 - Support for non-ascii characters in pathnames. Pathname encoding defaults
   to utf-8 on Unix and may be changed using ~ext:*default-external-format*~
   (Windows always uses the utf-16 format provided by the OS).

src/c/file.d

@@ -1330,7 +1330,7 @@ static int
 clos_stream_column(cl_object strm)
 {
   cl_object col = _ecl_funcall2(@'gray::stream-line-column', strm);
-  return Null(col)? -1 : ecl_to_size(col);
+  return Null(col)? -1 : ecl_to_size(ecl_floor1(col));
 }
 
 static cl_object

src/clos/streams.lsp

@@ -279,7 +279,7 @@
                                      column)
   (let ((current-column (stream-line-column stream)))
     (when current-column
-      (let ((fill (- column current-column)))
+      (let ((fill (floor (- column current-column))))
         (dotimes (i fill)
           (stream-write-char stream #\Space)))
       T)))

src/tests/normal-tests/mixed.lsp

@@ -395,3 +395,30 @@
     (signals simple-error (ed "qux"))
     (signals file-error (ed "baz"))))
 
+;;;; Author:   Tarn W. Burton
+;;;; Created:  2021-12-21
+;;;; Contains: pretty printer tests for real valued columns
+(defclass pp-stream-test (gray:fundamental-character-output-stream)
+  ((column :accessor gray:stream-line-column
+           :initform (random .5))
+   (value :accessor pp-stream-test-value
+          :initform (make-array 10 :adjustable t :fill-pointer 0
+                                :element-type 'character))))
+(defmethod gray:stream-write-char ((stream pp-stream-test) char)
+  (if (eql char #\Newline)
+      (setf (gray:stream-line-column stream) (random .5))
+      (incf (gray:stream-line-column stream)))
+  (vector-push-extend char (pp-stream-test-value stream)))
+(test mix.0021.pretty-printer
+  (let ((stream (make-instance 'pp-stream-test))
+        (*print-right-margin* 15))
+    (pprint '(let ((fu 1) (bar 2)) (+ fu bar 7))
+            stream)
+    (is-eql (sys:file-column stream) 15)
+    (is (gray:stream-advance-to-column stream 20))
+    (write-char #\A stream)
+    (is-equal (pp-stream-test-value stream)
+            "
+(LET ((FU 1)
+      (BAR 2))
+  (+ FU BAR 7))    A")))