t/lib/socket.t See if Socket works
t/lib/soundex.t See if Soundex works
t/lib/symbol.t See if Symbol works
+t/lib/syslfs.t See if large files work for sysio
t/lib/textfill.t See if Text::Wrap::fill works
t/lib/texttabs.t See if Text::Tabs works
t/lib/textwrap.t See if Text::Wrap::wrap works
t/op/int.t See if int works
t/op/join.t See if join works
t/op/lex_assign.t See if ops involving lexicals or pad temps work
-t/op/lfs.t See if large files work
+t/op/lfs.t See if large files work for perlio
t/op/list.t See if array lists work
t/op/local.t See if local works
t/op/lop.t See if logical operators work
The possible values and flag bits of the MODE parameter are
system-dependent; they are available via the standard module C<Fcntl>.
+See the documentation of your operating system's C<open> to see which
+values and flag bits are available. You may combine several flags
+using the C<|>-operator.
+
+Some of the most common values are C<O_RDONLY> for opening the file in
+read-only mode, C<O_WRONLY> for opening the file in write-only mode,
+and C<O_RDWR> for opening the file in read-write mode, and.
+
For historical reasons, some values work on almost every system
supported by perl: zero means read-only, one means write-only, and two
means read/write. We know that these values do I<not> work under
OS/390 & VM/ESA Unix and on the Macintosh; you probably don't want to
-use them in new code.
+se them in new code, use thhe constants discussed in the preceding
+paragraph.
If the file named by FILENAME does not exist and the C<open> call creates
it (typically because MODE includes the C<O_CREAT> flag), then the value of
These permission values need to be in octal, and are modified by your
process's current C<umask>.
+In many systems the C<O_EXCL> flag is available for opening files in
+exclusive mode. This is B<not> locking: exclusiveness means here that
+if the file already exists, sysopen() fails. The C<O_EXCL> wins
+C<O_TRUNC>.
+
+Sometimes you may want to truncate an already-existing file: C<O_TRUNC>.
+
You should seldom if ever use C<0644> as argument to C<sysopen>, because
that takes away the user's option to have a more permissive umask.
Better to omit it. See the perlfunc(1) entry on C<umask> for more
--- /dev/null
+# NOTE: this file tests how large files (>2GB) work with raw system IO.
+# open(), tell(), seek(), print(), read() are tested in t/op/lfs.t.
+# If you modify/add tests here, remember to update also t/op/lfs.t.
+
+BEGIN {
+ eval { my $q = pack "q", 0 };
+ if ($@) {
+ print "1..0\n# no 64-bit types\n";
+ bye();
+ }
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ require Fcntl; import Fcntl;
+}
+
+sub bye {
+ close(BIG);
+ unlink "big";
+ exit(0);
+}
+
+# First try to figure out whether we have sparse files.
+
+if ($^O eq 'win32' || $^O eq 'vms') {
+ print "1..0\n# no sparse files\n";
+ bye();
+}
+
+# We'll start off by creating a one megabyte file which has
+# only three "true" bytes.
+
+sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
+ do { warn "sysopen failed: $!\n"; bye };
+sysseek(BIG, 1_000_000, SEEK_SET);
+syswrite(BIG, "big");
+close(BIG);
+
+my @s;
+
+@s = stat("big");
+
+print "# @s\n";
+
+unless (@s == 13 &&
+ $s[7] == 1_000_003 &&
+ defined $s[11] &&
+ defined $s[12] &&
+ $s[11] * $s[12] < 1000_003) {
+ print "1..0\n# no sparse files?\n";
+ bye();
+}
+
+# By now we better be sure that we do have sparse files:
+# if we are not, the following will hog 5 gigabytes of disk. Ooops.
+
+print "1..8\n";
+
+sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
+ do { warn "sysopen failed: $!\n"; bye };
+sysseek(BIG, 5_000_000_000, SEEK_SET);
+syswrite(BIG, "big");
+close BIG;
+
+@s = stat("big");
+
+print "# @s\n";
+
+print "not " unless $s[7] == 5_000_000_003;
+print "ok 1\n";
+
+print "not " unless -s "big" == 5_000_000_003;
+print "ok 2\n";
+
+sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
+
+sysseek(BIG, 4_500_000_000, SEEK_SET);
+
+print "not " unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
+print "ok 3\n";
+
+sysseek(BIG, 1, SEEK_CUR);
+
+print "not " unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
+print "ok 4\n";
+
+sysseek(BIG, -1, SEEK_CUR);
+
+print "not " unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
+print "ok 5\n";
+
+sysseek(BIG, -3, SEEK_END);
+
+print "not " unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
+print "ok 6\n";
+
+my $big;
+
+print "not " unless sysread(BIG, $big, 3) == 3;
+print "ok 7\n";
+
+print "not " unless $big eq "big";
+print "ok 8\n";
+
+bye();
+
+# eof
BEGIN {
- eval { pack "q", 0 };
+ eval { my $q = pack "q", 0 };
if ($@) {
print "1..0\n# no 64-bit types\n";
exit(0);
}
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
}
# This could use a lot of more tests.
# Nota bene: bit operations (&, |, ^, ~, <<, >>, vec) are not 64-bit clean.
# See the beginning of pp.c and the explanation next to IBW/UBW.
+no warning 'overflow';
+
print "1..30\n";
my $q = 12345678901;
+# NOTE: this file tests how large files (>2GB) work with perlio (stdio/sfio).
+# sysopen(), sysseek(), syswrite(), sysread() are tested in t/lib/syslfs.t.
+# If you modify/add tests here, remember to update also t/lib/syslfs.t.
+
BEGIN {
- eval { pack "q", 0 };
+ eval { my $q = pack "q", 0 };
if ($@) {
print "1..0\n# no 64-bit types\n";
- bitedust();
+ bye();
}
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
}
sub bye {
bye();
}
-my $SEEK_SET;
-my $SEEK_CUR;
-my $SEEK_END;
-
-# We probe for the constants 'manually' because
-# we do not want to be dependent on any extensions.
-
-sub seek_it {
- my ($set, $cur, $end) = @_;
+my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
- my $test = 0;
-
- open(BIG, ">big") || do { warn "open failed: $!\n"; bye };
- binmode BIG;
- seek(BIG, 49, $set);
- print BIG "X";
- close(BIG);
- open(BIG, "big") || do { warn "open failed: $!\n"; bye };
- seek(BIG, 50, $set);
- if (tell(BIG) == 50) {
- seek(BIG, -10, $cur);
- if (tell(BIG) == 40) {
- seek(BIG, -20, $end);
- if (tell(BIG) == 30) {
- $test = 1;
- }
- }
- }
- close(BIG);
-
- return $test;
-}
+# We'll start off by creating a one megabyte file which has
+# only three "true" bytes.
-if (seek_it(0, 1, 2)) {
- ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
-} elsif (seek_it(1, 2, 3)) {
- ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (1, 2, 3);
-} else {
- print "1..0\n# no way to seek\n";
- bye;
-}
-
-print "# SEEK_SET = $SEEK_SET, SEEK_CUR = $SEEK_CUR, SEEK_END = $SEEK_END\n";
-
-open(BIG, ">big") || do { warn "open failed: $!\n"; bye };
+open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
binmode BIG;
-seek(BIG, 100_000, $SEEK_SET);
+seek(BIG, 1_000_000, $SEEK_SET);
print BIG "big";
close(BIG);
@s = stat("big");
+print "# @s\n";
+
unless (@s == 13 &&
- $s[7] == 100_003 &&
+ $s[7] == 1_000_003 &&
defined $s[11] &&
defined $s[12] &&
- $s[11] * $s[12] < 100_003) {
- print "1..0\n# no sparse files\n";
+ $s[11] * $s[12] < 1000_003) {
+ print "1..0\n# no sparse files?\n";
bye();
}
print "1..8\n";
-open(BIG, ">big") || do { warn "open failed: $!\n"; bye };
+open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
binmode BIG;
seek(BIG, 5_000_000_000, $SEEK_SET);
print BIG "big";
@s = stat("big");
+print "# @s\n";
+
print "not " unless $s[7] == 5_000_000_003;
print "ok 1\n";
print "not " unless -s "big" == 5_000_000_003;
print "ok 2\n";
-open(BIG, "big") || do { warn "open failed: $!\n"; bye };
+open(BIG, "big") or do { warn "open failed: $!\n"; bye };
binmode BIG;
seek(BIG, 4_500_000_000, $SEEK_SET);
bye();
# eof
-
-
projects / platform / upstream / perl.git / commitdiff