1#!./perl -w 2 3# 4# test method calls and autoloading. 5# 6 7BEGIN { 8 chdir 't' if -d 't'; 9 @INC = qw(. ../lib lib); 10 require "test.pl"; 11} 12 13use strict; 14no warnings 'once'; 15 16plan(tests => 147); 17 18@A::ISA = 'B'; 19@B::ISA = 'C'; 20 21sub C::d {"C::d"} 22sub D::d {"D::d"} 23 24# First, some basic checks of method-calling syntax: 25my $obj = bless [], "Pack"; 26sub Pack::method { shift; join(",", "method", @_) } 27my $mname = "method"; 28 29is(Pack->method("a","b","c"), "method,a,b,c"); 30is(Pack->$mname("a","b","c"), "method,a,b,c"); 31is(method Pack ("a","b","c"), "method,a,b,c"); 32is((method Pack "a","b","c"), "method,a,b,c"); 33 34is(Pack->method(), "method"); 35is(Pack->$mname(), "method"); 36is(method Pack (), "method"); 37is(Pack->method, "method"); 38is(Pack->$mname, "method"); 39is(method Pack, "method"); 40 41is($obj->method("a","b","c"), "method,a,b,c"); 42is($obj->$mname("a","b","c"), "method,a,b,c"); 43is((method $obj ("a","b","c")), "method,a,b,c"); 44is((method $obj "a","b","c"), "method,a,b,c"); 45 46is($obj->method(0), "method,0"); 47is($obj->method(1), "method,1"); 48 49is($obj->method(), "method"); 50is($obj->$mname(), "method"); 51is((method $obj ()), "method"); 52is($obj->method, "method"); 53is($obj->$mname, "method"); 54is(method $obj, "method"); 55 56is( A->d, "C::d"); # Update hash table; 57 58*B::d = \&D::d; # Import now. 59is(A->d, "D::d"); # Update hash table; 60 61{ 62 local @A::ISA = qw(C); # Update hash table with split() assignment 63 is(A->d, "C::d"); 64 $#A::ISA = -1; 65 is(eval { A->d } || "fail", "fail"); 66} 67is(A->d, "D::d"); 68 69{ 70 local *B::d; 71 eval 'sub B::d {"B::d1"}'; # Import now. 72 is(A->d, "B::d1"); # Update hash table; 73 undef &B::d; 74 is((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1); 75} 76 77is(A->d, "D::d"); # Back to previous state 78 79eval 'no warnings "redefine"; sub B::d {"B::d2"}'; # Import now. 80is(A->d, "B::d2"); # Update hash table; 81 82# What follows is hardly guarantied to work, since the names in scripts 83# are already linked to "pruned" globs. Say, 'undef &B::d' if it were 84# after 'delete $B::{d}; sub B::d {}' would reach an old subroutine. 85 86undef &B::d; 87delete $B::{d}; 88is(A->d, "C::d"); 89 90eval 'sub B::d {"B::d2.5"}'; 91A->d; # Update hash table; 92my $glob = \delete $B::{d}; # non-void context; hang on to the glob 93is(A->d, "C::d"); # Update hash table; 94 95eval 'sub B::d {"B::d3"}'; # Import now. 96is(A->d, "B::d3"); # Update hash table; 97 98delete $B::{d}; 99*dummy::dummy = sub {}; # Mark as updated 100is(A->d, "C::d"); 101 102eval 'sub B::d {"B::d4"}'; # Import now. 103is(A->d, "B::d4"); # Update hash table; 104 105delete $B::{d}; # Should work without any help too 106is(A->d, "C::d"); 107 108{ 109 local *C::d; 110 is(eval { A->d } || "nope", "nope"); 111} 112is(A->d, "C::d"); 113 114*A::x = *A::d; 115A->d; 116is(eval { A->x } || "nope", "nope", 'cache should not follow synonyms'); 117 118my $counter; 119 120eval <<'EOF'; 121sub C::e; 122BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg 123sub Y::f; 124$counter = 0; 125 126@X::ISA = 'Y'; 127@Y::ISA = 'B'; 128 129sub B::AUTOLOAD { 130 my $c = ++$counter; 131 my $method = $B::AUTOLOAD; 132 my $msg = "B: In $method, $c"; 133 eval "sub $method { \$msg }"; 134 goto &$method; 135} 136sub C::AUTOLOAD { 137 my $c = ++$counter; 138 my $method = $C::AUTOLOAD; 139 my $msg = "C: In $method, $c"; 140 eval "sub $method { \$msg }"; 141 goto &$method; 142} 143EOF 144 145is(A->e(), "C: In C::e, 1"); # We get a correct autoload 146is(A->e(), "C: In C::e, 1"); # Which sticks 147 148is(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top 149is(A->ee(), "B: In A::ee, 2"); # Which sticks 150 151is(Y->f(), "B: In Y::f, 3"); # We vivify a correct method 152is(Y->f(), "B: In Y::f, 3"); # Which sticks 153 154# This test is not intended to be reasonable. It is here just to let you 155# know that you broke some old construction. Feel free to rewrite the test 156# if your patch breaks it. 157 158{ 159no warnings 'redefine'; 160*B::AUTOLOAD = sub { 161 use warnings; 162 my $c = ++$counter; 163 my $method = $::AUTOLOAD; 164 no strict 'refs'; 165 *$::AUTOLOAD = sub { "new B: In $method, $c" }; 166 goto &$::AUTOLOAD; 167}; 168} 169 170is(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload 171is(A->eee(), "new B: In A::eee, 4"); # Which sticks 172 173{ 174 no strict 'refs'; 175 no warnings 'deprecated'; 176 # this test added due to bug discovery (in 5.004_04, fb73857aa0bfa8ed) 177 # Possibly kill this test now that defined @::array is finally properly 178 # deprecated? 179 is(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); 180} 181 182# test that failed subroutine calls don't affect method calls 183{ 184 package A1; 185 sub foo { "foo" } 186 package A2; 187 @A2::ISA = 'A1'; 188 package main; 189 is(A2->foo(), "foo"); 190 is(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1); 191 is(A2->foo(), "foo"); 192} 193 194## This test was totally misguided. It passed before only because the 195## code to determine if a package was loaded used to look for the hash 196## %Foo::Bar instead of the package Foo::Bar:: -- and Config.pm just 197## happens to export %Config. 198# { 199# is(do { use Config; eval 'Config->foo()'; 200# $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); 201# is(do { use Config; eval '$d = bless {}, "Config"; $d->foo()'; 202# $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); 203# } 204 205# test error messages if method loading fails 206my $e; 207 208eval '$e = bless {}, "E::A"; E::A->foo()'; 209like ($@, qr/^\QCan't locate object method "foo" via package "E::A" at/); 210eval '$e = bless {}, "E::B"; $e->foo()'; 211like ($@, qr/^\QCan't locate object method "foo" via package "E::B" at/); 212eval 'E::C->foo()'; 213like ($@, qr/^\QCan't locate object method "foo" via package "E::C" (perhaps /); 214 215eval 'UNIVERSAL->E::D::foo()'; 216like ($@, qr/^\QCan't locate object method "foo" via package "E::D" (perhaps /); 217eval 'my $e = bless {}, "UNIVERSAL"; $e->E::E::foo()'; 218like ($@, qr/^\QCan't locate object method "foo" via package "E::E" (perhaps /); 219 220$e = bless {}, "E::F"; # force package to exist 221eval 'UNIVERSAL->E::F::foo()'; 222like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/); 223eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()'; 224like ($@, qr/^\QCan't locate object method "foo" via package "E::F" at/); 225 226# SUPER:: pseudoclass 227@Saab::ISA = "Souper"; 228sub Souper::method { @_ } 229@OtherSaab::ISA = "OtherSouper"; 230sub OtherSouper::method { "Isidore Ropen, Draft Manager" } 231{ 232 my $o = bless [], "Saab"; 233 package Saab; 234 my @ret = $o->SUPER::method('whatever'); 235 ::is $ret[0], $o, 'object passed to SUPER::method'; 236 ::is $ret[1], 'whatever', 'argument passed to SUPER::method'; 237 @ret = $o->SUPER'method('whatever'); 238 ::is $ret[0], $o, "object passed to SUPER'method"; 239 ::is $ret[1], 'whatever', "argument passed to SUPER'method"; 240 @ret = Saab->SUPER::method; 241 ::is $ret[0], 'Saab', "package name passed to SUPER::method"; 242 @ret = OtherSaab->SUPER::method; 243 ::is $ret[0], 'OtherSaab', 244 "->SUPER::method uses current package, not invocant"; 245} 246() = *SUPER::; 247{ 248 local our @ISA = "Souper"; 249 is eval { (main->SUPER::method)[0] }, 'main', 250 'Mentioning *SUPER:: does not stop ->SUPER from working in main'; 251} 252{ 253 BEGIN { 254 *Mover:: = *Mover2::; 255 *Mover2:: = *foo; 256 } 257 package Mover; 258 no strict; 259 # Not our(@ISA), because the bug we are testing for interacts with an 260 # our() bug that cancels this bug out. 261 @ISA = 'door'; 262 sub door::dohtem { 'dohtem' } 263 ::is eval { Mover->SUPER::dohtem; }, 'dohtem', 264 'SUPER inside moved package'; 265 undef *door::dohtem; 266 *door::dohtem = sub { 'method' }; 267 ::is eval { Mover->SUPER::dohtem; }, 'method', 268 'SUPER inside moved package respects method changes'; 269} 270 271package foo120694 { 272 BEGIN { our @ISA = qw(bar120694) } 273 274 sub AUTOLOAD { 275 my $self = shift; 276 local our $recursive = $recursive; 277 return "recursive" if $recursive++; 278 return if our $AUTOLOAD eq 'DESTROY'; 279 $AUTOLOAD = "SUPER:" . substr $AUTOLOAD, rindex($AUTOLOAD, ':'); 280 return $self->$AUTOLOAD(@_); 281 } 282} 283package bar120694 { 284 sub AUTOLOAD { 285 return "xyzzy"; 286 } 287} 288is bless( [] => "foo120694" )->plugh, 'xyzzy', 289 '->SUPER::method autoloading uses parent of current pkg'; 290 291 292# failed method call or UNIVERSAL::can() should not autovivify packages 293is( $::{"Foo::"} || "none", "none"); # sanity check 1 294is( $::{"Foo::"} || "none", "none"); # sanity check 2 295 296is( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" ); 297is( $::{"Foo::"} || "none", "none"); # still missing? 298 299is( Foo->UNIVERSAL::can("boogie") ? "yes":"no", "no" ); 300is( $::{"Foo::"} || "none", "none"); # still missing? 301 302is( Foo->can("boogie") ? "yes":"no", "no" ); 303is( $::{"Foo::"} || "none", "none"); # still missing? 304 305is( eval 'Foo->boogie(); 1' ? "yes":"no", "no" ); 306is( $::{"Foo::"} || "none", "none"); # still missing? 307 308is(do { eval 'Foo->boogie()'; 309 $@ =~ /^\QCan't locate object method "boogie" via package "Foo" (perhaps / ? 1 : $@}, 1); 310 311eval 'sub Foo::boogie { "yes, sir!" }'; 312is( $::{"Foo::"} ? "ok" : "none", "ok"); # should exist now 313is( Foo->boogie(), "yes, sir!"); 314 315# TODO: universal.t should test NoSuchPackage->isa()/can() 316 317# This is actually testing parsing of indirect objects and undefined subs 318# print foo("bar") where foo does not exist is not an indirect object. 319# print foo "bar" where foo does not exist is an indirect object. 320eval 'sub AUTOLOAD { "ok ", shift, "\n"; }'; 321ok(1); 322 323# Bug ID 20010902.002 324is( 325 eval q[ 326 my $x = 'x'; # Lexical or package variable, 5.6.1 panics. 327 sub Foo::x : lvalue { $x } 328 Foo->$x = 'ok'; 329 ] || $@, 'ok' 330); 331 332# An autoloaded, inherited DESTROY may be invoked differently than normal 333# methods, and has been known to give rise to spurious warnings 334# eg <200203121600.QAA11064@gizmo.fdgroup.co.uk> 335 336{ 337 use warnings; 338 my $w = ''; 339 local $SIG{__WARN__} = sub { $w = $_[0] }; 340 341 sub AutoDest::Base::AUTOLOAD {} 342 @AutoDest::ISA = qw(AutoDest::Base); 343 { my $x = bless {}, 'AutoDest'; } 344 $w =~ s/\n//g; 345 is($w, ''); 346} 347 348# [ID 20020305.025] PACKAGE::SUPER doesn't work anymore 349 350package main; 351our @X; 352package Amajor; 353sub test { 354 push @main::X, 'Amajor', @_; 355} 356package Bminor; 357use base qw(Amajor); 358package main; 359sub Bminor::test { 360 $_[0]->Bminor::SUPER::test('x', 'y'); 361 push @main::X, 'Bminor', @_; 362} 363Bminor->test('y', 'z'); 364is("@X", "Amajor Bminor x y Bminor Bminor y z"); 365 366package main; 367for my $meth (['Bar', 'Foo::Bar'], 368 ['SUPER::Bar', 'main::SUPER::Bar'], 369 ['Xyz::SUPER::Bar', 'Xyz::SUPER::Bar']) 370{ 371 fresh_perl_is(<<EOT, 372package UNIVERSAL; sub AUTOLOAD { my \$c = shift; print "\$c \$AUTOLOAD\\n" } 373package Xyz; 374package main; Foo->$meth->[0](); 375EOT 376 "Foo $meth->[1]", 377 { switches => [ '-w' ] }, 378 "check if UNIVERSAL::AUTOLOAD works", 379 ); 380} 381 382# Test for #71952: crash when looking for a nonexistent destructor 383# Regression introduced by fbb3ee5af3d4 384{ 385 fresh_perl_is(<<'EOT', 386sub M::DESTROY; bless {}, "M" ; print "survived\n"; 387EOT 388 "survived", 389 {}, 390 "no crash with a declared but missing DESTROY method" 391 ); 392} 393 394# Test for calling a method on a packag name return by a magic variable 395sub TIESCALAR{bless[]} 396sub FETCH{"main"} 397my $kalled; 398sub bolgy { ++$kalled; } 399tie my $a, ""; 400$a->bolgy; 401is $kalled, 1, 'calling a class method via a magic variable'; 402 403{ 404 package NulTest; 405 sub method { 1 } 406 407 package main; 408 eval { 409 NulTest->${ \"method\0Whoops" }; 410 }; 411 like $@, qr/Can't locate object method "method\0Whoops" via package "NulTest" at/, 412 "method lookup is nul-clean"; 413 414 *NulTest::AUTOLOAD = sub { our $AUTOLOAD; return $AUTOLOAD }; 415 416 like(NulTest->${ \"nul\0test" }, "nul\0test", "AUTOLOAD is nul-clean"); 417} 418 419 420{ 421 fresh_perl_is( 422 q! sub T::DESTROY { $x = $_[0]; } bless [], "T";!, 423 "DESTROY created new reference to dead object 'T' during global destruction.", 424 {}, 425 "DESTROY creating a new reference to the object generates a warning." 426 ); 427} 428 429# [perl #43663] 430{ 431 $::{"Just"} = \1; 432 sub Just::a_japh { return "$_[0] another Perl hacker," } 433 is eval { "Just"->a_japh }, "Just another Perl hacker,", 434 'constants do not interfere with class methods'; 435} 436 437# [perl #109264] 438{ 439 no strict 'vars'; 440 sub bliggles { 1 } 441 sub lbiggles :lvalue { index "foo", "f" } 442 ok eval { main->bliggles(my($foo,$bar)) }, 443 'foo->bar(my($foo,$bar)) is not called in lvalue context'; 444 ok eval { main->bliggles(our($foo,$bar)) }, 445 'foo->bar(our($foo,$bar)) is not called in lvalue context'; 446 ok eval { main->bliggles(local($foo,$bar)) }, 447 'foo->bar(local($foo,$bar)) is not called in lvalue context'; 448 ok eval { () = main->lbiggles(my($foo,$bar)); 1 }, 449 'foo->lv(my($foo,$bar)) is not called in lvalue context'; 450 ok eval { () = main->lbiggles(our($foo,$bar)); 1 }, 451 'foo->lv(our($foo,$bar)) is not called in lvalue context'; 452 ok eval { () = main->lbiggles(local($foo,$bar)); 1 }, 453 'foo->lv(local($foo,$bar)) is not called in lvalue context'; 454} 455 456{ 457 # AUTOLOAD and DESTROY can be declared without a leading sub, 458 # like BEGIN and friends. 459 package NoSub; 460 461 eval 'AUTOLOAD { our $AUTOLOAD; return $AUTOLOAD }'; 462 ::ok( !$@, "AUTOLOAD without a leading sub is legal" ); 463 464 eval "DESTROY { ::pass( q!DESTROY without a leading sub is legal and gets called! ) }"; 465 { 466 ::ok( NoSub->can("AUTOLOAD"), "...and sets up an AUTOLOAD normally" ); 467 ::is( eval { NoSub->bluh }, "NoSub::bluh", "...which works as expected" ); 468 } 469 { bless {}, "NoSub"; } 470} 471 472eval { () = 3; new {} }; 473like $@, 474 qr/^Can't call method "new" without a package or object reference/, 475 'Err msg from new{} when stack contains a number'; 476eval { () = "foo"; new {} }; 477like $@, 478 qr/^Can't call method "new" without a package or object reference/, 479 'Err msg from new{} when stack contains a word'; 480eval { () = undef; new {} }; 481like $@, 482 qr/^Can't call method "new" without a package or object reference/, 483 'Err msg from new{} when stack contains undef'; 484 485package egakacp { 486 our @ISA = 'ASI'; 487 sub ASI::m { shift; "@_" }; 488 my @a = (bless([]), 'arg'); 489 my $r = SUPER::m{@a}; 490 ::is $r, 'arg', 'method{@array}'; 491 $r = SUPER::m{}@a; 492 ::is $r, 'arg', 'method{}@array'; 493 $r = SUPER::m{@a}"b"; 494 ::is $r, 'arg b', 'method{@array}$more_args'; 495} 496 497# [perl #114924] SUPER->method 498@SUPER::ISA = "SUPPER"; 499sub SUPPER::foo { "supper" } 500is "SUPER"->foo, 'supper', 'SUPER->method'; 501 502sub flomp { "flimp" } 503sub main::::flomp { "flump" } 504is "::"->flomp, 'flump', 'method call on ::'; 505is "::main"->flomp, 'flimp', 'method call on ::main'; 506eval { ""->flomp }; 507like $@, 508 qr/^Can't call method "flomp" without a package or object reference/, 509 'method call on empty string'; 510is "3foo"->CORE::uc, '3FOO', '"3foo"->CORE::uc'; 511{ no strict; @{"3foo::ISA"} = "CORE"; } 512is "3foo"->uc, '3FOO', '"3foo"->uc (autobox style!)'; 513 514# *foo vs (\*foo) 515sub myclass::squeak { 'eek' } 516eval { *myclass->squeak }; 517like $@, 518 qr/^Can't call method "squeak" without a package or object reference/, 519 'method call on typeglob ignores package'; 520eval { (\*myclass)->squeak }; 521like $@, 522 qr/^Can't call method "squeak" on unblessed reference/, 523 'method call on \*typeglob'; 524*stdout2 = *STDOUT; # stdout2 now stringifies as *main::STDOUT 525sub IO::Handle::self { $_[0] } 526# This used to stringify the glob: 527is *stdout2->self, (\*stdout2)->self, 528 '*glob->method is equiv to (\*glob)->method'; 529sub { $_[0] = *STDOUT; is $_[0]->self, \$::h{k}, '$pvlv_glob->method' } 530 ->($::h{k}); 531 532# Test that PL_stashcache doesn't change the resolution behaviour for file 533# handles and package names. 534SKIP: { 535 skip_if_miniperl('file handles as methods requires loading IO::File', 26); 536 require Fcntl; 537 538 foreach (qw (Count::DATA Count Colour::H1 Color::H1 C3::H1)) { 539 eval qq{ 540 package $_; 541 542 sub getline { 543 return "method in $_"; 544 } 545 546 1; 547 } or die $@; 548 } 549 550 BEGIN { 551 *The::Count:: = \*Count::; 552 } 553 554 is(Count::DATA->getline(), 'method in Count::DATA', 555 'initial resolution is a method'); 556 is(The::Count::DATA->getline(), 'method in Count::DATA', 557 'initial resolution is a method in aliased classes'); 558 559 require Count; 560 561 is(Count::DATA->getline(), "one! ha ha ha\n", 'file handles take priority'); 562 is(The::Count::DATA->getline(), "two! ha ha ha\n", 563 'file handles take priority in aliased classes'); 564 565 eval q{close Count::DATA} or die $!; 566 567 { 568 no warnings 'io'; 569 is(Count::DATA->getline(), undef, 570 "closing a file handle doesn't change object resolution"); 571 is(The::Count::DATA->getline(), undef, 572 "closing a file handle doesn't change object resolution in aliased classes"); 573} 574 575 undef *Count::DATA; 576 is(Count::DATA->getline(), 'method in Count::DATA', 577 'undefining the typeglob does change object resolution'); 578 is(The::Count::DATA->getline(), 'method in Count::DATA', 579 'undefining the typeglob does change object resolution in aliased classes'); 580 581 is(Count->getline(), 'method in Count', 582 'initial resolution is a method'); 583 is(The::Count->getline(), 'method in Count', 584 'initial resolution is a method in aliased classes'); 585 586 eval q{ 587 open Count, '<', $INC{'Count.pm'} 588 or die "Can't open $INC{'Count.pm'}: $!"; 5891; 590 } or die $@; 591 592 is(Count->getline(), "# zero! ha ha ha\n", 'file handles take priority'); 593 is(The::Count->getline(), 'method in Count', 'but not in an aliased class'); 594 595 eval q{close Count} or die $!; 596 597 { 598 no warnings 'io'; 599 is(Count->getline(), undef, 600 "closing a file handle doesn't change object resolution"); 601 } 602 603 undef *Count; 604 is(Count->getline(), 'method in Count', 605 'undefining the typeglob does change object resolution'); 606 607 open Colour::H1, 'op/method.t' or die $!; 608 while (<Colour::H1>) { 609 last if /^__END__/; 610 } 611 open CLOSED, 'TEST' or die $!; 612 close CLOSED or die $!; 613 614 my $fh_start = tell Colour::H1; 615 my $data_start = tell DATA; 616 is(Colour::H1->getline(), <DATA>, 'read from a file'); 617 is(Color::H1->getline(), 'method in Color::H1', 618 'initial resolution is a method'); 619 620 *Color::H1 = *Colour::H1{IO}; 621 622 is(Colour::H1->getline(), <DATA>, 'read from a file'); 623 is(Color::H1->getline(), <DATA>, 624 'file handles take priority after io-to-typeglob assignment'); 625 626 *Color::H1 = *CLOSED{IO}; 627 { 628 no warnings 'io'; 629 is(Color::H1->getline(), undef, 630 "assigning a closed a file handle doesn't change object resolution"); 631 } 632 633 undef *Color::H1; 634 is(Color::H1->getline(), 'method in Color::H1', 635 'undefining the typeglob does change object resolution'); 636 637 *Color::H1 = *Colour::H1; 638 639 is(Color::H1->getline(), <DATA>, 640 'file handles take priority after typeglob-to-typeglob assignment'); 641 642 seek Colour::H1, $fh_start, Fcntl::SEEK_SET() or die $!; 643 seek DATA, $data_start, Fcntl::SEEK_SET() or die $!; 644 645 is(Colour::H1->getline(), <DATA>, 'read from a file'); 646 is(C3::H1->getline(), 'method in C3::H1', 'intial resolution is a method'); 647 648 *Copy:: = \*C3::; 649 *C3:: = \*Colour::; 650 651 is(Colour::H1->getline(), <DATA>, 'read from a file'); 652 is(C3::H1->getline(), <DATA>, 653 'file handles take priority after stash aliasing'); 654 655 *C3:: = \*Copy::; 656 657 is(C3::H1->getline(), 'method in C3::H1', 658 'restoring the stash returns to a method'); 659} 660 661__END__ 662#FF9900 663#F78C08 664#FFA500 665#FF4D00 666#FC5100 667#FF5D00 668