1

我在 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));

setRuntimeexitFunc 根据变量 $RESPONSE设置 $TK internal an 。

  • $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

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

编辑定义：

在包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 );
}
4

1 回答 1

4

AppTK您在包中有一个名为getRuntimeValues有时会返回的子程序\&exitError，您想检查它是否是这样做的。

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

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

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

$TK->can("exitError")   # The sub called by `$TK->exitError`
于 2022-01-05T15:32:19.847 回答