X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fgray-streams.impure.lisp;h=181e0c16d58a3f2a59b33eaed0eaaf8213844851;hb=1b87bfbe482c555879d2a902e88f9d147ead394e;hp=2fb58c9ea1bada91a85697c889f8ec208603450b;hpb=57379ffaf35167d4843f68a98942297e02672833;p=sbcl.git

diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp
index 2fb58c9..181e0c1 100644
--- a/tests/gray-streams.impure.lisp
+++ b/tests/gray-streams.impure.lisp
@@ -1,4 +1,4 @@
-;;;; tests related to Gray streams 
+;;;; tests related to Gray streams
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -6,7 +6,7 @@
 ;;;; While most of SBCL is derived from the CMU CL system, the test
 ;;;; files (like this one) were written from scratch after the fork
 ;;;; from CMU CL.
-;;;; 
+;;;;
 ;;;; This software is in the public domain and is provided with
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
@@ -60,23 +60,24 @@
 
 (defclass character-output-stream (fundamental-character-output-stream)
   ((lisp-stream :initarg :lisp-stream
-		:accessor character-output-stream-lisp-stream)))
-  
+                :accessor character-output-stream-lisp-stream)
+   (position :initform 42 :accessor character-output-stream-position)))
+
 (defclass character-input-stream (fundamental-character-input-stream)
   ((lisp-stream :initarg :lisp-stream
-		:accessor character-input-stream-lisp-stream)))
-  
+                :accessor character-input-stream-lisp-stream)))
+
 ;;;; example character output stream encapsulating a lisp-stream
 
 (defun make-character-output-stream (lisp-stream)
   (make-instance 'character-output-stream :lisp-stream lisp-stream))
-  
+
 (defmethod open-stream-p ((stream character-output-stream))
   (open-stream-p (character-output-stream-lisp-stream stream)))
-  
+
 (defmethod close ((stream character-output-stream) &key abort)
   (close (character-output-stream-lisp-stream stream) :abort abort))
-  
+
 (defmethod input-stream-p ((stream character-output-stream))
   (input-stream-p (character-output-stream-lisp-stream stream)))
 
@@ -100,6 +101,11 @@
 
 (defmethod stream-clear-output ((stream character-output-stream))
   (clear-output (character-output-stream-lisp-stream stream)))
+
+(defmethod stream-file-position ((stream character-output-stream) &optional new-value)
+  (if new-value
+      (setf (character-output-stream-position stream) new-value)
+      (character-output-stream-position stream)))
 
 ;;;; example character input stream encapsulating a lisp-stream
 
@@ -176,10 +182,10 @@
 ;;; bare Gray streams and thus bogusly omitting pretty-printing
 ;;; operations.
 (flet ((frob ()
-	 (with-output-to-string (string)
-	   (let ((gray-output-stream (make-character-output-stream string)))
-	     (format gray-output-stream
-		     "~@<testing: ~@:_pretty Gray line breaks~:>~%")))))
+         (with-output-to-string (string)
+           (let ((gray-output-stream (make-character-output-stream string)))
+             (format gray-output-stream
+                     "~@<testing: ~@:_pretty Gray line breaks~:>~%")))))
   (assert (= 1 (count #\newline (let ((*print-pretty* nil)) (frob)))))
   (assert (= 2 (count #\newline (let ((*print-pretty* t)) (frob))))))
 
@@ -220,11 +226,11 @@
 
 (defclass binary-to-char-output-stream (fundamental-binary-output-stream)
   ((lisp-stream :initarg :lisp-stream
-		:accessor binary-to-char-output-stream-lisp-stream)))
-  
+                :accessor binary-to-char-output-stream-lisp-stream)))
+
 (defclass binary-to-char-input-stream (fundamental-binary-input-stream)
   ((lisp-stream :initarg :lisp-stream
-		:accessor binary-to-char-input-stream-lisp-stream)))
+                :accessor binary-to-char-input-stream-lisp-stream)))
 
 (defmethod stream-element-type ((stream binary-to-char-output-stream))
   '(unsigned-byte 8))
@@ -233,24 +239,24 @@
 
 (defun make-binary-to-char-input-stream (lisp-stream)
   (make-instance 'binary-to-char-input-stream
-		 :lisp-stream lisp-stream))
+                 :lisp-stream lisp-stream))
 
 (defun make-binary-to-char-output-stream (lisp-stream)
   (make-instance 'binary-to-char-output-stream
-		 :lisp-stream lisp-stream))
-  
+                 :lisp-stream lisp-stream))
+
 (defmethod stream-read-byte ((stream binary-to-char-input-stream))
   (let ((char (read-char
-	       (binary-to-char-input-stream-lisp-stream stream) nil :eof)))
+               (binary-to-char-input-stream-lisp-stream stream) nil :eof)))
     (if (eq char :eof)
-	char
-	(char-code char))))
+        char
+        (char-code char))))
 
 (defmethod stream-write-byte ((stream binary-to-char-output-stream) integer)
   (let ((char (code-char integer)))
     (write-char char
-		(binary-to-char-output-stream-lisp-stream stream))))
-      
+                (binary-to-char-output-stream-lisp-stream stream))))
+
 ;;;; tests using binary i/o, using the above
 
 (let ((test-string (format nil
@@ -260,9 +266,9 @@
     (assert (equal
              (with-output-to-string (bar)
                (let ((our-bin-to-char-input (make-binary-to-char-input-stream
-					     foo))
+                                             foo))
                      (our-bin-to-char-output (make-binary-to-char-output-stream
-					      bar)))
+                                              bar)))
                  (assert (open-stream-p our-bin-to-char-input))
                  (assert (open-stream-p our-bin-to-char-output))
                  (assert (input-stream-p our-bin-to-char-input))
@@ -271,7 +277,11 @@
                      ((eq byte :eof))
                    (write-byte byte our-bin-to-char-output))))
              test-string))))
+
 
-;;;; Voila!
 
-(quit :unix-status 104) ; success
+;;; Minimal test of file-position
+(let ((stream (make-instance 'character-output-stream)))
+  (assert (= (file-position stream) 42))
+  (assert (file-position stream 50))
+  (assert (= (file-position stream) 50)))