I'm using Moo (OO) under Perl v5.26 and Linux.
I'm writing tests and have some kind of runtime dictionary in an object to store states of an application. I want to test if a defined code reference points to the adequate method in that object.
My problem is to find the right expression for this test.
# Struggle point
ok($exitFun == \$TK->exitError);
diag($exitFun," "); # OK .. CODE(0x55a8a9027808)
diag(\$TK->exitError,"\n"); # ERROR .. Too few args for AppTK::exitError
Details
The application toolkit is initialized by several steps during the runtime to standardize some things. Here is the setup:
# ---------------------------------------------------
# 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 sets $TK internal an exitFunc depending on the variable $RESPONSE.
$RESPONSE = 'ERROR'links the method$exitFun = \&exitError is $TK->exitError.$RESPONSE = 'WARN'links the method$exitFun = \&exitWarn is $TK->exitWarn.
Within the test suite I want test which $exitFun (CODE REFERENCE) is given back by $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
It seem that the test tries to call the method. What is the right expression for the test to get the CODE REF from the method beyond $TK->?
Edit Definition:
Within the package AppTK the relation is defined by a dictionary:
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 );
}
