Commit | Line | Data |
e1a479c5 |
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 | |
5f5ae4a7 |
15 | require './test.pl'; |
e1a479c5 |
16 | |
17 | { |
18 | package MCTest::Base; |
19 | sub foo { return $_[1]+1 }; |
e1a479c5 |
20 | |
21 | package MCTest::Derived; |
22 | our @ISA = qw/MCTest::Base/; |
dd69841b |
23 | |
24 | package Foo; our @FOO = qw//; |
e1a479c5 |
25 | } |
26 | |
27 | # These are various ways of re-defining MCTest::Base::foo and checking whether the method is cached when it shouldn't be |
28 | my @testsubs = ( |
dd69841b |
29 | sub { is(MCTest::Derived->foo(0), 1); }, |
e1a479c5 |
30 | sub { eval 'sub MCTest::Base::foo { return $_[1]+2 }'; is(MCTest::Derived->foo(0), 2); }, |
31 | sub { eval 'sub MCTest::Base::foo($) { return $_[1]+3 }'; is(MCTest::Derived->foo(0), 3); }, |
32 | sub { eval 'sub MCTest::Base::foo($) { 4 }'; is(MCTest::Derived->foo(0), 4); }, |
33 | sub { *MCTest::Base::foo = sub { $_[1]+5 }; is(MCTest::Derived->foo(0), 5); }, |
34 | sub { local *MCTest::Base::foo = sub { $_[1]+6 }; is(MCTest::Derived->foo(0), 6); }, |
35 | sub { is(MCTest::Derived->foo(0), 5); }, |
dd69841b |
36 | sub { sub FFF { $_[1]+7 }; local *MCTest::Base::foo = *FFF; is(MCTest::Derived->foo(0), 7); }, |
e1a479c5 |
37 | sub { is(MCTest::Derived->foo(0), 5); }, |
dd69841b |
38 | sub { sub DDD { $_[1]+8 }; *MCTest::Base::foo = *DDD; is(MCTest::Derived->foo(0), 8); }, |
39 | sub { *ASDF::asdf = sub { $_[1]+9 }; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 9); }, |
40 | sub { undef *MCTest::Base::foo; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); }, |
41 | sub { eval "sub MCTest::Base::foo($);"; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 9); }, |
42 | sub { *XYZ = sub { $_[1]+10 }; ${MCTest::Base::}{foo} = \&XYZ; is(MCTest::Derived->foo(0), 10); }, |
43 | sub { ${MCTest::Base::}{foo} = sub { $_[1]+11 }; is(MCTest::Derived->foo(0), 11); }, |
44 | |
e1a479c5 |
45 | sub { undef *MCTest::Base::foo; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); }, |
dd69841b |
46 | sub { eval 'package MCTest::Base; sub foo { $_[1]+12 }'; is(MCTest::Derived->foo(0), 12); }, |
47 | sub { eval 'package ZZZ; sub foo { $_[1]+13 }'; *MCTest::Base::foo = \&ZZZ::foo; is(MCTest::Derived->foo(0), 13); }, |
48 | sub { ${MCTest::Base::}{foo} = sub { $_[1]+14 }; is(MCTest::Derived->foo(0), 14); }, |
49 | # 5.8.8 fails this one |
50 | sub { undef *{MCTest::Base::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); }, |
51 | sub { eval 'package MCTest::Base; sub foo { $_[1]+15 }'; is(MCTest::Derived->foo(0), 15); }, |
52 | sub { undef %{MCTest::Base::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); }, |
53 | sub { eval 'package MCTest::Base; sub foo { $_[1]+16 }'; is(MCTest::Derived->foo(0), 16); }, |
54 | sub { %{MCTest::Base::} = (); eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); }, |
55 | sub { eval 'package MCTest::Base; sub foo { $_[1]+17 }'; is(MCTest::Derived->foo(0), 17); }, |
56 | # 5.8.8 fails this one too |
57 | sub { *{MCTest::Base::} = *{Foo::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); }, |
5f2fca8a |
58 | sub { *MCTest::Derived::foo = \&MCTest::Base::foo; eval { MCTest::Derived::foo(0,0) }; ok(!$@); undef *MCTest::Derived::foo }, |
dd69841b |
59 | sub { eval 'package MCTest::Base; sub foo { $_[1]+18 }'; is(MCTest::Derived->foo(0), 18); }, |
e1a479c5 |
60 | ); |
61 | |
dd69841b |
62 | plan(tests => scalar(@testsubs)); |
e1a479c5 |
63 | |
e1a479c5 |
64 | $_->() for (@testsubs); |