1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7}
8use strict;
9
10plan tests => 2116;
11
12open(FOO,'op/read.t') || open(FOO,'t/op/read.t') || open(FOO,':op:read.t') || die "Can't open op.read";
13seek(FOO,4,0) or die "Seek failed: $!";
14my $buf;
15my $got = read(FOO,$buf,4);
16
17is ($got, 4);
18is ($buf, "perl");
19
20seek (FOO,0,2) || seek(FOO,20000,0);
21$got = read(FOO,$buf,4);
22
23is ($got, 0);
24is ($buf, "");
25
26# This is true if Config is not built, or if PerlIO is enabled
27# ie assume that PerlIO is present, unless we know for sure otherwise.
28my $has_perlio = !eval {
29    no warnings;
30    require Config;
31    !$Config::Config{useperlio}
32};
33
34my $tmpfile = tempfile();
35
36my @values  = ('');
37my @buffers = ('');
38
39foreach (65, 161, 253, 9786) {
40    push @values, join "", map {chr $_} $_ .. $_ + 4;
41    push @buffers, join "", map {chr $_} $_ + 5 .. $_ + 20;
42}
43my @offsets = (0, 3, 7, 22, -1, -3, -5, -7);
44my @lengths = (0, 2, 5, 10);
45
46foreach my $value (@values) {
47    foreach my $initial_buffer (@buffers) {
48	my @utf8 = 1;
49	if ($value !~ tr/\0-\377//c) {
50	    # It's all 8 bit
51	    unshift @utf8, 0;
52	}
53      SKIP:
54	foreach my $utf8 (@utf8) {
55	    skip "Needs :utf8 layer but no perlio", 2 * @offsets * @lengths
56	      if $utf8 and !$has_perlio;
57
58	    open FH, ">$tmpfile" or die "Can't open $tmpfile: $!";
59	    binmode FH, "utf8" if $utf8;
60	    print FH $value;
61	    close FH;
62	    foreach my $offset (@offsets) {
63                next if !length($initial_buffer) && $offset != 0;
64		foreach my $length (@lengths) {
65		    # Will read the lesser of the length of the file and the
66		    # read length
67		    my $will_read = $value;
68		    if ($length < length $will_read) {
69			substr ($will_read, $length) = '';
70		    }
71		    # Going to trash this so need a copy
72		    my $buffer = $initial_buffer;
73
74		    my $expect = $buffer;
75		    if ($offset > 0) {
76			# Right pad with NUL bytes
77			$expect .= "\0" x $offset;
78			substr ($expect, $offset) = '';
79		    }
80		    substr ($expect, $offset) = $will_read;
81
82		    open FH, $tmpfile or die "Can't open $tmpfile: $!";
83		    binmode FH, "utf8" if $utf8;
84		    my $what = sprintf "%d into %d l $length o $offset",
85			ord $value, ord $buffer;
86		    $what .= ' u' if $utf8;
87		    $got = read (FH, $buffer, $length, $offset);
88		    is ($got, length $will_read, "got $what");
89		    is ($buffer, $expect, "buffer $what");
90		    close FH;
91		}
92	    }
93	}
94    }
95}
96
97
98
99