1#!/usr/local/bin/perl -ws
2
3use strict ;
4use warnings ;
5use Carp ;
6use Config ;
7use Fcntl qw( :seek ) ;
8use File::Temp qw( tempfile );
9use Test::More ;
10
11use File::ReadBackwards ;
12
13# NOTE: much of this code was taken from the core perl test script
14# ops/lfs.t. it was modified to test File::ReadBackwards and large files
15
16my (undef, $test_file) = tempfile('bw-XXXXXX', SUFFIX => '.data', TMPDIR => 1, CLEANUP => 1);
17
18my @test_lines = (
19	"3rd from last line\n",
20	"2nd from last\n",
21	"last line\n",
22) ;
23
24my $test_text = join '', @test_lines ;
25
26
27sub skip_all_tests {
28
29	my( $skip_text ) = @_ ;
30
31#	unlink $test_file ;
32	plan skip_all => $skip_text ;
33}
34
35if( $Config{lseeksize} < 8 ) {
36	skip_all_tests( "no 64-bit file offsets\n" ) ;
37}
38
39unless( $Config{uselargefiles} ) {
40	skip_all_tests( "no large file support\n" ) ;
41}
42
43unless ( have_sparse_files() ) {
44	skip_all_tests( "no sparse file support\n" ) ;
45}
46
47# run the long seek code below in a subprocess in case it exits with a
48# signal
49
50my $rc = system $^X, '-e', <<"EOF";
51open(BIG, ">$test_file");
52seek(BIG, 5_000_000_000, 0);
53print BIG "$test_text" ;
54exit 0;
55EOF
56
57if( $rc ) {
58
59	my $error = 'signal ' . ($rc & 0x7f) ;
60	skip_all_tests( "seeking past 2GB failed: $error" ) ;
61}
62
63open(BIG, ">$test_file");
64
65unless( seek(BIG, 5_000_000_000, 0) ) {
66	skip_all_tests( "seeking past 2GB failed: $!" ) ;
67}
68
69
70# Either the print or (more likely, thanks to buffering) the close will
71# fail if there are are filesize limitations (process or fs).
72
73my $print = print BIG $test_text ;
74my $close = close BIG;
75
76unless ($print && $close) {
77
78	print "# print failed: $!\n" unless $print;
79	print "# close failed: $!\n" unless $close;
80
81	if( $! =~/too large/i ) {
82		skip_all_tests( 'writing past 2GB failed: process limits?' ) ;
83	}
84
85	if( $! =~ /quota/i ) {
86		skip_all_tests( 'filesystem quota limits?' ) ;
87	}
88
89	skip_all_tests( "large file error: $!" ) ;
90}
91
92plan tests => 2 ;
93
94my $bw = File::ReadBackwards->new( $test_file ) or
95	die "can't open $test_file: $!" ;
96
97my $line = $bw->readline() ;
98is( $line, $test_lines[-1], 'last line' ) ;
99
100$line = $bw->readline() ;
101is( $line, $test_lines[-2], 'next to last line' ) ;
102
103unlink $test_file ;
104
105exit ;
106
107
108######## subroutines
109
110# this is lifted wholesale from t/op/lfs.t in perl.  Also, Uri is the
111# wind beneath my wings.
112sub have_sparse_files {
113
114     # don't even try for spare files on some OSs
115     return 0 if {
116         map { $_ => 1 } qw( MSWin32 NetWare VMS unicos )
117     }->{ $^O };
118     # take that, readability.
119
120     my (undef,$big0) = tempfile();
121     my (undef,$big1) = tempfile();
122     my (undef,$big2) = tempfile();
123
124     # We'll start off by creating a one megabyte file which has
125     # only three "true" bytes.  If we have sparseness, we should
126     # consume less blocks than one megabyte (assuming nobody has
127     # one megabyte blocks...)
128
129     open(BIG, ">$big1") or
130         die "open $big1 failed: $!";
131     binmode(BIG) or
132         die "binmode $big1 failed: $!";
133     seek(BIG, 1_000_000, SEEK_SET) or
134         die "seek $big1 failed: $!";
135     print BIG "big" or
136         die "print $big1 failed: $!";
137     close(BIG) or
138         die "close $big1 failed: $!";
139
140     my @s1 = stat($big1);
141
142 #    diag "s1 = @s1";
143
144     open(BIG, ">$big2") or
145         die "open $big2 failed: $!";
146     binmode(BIG) or
147         die "binmode $big2 failed: $!";
148     seek(BIG, 2_000_000, SEEK_SET) or
149         die "seek $big2 failed: $!";
150     print BIG "big" or
151         die "print $big2 failed: $!";
152     close(BIG) or
153         die "close $big2 failed: $!";
154
155     my @s2 = stat($big2);
156
157#     diag "s2 = @s2";
158
159     unless (
160         $s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
161	$s1[11] == $s2[11] && $s1[12] == $s2[12] &&
162         $s1[12] > 0 ) {
163#         diag 'no sparse files.  sad face.';
164         return 0;
165     }
166
167#     diag 'we seem to have sparse files...';
168
169     return 1 ;
170}
171
172
173
174