3 # Check PUSH, POP, SHIFT, and UNSHIFT
5 # Each call to 'check_contents' actually performs two tests.
6 # First, it calls the tied object's own 'check_integrity' method,
7 # which makes sure that the contents of the read cache and offset tables
8 # accurately reflect the contents of the file.
9 # Then, it checks the actual contents of the file against the expected
14 my $file = "tf$$.txt";
16 $: = Tie::File::_default_recsep();
17 my $data = "rec0$:rec1$:rec2$:";
23 print "ok $N\n"; $N++; # partial credit just for showing up
25 my $o = tie @a, 'Tie::File', $file, autochomp => 0;
26 print $o ? "ok $N\n" : "not ok $N\n";
32 $n = push @a, "rec0", "rec1", "rec2";
33 check_contents($data);
34 print $n == 3 ? "ok $N\n" : "not ok $N # size is $n, should be 3\n";
37 $n = push @a, "rec3", "rec4$:";
38 check_contents("$ {data}rec3$:rec4$:");
39 print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
44 check_contents("$ {data}rec3$:rec4$:");
45 print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
50 check_contents("$ {data}rec3$:");
51 print $n eq "rec4$:" ? "ok $N\n" : "not ok $N # last rec is $n, should be rec4\n";
54 # Presumably we have already tested this to death
58 print $n eq "rec0$:" ? "ok $N\n" : "not ok $N # last rec is $n, should be rec0\n";
63 print ! defined $n ? "ok $N\n" : "not ok $N # last rec should be undef, is $n\n";
67 # (21-29) UNSHIFT tests
68 $n = unshift @a, "rec0", "rec1", "rec2";
69 check_contents($data);
70 print $n == 3 ? "ok $N\n" : "not ok $N # size is $n, should be 3\n";
73 $n = unshift @a, "rec3", "rec4$:";
74 check_contents("rec3$:rec4$:$data");
75 print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
80 check_contents("rec3$:rec4$:$data");
81 print $n == 5 ? "ok $N\n" : "not ok $N # size is $n, should be 5\n";
86 check_contents("rec4$:$data");
87 print $n eq "rec3$:" ? "ok $N\n" : "not ok $N # last rec is $n, should be rec3\n";
90 # Presumably we have already tested this to death
94 print $n eq "rec4$:" ? "ok $N\n" : "not ok $N # last rec is $n, should be rec4\n";
99 print ! defined $n ? "ok $N\n" : "not ok $N # last rec should be undef, is $n\n";
105 my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
106 print $integrity ? "ok $N\n" : "not ok $N\n";
109 local *FH = $o->{fh};
110 seek FH, 0, SEEK_SET;
112 { local $/; $a = <FH> }
113 $a = "" unless defined $a;
117 ctrlfix(my $msg = "# expected <$x>, got <$a>");
118 print "not ok $N\n$msg\n";
133 1 while unlink $file;