lib/Tie/File/t/05_size.t

   1 #!/usr/bin/perl
   2 #
   3 # Check FETCHSIZE and SETSIZE functions
   4 # PUSH POP SHIFT UNSHIFT
   5 #
   6
   7 use POSIX 'SEEK_SET';
   8
   9 my $file = "tf$$.txt";
  10 my ($o, $n);
  11
  12 print "1..16\n";
  13
  14 my $N = 1;
  15 use Tie::File;
  16 print "ok $N\n"; $N++;
  17
  18 # 2-3 FETCHSIZE 0-length file
  19 open F, "> $file" or die $!;
  20 binmode F;
  21 close F;
  22 $o = tie @a, 'Tie::File', $file;
  23 print $o ? "ok $N\n" : "not ok $N\n";
  24 $N++;
  25
  26 $: = $o->{recsep};
  27
  28 $n = @a;
  29 print $n == 0 ? "ok $N\n" : "not ok $N # $n, s/b 0\n";
  30 $N++;
  31
  32 # Reset everything
  33 undef $o;
  34 untie @a;
  35
  36 my $data = "rec0$:rec1$:rec2$:";
  37 open F, "> $file" or die $!;
  38 binmode F;
  39 print F $data;
  40 close F;
  41
  42 $o = tie @a, 'Tie::File', $file;
  43 print $o ? "ok $N\n" : "not ok $N\n";
  44 $N++;
  45
  46 # 4-5 FETCHSIZE positive-length file
  47 $n = @a;
  48 print $n == 3 ? "ok $N\n" : "not ok $N # $n, s/b 0\n";
  49 $N++;
  50
  51 # STORESIZE
  52 # (6-7) Make it longer:
  53 populate();
  54 $#a = 4;
  55 check_contents("$data$:$:");
  56
  57 # (8-9) Make it longer again:
  58 populate();
  59 $#a = 6;
  60 check_contents("$data$:$:$:$:");
  61
  62 # (10-11) Make it shorter:
  63 populate();
  64 $#a = 4;
  65 check_contents("$data$:$:");
  66
  67 # (12-13) Make it shorter again:
  68 populate();
  69 $#a = 2;
  70 check_contents($data);
  71
  72 # (14-15) Get rid of it completely:
  73 populate();
  74 $#a = -1;
  75 check_contents('');
  76
  77 # (16) 20020324 I have an idea that shortening the array will not
  78 # expunge a cached record at the end if one is present.
  79 $o->defer;
  80 $a[3] = "record";
  81 my $r = $a[3];
  82 $#a = -1;
  83 $r = $a[3];
  84 print (! defined $r ? "ok $N\n" : "not ok $N \# was <$r>; should be UNDEF\n");
  85 # Turns out not to be the case---STORESIZE explicitly removes them later
  86 # 20020326 Well, but happily, this test did fail today.
  87
  88 # In the past, there was a bug in STORESIZE that it didn't correctly
  89 # remove deleted records from the cache.  This wasn't detected
  90 # because these tests were all done with an empty cache.  populate()
  91 # will ensure that the cache is fully populated.
  92 sub populate {
  93   my $z;
  94   $z = $a[$_] for 0 .. $#a;
  95 }
  96
  97 sub check_contents {
  98   my $x = shift;
  99   local *FH = $o->{fh};
 100   seek FH, 0, SEEK_SET;
 101   my $a;
 102   { local $/; $a = <FH> }
 103   $a = "" unless defined $a;
 104   if ($a eq $x) {
 105     print "ok $N\n";
 106   } else {
 107     ctrlfix($a, $x);
 108     print "not ok $N\n# expected <$x>, got <$a>\n";
 109   }
 110   $N++;
 111   my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
 112   print $integrity ? "ok $N\n" : "not ok $N \# integrity\n";
 113   $N++;
 114 }
 115
 116
 117 sub ctrlfix {
 118   for (@_) {
 119     s/\n/\\n/g;
 120     s/\r/\\r/g;
 121   }
 122 }
 123
 124 END {
 125   undef $o;
 126   untie @a;
 127   1 while unlink $file;
 128 }
 129