skip integrate of change#6267 from cfgperl into mainline (the
Gurusamy Sarathy [Tue, 11 Jul 2000 18:55:13 +0000 (18:55 +0000)]
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..)

t/op/method2entersub.t [new file with mode: 0644]

diff --git a/t/op/method2entersub.t b/t/op/method2entersub.t
new file mode 100644 (file)
index 0000000..5e9b924
--- /dev/null
@@ -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));