如何使用 Moo 从对象方法获取代码引用

Question

我在 Perl v5.26 和 Linux 下使用 Moo (OO)。

我正在编写测试，并且在对象中有某种运行时字典来存储应用程序的状态。我想测试定义的代码引用是否指向该对象中的适当方法。

我的问题是为这个测试找到正确的表达方式。

# Struggle point 
ok($exitFun == $TK->exitError);

diag($exitFun," ");          # OK    .. CODE(0x55a8a9027808) 
diag($TK->exitError,"\n");  # ERROR .. Too few args for AppTK::exitError

详情

应用程序工具包在运行时通过几个步骤进行初始化，以标准化一些东西。这是设置：

# ---------------------------------------------------
# Support variables
# ----------------------------------------------------
my $TOOL    = 'TEST.TOOL';
my $MAGIC   = 'TEST.MAGIC';
my $IOTYPE  = 'ASCII.DICT';
my $VERSION = 'VERSION';
my $AUTHOR  = 'AUTHOR';
my $CONTACT = 'CONTACT';
my $OUTPUT  = 'TEST.CASE';
my $RES_ERROR = 'ERROR';

# Some paremter with certain types
my $OPT_STR  = 'OPT_STR';
my $OPT_INT  = 100;
my $OPT_REAL = 1.8;
my $OPT_BOOL = 0;
my $OPT_DATE = '2021-11-12';
my $OPT_TOOL = `which bash`;
chomp($OPT_TOOL);
my @PARAM = qw(--tool $OPT_TOOL --bool $OPT_BOOL --STR  $OPT_STR
               --INT  $OPT_INT  --REAL $OPT_REAL --DATE $OPT_DATE
               --output +OUTPUT --response ERROR);

# -----------------------------------------------------
# Command environment setup
# -----------------------------------------------------
# Command 
my $COMMAND = 'command1';

# Command Parameter Brancher 
my $COMMANDS = {
                  # Assoc. sub for the command 
    $COMMAND => [ \&testCommant,
                  # Parameter set for the sub
                  { INT  => $OPT_INT  ,
                    STR  => $OPT_STR  ,
                    BOOL => $OPT_BOOL ,
                    DATE => $OPT_DATE ,
                    REAL => $OPT_REAL ,
                    TOOL => $OPT_TOOL },
              ],
};

# Create a new application object
$TK->new;

# Init Application Context 
ok($TK->initApplication($VERSION, $DATE, $AUTHOR, $CONTACT))
...
# Init Runtime context before parsing the CLI data
ok($TK->initRuntime($MAGIC, $TOOL, $IOTYPE, \@PARAM),
   "Init runtime set");
...
# Set runtime parameter before calling the command brancher 
# to run a certein sub routine with a defined parameter set.
ok($TK->setRuntime($COMMANDS, $OUTPUT, $RES_ERROR, $COMMAND));

setRuntime 根据变量 $RESPONSE.

设置 $TK 内部 exitFunc

$RESPONSE = 'ERROR'链接方法$exitFun = \&exitError is $TK->exitError.
$RESPONSE = 'WARN'链接方法$exitFun = \&exitWarn is $TK->exitWarn.

在测试套件中，我想测试 $exitFun（代码参考）由 $TK->getRuntimeValues 返回。

# Check what was stored
my ( $tool, $output, $response,
     $command, $exitFun, $param ) = $TK->getRuntimeValues; 
ok($tool     eq $TOOL);      # OK
ok($output   eq $OUTPUT);    # OK
ok($response eq $RES_ERROR); # OK
ok($command  eq $COMMAND);
...

# Struggle point 
ok($exitFun == $TK->exitError);

diag($exitFun,"\n");         # OK    .. CODE(0x55a8a9027808) 
diag($TK->exitError,"\n");  # ERROR .. Too few args for AppTK::exitError

测试似乎试图调用该方法。从 $TK-> 之外的方法获取 CODE REF 的测试的正确表达式是什么？

编辑定义：

在包 AppTK 中，关系由字典定义：

my %EXITS = (
    FATAL => \&exitFatal,    # Response that signals a failure
    WARN  => \&exitWarn,     # Response that signals a warning
    ERROR => \&exitError,    # Response that signals a Error
    INFO  => \&exitInfo,     # Response that signals a Info
);
...
# -----------------------------------------------------------------
sub exitRuntime ( $self, $error, $remarks = '', $example = '' ) {
    my $exitFun = $self->runtime->{ +CONST::KEY_EXIT_FUN };
    &$exitFun( $self, $error, $remarks, $example );
}

# -----------------------------------------------------------------
sub exitError ( $self, $message, $remarks = '', $example = '' ) {
    exitStatus( $self, 'E', $message, $remarks, $example );
}

# -----------------------------------------------------------------
sub exitFatal ( $self, $message, $remarks = '', $example = '' ) {
    exitStatus( $self, 'F', $message, $remarks, $example );
}

# -----------------------------------------------------------------
sub exitInfo ( $self, $message, $remarks = '', $example = '' ) {
    exitStatus( $self, 'I', $message, $remarks, $example );
}

# -----------------------------------------------------------------
sub exitCancel ( $self, $message, $remarks = '', $example = '' ) {
    exitStatus( $self, 'C', $message, $remarks, $example );
}

# -----------------------------------------------------------------
sub exitWarn ( $self, $message, $remarks = '', $example = '' ) {
    exitStatus( $self, 'W', $message, $remarks, $example );
}

Answer 1

您在 AppTK 包中有一个名为 getRuntimeValues 的子程序，有时 returns \&exitError，您想要检查它是否确实如此。

为此，您可以与以下内容进行比较：

\&AppTK::exitError      # The sub returned by `\&exitError` from package `AppTK`

虽然不严格等价，但如果 $TK 被祝福为 AppTK，以下将产生相同的结果：

$TK->can("exitError")   # The sub called by `$TK->exitError`

如何使用 Moo 从对象方法获取代码引用

How to get a code reference from a object method using Moo

perl

coderef

moo

详情

编辑定义：