1N/A chdir 't' if -d 't'; 1N/A# Test glob operations. 1N/A# Test fake references. 1N/A# Test real references. 1N/A# Test references to real arrays. 1N/A# Test references to references. 1N/A# Test nested anonymous lists. 1N/Aprint $
$ref[
1] ==
2 ?
"ok 15\n" :
"not ok 15\n";
1N/Aprint ${$
$ref[
2]}[
2] ==
5 ?
"ok 16\n" :
"not ok 16\n";
1N/Aprint $ref->[
1] ==
2 ?
"ok 18\n" :
"not ok 18\n";
1N/Aprint $ref->[
2]->[
0] ==
3 ?
"ok 19\n" :
"not ok 19\n";
1N/A# Test references to hashes of references. 1N/Aprint $refref->{
"key"}->[
2]->[
0] ==
3 ?
"ok 20\n" :
"not ok 20\n";
1N/A# Test to see if anonymous subarrays spring into existence. 1N/A# Test to see if anonymous subhashes spring into existence. 1N/A# Test references to subroutines. 1N/A# Test the ref operator. 1N/A# Test anonymous hash syntax. 1N/A# Test bless operator. 1N/Aprint ref $object eq MYHASH ? "ok 30\n" : "not ok 30\n"; 1N/Aprint $object->{ABC} eq XYZ ? "ok 31\n" : "not ok 31\n"; 1N/Aprint ref $object2 eq MYHASH ? "ok 32\n" : "not ok 32\n"; 1N/A# Test ordinary call on object method. 1N/A&mymethod($object,33); 1N/A local($THIS, @ARGS) = @_; 1N/A unless ref $THIS eq MYHASH; 1N/A print $THIS->{FOO} eq BAR ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n"; 1N/A# Test automatic destructor call. 1N/A$string = "not ok 34\n"; 1N/A # Test that the object has not already been "cursed". 1N/A# Now test inheritance of methods. 1N/A$main'object = bless {FOO => foo, BAR => bar}; 1N/A# Test arrow-style method invocation. 1N/Aprint $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n"; 1N/A# Test indirect-object-style method invocation. 1N/A$foo = doit $object "FOO"; 1N/Aprint $foo eq foo ? "ok 37\n" : "not ok 37\n"; 1N/A# test the \(@foo) construct 1N/Aprint @bar == 3 ? "ok 39\n" : "not ok 39\n"; 1N/Aprint @baz == 3 ? "ok 41\n" : "not ok 41\n"; 1N/Aprint @baa == 3 ? "ok 42\n" : "not ok 42\n"; 1N/Aprint @bzz == 3 ? "ok 44\n" : "not ok 44\n"; 1N/A# also, it can't be an lvalue 1N/Aeval '\\($x, $y) = (1, 2);'; 1N/A# test for proper destruction of lexical objects 1N/A print "# leaving block\n"; 1N/Aprint "# left block\n"; 1N/A# test if reblessing during destruction results in more destruction 1N/A# test if $_[0] is properly protected in DESTROY() 1N/A print "# infinite recursion, bailing\nnot ok 53\n"; 1N/A print "# should generate an error...\n"; 1N/A print "# good, didn't recurse\n"; 1N/A# test if refgen behaves with autoviv magic 1N/A print ${\$_} for @a; 1N/A# This test is the reason for postponed destruction in sv_unref 1N/A# This test used to coredump. The BEGIN block is important as it causes the 1N/A# op that created the constant reference to be freed. Hence the only 1N/A# reference to the constant string "pass" is in $a. The hack that made 1N/A# sure $a = $a->[1] would work didn't work with references to constants. 1N/A prog=> 'print 1; print qq-*$\*-;print 1;'); 1N/Aif ($? != 0) { print "not " }; 1N/Aprint "ok ",++$test," - UNIVERSAL::AUTOLOAD called when freeing qr//\n"; 1N/Aif ($? != 0) { print "not " }; 1N/Aprint "ok ",++$test," - warn called inside UNIVERSAL::DESTROY\n"; 1N/Aif ($? != 0) { print "not " }; 1N/Aprint "ok ",++$test," - coredump on typeglob = (SvRV && !SvROK)\n"; 1N/A# bug #27268: freeing self-referential typeglobs could trigger 1N/A# "Attempt to free unreferenced scalar" warnings 1N/A prog => 'use Symbol;my $x=bless \gensym,"t"; print;*$$x=$x', 1N/Aprint "ok ",++$test," - freeing self-referential typeglob\n"; 1N/A# test global destruction 1N/A 1; # flush any temp values on stack