Question

我需要动态替换我的模拟框架Test :: Mockify的匿名子函数。 Internely我使用了Sub :: Override。但我在这里有一个问题，我喜欢模拟的函数的原型。由于警告（Prototype mismatch：sub（$; $）vs none），我认识到了这个问题。为了显示问题，我在普通perl中没有这个框架的情况下重现了问题。

带有原型函数的示例包：

package Hello;
sub FunctionWithPrototype($;$){
    my ($Mandatory, $Optional) = @_;
    return "original. m:$Mandatory. o:$Optional";
}
1;

我的示例测试：

use Hello;
sub test {
    no warnings 'redefine';
    # no warnings 'prototype'; # This would hide the problem

    is(Hello::FunctionWithPrototype('mand', 'opt'), 'original. m:mand. o:opt' ,'prove return value before change');
    is (prototype('Hello::FunctionWithPrototype'),'$;$', 'Prove prototype output of function');

    my $OriginalCode = *Hello::FunctionWithPrototype{CODE};
    # warn: Prototype mismatch: sub Hello::FunctionWithPrototype ($;$) vs none
    *Hello::FunctionWithPrototype = sub {return 'overriden'};


    is(Hello::FunctionWithPrototype('mand', 'opt'), 'overriden','prove the mocked function');
    # warn: Prototype mismatch: sub Hello::FunctionWithPrototype: none vs ($;$)
    *Hello::FunctionWithPrototype = $OriginalCode; # 

    is(Hello::FunctionWithPrototype('mand', 'opt'), 'original. m:mand. o:opt' ,'prove return value before change (should be as before)');
}

我可以想到一个像以下的解决方案：

my $proto = prototype('FunctionWithPrototype') ? (prototype('FunctionWithPrototype')):undef;
*t::TestDummies::DummyImportTools::Doubler = sub $proto {};

但是，当然，这不是编译：'非法声明匿名子程序'，在sub中添加var是不可能的

Answer 1

您需要Sub::Prototype模块。因此使用它：

my $original = \&foo;
my $replacement = sub { ... };
Sub::Prototype::set_prototype(
    $replacement,
    prototype($original)
);
*foo = $replacement;

Answer 2

使用字符串documentation：

eval "*Hello::FunctionWithPrototype = sub (" .
    prototype('Hello::FunctionWithPrototype') .
    ") {return 'overriden'};";

Answer 3

我决定使用eval方法。对我来说很好。由于eval将吞下可能的拼写错误，因此我抛出Error以获得有用的错误消息以进行调试。

sub AddPrototypeToSub {
    my ($Path, $Sub) = @_;
    my $Prototype = prototype($Path);
    if($Prototype){
         my $SubWithPrototype =  eval( 'return sub ('. $Prototype .') {$Sub->(@_)}');
         die($@) if($@); # Rethrow error if something went wrong in the eval.
        return $SubWithPrototype;
    }
    return $Sub;
}

Answer 4

对DrHide的答案作一些澄清，以使可能会感到困惑的人：

问题在于为匿名子对象设置原型。就这么简单：

use Sub::Prototype;

BEGIN { # Important
    my $code = sub { ... };
    set_prototype($code, '&@');
}

但是，如原始答案中所述，如果要用代码ref替换子例程的现有定义，则该代码ref应该具有与为该子例程声明的原型相同的原型。您可以使用函数prototype(\&subroutine_name)获得原始的原型定义。

在BEGIN块中进行设置非常重要，因为原型只能在编译时设置。如果您尝试在运行时设置或更改常规子例程的原型，那就没关系了。

如何设置匿名perl函数的原型

4 个答案: