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

use strict;
no strict 'refs'; # we do a lot of this
use warnings;
no warnings 'redefine'; # we do a lot of this
no warnings 'prototype'; # we do a lot of this

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

{
    package MCTest::Base;
    sub foo { return $_[1]+1 };

package MCTest::Derived;
    our @ISA = qw/MCTest::Base/;

package Foo; our @FOO = qw//;
}

# These are various ways of re-defining MCTest::Base::foo and checking whether the method is cached when it shouldn't be
my @testsubs = (
    sub { is(MCTest::Derived->foo(0), 1); },
    sub { eval 'sub MCTest::Base::foo { return $_[1]+2 }'; is(MCTest::Derived->foo(0), 2); },
    sub { eval 'sub MCTest::Base::foo($) { return $_[1]+3 }'; is(MCTest::Derived->foo(0), 3); },
    sub { eval 'sub MCTest::Base::foo($) { 4 }'; is(MCTest::Derived->foo(0), 4); },
    sub { *MCTest::Base::foo = sub { $_[1]+5 }; is(MCTest::Derived->foo(0), 5); },
    sub { local *MCTest::Base::foo = sub { $_[1]+6 }; is(MCTest::Derived->foo(0), 6); },
    sub { is(MCTest::Derived->foo(0), 5); },
    sub { sub FFF { $_[1]+7 }; local *MCTest::Base::foo = *FFF; is(MCTest::Derived->foo(0), 7); },
    sub { is(MCTest::Derived->foo(0), 5); },
    sub { { local *MCTest::Base::can = sub { "tomatoes" };
            MCTest::Derived->can(0); }
          is(MCTest::Derived->can("isa"), \&UNIVERSAL::isa,
              'removing method when unwinding local *method=sub{}'); },
    sub { sub peas { "peas" }
          { local *MCTest::Base::can = *peas;
            MCTest::Derived->can(0); }
          is(MCTest::Derived->can("isa"), \&UNIVERSAL::isa,
              'removing method when unwinding local *method=*other'); },
    sub { sub DDD { $_[1]+8 }; *MCTest::Base::foo = *DDD; is(MCTest::Derived->foo(0), 8); },
    sub { *ASDF::asdf = sub { $_[1]+9 }; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 9); },
    sub { undef *MCTest::Base::foo; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
    sub { eval "sub MCTest::Base::foo($);"; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 9); },
    sub { *XYZ = sub { $_[1]+10 }; ${MCTest::Base::}{foo} = \&XYZ; is(MCTest::Derived->foo(0), 10); },
    sub { ${MCTest::Base::}{foo} = sub { $_[1]+11 }; is(MCTest::Derived->foo(0), 11); },

sub { undef *MCTest::Base::foo; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
    sub { eval 'package MCTest::Base; sub foo { $_[1]+12 }'; is(MCTest::Derived->foo(0), 12); },
    sub { eval 'package ZZZ; sub foo { $_[1]+13 }'; *MCTest::Base::foo = \&ZZZ::foo; is(MCTest::Derived->foo(0), 13); },
    sub { ${MCTest::Base::}{foo} = sub { $_[1]+14 }; is(MCTest::Derived->foo(0), 14); },
    # 5.8.8 fails this one
    sub { undef *{MCTest::Base::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
    sub { eval 'package MCTest::Base; sub foo { $_[1]+15 }'; is(MCTest::Derived->foo(0), 15); },
    sub { undef %{MCTest::Base::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
    sub { eval 'package MCTest::Base; sub foo { $_[1]+16 }'; is(MCTest::Derived->foo(0), 16); },
    sub { %{MCTest::Base::} = (); eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
    sub { eval 'package MCTest::Base; sub foo { $_[1]+17 }'; is(MCTest::Derived->foo(0), 17); },
    # 5.8.8 fails this one too
    sub { *{MCTest::Base::} = *{Foo::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
    sub { *MCTest::Derived::foo = \&MCTest::Base::foo; eval { MCTest::Derived::foo(0,0) }; ok(!$@); undef *MCTest::Derived::foo },
    sub { eval 'package MCTest::Base; sub foo { $_[1]+18 }'; is(MCTest::Derived->foo(0), 18); },

# Redefining through a glob alias
    sub { *A = *{'MCTest::Base::foo'}; eval 'sub A { $_[1]+19 }';
          is(MCTest::Derived->foo(0), 19,
            'redefining sub through glob alias via decl'); },
    sub { SKIP: {
              skip_if_miniperl("no XS");
              eval { require XS::APItest; }
                or skip "XS::APItest not available", 1;
              *A = *{'MCTest::Base::foo'};
              XS::APItest::newCONSTSUB(\%main::, "A", 0, 20);
              is (MCTest::Derived->foo(0), 20,
                  'redefining sub through glob alias via newXS');
        } },
    sub { undef *{'MCTest::Base::foo'}; *A = *{'MCTest::Base::foo'};
          eval { no warnings 'once'; local *UNIVERSAL::foo = sub {96};
                 MCTest::Derived->foo };
          ()=\&A;
          eval { MCTest::Derived->foo };
          like($@, qr/Undefined subroutine/,
            'redefining sub through glob alias via stub vivification'); },
    sub { *A = *{'MCTest::Base::foo'};
          local *A = sub { 21 };
          is(MCTest::Derived->foo, 21,
            'redef sub through glob alias via local cv-to-glob assign'); },
    sub { *A = *{'MCTest::Base::foo'};
          eval 'sub MCTest::Base::foo { 22 }';
          { local *A = sub { 23 }; MCTest::Derived->foo }
          is(MCTest::Derived->foo, 22,
            'redef sub through glob alias via localisation unwinding'); },
    sub { *A = *{'MCTest::Base::foo'}; *A = sub { 24 };
          is(MCTest::Derived->foo(0), 24,
            'redefining sub through glob alias via cv-to-glob assign'); },
);

plan(tests => scalar(@testsubs));

$_->() for (@testsubs);