Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / read.t
CommitLineData
a687059c 1#!./perl
2
1a24607b 3BEGIN {
4 chdir 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8use strict;
a687059c 9
8c515176 10plan tests => 2564;
a687059c 11
dc459aad 12open(FOO,'op/read.t') || open(FOO,'t/op/read.t') || open(FOO,':op:read.t') || die "Can't open op.read";
1a24607b 13seek(FOO,4,0) or die "Seek failed: $!";
14my $buf;
15my $got = read(FOO,$buf,4);
a687059c 16
1a24607b 17is ($got, 4);
18is ($buf, "perl");
a687059c 19
a0d0e21e 20seek (FOO,0,2) || seek(FOO,20000,0);
a687059c 21$got = read(FOO,$buf,4);
22
1a24607b 23is ($got, 0);
24is ($buf, "");
69938bba 25
39cd9b99 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
69938bba 34my $tmpfile = 'Op_read.tmp';
35
846e3505 36END { 1 while unlink $tmpfile }
69938bba 37
38my (@values, @buffers) = ('', '');
39
8c515176 40foreach (65, 161, 253, 9786) {
69938bba 41 push @values, join "", map {chr $_} $_ .. $_ + 4;
42 push @buffers, join "", map {chr $_} $_ + 5 .. $_ + 20;
43}
39cd9b99 44my @offsets = (0, 3, 7, 22, -1, -3, -5, -7);
45my @lengths = (0, 2, 5, 10);
69938bba 46
47foreach my $value (@values) {
48 foreach my $initial_buffer (@buffers) {
49 my @utf8 = 1;
50 if ($value !~ tr/\0-\377//c) {
51 # It's all 8 bit
52 unshift @utf8, 0;
53 }
39cd9b99 54 SKIP:
1dd30107 55 foreach my $utf8 (@utf8) {
39cd9b99 56 skip "Needs :utf8 layer but no perlio", 2 * @offsets * @lengths
57 if $utf8 and !$has_perlio;
58
1dd30107 59 1 while unlink $tmpfile;
60 open FH, ">$tmpfile" or die "Can't open $tmpfile: $!";
61 binmode FH, "utf8" if $utf8;
62 print FH $value;
63 close FH;
39cd9b99 64 foreach my $offset (@offsets) {
65 foreach my $length (@lengths) {
1dd30107 66 # Will read the lesser of the length of the file and the
67 # read length
68 my $will_read = $value;
69 if ($length < length $will_read) {
70 substr ($will_read, $length) = '';
71 }
72 # Going to trash this so need a copy
73 my $buffer = $initial_buffer;
74
75 my $expect = $buffer;
76 if ($offset > 0) {
77 # Right pad with NUL bytes
78 $expect .= "\0" x $offset;
79 substr ($expect, $offset) = '';
80 }
81 substr ($expect, $offset) = $will_read;
82
83 open FH, $tmpfile or die "Can't open $tmpfile: $!";
84 binmode FH, "utf8" if $utf8;
85 my $what = sprintf "%d into %d l $length o $offset",
86 ord $value, ord $buffer;
87 $what .= ' u' if $utf8;
88 $got = read (FH, $buffer, $length, $offset);
89 is ($got, length $will_read, "got $what");
90 is ($buffer, $expect, "buffer $what");
846e3505 91 close FH;
69938bba 92 }
69938bba 93 }
94 }
69938bba 95 }
96}
97
98
99