summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>2000-07-11 18:55:13 +0000
committerGurusamy Sarathy <gsar@cpan.org>2000-07-11 18:55:13 +0000
commit208fb4918fd588b3d206772fe40cb5dff1773ad4 (patch)
tree7538488d591713150f219fd676456d184c8fdea1 /t
parentb250498faaf6fbd04315d2b632649596e2498c42 (diff)
downloadperl-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.t66
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));