#!./perl
-print "1..40\n";
+print "1..50\n";
# Test glob operations.
print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n";
print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n";
-print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 18\n";
+print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 19\n";
# Test references to hashes of references.
&$subref;
$subrefref = \\&mysub2;
-&$$subrefref("ok 24\n");
+$$subrefref->("ok 24\n");
sub mysub2 { print shift }
# Test the ref operator.
return unless $string;
print $string;
- # Test that the object has already been "cursed".
- print ref shift eq HASH ? "ok 35\n" : "not ok 35\n";
+ # Test that the object has not already been "cursed".
+ print ref shift ne HASH ? "ok 35\n" : "not ok 35\n";
}
# Now test inheritance of methods.
sub BASEOBJ'doit {
local $ref = shift;
die "Not an OBJ" unless ref $ref eq OBJ;
- $ref->{shift};
+ $ref->{shift()};
}
+package UNIVERSAL;
+@ISA = 'LASTCHANCE';
+
+package LASTCHANCE;
+sub foo { print $_[1] }
+
+package WHATEVER;
+foo WHATEVER "ok 38\n";
+
+#
+# test the \(@foo) construct
+#
+package main;
+@foo = (1,2,3);
+@bar = \(@foo);
+@baz = \(1,@foo,@bar);
+print @bar == 3 ? "ok 39\n" : "not ok 39\n";
+print grep(ref($_), @bar) == 3 ? "ok 40\n" : "not ok 40\n";
+print @baz == 3 ? "ok 41\n" : "not ok 41\n";
+
+my(@fuu) = (1,2,3);
+my(@baa) = \(@fuu);
+my(@bzz) = \(1,@fuu,@baa);
+print @baa == 3 ? "ok 42\n" : "not ok 42\n";
+print grep(ref($_), @baa) == 3 ? "ok 43\n" : "not ok 43\n";
+print @bzz == 3 ? "ok 44\n" : "not ok 44\n";
+
+# test for proper destruction of lexical objects
+
+sub larry::DESTROY { print "# larry\nok 45\n"; }
+sub curly::DESTROY { print "# curly\nok 46\n"; }
+sub moe::DESTROY { print "# moe\nok 47\n"; }
+
+{
+ my ($joe, @curly, %larry);
+ my $moe = bless \$joe, 'moe';
+ my $curly = bless \@curly, 'curly';
+ my $larry = bless \%larry, 'larry';
+ print "# leaving block\n";
+}
+
+print "# left block\n";
+
package FINALE;
{
- $ref3 = bless ["ok 40\n"]; # package destruction
- my $ref2 = bless ["ok 39\n"]; # lexical destruction
- local $ref1 = bless ["ok 38\n"]; # dynamic destruction
+ $ref3 = bless ["ok 50\n"]; # package destruction
+ my $ref2 = bless ["ok 49\n"]; # lexical destruction
+ local $ref1 = bless ["ok 48\n"]; # dynamic destruction
1; # flush any temp values on stack
}