lib/Tie/File/05_size.t

   1 #!/usr/bin/perl
   2 #
   3 # Check FETCHSIZE and SETSIZE functions
   4 # PUSH POP SHIFT UNSHIFT
   5 #
   6
   7 my $file = "tf$$.txt";
   8 my $data = "rec0$/rec1$/rec2$/";
   9 my ($o, $n);
  10
  11 print "1..10\n";
  12
  13 my $N = 1;
  14 use Tie::File;
  15 print "ok $N\n"; $N++;
  16
  17 # 2-3 FETCHSIZE 0-length file
  18 open F, "> $file" or die $!;
  19 close F;
  20 $o = tie @a, 'Tie::File', $file;
  21 print $o ? "ok $N\n" : "not ok $N\n";
  22 $N++;
  23 $n = @a;
  24 print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n";
  25 $N++;
  26
  27 # Reset everything
  28 undef $o;
  29 untie @a;
  30
  31 # 4-5 FETCHSIZE positive-length file
  32 open F, "> $file" or die $!;
  33 print F $data;
  34 close F;
  35 $o = tie @a, 'Tie::File', $file;
  36 print $o ? "ok $N\n" : "not ok $N\n";
  37 $N++;
  38 $n = @a;
  39 print $n == 3 ? "ok $N\n" : "not ok $N # $n, s/b 0\n";
  40 $N++;
  41
  42 # STORESIZE
  43 # 6 Make it longer:
  44 $#a = 4;
  45 check_contents("$data$/$/");
  46
  47 # 7 Make it longer again:
  48 $#a = 6;
  49 check_contents("$data$/$/$/$/");
  50
  51 # 8 Make it shorter:
  52 $#a = 4;
  53 check_contents("$data$/$/");
  54
  55 # 9 Make it shorter again:
  56 $#a = 2;
  57 check_contents($data);
  58
  59 # 10 Get rid of it completely:
  60 $#a = -1;
  61 check_contents('');
  62
  63
  64 sub check_contents {
  65   my $x = shift;
  66   local *FH;
  67   my $open = open FH, "< $file";
  68   my $a;
  69   { local $/; $a = <FH> }
  70   print (($open && $a eq $x) ? "ok $N\n" : "not ok $N\n");
  71   $N++;
  72 }
  73
  74
  75 END {
  76   1 while unlink $file;
  77 }
  78