~ chicken-core (chicken-5) 3eba42bfa0177e923703d3506d0800d4db75ed63

commit 3eba42bfa0177e923703d3506d0800d4db75ed63
Author:     Jim Ursetto <zbigniewsz@gmail.com>
AuthorDate: Fri May 31 16:47:00 2013 -0500
Commit:     Jim Ursetto <zbigniewsz@gmail.com>
CommitDate: Fri May 31 16:49:45 2013 -0500

    Add tests for #978 (read-line port position).
    
    Tests are added for string ports, process ports and TCP ports.
    Process and TCP tests are disabled by default as they are
    dependent on environment or slightly fragile (although the
    behavior has been verified here).

diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index 81db14c4..ca334e98 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -1,5 +1,8 @@
 (require-extension srfi-1 ports utils srfi-4 extras tcp posix)
 
+(include "test.scm")
+(test-begin)
+
 (define-syntax assert-error
   (syntax-rules ()
     ((_ expr) 
@@ -223,4 +226,80 @@ EOF
                             (read-string! 10 buf in) buf))))
 
 (print "\nEmbedded NUL bytes in filenames are rejected\n")
-(assert-error (with-output-to-file "embedded\x00null-byte" void))
\ No newline at end of file
+(assert-error (with-output-to-file "embedded\x00null-byte" void))
+
+;;; #978 -- port-position checks for read-line
+
+(define (read-line/pos p limit)  ;; common
+  (let ((s (read-line p limit)))
+    (let-values (((row col) (port-position p)))
+      (list s row col))))
+
+(define (read-string-line/pos str limit)
+  (read-line/pos (open-input-string str) limit))
+
+(define (read-process-line/pos cmd args limit)
+  (let-values (((i o pid) (process cmd args)))
+    (let ((rc (read-line/pos i limit)))
+      (close-input-port i)
+      (close-output-port o)
+      rc)))
+(define (read-echo-line/pos str limit)
+  (read-process-line/pos "echo" (list "-n" str) limit))
+
+(use srfi-18)
+(define (read-tcp-line/pos str limit)
+  (let ((pn 8079))
+    (thread-start! (lambda ()
+		     (let ((L (tcp-listen pn)))
+		       (let-values (((i o) (tcp-accept L)))
+			 (display str o)
+			 (close-input-port i)
+			 (close-output-port o)
+			 (tcp-close L)))))
+    (let-values (((i o)
+		  (let lp ((n 10))
+		    (if (zero? n)
+			(error "timeout connecting to server")
+			(condition-case (tcp-connect "localhost" pn)
+					((exn i/o net) (thread-sleep! 0.1) (lp (- n 1))))))))
+      (let ((rc (read-line/pos i limit)))
+	(close-input-port i)
+	(close-output-port o)
+	rc))))
+
+(define (test-port-position proc)
+  (test-equal "advance row when encountering delim" 
+	      (proc "abcde\nfghi" 6)
+	      '("abcde" 2 0))
+  (test-equal "reaching limit sets col to limit, and does not advance row"
+	      (proc "abcdefghi" 6)
+	      '("abcdef" 1 6))
+  (test-equal "delimiter counted in limit" ;; observed behavior, strange
+	      (proc "abcdef\nghi" 6)
+	      '("abcdef" 1 6))
+  (test-equal "EOF reached"
+	      (proc "abcde" 6)
+	      '("abcde" 1 5)))
+
+(test-group
+ "read-line string port position tests"
+(test-port-position read-string-line/pos))
+
+;; Disabled because it requires `echo -n` for
+;; the EOF test, and that is not available on all systems.
+;; Uncomment locally to run.
+#;
+(test-group
+ "read-line process port position tests"
+ (test-port-position read-echo-line/pos))
+
+;; Disabled because currently fragile if port is already taken by
+;; another service.
+;; Uncomment locally to run.
+#;
+(test-group
+ "read-line TCP port position tests"
+ (test-port-position read-tcp-line/pos))
+
+;;;