[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2014-08-8-ge585e8d
Raymond Toy
rtoy at common-lisp.net
Sun Aug 10 06:49:28 UTC 2014
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via e585e8d6acbc146e978d1c2c5171987b6ba2fddf (commit)
via 63d44f2cd88f1675a99b98d0c7f91f091e375823 (commit)
via fc3d88a64b6d6297d2b8639032b4f92d6d242149 (commit)
via 53bfdda42de6d4f464546cdba1456262d4065ee7 (commit)
from c0052f5544d27980c74d5a17cd55dc2069085602 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit e585e8d6acbc146e978d1c2c5171987b6ba2fddf
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Sat Aug 9 23:49:14 2014 -0700
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.
diff --git a/src/code/format.lisp b/src/code/format.lisp
index 704ec34..7a2de48 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 388ca02..265b0b5 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 7de3c1b..8afeb50 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 at T")
+ (format gray-stream "~10T")
+ (format gray-stream "~8,10 at 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*)))))
commit 63d44f2cd88f1675a99b98d0c7f91f091e375823
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Sat Aug 9 23:44:57 2014 -0700
Regenerated.
diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot
index 19b58d4..15366ac 100644
--- a/src/i18n/locale/cmucl.pot
+++ b/src/i18n/locale/cmucl.pot
@@ -21046,6 +21046,14 @@ msgid "Implements WRITE-SEQUENCE for the stream."
msgstr ""
#: src/pcl/gray-streams.lisp
+msgid "Implements FILE-POSITION for the stream."
+msgstr ""
+
+#: src/pcl/gray-streams.lisp
+msgid "Implements FILE-POSITION for the stream for setting the position."
+msgstr ""
+
+#: src/pcl/gray-streams.lisp
msgid ""
"Used by READ-BYTE; returns either an integer, or the symbol :EOF\n"
" if the stream is at end-of-file."
commit fc3d88a64b6d6297d2b8639032b4f92d6d242149
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Sat Aug 9 22:15:31 2014 -0700
Clean up the CLEAR-OUTPUT test a bit.
diff --git a/tests/gray-streams.lisp b/tests/gray-streams.lisp
index 6308882..7de3c1b 100644
--- a/tests/gray-streams.lisp
+++ b/tests/gray-streams.lisp
@@ -24,16 +24,16 @@
;; Create a Gray stream and make sure that clear-output works.
(assert-eql
0
- (unwind-protect
- (let ((s (open *test-file*
- :direction :output
- :if-exists :supersede
- :class 'lisp::character-output-stream)))
- (write-char #\a s)
- (clear-output s)
- (close s)
- (setf s (open *test-file*))
- (file-length s))
- (delete-file *test-file*))))
-
-
\ No newline at end of file
+ (let ((s (open *test-file*
+ :direction :output
+ :if-exists :supersede
+ :class 'lisp::character-output-stream)))
+ (unwind-protect
+ (progn
+ (write-char #\a s)
+ (clear-output s)
+ (close s)
+ (setf s (open *test-file*))
+ (file-length s))
+ (close s)
+ (delete-file *test-file*)))))
commit 53bfdda42de6d4f464546cdba1456262d4065ee7
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Sat Aug 9 22:15:07 2014 -0700
Add test for ticket:101 for the case of CLEAR-OUTPUT of a lisp
stream.
diff --git a/tests/trac.lisp b/tests/trac.lisp
index 571b069..8253bc2 100644
--- a/tests/trac.lisp
+++ b/tests/trac.lisp
@@ -367,6 +367,36 @@
(assert-error 'reader-error (read-from-string "1d-324"))
(assert-error 'reader-error (read-from-string "1w-324")))
+(defparameter *test-path*
+ (merge-pathnames (make-pathname :name :unspecific :type :unspecific
+ :version :unspecific)
+ *load-truename*)
+ "Directory for temporary test files.")
+
+(defparameter *test-file*
+ (merge-pathnames #p"test-data.tmp" *test-path*))
+
+
+;; Not quite what ticket 101 is about, but it came up in investigating
+;; CLEAR-OUTPUT on a Gray stream. Verify CLEAR-OUTPUT actually
+;; does. Previously, it did nothing.
+(define-test trac.101
+ (:tag :trac)
+ (assert-eql
+ 0
+ (let ((s (open *test-file*
+ :direction :output
+ :if-exists :supersede)))
+ (unwind-protect
+ (progn
+ (write-char #\a s)
+ (clear-output s)
+ (close s)
+ (setf s (open *test-file*))
+ (file-length s))
+ (close s)
+ (delete-file *test-file*)))))
+
(defun read-string-fn (str)
(handler-case
(let ((acc nil))
-----------------------------------------------------------------------
Summary of changes:
src/code/format.lisp | 76 +++++++++++++++++++++++------
src/general-info/release-20f.txt | 1 +
src/i18n/locale/cmucl.pot | 8 +++
tests/gray-streams.lisp | 99 +++++++++++++++++++++++++++++++++-----
tests/trac.lisp | 30 ++++++++++++
5 files changed, 186 insertions(+), 28 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-commit
mailing list