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

【问题标题】：How to set the prototype of an anonymous perl function如何设置匿名 perl 函数的原型
【发布时间】：2018-09-04 13:10:46
【问题描述】：

我需要为我的模拟框架 Test::Mockify 动态替换带有匿名子的函数。内部我使用了 Sub::Override。但是我在这里遇到了我喜欢模拟的函数原型的问题。由于警告（原型不匹配：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 {};

但这当然不是编译：'Illegal declaration of anonymous subroutine'，在 sub 中添加 var 是不可能的

【问题讨论】：

标签： perl mocking

【解决方案1】：

您想要Sub::Prototype 模块。这样使用它：

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

【讨论】：

【解决方案2】：

使用字符串eval:

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

【讨论】：

我也想过这个，但我不确定这是否是一个邪恶的黑客;-) 所以我现在这样做了：sub AddPrototype {my ($Path, $Sub) = @;我的 $Prototype = 原型（$Path）； if($Prototype){ 我的 $CodeAsString = B::Deparse->new()->coderef2text($Sub); return eval("sub ($Prototype) {$CodeAsString};"); } 返回 $Sub; }

【解决方案3】：

我决定采用评估方法。对我来说很好。由于 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;
}

【讨论】：

【解决方案4】：

澄清一下DrHide对可能会感到困惑的人的回答：

问题是关于为匿名子设置原型。就这么简单：

use Sub::Prototype;

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

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

在BEGIN 块中设置它很重要，因为原型只能在编译时设置。如果您尝试在运行时设置或更改普通子程序的原型，这并不重要。