Commit | Line | Data |
0308c4d5 |
1 | #!/usr/local/bin/perl -ws |
2 | |
3 | use strict ; |
4 | |
5 | use Carp ; |
6 | use Config ; |
7 | use Fcntl qw( :seek ) ; |
8 | use Test::More ; |
9 | |
10 | use File::ReadBackwards ; |
11 | |
12 | # NOTE: much of this code was taken from the core perl test script |
13 | # ops/lfs.t. it was modified to test File::ReadBackwards and large files |
14 | |
15 | my %has_no_sparse_files = map { $_ => 1 } |
16 | qw( MSWin32 NetWare VMS unicos ) ; |
17 | |
18 | my $test_file = 'bw.data' ; |
19 | |
20 | my @test_lines = ( |
21 | "3rd from last line\n", |
22 | "2nd from last\n", |
23 | "last line\n", |
24 | ) ; |
25 | |
26 | my $test_text = join '', @test_lines ; |
27 | |
28 | |
29 | sub skip_all_tests { |
30 | |
31 | my( $skip_text ) = @_ ; |
32 | |
33 | # unlink $test_file ; |
34 | plan skip_all => $skip_text ; |
35 | } |
36 | |
37 | if( $Config{lseeksize} < 8 ) { |
38 | skip_all_tests( "no 64-bit file offsets\n" ) ; |
39 | } |
40 | |
41 | unless( $Config{uselargefiles} ) { |
42 | skip_all_tests( "no large file support\n" ) ; |
43 | } |
44 | |
45 | if ( $has_no_sparse_files{ $^O } ) { |
46 | skip_all_tests( "no sparse files in $^O\n" ) ; |
47 | } |
48 | |
49 | # run the long seek code below in a subprocess in case it exits with a |
50 | # signal |
51 | |
52 | my $rc = system $^X, '-e', <<"EOF"; |
53 | open(BIG, ">$test_file"); |
54 | seek(BIG, 5_000_000_000, 0); |
55 | print BIG "$test_text" ; |
56 | exit 0; |
57 | EOF |
58 | |
59 | if( $rc ) { |
60 | |
61 | my $error = 'signal ' . ($rc & 0x7f) ; |
62 | skip_all_tests( "seeking past 2GB failed: $error" ) ; |
63 | } |
64 | |
65 | open(BIG, ">$test_file"); |
66 | |
67 | unless( seek(BIG, 5_000_000_000, 0) ) { |
68 | skip_all_tests( "seeking past 2GB failed: $!" ) ; |
69 | } |
70 | |
71 | |
72 | # Either the print or (more likely, thanks to buffering) the close will |
73 | # fail if there are are filesize limitations (process or fs). |
74 | |
75 | my $print = print BIG $test_text ; |
76 | my $close = close BIG; |
77 | |
78 | unless ($print && $close) { |
79 | |
80 | print "# print failed: $!\n" unless $print; |
81 | print "# close failed: $!\n" unless $close; |
82 | |
83 | if( $! =~/too large/i ) { |
84 | skip_all_tests( 'writing past 2GB failed: process limits?' ) ; |
85 | } |
86 | |
87 | if( $! =~ /quota/i ) { |
88 | skip_all_tests( 'filesystem quota limits?' ) ; |
89 | } |
90 | |
91 | skip_all_tests( "large file error: $!" ) ; |
92 | } |
93 | |
94 | plan tests => 2 ; |
95 | |
96 | my $bw = File::ReadBackwards->new( $test_file ) or |
97 | die "can't open $test_file: $!" ; |
98 | |
99 | my $line = $bw->readline() ; |
100 | is( $line, $test_lines[-1], 'last line' ) ; |
101 | |
102 | $line = $bw->readline() ; |
103 | is( $line, $test_lines[-2], 'next to last line' ) ; |
104 | |
105 | unlink $test_file ; |
106 | |
107 | exit ; |