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

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 );
}

>Solution :

You have a sub in the AppTK package named getRuntimeValues that sometimes returns \&exitError, and you want to check if that’s what it did.

To do this, you can compare against the following:

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

While not strictly equivalent, the following will produce the same result if $TK is blessed into AppTK:

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

Leave a Reply