~ chicken-core (chicken-5) 59007e8bb8ea153f9e942945380139714a045f88

commit 59007e8bb8ea153f9e942945380139714a045f88
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Dec 27 06:41:48 2013 +1300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Dec 27 06:41:48 2013 +1300

    Fix premature EOF termination
    
    This fixes the same issue as 1d9b585 in a slightly different way, in
    order to fix a bug in empty line handling for here documents introduced
    by that change.

diff --git a/library.scm b/library.scm
index 7ff334dc..2f81948e 100644
--- a/library.scm
+++ b/library.scm
@@ -4577,7 +4577,7 @@ EOF
       (let ([ln (open-output-string)])
 	(do ([c (##sys#read-char-0 port) (##sys#read-char-0 port)])
 	    ((or (eof-object? c) (char=? #\newline c))
-	     (get-output-string ln))
+	     (if (eof-object? c) c (get-output-string ln)))
 	  (##sys#write-char-0 c ln) ) ) )
     (define (read-escaped-sexp port skip-brace?)
       (when skip-brace? (##sys#read-char-0 port))
@@ -4600,7 +4600,7 @@ EOF
 		(let ([str (open-output-string)]
 		      [end (readln port)] 
 		      [f #f] )
-		  (let ((endlen (string-length end)))
+		  (let ((endlen (if (eof-object? end) 0 (string-length end))))
 		    (cond
 		     ((fx= endlen 0)
 		      (##sys#read-warning
@@ -4611,8 +4611,8 @@ EOF
 		       port "Whitespace after #<< here-doc tag"))
 		     ))			    
 		  (do ([ln (readln port) (readln port)])
-		      ((or (string=? "" ln) (string=? end ln))
-		       (when (string=? "" ln)
+		      ((or (eof-object? ln) (string=? end ln))
+		       (when (eof-object? ln)
 			 (##sys#read-warning port
 			  (##sys#format-here-doc-warning end)))
 		       (get-output-string str) )
@@ -4629,7 +4629,7 @@ EOF
 		      (set! str (open-output-string))
 		      s))
 
-		  (let ((endlen (string-length end)))
+		  (let ((endlen (if (eof-object? end) 0 (string-length end))))
 		    (cond
 		     ((fx= endlen 0)
 		      (##sys#read-warning
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 562f8846..ba75076d 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -377,6 +377,31 @@
 (assert-fail (with-input-from-string "|\\" read))
 (assert-fail (with-input-from-string "\"\\" read))
 
+;;; here documents
+
+(assert (string=? "" #<<A
+A
+))
+
+(assert (string=? "foo" #<<A
+foo
+A
+))
+
+(assert (string=? "\nfoo\n" #<<A
+
+foo
+
+A
+))
+
+(assert (string=? "foo\nbar\nbaz" #<<A
+foo
+bar
+baz
+A
+))
+
 ;;; setters
 
 (define x '(a b c))