Upgrade to Tie::File 0.20.
[perl.git] / lib / Tie / File / t / 01_gen.t
1 #!/usr/bin/perl
2
3 my $file = "tf$$.txt";
4
5 print "1..62\n";
6
7 my $N = 1;
8 use Tie::File;
9 print "ok $N\n"; $N++;
10
11 my $o = tie @a, 'Tie::File', $file, autochomp => 0;
12 print $o ? "ok $N\n" : "not ok $N\n";
13 $N++;
14
15 $: = $o->{recsep};
16
17 # 3-5 create
18 $a[0] = 'rec0';
19 check_contents("rec0");
20
21 # 6-11 append
22 $a[1] = 'rec1';
23 check_contents("rec0", "rec1");
24 $a[2] = 'rec2';
25 check_contents("rec0", "rec1", "rec2");
26
27 # 12-20 same-length alterations
28 $a[0] = 'new0';
29 check_contents("new0", "rec1", "rec2");
30 $a[1] = 'new1';
31 check_contents("new0", "new1", "rec2");
32 $a[2] = 'new2';
33 check_contents("new0", "new1", "new2");
34
35 # 21-35 lengthening alterations
36 $a[0] = 'long0';
37 check_contents("long0", "new1", "new2");
38 $a[1] = 'long1';
39 check_contents("long0", "long1", "new2");
40 $a[2] = 'long2';
41 check_contents("long0", "long1", "long2");
42 $a[1] = 'longer1';
43 check_contents("long0", "longer1", "long2");
44 $a[0] = 'longer0';
45 check_contents("longer0", "longer1", "long2");
46
47 # 36-50 shortening alterations, including truncation
48 $a[0] = 'short0';
49 check_contents("short0", "longer1", "long2");
50 $a[1] = 'short1';
51 check_contents("short0", "short1", "long2");
52 $a[2] = 'short2';
53 check_contents("short0", "short1", "short2");
54 $a[1] = 'sh1';
55 check_contents("short0", "sh1", "short2");
56 $a[0] = 'sh0';
57 check_contents("sh0", "sh1", "short2");
58
59 # (51-56) file with holes
60 $a[4] = 'rec4';
61 check_contents("sh0", "sh1", "short2", "", "rec4");
62 $a[3] = 'rec3';
63 check_contents("sh0", "sh1", "short2", "rec3", "rec4");
64
65 # (57-59) zero out file
66 @a = ();
67 check_contents();
68
69 # (60-62) insert into the middle of an empty file
70 $a[3] = "rec3";
71 check_contents("", "", "", "rec3");
72
73 use POSIX 'SEEK_SET';
74 sub check_contents {
75   my @c = @_;
76   my $x = join $:, @c, '';
77   local *FH = $o->{fh};
78   seek FH, 0, SEEK_SET;
79 #  my $open = open FH, "< $file";
80   my $a;
81   { local $/; $a = <FH> }
82   $a = "" unless defined $a;
83   if ($a eq $x) {
84     print "ok $N\n";
85   } else {
86     ctrlfix($a, $x);
87     print "not ok $N\n# expected <$x>, got <$a>\n";
88   }
89   $N++;
90
91   # now check FETCH:
92   my $good = 1;
93   my $msg;
94   for (0.. $#c) {
95     my $aa = $a[$_];
96     unless ($aa eq "$c[$_]$:") {
97       $msg = "expected <$c[$_]$:>, got <$aa>";
98       ctrlfix($msg);
99       $good = 0;
100     }
101   }
102   print $good ? "ok $N\n" : "not ok $N # $msg\n";
103   $N++;
104
105   print $o->_check_integrity($file, $ENV{INTEGRITY}) 
106       ? "ok $N\n" : "not ok $N\n";
107   $N++;
108 }
109
110 sub ctrlfix {
111   for (@_) {
112     s/\n/\\n/g;
113     s/\r/\\r/g;
114   }
115 }
116
117 END {
118   undef $o;
119   untie @a;
120   1 while unlink $file;
121 }
122