Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
basic.t	9.74 KB	-r--r--r--	2014-12-27 11:49
basic_01_c3.t	932 B	-r--r--r--	2014-12-27 11:49
basic_01_c3_utf8.t	1.05 KB	-r--r--r--	2014-12-27 11:49
basic_01_dfs.t	933 B	-r--r--r--	2014-12-27 11:49
basic_01_dfs_utf8.t	1.05 KB	-r--r--r--	2014-12-27 11:49
basic_02_c3.t	3.09 KB	-r--r--r--	2014-12-27 11:49
basic_02_c3_utf8.t	3.32 KB	-r--r--r--	2014-12-27 11:49
basic_02_dfs.t	3.1 KB	-r--r--r--	2014-12-27 11:49
basic_02_dfs_utf8.t	3.32 KB	-r--r--r--	2014-12-27 11:49
basic_03_c3.t	2.37 KB	-r--r--r--	2014-12-27 11:49
basic_03_c3_utf8.t	2.55 KB	-r--r--r--	2014-12-27 11:49
basic_03_dfs.t	2.37 KB	-r--r--r--	2014-12-27 11:49
basic_03_dfs_utf8.t	2.56 KB	-r--r--r--	2014-12-27 11:49
basic_04_c3.t	705 B	-r--r--r--	2014-12-27 11:49
basic_04_c3_utf8.t	839 B	-r--r--r--	2014-12-27 11:49
basic_04_dfs.t	711 B	-r--r--r--	2014-12-27 11:49
basic_04_dfs_utf8.t	858 B	-r--r--r--	2014-12-27 11:49
basic_05_c3.t	959 B	-r--r--r--	2014-12-27 11:49
basic_05_c3_utf8.t	1.05 KB	-r--r--r--	2014-12-27 11:49
basic_05_dfs.t	945 B	-r--r--r--	2014-12-27 11:49
basic_05_dfs_utf8.t	1.04 KB	-r--r--r--	2014-12-27 11:49
basic_utf8.t	8.63 KB	-r--r--r--	2014-12-27 11:49
c3_with_overload.t	1.13 KB	-r--r--r--	2014-12-27 11:49
c3_with_overload_utf8.t	1.13 KB	-r--r--r--	2014-12-27 11:49
complex_c3.t	4.03 KB	-r--r--r--	2014-12-27 11:49
complex_c3_utf8.t	4.44 KB	-r--r--r--	2014-12-27 11:49
complex_dfs.t	3.89 KB	-r--r--r--	2014-12-27 11:49
complex_dfs_utf8.t	4.3 KB	-r--r--r--	2014-12-27 11:49
dbic_c3.t	4.05 KB	-r--r--r--	2014-12-27 11:49
dbic_c3_utf8.t	5.07 KB	-r--r--r--	2014-12-27 11:49
dbic_dfs.t	4.08 KB	-r--r--r--	2014-12-27 11:49
dbic_dfs_utf8.t	5.1 KB	-r--r--r--	2014-12-27 11:49
inconsistent_c3.t	870 B	-r--r--r--	2014-12-27 11:49
inconsistent_c3_utf8.t	888 B	-r--r--r--	2014-12-27 11:49
isa_aliases.t	1.51 KB	-r--r--r--	2014-12-27 11:49
isa_aliases_utf8.t	1.46 KB	-r--r--r--	2014-12-27 11:49
isa_c3.t	1.28 KB	-r--r--r--	2014-12-27 11:49
isa_c3_utf8.t	1.31 KB	-r--r--r--	2014-12-27 11:49
isa_dfs.t	1.06 KB	-r--r--r--	2014-12-27 11:49
isa_dfs_utf8.t	1.24 KB	-r--r--r--	2014-12-27 11:49
isarev.t	4.71 KB	-r--r--r--	2014-12-27 11:49
isarev_utf8.t	5.39 KB	-r--r--r--	2014-12-27 11:49
method_caching.t	5.31 KB	-r--r--r--	2014-12-27 11:49
method_caching_utf8.t	3.79 KB	-r--r--r--	2014-12-27 11:49
next_NEXT.t	1012 B	-r--r--r--	2014-12-27 11:49
next_NEXT_utf8.t	1.07 KB	-r--r--r--	2014-12-27 11:49
next_edgecases.t	2.01 KB	-r--r--r--	2014-12-27 11:49
next_edgecases_utf8.t	2.05 KB	-r--r--r--	2014-12-27 11:49
next_goto.t	856 B	-r--r--r--	2014-12-27 11:49
next_goto_utf8.t	953 B	-r--r--r--	2014-12-27 11:49
next_inanon.t	889 B	-r--r--r--	2014-12-27 11:49
next_inanon_utf8.t	972 B	-r--r--r--	2014-12-27 11:49
next_ineval.t	561 B	-r--r--r--	2014-12-27 11:49
next_ineval_utf8.t	629 B	-r--r--r--	2014-12-27 11:49
next_method.t	1.49 KB	-r--r--r--	2014-12-27 11:49
next_method_utf8.t	1.59 KB	-r--r--r--	2014-12-27 11:49
next_skip.t	2.43 KB	-r--r--r--	2014-12-27 11:49
next_skip_utf8.t	2.75 KB	-r--r--r--	2014-12-27 11:49
overload_c3.t	1.22 KB	-r--r--r--	2014-12-27 11:49
overload_c3_utf8.t	1.4 KB	-r--r--r--	2014-12-27 11:49
overload_dfs.t	1.22 KB	-r--r--r--	2014-12-27 11:49
package_aliases.t	11.02 KB	-r--r--r--	2014-12-27 11:49
package_aliases_utf8.t	12.86 KB	-r--r--r--	2014-12-27 11:49
pkg_gen.t	908 B	-r--r--r--	2014-12-27 11:49
pkg_gen_utf8.t	964 B	-r--r--r--	2014-12-27 11:49
recursion_c3.t	2.11 KB	-r--r--r--	2014-12-27 11:49
recursion_c3_utf8.t	2.24 KB	-r--r--r--	2014-12-27 11:49
recursion_dfs.t	1.9 KB	-r--r--r--	2014-12-27 11:49
recursion_dfs_utf8.t	2.03 KB	-r--r--r--	2014-12-27 11:49
vulcan_c3.t	1.3 KB	-r--r--r--	2014-12-27 11:49
vulcan_c3_utf8.t	1.49 KB	-r--r--r--	2014-12-27 11:49
vulcan_dfs.t	1.31 KB	-r--r--r--	2014-12-27 11:49
vulcan_dfs_utf8.t	1.48 KB	-r--r--r--	2014-12-27 11:49

Rename

#!./perl

BEGIN {
    $ENV{PERL_UNICODE} = 0;
    unless (-d 'blib') {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    require q(./test.pl);
}

use strict;
use warnings;
use utf8;
use open qw( :utf8 :std );

plan(tests => 52);

{
    package Ｎeẁ;
    use strict;
    use warnings;

package ऑlㄉ;
    use strict;
    use warnings;

{
      no strict 'refs';
      *{'ऑlㄉ::'} = *{'Ｎeẁ::'};
    }
}

ok (ऑlㄉ->isa(Ｎeẁ::), 'ऑlㄉ inherits from Ｎeẁ');
ok (Ｎeẁ->isa(ऑlㄉ::), 'Ｎeẁ inherits from ऑlㄉ');

object_ok (bless ({}, ऑlㄉ::), Ｎeẁ::, 'ऑlㄉ object');
object_ok (bless ({}, Ｎeẁ::), ऑlㄉ::, 'Ｎeẁ object');

# Test that replacing a package by assigning to an existing glob
# invalidates the isa caches
for(
 {
   name => 'assigning a glob to a glob',
   code => '$life_raft = $::{"ｌㅔf::"}; *ｌㅔf:: = $::{"릭Ⱶᵀ::"}',
 },
 {
   name => 'assigning a string to a glob',
   code => '$life_raft = $::{"ｌㅔf::"}; *ｌㅔf:: = "릭Ⱶᵀ::"',
 },
 {
   name => 'assigning a stashref to a glob',
   code => '$life_raft = \%ｌㅔf::; *ｌㅔf:: = \%릭Ⱶᵀ::',
 },
) {
my $prog =    q~
     BEGIN {
         unless (-d 'blib') {
             chdir 't' if -d 't';
             @INC = '../lib';
         }
     }
     use utf8;
     use open qw( :utf8 :std );

@숩cਲꩋ::ISA = "ｌㅔf";
     @ｌㅔf::ISA = "톺ĺФț";

sub 톺ĺФț::Ｓᑊeಅḱ { "Woof!" }
     sub ᴖ릭ᚽʇ::Ｓᑊeಅḱ { "Bow-wow!" }

my $thing = bless [], "숩cਲꩋ";

# mro_package_moved needs to know to skip non-globs
     $릭Ⱶᵀ::{"ᚷꝆエcƙ::"} = 3;

@릭Ⱶᵀ::ISA = 'ᴖ릭ᚽʇ';
     my $life_raft;
    __code__;

print $thing->Ｓᑊeಅḱ, "\n";

undef $life_raft;
     print $thing->Ｓᑊeಅḱ, "\n";
   ~ =~ s\__code__\$$_{code}\r; #\
utf8::encode($prog);
 fresh_perl_is
  $prog, 
  "Bow-wow!\nBow-wow!\n",
   {},
  "replacing packages by $$_{name} updates isa caches";
}

# Similar test, but with nested packages
#
#  톺ĺФț (Woof)    ᴖ릭ᚽʇ (Bow-wow)
#      |                 |
#  ｌㅔf::Side   <-   릭Ⱶᵀ::Side
#      |
#   숩cਲꩋ
#
# This test assigns 릭Ⱶᵀ:: to ｌㅔf::, indirectly making ｌㅔf::Side an
# alias to 릭Ⱶᵀ::Side (following the arrow in the diagram).
for(
 {
   name => 'assigning a glob to a glob',
   code => '$life_raft = $::{"ｌㅔf::"}; *ｌㅔf:: = $::{"릭Ⱶᵀ::"}',
 },
 {
   name => 'assigning a string to a glob',
   code => '$life_raft = $::{"ｌㅔf::"}; *ｌㅔf:: = "릭Ⱶᵀ::"',
 },
 {
   name => 'assigning a stashref to a glob',
   code => '$life_raft = \%ｌㅔf::; *ｌㅔf:: = \%릭Ⱶᵀ::',
 },
) {
 my $prog = q~
     BEGIN {
         unless (-d 'blib') {
             chdir 't' if -d 't';
             @INC = '../lib';
         }
     }
     use utf8;
     use open qw( :utf8 :std );
     @숩cਲꩋ::ISA = "ｌㅔf::Side";
     @ｌㅔf::Side::ISA = "톺ĺФț";

sub 톺ĺФț::Ｓᑊeಅḱ { "Woof!" }
     sub ᴖ릭ᚽʇ::Ｓᑊeಅḱ { "Bow-wow!" }

my $thing = bless [], "숩cਲꩋ";

@릭Ⱶᵀ::Side::ISA = 'ᴖ릭ᚽʇ';
     my $life_raft;
    __code__;

print $thing->Ｓᑊeಅḱ, "\n";

undef $life_raft;
     print $thing->Ｓᑊeಅḱ, "\n";
   ~ =~ s\__code__\$$_{code}\r;
 utf8::encode($prog);

fresh_perl_is
  $prog,
  "Bow-wow!\nBow-wow!\n",
   {},
  "replacing nested packages by $$_{name} updates isa caches";
}

# Another nested package test, in which the isa cache needs to be reset on
# the subclass of a package that does not exist.
#
# Parenthesized packages do not exist.
#
#  ɵűʇㄦ::인ንʵ    ( cฬnए::인ንʵ )
#       |                 |
#     Ｌфť              R익hȚ
#
#        ɵűʇㄦ  ->  cฬnए
#
# This test assigns ɵűʇㄦ:: to cฬnए::, making cฬnए::인ንʵ an alias to
# ɵűʇㄦ::인ንʵ.
#
# Then we also run the test again, but without ɵűʇㄦ::인ንʵ
for(
 {
   name => 'assigning a glob to a glob',
   code => '*cฬnए:: = *ɵűʇㄦ::',
 },
 {
   name => 'assigning a string to a glob',
   code => '*cฬnए:: = "ɵűʇㄦ::"',
 },
 {
   name => 'assigning a stashref to a glob',
   code => '*cฬnए:: = \%ɵűʇㄦ::',
 },
) {
 for my $tail ('인ንʵ', '인ንʵ::', '인ንʵ:::', '인ንʵ::::') {
  my $prog =     q~
     BEGIN {
         unless (-d 'blib') {
             chdir 't' if -d 't';
             @INC = '../lib';
         }
     }
      use utf8;
      use open qw( :utf8 :std );
      use Encode ();

if (grep /\P{ASCII}/, @ARGV) {
        @ARGV = map { Encode::decode("UTF-8", $_) } @ARGV;
      }

my $tail = shift;
      @Ｌфť::ISA = "ɵűʇㄦ::$tail";
      @R익hȚ::ISA = "cฬnए::$tail";
      bless [], "ɵűʇㄦ::$tail"; # autovivify the stash

__code__;

print "ok 1", "\n" if Ｌфť->isa("cฬnए::$tail");
      print "ok 2", "\n" if R익hȚ->isa("ɵűʇㄦ::$tail");
      print "ok 3", "\n" if R익hȚ->isa("cฬnए::$tail");
      print "ok 4", "\n" if Ｌфť->isa("ɵűʇㄦ::$tail");
    ~ =~ s\__code__\$$_{code}\r;
  utf8::encode($prog);
  fresh_perl_is
   $prog,
   "ok 1\nok 2\nok 3\nok 4\n",
    { args => [$tail] },
   "replacing nonexistent nested packages by $$_{name} updates isa caches"
     ." ($tail)";

# Same test but with the subpackage autovivified after the assignment
  $prog =     q~
      BEGIN {
         unless (-d 'blib') {
             chdir 't' if -d 't';
             @INC = '../lib';
         }
      }
      use utf8;
      use open qw( :utf8 :std );
      use Encode ();

if (grep /\P{ASCII}/, @ARGV) {
        @ARGV = map { Encode::decode("UTF-8", $_) } @ARGV;
      }

my $tail = shift;
      @Ｌфť::ISA = "ɵűʇㄦ::$tail";
      @R익hȚ::ISA = "cฬnए::$tail";

__code__;

bless [], "ɵűʇㄦ::$tail";

print "ok 1", "\n" if Ｌфť->isa("cฬnए::$tail");
      print "ok 2", "\n" if R익hȚ->isa("ɵűʇㄦ::$tail");
      print "ok 3", "\n" if R익hȚ->isa("cฬnए::$tail");
      print "ok 4", "\n" if Ｌфť->isa("ɵűʇㄦ::$tail");
    ~ =~ s\__code__\$$_{code}\r;
  utf8::encode($prog);
  fresh_perl_is
   $prog,
   "ok 1\nok 2\nok 3\nok 4\n",
    { args => [$tail] },
   "Giving nonexistent packages multiple effective names by $$_{name}"
     . " ($tail)";
 }
}

no warnings; # temporary; there seems to be a scoping bug, as this does not
             # work when placed in the blocks below

# Test that deleting stash elements containing
# subpackages also invalidates the isa cache.
# Maybe this does not belong in package_aliases.t, but it is closely
# related to the tests immediately preceding.
{
 @ቹऋ::ISA = ("Cuȓ", "ฮﾝᛞ");
 @Cuȓ::ISA = "Hyḹ앛Ҭテ";

sub Hyḹ앛Ҭテ::Ｓᑊeಅḱ { "Arff!" }
 sub ฮﾝᛞ::Ｓᑊeಅḱ { "Woof!" }

my $pet = bless [], "ቹऋ";

my $life_raft = delete $::{'Cuȓ::'};

is $pet->Ｓᑊeಅḱ, 'Woof!',
  'deleting a stash from its parent stash invalidates the isa caches';

undef $life_raft;
 is $pet->Ｓᑊeಅḱ, 'Woof!',
  'the deleted stash is gone completely when freed';
}
# Same thing, but with nested packages
{
 @펱ᑦ::ISA = ("Cuȓȓ::Cuȓȓ::Cuȓȓ", "ɥwn");
 @Cuȓȓ::Cuȓȓ::Cuȓȓ::ISA = "lȺt랕ᚖ";

sub lȺt랕ᚖ::Ｓᑊeಅḱ { "Arff!" }
 sub ɥwn::Ｓᑊeಅḱ { "Woof!" }

my $pet = bless [], "펱ᑦ";

my $life_raft = delete $::{'Cuȓȓ::'};

is $pet->Ｓᑊeಅḱ, 'Woof!',
  'deleting a stash from its parent stash resets caches of substashes';

undef $life_raft;
 is $pet->Ｓᑊeಅḱ, 'Woof!',
  'the deleted substash is gone completely when freed';
}

# [perl #77358]
my $prog =    q~#!perl -w
     BEGIN {
         unless (-d 'blib') {
             chdir 't' if -d 't';
             @INC = '../lib';
         }
     }
     use utf8;
     use open qw( :utf8 :std );
     @펱ᑦ::ISA = "T잌ዕ";
     @T잌ዕ::ISA = "Bᛆヶṝ";
     
     sub Bᛆヶṝ::Ｓᑊeಅḱ { print "Woof!\n" }
     sub lȺt랕ᚖ::Ｓᑊeಅḱ { print "Bow-wow!\n" }
     
     my $pet = bless [], "펱ᑦ";
     
     $pet->Ｓᑊeಅḱ;
     
     sub ດƓ::Ｓᑊeಅḱ { print "Hello.\n" } # strange ດƓ!
     @ດƓ::ISA = 'lȺt랕ᚖ';
     *T잌ዕ:: = delete $::{'ດƓ::'};
     
     $pet->Ｓᑊeಅḱ;
   ~;
utf8::encode($prog);
fresh_perl_is
  $prog,
  "Woof!\nHello.\n",
   { stderr => 1 },
  "Assigning a nameless package over one w/subclasses updates isa caches";

# mro_package_moved needs to make a distinction between replaced and
# assigned stashes when keeping track of what it has seen so far.
no warnings; {
    no strict 'refs';

sub ʉ::bᓗnǩ::bᓗnǩ::ພo { "bbb" }
    sub ᵛeↄl움::ພo { "lasrevinu" }
    @ݏ엗Ƚeᵬૐᵖ::ISA = qw 'ພo::bᓗnǩ::bᓗnǩ ᵛeↄl움';
    *ພo::ବㄗ:: = *ʉ::bᓗnǩ::;   # now ʉ::bᓗnǩ:: is on both sides
    *ພo:: = *ʉ::;         # here ʉ::bᓗnǩ:: is both deleted and added
    *ʉ:: = *ቦᵕ::;          # now it is only known as ພo::bᓗnǩ::

# At this point, before the bug was fixed, %ພo::bᓗnǩ::bᓗnǩ:: ended
    # up with no effective name, allowing it to be deleted without updating
    # its subclassesâ caches.

my $accum = '';

$accum .= 'ݏ엗Ƚeᵬૐᵖ'->ພo;          # bbb
    delete ${"ພo::bᓗnǩ::"}{"bᓗnǩ::"};
    $accum .= 'ݏ엗Ƚeᵬૐᵖ'->ພo;          # bbb (Oops!)
    @ݏ엗Ƚeᵬૐᵖ::ISA = @ݏ엗Ƚeᵬૐᵖ::ISA;
    $accum .= 'ݏ엗Ƚeᵬૐᵖ'->ພo;          # lasrevinu

is $accum, 'bbblasrevinulasrevinu',
      'nested classes deleted & added simultaneously';
}
use warnings;

# mro_package_moved needs to check for self-referential packages.
# This broke Text::Template [perl #78362].
watchdog 3;
*ᕘ:: = \%::;
*Aᶜme::Mῌ::Aᶜme:: = \*Aᶜme::; # indirect self-reference
pass("mro_package_moved and self-referential packages");

# Deleting a glob whose name does not indicate its location in the symbol
# table but which nonetheless *is* in the symbol table.
{
    no strict refs=>;
    no warnings;
    @ოƐ::mഒrェ::ISA = "foᚒ";
    sub foᚒ::ວmᑊ { "aoeaa" }
    *ťວ:: = *ოƐ::;
    delete $::{"ოƐ::"};
    @C힐dᒡl았::ISA = 'ťວ::mഒrェ';
    my $accum = 'C힐dᒡl았'->ວmᑊ . '-';
    my $life_raft = delete ${"ťວ::"}{"mഒrェ::"};
    $accum .= eval { 'C힐dᒡl았'->ວmᑊ } // '<undef>';
    is $accum, 'aoeaa-<undef>',
     'Deleting globs whose loc in the symtab differs from gv_fullname'
}

# Pathological test for undeffing a stash that has an alias.
*ᵍh엞:: = *ኔƞ::;
@숩cਲꩋ::ISA = 'ᵍh엞';
undef %ᵍh엞::;
sub F렐ᛔ::ວmᑊ { "clumpren" }
eval '
  $ኔƞ::whatever++;
  @ኔƞ::ISA = "F렐ᛔ";
';
is eval { '숩cਲꩋ'->ວmᑊ }, 'clumpren',
 'Changes to @ISA after undef via original name';
undef %ᵍh엞::;
eval '
  $ᵍh엞::whatever++;
  @ᵍh엞::ISA = "F렐ᛔ";
';
is eval { '숩cਲꩋ'->ວmᑊ }, 'clumpren',
 'Changes to @ISA after undef via alias';

# Packages whose containing stashes have aliases must lose all names cor-
# responding to that container when detached.
{
 {package śmᛅḙ::በɀ} # autovivify
 *pḢ린ᚷ:: = *śmᛅḙ::;  # śmᛅḙ::በɀ now also named pḢ린ᚷ::በɀ
 *본:: = delete $śmᛅḙ::{"በɀ::"};
 # In 5.13.7, it has now lost its śmᛅḙ::በɀ name (reverting to pḢ린ᚷ::በɀ
 # as the effective name), and gained 본 as an alias.
 # In 5.13.8, both śmᛅḙ::በɀ *and* pḢ린ᚷ::በɀ names are deleted.

# Make some methods
 no strict 'refs';
 *{"pḢ린ᚷ::በɀ::fฤmᛈ"} = sub { "hello" };
 sub Ｆルmፕṟ::fฤmᛈ { "good bye" };

@ᵇるᣘ킨::ISA = qw "본 Ｆルmፕṟ"; # now wrongly inherits from pḢ린ᚷ::በɀ

is fฤmᛈ ᵇるᣘ킨, "good bye",
  'detached stashes lose all names corresponding to the containing stash';
}

# Crazy edge cases involving packages ending with a single :
@촐oン::ISA = 'ᚖგ:'; # pun intended!
bless [], "ᚖგ:"; # autovivify the stash
ok "촐oン"->isa("ᚖგ:"), 'class isa "class:"';
{ no strict 'refs'; *{"ᚖგ:::"} = *ᚖგ:: }
ok "촐oン"->isa("ᚖგ"),
 'isa(ᕘ) when inheriting from "class:" which is an alias for ᕘ';
{
 no warnings;
 # The next line of code is *not* normative. If the structure changes,
 # this line needs to change, too.
 my $ᕘ = delete $ᚖგ::{":"};
 ok !촐oン->isa("ᚖგ"),
  'class that isa "class:" no longer isa ᕘ if "class:" has been deleted';
}
@촐oン::ISA = ':';
bless [], ":";
ok "촐oン"->isa(":"), 'class isa ":"';
{ no strict 'refs'; *{":::"} = *ፑňṪu앝ȋ온:: }
ok "촐oン"->isa("ፑňṪu앝ȋ온"),
 'isa(ᕘ) when inheriting from ":" which is an alias for ᕘ';
@촐oン::ISA = 'ᚖგ:';
bless [], "ᚖგ:";
{
 no strict 'refs';
 my $life_raft = \%{"ᚖგ:::"};
 *{"ᚖგ:::"} = \%ᚖგ::;
 ok "촐oン"->isa("ᚖგ"),
  'isa(ᕘ) when inheriting from "class:" after hash-to-glob assignment';
}
@촐oン::ISA = 'ŏ:';
bless [], "ŏ:";
{
 no strict 'refs';
 my $life_raft = \%{"ŏ:::"};
 *{"ŏ:::"} = "ᚖგ::";
 ok "촐oン"->isa("ᚖგ"),
  'isa(ᕘ) when inheriting from "class:" after string-to-glob assignment';
}
=cut