xref: /openbsd/gnu/usr.bin/perl/t/io/through.t (revision 404b540a) 
1#!./perl
2
3BEGIN {
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    }
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 = '';
41$set_out = "binmode STDOUT, ':crlf'"
42    if defined  $main::use_crlf && $main::use_crlf == 1;
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  }
84  binmode $fh, ':crlf'
85      if defined $main::use_crlf && $main::use_crlf == 1;
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
93  my $filename = tempfile();
94  open my $fh, '>', $filename or die;
95  select $fh;
96  binmode $fh, ':crlf'
97      if defined $main::use_crlf && $main::use_crlf == 1;
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: $!";
110  open $fh, '<', $filename or die;
111  binmode $fh, ':crlf'
112      if defined $main::use_crlf && $main::use_crlf == 1;
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');
121$c = undef;
122my @c;
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
1471;
148