t/large_file.t

   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 ;