From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 20 Apr 2002 21:42:09 +0000 (+0000)
Subject: Fix perlio for Encode/t/perlio.t's SKIPPED TODO tests,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e66821e8151d62edad66fb30ff4507c6d719f51b;p=p5sagit%2Fp5-mst-13.2.git

Fix perlio for Encode/t/perlio.t's SKIPPED TODO tests,
and change test not to skip them.

p4raw-id: //depot/perlio@16027
---

diff --git a/ext/Encode/t/perlio.t b/ext/Encode/t/perlio.t
index 8d55d85..671be8a 100644
--- a/ext/Encode/t/perlio.t
+++ b/ext/Encode/t/perlio.t
@@ -63,14 +63,15 @@ for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){
 
     # then create a file via perlio without autoflush
 	
- TODO:{
-	todo_skip "$e: !perlio_ok", 1  unless perlio_ok($e);
+# TODO:{
+#        local $TODO = "perlio broken";
+#	todo_skip "$e: !perlio_ok", 1  unless perlio_ok($e);
 	open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
 	$fh->autoflush(0);
 	print $fh $utext;
 	close $fh;
 	ok(compare($sfile, $pfile) == 0 => ">:encoding($e)");
-    }
+#    }
 	
     # this time print line by line.
     # works even for ISO-2022!
@@ -82,8 +83,9 @@ for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){
     close $fh;
     is(compare($sfile, $pfile), 0 => ">:encoding($e); line-by-line");
 
- TODO:{
-	todo_skip "$e: !perlio_ok", 2 unless perlio_ok($e);
+# TODO:{
+#        local $TODO = "perlio broken";
+#	todo_skip "$e: !perlio_ok", 2 unless perlio_ok($e);
 	open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
 	$fh->autoflush(0);
 	my $dtext = join('' => <$fh>);
@@ -96,7 +98,7 @@ for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){
 	}
 	close $fh;
 	ok($utext eq $dtext, "<:encoding($e); line-by-line");
-    }
+#    }
     $DEBUG or unlink ($sfile, $pfile);
 }
 
diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index 5bdc0c7..09eeb45 100644
--- a/ext/PerlIO/encoding/encoding.xs
+++ b/ext/PerlIO/encoding/encoding.xs
@@ -51,7 +51,7 @@ typedef struct {
 #define NEEDS_LINES	1
 
 #if 0
-#define OUR_ENCODE_FB "Encode::FB_DEFAULT"
+#define OUR_ENCODE_FB "Encode::FB_PERLQQ"
 #else
 #define OUR_ENCODE_FB "Encode::FB_QUIET"
 #endif
@@ -139,9 +139,6 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg)
 	    }
 	}
 	PerlIOBase(f)->flags |= PERLIO_F_UTF8;
-	if (e->flags & NEEDS_LINES) {
-	    PerlIOBase(f)->flags |= PERLIO_F_LINEBUF;
-	}
     }
 
     e->chk = newSVsv(get_sv("PerlIO::encoding::check",0));
@@ -528,11 +525,33 @@ PerlIOEncode_dup(pTHX_ PerlIO * f, PerlIO * o,
 SSize_t
 PerlIOEncode_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    SSize_t size = PerlIOBuf_write(aTHX_ f, vbuf, count);
     PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
     if (e->flags & NEEDS_LINES) {
+	SSize_t done = 0;
+	const char *ptr = (const char *) vbuf;
+	const char *end = ptr+count;
+	while (ptr < end) {
+	    const char *nl = ptr;
+	    while (nl < end && *nl++ != '\n') /* empty body */;
+	    done = PerlIOBuf_write(aTHX_ f, ptr, nl-ptr);
+	    if (done != nl-ptr) {
+		if (done > 0) {
+		    ptr += done;
+		}
+		break;
+	    }
+	    ptr += done;
+	    if (ptr[-1] == '\n') {
+		if (PerlIOEncode_flush(aTHX_ f) != 0) {
+		    break;
+		}
+	    }
+	}
+	return (SSize_t) (ptr - (const char *) vbuf);
+    }
+    else {
+	return PerlIOBuf_write(aTHX_ f, vbuf, count);
     }
-    return size;
 }
 
 PerlIO_funcs PerlIO_encode = {