t/mro/method_caching.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5 no warnings 'redefine'; # we do a lot of this
   6 no warnings 'prototype'; # we do a lot of this
   7
   8 BEGIN {
   9     unless (-d 'blib') {
  10         chdir 't' if -d 't';
  11         @INC = '../lib';
  12     }
  13 }
  14
  15 require './test.pl';
  16
  17 {
  18     package MCTest::Base;
  19     sub foo { return $_[1]+1 };
  20     sub bar { 42 };
  21
  22     package MCTest::Derived;
  23     our @ISA = qw/MCTest::Base/;
  24 }
  25
  26 # These are various ways of re-defining MCTest::Base::foo and checking whether the method is cached when it shouldn't be
  27 my @testsubs = (
  28     sub { eval 'sub MCTest::Base::foo { return $_[1]+2 }'; is(MCTest::Derived->foo(0), 2); },
  29     sub { eval 'sub MCTest::Base::foo($) { return $_[1]+3 }'; is(MCTest::Derived->foo(0), 3); },
  30     sub { eval 'sub MCTest::Base::foo($) { 4 }'; is(MCTest::Derived->foo(0), 4); },
  31     sub { *MCTest::Base::foo = sub { $_[1]+5 }; is(MCTest::Derived->foo(0), 5); },
  32     sub { local *MCTest::Base::foo = sub { $_[1]+6 }; is(MCTest::Derived->foo(0), 6); },
  33     sub { is(MCTest::Derived->foo(0), 5); },
  34     sub { sub FFF { $_[1]+9 }; local *MCTest::Base::foo = *FFF; is(MCTest::Derived->foo(0), 9); },
  35     sub { is(MCTest::Derived->foo(0), 5); },
  36     sub { *ASDF::asdf = sub { $_[1]+7 }; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 7); },
  37     sub { *ASDF::asdf = sub { $_[1]+7 }; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 7); },
  38     sub { undef *MCTest::Base::foo; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
  39     sub { sub MCTest::Base::foo($); *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 7); },
  40     sub { *XYZ = sub { $_[1]+8 }; ${MCTest::Base::}{foo} = \&XYZ; is(MCTest::Derived->foo(0), 8); },
  41     sub { *MCTest::Derived::foo = \&MCTest::Base::foo; eval { MCTest::Derived::foo(0,0) }; ok(!$@); undef *MCTest::Derived::foo },
  42 );
  43
  44 plan(tests => scalar(@testsubs) + 1);
  45
  46 is(MCTest::Derived->foo(0), 1);
  47 $_->() for (@testsubs);