| 1 | #!./perl |
| 2 | |
| 3 | use utf8; |
| 4 | use open qw( :utf8 :std ); |
| 5 | use strict; |
| 6 | use warnings; |
| 7 | no warnings 'redefine'; # we do a lot of this |
| 8 | no warnings 'prototype'; # we do a lot of this |
| 9 | |
| 10 | BEGIN { |
| 11 | unless (-d 'blib') { |
| 12 | chdir 't' if -d 't'; |
| 13 | @INC = '../lib'; |
| 14 | } |
| 15 | } |
| 16 | |
| 17 | require './test.pl'; |
| 18 | |
| 19 | { |
| 20 | package MC텟ᵀ::Bࡎᶓ; |
| 21 | sub ᕘ { return $_[1]+1 }; |
| 22 | |
| 23 | package MC텟ᵀ::ድ리ᭉᛞ; |
| 24 | our @ISA = qw/MC텟ᵀ::Bࡎᶓ/; |
| 25 | |
| 26 | package Ƒoo; our @ƑOO = qw//; |
| 27 | } |
| 28 | |
| 29 | # These are various ways of re-defining MC텟ᵀ::Bࡎᶓ::ᕘ and checking whether the method is cached when it shouldn't be |
| 30 | my @testsubs = ( |
| 31 | sub { is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 1); }, |
| 32 | sub { eval 'sub MC텟ᵀ::Bࡎᶓ::ᕘ { return $_[1]+2 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 2); }, |
| 33 | sub { eval 'sub MC텟ᵀ::Bࡎᶓ::ᕘ($) { return $_[1]+3 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 3); }, |
| 34 | sub { eval 'sub MC텟ᵀ::Bࡎᶓ::ᕘ($) { 4 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 4); }, |
| 35 | sub { *MC텟ᵀ::Bࡎᶓ::ᕘ = sub { $_[1]+5 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 5); }, |
| 36 | sub { local *MC텟ᵀ::Bࡎᶓ::ᕘ = sub { $_[1]+6 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 6); }, |
| 37 | sub { is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 5); }, |
| 38 | sub { sub FFF { $_[1]+7 }; local *MC텟ᵀ::Bࡎᶓ::ᕘ = *FFF; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 7); }, |
| 39 | sub { is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 5); }, |
| 40 | sub { sub DḊƋ { $_[1]+8 }; *MC텟ᵀ::Bࡎᶓ::ᕘ = *DḊƋ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 8); }, |
| 41 | sub { *ǎᔆɗF::앗dƑ = sub { $_[1]+9 }; *MC텟ᵀ::Bࡎᶓ::ᕘ = \&ǎᔆɗF::앗dƑ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 9); }, |
| 42 | sub { undef *MC텟ᵀ::Bࡎᶓ::ᕘ; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); }, |
| 43 | sub { eval "sub MC텟ᵀ::Bࡎᶓ::ᕘ($);"; *MC텟ᵀ::Bࡎᶓ::ᕘ = \&ǎᔆɗF::앗dƑ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 9); }, |
| 44 | sub { *Xƴƶ = sub { $_[1]+10 }; ${MC텟ᵀ::Bࡎᶓ::}{ᕘ} = \&Xƴƶ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 10); }, |
| 45 | sub { ${MC텟ᵀ::Bࡎᶓ::}{ᕘ} = sub { $_[1]+11 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 11); }, |
| 46 | |
| 47 | sub { undef *MC텟ᵀ::Bࡎᶓ::ᕘ; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); }, |
| 48 | sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+12 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 12); }, |
| 49 | sub { eval 'package ᛎᛎᛎ; sub ᕘ { $_[1]+13 }'; *MC텟ᵀ::Bࡎᶓ::ᕘ = \&ᛎᛎᛎ::ᕘ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 13); }, |
| 50 | sub { ${MC텟ᵀ::Bࡎᶓ::}{ᕘ} = sub { $_[1]+14 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 14); }, |
| 51 | # 5.8.8 fails this one |
| 52 | sub { undef *{MC텟ᵀ::Bࡎᶓ::}; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); }, |
| 53 | sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+15 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 15); }, |
| 54 | sub { undef %{MC텟ᵀ::Bࡎᶓ::}; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); }, |
| 55 | sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+16 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 16); }, |
| 56 | sub { %{MC텟ᵀ::Bࡎᶓ::} = (); eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); }, |
| 57 | sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+17 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 17); }, |
| 58 | # 5.8.8 fails this one too |
| 59 | #TODO: This fails due to the tokenizer not being clean, rather than mro. |
| 60 | sub { *{MC텟ᵀ::Bࡎᶓ::} = *{Ƒoo::}; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); }, |
| 61 | sub { *MC텟ᵀ::ድ리ᭉᛞ::ᕘ = \&MC텟ᵀ::Bࡎᶓ::ᕘ; eval { MC텟ᵀ::ድ리ᭉᛞ::ᕘ(0,0) }; ok(!$@); undef *MC텟ᵀ::ድ리ᭉᛞ::ᕘ }, |
| 62 | sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+18 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 18); }, |
| 63 | ); |
| 64 | |
| 65 | plan(tests => scalar(@testsubs)); |
| 66 | |
| 67 | $_->() for (@testsubs); |