This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/io/through.t: Generalize for EBCDIC platforms
authorKarl Williamson <public@khwilliamson.com>
Sat, 13 Apr 2013 19:36:41 +0000 (13:36 -0600)
committerKarl Williamson <khw@cpan.org>
Fri, 6 Mar 2015 04:48:26 +0000 (21:48 -0700)
This uses hard-coded values for EBCDIC because of the shell issues

t/io/through.t

index 315de90..eaf9bc0 100644 (file)
@@ -72,10 +72,20 @@ sub testpipe ($$$$$$) {
     open $fh, '-|', qq[$Perl -we "$set_out;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
   } elsif ($how_w eq 'print/flush') {
     # shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
-    open $fh, '-|', qq[$Perl -we "$set_out;eval qq(\\x24\\x7c = 1) or die;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+    if ($::IS_ASCII) {
+        open $fh, '-|', qq[$Perl -we "$set_out;eval qq(\\x24\\x7c = 1) or die;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+    }
+    else {
+        open $fh, '-|', qq[$Perl -we "$set_out;eval qq(\\x5b\\x4f = 1) or die;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+    }
   } elsif ($how_w eq 'syswrite') {
     ### How to protect \$_
-    open $fh, '-|', qq[$Perl -we "$set_out;eval qq(sub w {syswrite STDOUT, \\x24_} 1) or die; w() for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+    if ($::IS_ASCII) {
+        open $fh, '-|', qq[$Perl -we "$set_out;eval qq(sub w {syswrite STDOUT, \\x24_} 1) or die; w() for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+    }
+    else {
+        open $fh, '-|', qq[$Perl -we "$set_out;eval qq(sub w {syswrite STDOUT, \\x5B_} 1) or die; w() for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+    }
   } else {
     die "Unrecognized write: '$how_w'";
   }
@@ -112,7 +122,13 @@ sub testfile ($$$$$$) {
 }
 
 # shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
-open my $fh, '-|', qq[$Perl -we "eval qq(\\x24\\x7c = 1) or die; binmode STDOUT; sleep 1, print for split //, qq(a\nb\n\nc\n\n\n)"] or die "open: $!";
+my $fh;
+if ($::IS_ASCII) {
+    open $fh, '-|', qq[$Perl -we "eval qq(\\x24\\x7c = 1) or die; binmode STDOUT; sleep 1, print for split //, qq(a\nb\n\nc\n\n\n)"] or die "open: $!";
+}
+else {
+    open $fh, '-|', qq[$Perl -we "eval qq(\\x5B\\x4f = 1) or die; binmode STDOUT; sleep 1, print for split //, qq(a\nb\n\nc\n\n\n)"] or die "open: $!";
+}
 ok(1, 'open pipe');
 binmode $fh, q(:crlf);
 ok(1, 'binmode');
@@ -121,7 +137,16 @@ my @c;
 push @c, ord $c while $c = getc $fh;
 ok(1, 'got chars');
 is(scalar @c, 9, 'got 9 chars');
-is("@c", '97 10 98 10 10 99 10 10 10', 'got expected chars');
+is("@c", join(" ", utf8::unicode_to_native(97),
+                   utf8::unicode_to_native(10),
+                   utf8::unicode_to_native(98),
+                   utf8::unicode_to_native(10),
+                   utf8::unicode_to_native(10),
+                   utf8::unicode_to_native(99),
+                   utf8::unicode_to_native(10),
+                   utf8::unicode_to_native(10),
+                   utf8::unicode_to_native(10)),
+         'got expected chars');
 ok(close($fh), 'close');
 
 for my $s (1..2) {