From e585e8d6acbc146e978d1c2c5171987b6ba2fddf Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Sat, 9 Aug 2014 23:49:14 -0700 Subject: [PATCH] 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. --- src/code/format.lisp | 76 +++++++++++++++++++++++++------- src/general-info/release-20f.txt | 1 + tests/gray-streams.lisp | 73 ++++++++++++++++++++++++++++++ 3 files changed, 135 insertions(+), 15 deletions(-) diff --git a/src/code/format.lisp b/src/code/format.lisp index 704ec347a..7a2de48c7 100644 --- a/src/code/format.lisp +++ b/src/code/format.lisp @@ -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 diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 388ca02f7..265b0b5cf 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -110,6 +110,7 @@ New in this release: * Ticket #105, fixed. * Ticket #84 fixed on x86. * Ticket #105 fixed. + * Ticket #101 fixed. * Other changes: diff --git a/tests/gray-streams.lisp b/tests/gray-streams.lisp index 7de3c1bf8..8afeb50d5 100644 --- a/tests/gray-streams.lisp +++ b/tests/gray-streams.lisp @@ -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*))))) -- GitLab