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