3 # Check miscellaneous tied-array interface methods
4 # EXTEND, CLEAR, DELETE, EXISTS
8 $: = Tie::File::_default_recsep();
15 print "ok $N\n"; $N++;
17 my $o = tie @a, 'Tie::File', $file, autodefer => 0;
18 print $o ? "ok $N\n" : "not ok $N\n";
23 check_contents("$:$:$:");
25 check_contents("$:$:$:$:");
27 check_contents("$:$:$:$:");
36 print !exists $a[0] ? "ok $N\n" : "not ok $N\n";
38 $a[0] = "I like pie.";
39 print exists $a[0] ? "ok $N\n" : "not ok $N\n";
41 print !exists $a[1] ? "ok $N\n" : "not ok $N\n";
43 $a[2] = "GIVE ME PIE";
44 print exists $a[0] ? "ok $N\n" : "not ok $N\n";
46 # exists $a[1] is not defined by this module under these circumstances
47 print exists $a[1] ? "ok $N\n" : "ok $N\n";
49 print exists $a[2] ? "ok $N\n" : "not ok $N\n";
51 print exists $a[-1] ? "ok $N\n" : "not ok $N\n";
53 print exists $a[-2] ? "ok $N\n" : "not ok $N\n";
55 print exists $a[-3] ? "ok $N\n" : "not ok $N\n";
57 print !exists $a[-4] ? "ok $N\n" : "not ok $N\n";
60 } else { # perl 5.005 doesn't have exists $array[1]
62 print "ok $_ \# skipped (no exists for arrays)\n";
73 check_contents("$:$:GIVE ME PIE$:");
74 # 20020317 Through 0.20, the 'delete' function returned the wrong values.
75 expect($del, "I like pie.");
77 check_contents("$:$:");
78 expect($del, "GIVE ME PIE");
80 check_contents("$:$:");
86 # 20020317 Through 0.20, we had a bug where deleting an element past the
87 # end of the array would actually extend the array to that length.
95 } else { # perl 5.005 doesn't have delete $array[1]
97 print "ok $_ \# skipped (no delete for arrays)\n";
102 use POSIX 'SEEK_SET';
105 local *FH = $o->{fh};
106 seek FH, 0, SEEK_SET;
108 { local $/; $a = <FH> }
109 $a = "" unless defined $a;
113 ctrlfix(my $msg = "# expected <$x>, got <$a>");
114 print "not ok $N # $msg\n";
117 print $o->_check_integrity($file, $ENV{INTEGRITY}) ? "ok $N\n" : "not ok $N\n";
123 print $_[0] ? "ok $N\n" : "not ok $N\n";
126 if (! defined($a) && ! defined($x)) { print "ok $N\n" }
127 elsif ( defined($a) && ! defined($x)) {
128 ctrlfix(my $msg = "expected UNDEF, got <$a>");
129 print "not ok $N \# $msg\n";
131 elsif (! defined($a) && defined($x)) {
132 ctrlfix(my $msg = "expected <$x>, got UNDEF");
133 print "not ok $N \# $msg\n";
134 } elsif ($a eq $x) { print "ok $N\n" }
136 ctrlfix(my $msg = "expected <$x>, got <$a>");
137 print "not ok $N \# $msg\n";
140 die "expect() got ", scalar(@_), " args, should have been 1 or 2";
155 1 while unlink $file;