diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 2000-07-11 18:55:13 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 2000-07-11 18:55:13 +0000 |
commit | 208fb4918fd588b3d206772fe40cb5dff1773ad4 (patch) | |
tree | 7538488d591713150f219fd676456d184c8fdea1 /t | |
parent | b250498faaf6fbd04315d2b632649596e2498c42 (diff) | |
download | perl-208fb4918fd588b3d206772fe40cb5dff1773ad4.tar.gz |
skip integrate of change#6267 from cfgperl into mainline (the
method call optimization is flawed without additional hints
from user about immutableness of @ISA and no runtime method
definitions)
p4raw-link: @6267 on //depot/cfgperl: 4f470f63ec19cae10190b8f3ed622153f261d3b1
p4raw-id: //depot/perl@6364
p4raw-branched: from //depot/cfgperl@6363 'branch in'
t/op/method2entersub.t
p4raw-integrated: from //depot/cfgperl@6363 'ignore'
lib/ExtUtils/Install.pm lib/base.pm (@5586..) xsutils.c
(@5996..)
p4raw-integrated: from //depot/cfgperl@6267 'ignore' t/op/sprintf.t
(@5717..) perl.h (@6193..) embed.pl (@6254..) op.c (@6257..)
MANIFEST (@6259..)
Diffstat (limited to 't')
-rw-r--r-- | t/op/method2entersub.t | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/t/op/method2entersub.t b/t/op/method2entersub.t new file mode 100644 index 0000000000..5e9b9240eb --- /dev/null +++ b/t/op/method2entersub.t @@ -0,0 +1,66 @@ +#!./perl + +BEGIN { + package BaseClass; #forward package declaration for base.pm + + chdir 't' if -d 't'; + unshift @INC, '../lib' if -d '../lib'; +} + +{ + package BaseClass; + + sub method { + } +} + +{ + package Class; + use base qw(BaseClass +readonly); + + sub mtest { + Class->method; + + my Class $obj = bless {}; + + $obj->method; + } + +} + +{ + package Class2; + use base qw(BaseClass); + + sub mtest { + Class2->method; + + my Class2 $obj = bless {}; + + $obj->method; + } +} + +use Test; + +plan tests => 2; + +use B (); + +sub cv_root { + B::svref_2object(shift)->ROOT; +} + +sub method_in_tree { + my $op = shift; + if ($$op && ($op->flags & B::OPf_KIDS)) { + for (my $kid = $op->first; $$kid; $kid = $kid->sibling) { + return 1 if $kid->ppaddr =~ /method/i; + return 1 if method_in_tree($kid); + } + } + return 0; +} + +ok ! method_in_tree(cv_root(\&Class::mtest)); +ok method_in_tree(cv_root(\&Class2::mtest)); |