t/op/method2entersub.t

   1 #!./perl
   2
   3 BEGIN {
   4     package BaseClass; #forward package declaration for base.pm
   5
   6     chdir 't' if -d 't';
   7     unshift @INC, '../lib' if -d '../lib';
   8 }
   9
  10 {
  11     package BaseClass;
  12
  13     sub method {
  14     }
  15 }
  16
  17 {
  18     package Class;
  19     use base qw(BaseClass +readonly);
  20
  21     sub mtest {
  22         Class->method;
  23
  24         my Class $obj = bless {};
  25
  26         $obj->method;
  27     }
  28
  29 }
  30
  31 {
  32     package Class2;
  33     use base qw(BaseClass);
  34
  35     sub mtest {
  36         Class2->method;
  37
  38         my Class2 $obj = bless {};
  39
  40         $obj->method;
  41     }
  42 }
  43
  44 use Test;
  45
  46 plan tests => 2;
  47
  48 use B ();
  49
  50 sub cv_root {
  51     B::svref_2object(shift)->ROOT;
  52 }
  53
  54 sub method_in_tree {
  55     my $op = shift;
  56     if ($$op && ($op->flags & B::OPf_KIDS)) {
  57         for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
  58             return 1 if $kid->ppaddr =~ /method/i;
  59             return 1 if method_in_tree($kid);
  60         }
  61     }
  62     return 0;
  63 }
  64
  65 ok ! method_in_tree(cv_root(\&Class::mtest));
  66 ok   method_in_tree(cv_root(\&Class2::mtest));