From ea2b5ef6d751420797c96208ee3824f54bf1d97a Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Wed, 11 Aug 1999 08:19:23 +0000 Subject: [PATCH] Add sysio large file support testing. p4raw-id: //depot/cfgperl@3956 --- MANIFEST | 3 +- pod/perlfunc.pod | 18 +++++++++- t/lib/syslfs.t | 106 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/op/64bit.t | 6 +++- t/op/lfs.t | 75 ++++++++++++--------------------------- 5 files changed, 152 insertions(+), 56 deletions(-) create mode 100644 t/lib/syslfs.t diff --git a/MANIFEST b/MANIFEST index b6472fb..4346b88 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1190,6 +1190,7 @@ t/lib/selectsaver.t See if SelectSaver works 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 @@ -1240,7 +1241,7 @@ t/op/index.t See if index 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 diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 3e10038..d5456d2 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4435,11 +4435,20 @@ FILENAME, MODE, PERMS. The possible values and flag bits of the MODE parameter are system-dependent; they are available via the standard module C. +See the documentation of your operating system's C 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 for opening the file in +read-only mode, C for opening the file in write-only mode, +and C 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 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 call creates it (typically because MODE includes the C flag), then the value of @@ -4448,6 +4457,13 @@ the PERMS argument to C, Perl uses the octal value C<0666>. These permission values need to be in octal, and are modified by your process's current C. +In many systems the C flag is available for opening files in +exclusive mode. This is B locking: exclusiveness means here that +if the file already exists, sysopen() fails. The C wins +C. + +Sometimes you may want to truncate an already-existing file: C. + You should seldom if ever use C<0644> as argument to C, 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 for more diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t new file mode 100644 index 0000000..181a147 --- /dev/null +++ b/t/lib/syslfs.t @@ -0,0 +1,106 @@ +# 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 diff --git a/t/op/64bit.t b/t/op/64bit.t index 10f570a..97c1b03 100644 --- a/t/op/64bit.t +++ b/t/op/64bit.t @@ -1,9 +1,11 @@ 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. @@ -11,6 +13,8 @@ BEGIN { # 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; diff --git a/t/op/lfs.t b/t/op/lfs.t index 23f8113..ce7d1a5 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -1,9 +1,15 @@ +# 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 { @@ -19,53 +25,14 @@ if ($^O eq 'win32' || $^O eq 'vms') { 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); @@ -73,12 +40,14 @@ my @s; @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(); } @@ -87,7 +56,7 @@ unless (@s == 13 && 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"; @@ -95,13 +64,15 @@ 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"; -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); @@ -135,5 +106,3 @@ print "ok 8\n"; bye(); # eof - - -- 2.7.4