t/mro/method_caching_utf8.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless (-d 'blib') {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use utf8;
  11 use open qw( :utf8 :std );
  12 use strict;
  13 use warnings;
  14 no warnings 'redefine'; # we do a lot of this
  15 no warnings 'prototype'; # we do a lot of this
  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 Ƒｏｏ; our @ƑＯＯ = 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 { *ǎᔆɗＦ::앗ｄƑ = sub { $_[1]+9 }; *MC텟ᵀ::Bࡎᶓ::ᕘ = \&ǎᔆɗＦ::앗ｄƑ; 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ࡎᶓ::ᕘ = \&ǎᔆɗＦ::앗ｄƑ; 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ࡎᶓ::} = *{Ƒｏｏ::}; 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);