Change 29550: [PATCH 5.8.8] Text mode wrongly set on pipe file descriptors

[Steve Peters]

Change 29550 by [EMAIL PROTECTED] on 2006/12/13 19:53:02

        Subject: [PATCH 5.8.8] Text mode wrongly set on pipe file descriptors
        From: Ilya Zakharevich <[EMAIL PROTECTED]>
        Date: Tue, 12 Dec 2006 23:28:25 -0800
        Message-ID: <[EMAIL PROTECTED]>

Affected files ...

... //depot/perl/t/io/pipe.t#28 edit
... //depot/perl/util.c#601 edit

Differences ...

==== //depot/perl/t/io/pipe.t#28 (xtext) ====
Index: perl/t/io/pipe.t
--- perl/t/io/pipe.t#27~25973~  2005-11-03 06:56:25.000000000 -0800
+++ perl/t/io/pipe.t    2006-12-13 11:53:02.000000000 -0800
@@ -10,7 +10,7 @@
         skip_all("fork required to pipe");
     }
     else {
-        plan(tests => 22);
+        plan(tests => 24);
     }
 }
 
@@ -30,7 +30,7 @@
 SKIP: {
     # Technically this should be TODO.  Someone try it if you happen to
     # have a vmesa machine.
-    skip "Doesn't work here yet", 4 if $^O eq 'vmesa';
+    skip "Doesn't work here yet", 6 if $^O eq 'vmesa';
 
     if (open(PIPE, "-|")) {
        while(<PIPE>) {
@@ -50,6 +50,49 @@
     # This has to be *outside* the fork
     next_test() for 1..2;
 
+    my $raw = "abc\nrst\rxyz\r\nfoo\n";
+    if (open(PIPE, "-|")) {
+       $_ = join '', <PIPE>;
+       (my $raw1 = $_) =~ s/not ok \d+ - //;
+       my @r  = map ord, split //, $raw;
+       my @r1 = map ord, split //, $raw1;
+        if ($raw1 eq $raw) {
+           s/^not (ok \d+ -) .*/$1 '@r1' passes through '-|'\n/s;
+       } else {
+           s/^(not ok \d+ -) .*/$1 expect '@r', got '@r1'\n/s;
+       }
+       print;
+       close PIPE;        # avoid zombies
+    }
+    else {
+       printf STDOUT "not ok %d - $raw", curr_test();
+        exec $Perl, '-e0';     # Do not run END()...
+    }
+
+    # This has to be *outside* the fork
+    next_test();
+
+    if (open(PIPE, "|-")) {
+       printf PIPE "not ok %d - $raw", curr_test();
+       close PIPE;        # avoid zombies
+    }
+    else {
+       $_ = join '', <STDIN>;
+       (my $raw1 = $_) =~ s/not ok \d+ - //;
+       my @r  = map ord, split //, $raw;
+       my @r1 = map ord, split //, $raw1;
+        if ($raw1 eq $raw) {
+           s/^not (ok \d+ -) .*/$1 '@r1' passes through '|-'\n/s;
+       } else {
+           s/^(not ok \d+ -) .*/$1 expect '@r', got '@r1'\n/s;
+       }
+       print;
+        exec $Perl, '-e0';     # Do not run END()...
+    }
+
+    # This has to be *outside* the fork
+    next_test();
+
     SKIP: {
         skip "fork required", 2 unless $Config{d_fork};
 

==== //depot/perl/util.c#601 (text) ====
Index: perl/util.c
--- perl/util.c#600~29544~      2006-12-13 00:35:43.000000000 -0800
+++ perl/util.c 2006-12-13 11:53:02.000000000 -0800
@@ -2356,6 +2356,14 @@
            PerlProc__exit(1);
        }
 #endif /* defined OS2 */
+
+#ifdef PERLIO_USING_CRLF
+   /* Since we circumvent IO layers when we manipulate low-level
+      filedescriptors directly, need to manually switch to the
+      default, binary, low-level mode; see PerlIOBuf_open(). */
+   PerlLIO_setmode((*mode == 'r'), O_BINARY);
+#endif 
+
        if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
            SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), PerlProc_getpid());
End of Patch.