Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / t / io / through.t
CommitLineData
93c2c2ec 1#!./perl
2
3BEGIN {
0af9e257 4 if ($^O eq 'VMS') {
5 print "1..0 # Skip on VMS -- too picky about line endings for record-oriented pipes\n";
6 exit;
7 }
93c2c2ec 8 chdir 't' if -d 't';
9 @INC = '../lib';
10}
11
12use strict;
13require './test.pl';
14
15my $Perl = which_perl();
16
17my $data = <<'EOD';
18x
19 yy
20z
21EOD
22
23(my $data2 = $data) =~ s/\n/\n\n/g;
24
25my $t1 = { data => $data, write_c => [1,2,length $data], read_c => [1,2,3,length $data]};
26my $t2 = { data => $data2, write_c => [1,2,length $data2], read_c => [1,2,3,length $data2]};
27
28$_->{write_c} = [1..length($_->{data})],
29 $_->{read_c} = [1..length($_->{data})+1, 0xe000] # Need <0xffff for REx
30 for (); # $t1, $t2;
31
32my $c; # len write tests, for each: one _all test, and 3 each len+2
33$c += @{$_->{write_c}} * (1 + 3*@{$_->{read_c}}) for $t1, $t2;
34$c *= 3*2*2; # $how_w, file/pipe, 2 reports
35
36$c += 6; # Tests with sleep()...
37
38print "1..$c\n";
39
40my $set_out = '';
1031ca5c 41$set_out = "binmode STDOUT, ':crlf'"
42 if defined $main::use_crlf && $main::use_crlf == 1;
93c2c2ec 43
44sub testread ($$$$$$$) {
45 my ($fh, $str, $read_c, $how_r, $write_c, $how_w, $why) = @_;
46 my $buf = '';
47 if ($how_r eq 'readline_all') {
48 $buf .= $_ while <$fh>;
49 } elsif ($how_r eq 'readline') {
50 $/ = \$read_c;
51 $buf .= $_ while <$fh>;
52 } elsif ($how_r eq 'read') {
53 my($in, $c);
54 $buf .= $in while $c = read($fh, $in, $read_c);
55 } elsif ($how_r eq 'sysread') {
56 my($in, $c);
57 $buf .= $in while $c = sysread($fh, $in, $read_c);
58 } else {
59 die "Unrecognized read: '$how_r'";
60 }
61 close $fh or die "close: $!";
62 # The only contamination allowed is with sysread/prints
63 $buf =~ s/\r\n/\n/g if $how_r eq 'sysread' and $how_w =~ /print/;
64 is(length $buf, length $str, "length with wrc=$write_c, rdc=$read_c, $how_w, $how_r, $why");
65 is($buf, $str, "content with wrc=$write_c, rdc=$read_c, $how_w, $how_r, $why");
66}
67
68sub testpipe ($$$$$$) {
69 my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
70 (my $quoted = $str) =~ s/\n/\\n/g;;
71 my $fh;
72 if ($how_w eq 'print') { # AUTOFLUSH???
73 # Should be shell-neutral:
74 open $fh, '-|', qq[$Perl -we "$set_out;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
75 } elsif ($how_w eq 'print/flush') {
76 # shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
77 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: $!";
78 } elsif ($how_w eq 'syswrite') {
79 ### How to protect \$_
80 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: $!";
81 } else {
82 die "Unrecognized write: '$how_w'";
83 }
1031ca5c 84 binmode $fh, ':crlf'
85 if defined $main::use_crlf && $main::use_crlf == 1;
93c2c2ec 86 testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "pipe$why");
87}
88
89sub testfile ($$$$$$) {
90 my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
91 my @data = grep length, split /(.{1,$write_c})/s, $str;
92
62a28c97 93 my $filename = tempfile();
94 open my $fh, '>', $filename or die;
93c2c2ec 95 select $fh;
1031ca5c 96 binmode $fh, ':crlf'
97 if defined $main::use_crlf && $main::use_crlf == 1;
93c2c2ec 98 if ($how_w eq 'print') { # AUTOFLUSH???
99 $| = 0;
100 print $fh $_ for @data;
101 } elsif ($how_w eq 'print/flush') {
102 $| = 1;
103 print $fh $_ for @data;
104 } elsif ($how_w eq 'syswrite') {
105 syswrite $fh, $_ for @data;
106 } else {
107 die "Unrecognized write: '$how_w'";
108 }
109 close $fh or die "close: $!";
62a28c97 110 open $fh, '<', $filename or die;
1031ca5c 111 binmode $fh, ':crlf'
112 if defined $main::use_crlf && $main::use_crlf == 1;
93c2c2ec 113 testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why");
114}
115
116# shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
117open 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: $!";
118ok(1, 'open pipe');
119binmode $fh, q(:crlf);
120ok(1, 'binmode');
1031ca5c 121$c = undef;
122my @c;
93c2c2ec 123push @c, ord $c while $c = getc $fh;
124ok(1, 'got chars');
125is(scalar @c, 9, 'got 9 chars');
126is("@c", '97 10 98 10 10 99 10 10 10', 'got expected chars');
127ok(close($fh), 'close');
128
129for my $s (1..2) {
130 my $t = ($t1, $t2)[$s-1];
131 my $str = $t->{data};
132 my $r = $t->{read_c};
133 my $w = $t->{write_c};
134 for my $read_c (@$r) {
135 for my $write_c (@$w) {
136 for my $how_r (qw(readline_all readline read sysread)) {
137 next if $how_r eq 'readline_all' and $read_c != 1;
138 for my $how_w (qw(print print/flush syswrite)) {
139 testfile($str, $write_c, $read_c, $how_w, $how_r, $s);
140 testpipe($str, $write_c, $read_c, $how_w, $how_r, $s);
141 }
142 }
143 }
144 }
145}
146
93c2c2ec 1471;