lib/Tie/File/t/42_offset.t

   1 #!/usr/bin/perl
   2
   3 # 2003-04-09 Tels: test the offset method from 0.94
   4
   5 use Test::More;
   6 use strict;
   7 use File::Spec;
   8
   9 use POSIX 'SEEK_SET';
  10 my $file = "tf$$.txt";
  11
  12 BEGIN
  13   {
  14   $| = 1;
  15   if ($ENV{PERL_CORE})
  16     {
  17     # testing with the core distribution
  18     @INC = ( File::Spec->catdir(File::Spec->updir, 't', 'lib') );
  19     }
  20   unshift @INC, File::Spec->catdir(File::Spec->updir, 'lib');
  21   chdir 't' if -d 't';
  22   print "# INC = @INC\n";
  23
  24   plan tests => 24;
  25
  26   use_ok ('Tie::File');
  27   }
  28
  29 $/ = "#";       # avoid problems with \n\r vs. \n
  30
  31 my @a;
  32 my $o = tie @a, 'Tie::File', $file, autodefer => 0;
  33
  34 is (ref($o), 'Tie::File');
  35
  36 is ($o->offset(0), 0, 'first one always there');
  37 is ($o->offset(1), undef, 'no offsets yet');
  38
  39 $a[0] = 'Bourbon';
  40 is ($o->offset(0), 0, 'first is ok');
  41 is ($o->offset(1), 8, 'and second ok');
  42 is ($o->offset(2), undef, 'third undef');
  43
  44 $a[1] = 'makes';
  45 is ($o->offset(0), 0, 'first is ok');
  46 is ($o->offset(1), 8, 'and second ok');
  47 is ($o->offset(2), 14, 'and third ok');
  48 is ($o->offset(3), undef, 'fourth undef');
  49
  50 $a[2] = 'the baby';
  51 is ($o->offset(0), 0, 'first is ok');
  52 is ($o->offset(1), 8, 'and second ok');
  53 is ($o->offset(2), 14, 'and third ok');
  54 is ($o->offset(3), 23, 'and fourth ok');
  55 is ($o->offset(4), undef, 'fourth undef');
  56
  57 $a[3] = 'grin';
  58 is ($o->offset(0), 0, 'first is ok');
  59 is ($o->offset(1), 8, 'and second ok');
  60 is ($o->offset(2), 14, 'and third ok');
  61 is ($o->offset(3), 23, 'and fourth ok');
  62 is ($o->offset(4), 28, 'and fifth ok');
  63
  64 $a[4] = '!';
  65 is ($o->offset(5), 30, 'and fifth ok');
  66 $a[3] = 'water';
  67 is ($o->offset(4), 29, 'and fourth changed ok');
  68 is ($o->offset(5), 31, 'and fifth ok');
  69
  70 END {
  71   undef $o;
  72   untie @a;
  73   1 while unlink $file;
  74 }