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 (file)
--- 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 (file)
--- 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 = {