guile/guile-core/test-suite/tests ports.test

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/06/16 13:13:50

Modified files:
        guile-core/test-suite/tests: ports.test 

Log message:
        * tests/ports.test: New test for output port line counts.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/test-suite/tests/ports.test.diff?cvsroot=OldCVS&tr1=1.25&tr2=1.26&r1=text&r2=text

Patches:
Index: guile/guile-core/test-suite/tests/ports.test
diff -u guile/guile-core/test-suite/tests/ports.test:1.25 
guile/guile-core/test-suite/tests/ports.test:1.26
--- guile/guile-core/test-suite/tests/ports.test:1.25   Wed Apr 25 16:13:51 2001
+++ guile/guile-core/test-suite/tests/ports.test        Sat Jun 16 13:13:50 2001
@@ -380,7 +380,36 @@
      "He who receives an idea from me, receives instruction"
      15)))
 
-
+;; Test port-line and port-column for output ports
+
+(define (test-output-line-counter text final-column)
+  (with-test-prefix "port-line and port-column for output ports"
+    (let ((port (open-output-string)))
+      (pass-if "at beginning of input"
+              (and (= (port-line port) 0)
+                   (= (port-column port) 0)))
+      (write-char #\x port)
+      (pass-if "after writing one character"
+              (and (= (port-line port) 0)
+                   (= (port-column port) 1)))
+      (write-char #\newline port)
+      (pass-if "after writing first newline char"
+              (and (= (port-line port) 1)
+                   (= (port-column port) 0)))
+      (display text port)
+      (pass-if "line count is 5 at end"
+              (= (port-line port) 5))
+      (pass-if "column is correct at end"
+              (= (port-column port) final-column)))))
+
+(test-output-line-counter
+ (string-append "He who receives an idea from me, receives instruction\n"
+               "himself without lessening mine; as he who lights his\n"
+               "taper at mine, receives light without darkening me.\n"
+               "  --- Thomas Jefferson\n"
+               "no newline here")
+ 15)
+
 ;;;; testing read-delimited and friends
 
 (with-test-prefix "read-delimited!"