Skip to content
Snippets Groups Projects
Commit e585e8d6 authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix ticket:101, implementing STREAM-ADVANCE-TO-COLUMN for FORMAT ~T.

 * code/format.lisp:
   * Add support for Gray streams for tabulation, calling
     STREAM-ADVANCE-TO-COLUMN as needed.
 * tests/gray-stream.lisp:
   * Add tests for absolute and relative tabulation. These are simple
     and just compare that lisp streams and Gray streams produce the
     same output.
 * general-info/release-20f.txt:
   * Update.
parent 63d44f2c
No related branches found
No related tags found
No related merge requests found
......@@ -2122,27 +2122,73 @@
(decf n (length spaces)))
(write-string spaces stream :end n)))
;; CLHS 22.3.6.1 for relative tabulations says:
;;
;; ... outputs COLREL spaces and then outputs the smallest
;; non-negative number of additional spaces necessary to move the
;; cursor to a column that is a multiple of COLINC.... If the
;; current output column cannot be determined, however, then colinc
;; is ignored, and exactly colrel spaces are output.
(defun format-relative-tab (stream colrel colinc)
(if (pp:pretty-stream-p stream)
(pprint-tab :line-relative colrel colinc stream)
(let* ((cur (lisp::charpos stream))
(spaces (if (and cur (plusp colinc))
(- (* (ceiling (+ cur colrel) colinc) colinc) cur)
colrel)))
(output-spaces stream spaces))))
(flet ((advance-to-column ()
(let* ((cur (lisp::charpos stream))
(spaces (if (and cur (plusp colinc))
(- (* (ceiling (+ cur colrel) colinc) colinc) cur)
colrel)))
(output-spaces stream spaces))))
(lisp::stream-dispatch stream
;; simple-stream
(advance-to-column)
;; lisp-stream
(advance-to-column)
;; fundamental-stream
(let ((cur (stream-line-column stream)))
(cond ((and cur (plusp colinc))
(stream-advance-to-column stream
(+ cur
(* (floor (+ cur colrel) colinc)
colinc))))
(t
(stream-advance-to-column stream (+ cur colrel)))))))))
;; CLHS 22.3.6.1 says:
;;
;; If the cursor is already at or beyond the column COLNUM, it will
;; output spaces to move it to COLNUM + k*COLINC for the smallest
;; positive integer k possible, unless COLINC is zero, in which case
;; no spaces are output.
(defun format-absolute-tab (stream colnum colinc)
(if (pp:pretty-stream-p stream)
(pprint-tab :line colnum colinc stream)
(let ((cur (lisp::charpos stream)))
(cond ((null cur)
(write-string " " stream))
((< cur colnum)
(output-spaces stream (- colnum cur)))
(t
(unless (zerop colinc)
(output-spaces stream
(- colinc (rem (- cur colnum) colinc)))))))))
(flet ((advance-to-column ()
(let ((cur (lisp::charpos stream)))
(cond ((null cur)
(write-string " " stream))
((< cur colnum)
(output-spaces stream (- colnum cur)))
(t
(unless (zerop colinc)
(output-spaces stream
(- colinc (rem (- cur colnum) colinc)))))))))
(lisp::stream-dispatch stream
;; simple-stream. NOTE: Do we need to do soemthing better for
;; simple streams?
(advance-to-column)
;; lisp-stream
(advance-to-column)
;; fundamental-stream
(let ((cur (stream-line-column stream)))
(cond ((null cur)
(write-string " " stream))
((< cur colnum)
(stream-advance-to-column stream colnum))
(t
(unless (zerop colinc)
(let ((k (ceiling (- cur colnum) colinc)))
(stream-advance-to-column stream
(+ colnum (* k colinc))))))))))))
(def-format-directive #\_ (colonp atsignp params)
(expand-bind-defaults () params
......
......@@ -110,6 +110,7 @@ New in this release:
* Ticket #105, fixed.
* Ticket #84 fixed on x86.
* Ticket #105 fixed.
* Ticket #101 fixed.
* Other changes:
......
......@@ -16,6 +16,9 @@
(defparameter *test-file*
(merge-pathnames #p"test-data.tmp" *test-path*))
(defparameter *test-file-2*
(merge-pathnames #P"test-data-gray.tmp" *test-path*))
(eval-when (:load-toplevel)
(ensure-directories-exist *test-path* :verbose t))
......@@ -37,3 +40,73 @@
(file-length s))
(close s)
(delete-file *test-file*)))))
(define-test format-abs-stream-advance
(:tag :trac)
;; Create a lisp stream and a Gray stream and test format ~T on
;; each. Compare the length of each file and declare success if the
;; lengths are the same.
;;
;; FIXME: This doesn't actually test that STREAM-ADVANCE-TO-COLUMN
;; was actually called. Another test should be added for that. We're
;; testing functionality here. It was verified manually using TRACE
;; that FORMAT on a Gray stream does in fact call
;; STREAM-ADVANCE-TO-COLUMN
(assert-equal "18 18"
(let ((lisp-stream (open *test-file*
:direction :output
:if-exists :supersede))
(gray-stream (open *test-file-2*
:direction :output
:if-exists :supersede
:class 'lisp::character-output-stream)))
(unwind-protect
(progn
(format lisp-stream "~10T")
(format lisp-stream "~8,10T")
(format gray-stream "~10T")
(format gray-stream "~8,10T")
(force-output lisp-stream)
(force-output gray-stream)
(format nil "~D ~D"
(file-position lisp-stream)
(file-position gray-stream)))
(close lisp-stream)
(close gray-stream)
(delete-file *test-file*)
(delete-file *test-file-2*)))))
(define-test format-rel-stream-advance
(:tag :trac)
;; Create a lisp stream and a Gray stream and test format ~@T on
;; each. Compare the length of each file and declare success if the
;; lengths are the same.
;;
;; FIXME: This doesn't actually test that STREAM-ADVANCE-TO-COLUMN
;; was actually called. Another test should be added for that. We're
;; testing functionality here. It was verified manually using TRACE
;; that FORMAT on a Gray stream does in fact call
;; STREAM-ADVANCE-TO-COLUMN
(assert-equal "20 20"
(let ((lisp-stream (open *test-file*
:direction :output
:if-exists :supersede))
(gray-stream (open *test-file-2*
:direction :output
:if-exists :supersede
:class 'lisp::character-output-stream)))
(unwind-protect
(progn
(format lisp-stream "~10T")
(format lisp-stream "~8,10@T")
(format gray-stream "~10T")
(format gray-stream "~8,10@T")
(force-output lisp-stream)
(force-output gray-stream)
(format nil "~D ~D"
(file-position lisp-stream)
(file-position gray-stream)))
(close lisp-stream)
(close gray-stream)
(delete-file *test-file*)
(delete-file *test-file-2*)))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment