fix $METHOD / $METHOD_REF determination

pkg-perl-tools · Jul 9, 2023 · d3242fa · d3242fa
1 parent 15773b8
commit d3242fa
Show file tree

Hide file tree

Showing 3 changed files with 62 additions and 17 deletions.
diff --git a/lib/Test/Expander.pm b/lib/Test/Expander.pm
@@ -31,7 +31,7 @@ use Test::Expander::Constants qw(
   $NOTE
   $REGEX_ANY_EXTENSION $REGEX_CLASS_HIERARCHY_LEVEL $REGEX_TOP_DIR_IN_PATH $REGEX_VERSION_NUMBER
   $TRUE
-  %CONSTANTS_TO_EXPORT
+  %MOST_CONSTANTS_TO_EXPORT %REST_CONSTANTS_TO_EXPORT
 );
 
 readonly_on( $VERSION );
@@ -66,10 +66,12 @@ sub import {
   }
   my $options = _parse_options( \@exports, $test_file );
 
-  _export_symbols( $options, $test_file );
+  _export_most_symbols( $options, $test_file );
   _set_env( $options->{ -target }, $test_file );
 
   Test2::V0->import( %$options );
+
+  _export_rest_symbols();
   Importer->import_into( $class, scalar( caller ), () );
 
   return;
@@ -178,21 +180,31 @@ sub _error {
   return $error;
 }
 
-sub _export_symbols {
+sub _export_most_symbols {
   my ( $options, $test_file ) = @_;
 
   $TEST_FILE = path( $test_file )->absolute->stringify;
-  foreach my $var ( sort keys( %CONSTANTS_TO_EXPORT ) ) {   # Export defined constants
+
+  return _export_symbols( %MOST_CONSTANTS_TO_EXPORT );
+}
+
+sub _export_rest_symbols {
+                                                            # Further export if class and method are known
+  return _export_symbols( %REST_CONSTANTS_TO_EXPORT ) if $CLASS && $METHOD && ( $METHOD_REF = $CLASS->can( $METHOD ) );
+
+  $METHOD = undef;
+  return;
+}
+
+sub _export_symbols {
+  my %constants = @_;
+
+  foreach my $name ( sort keys( %constants ) ) {            # Export defined constants
     no strict qw( refs );                                   ## no critic (ProhibitProlongedStrictureOverride)
-    my $value = eval( "${ \$var }" ) or next;
-    readonly_on( ${ __PACKAGE__ . '::' . $var =~ s/^.//r } );
-    push( @EXPORT, $var );
-    $NOTE->( $FMT_SET_TO, $var, $CONSTANTS_TO_EXPORT{ $var }->( $value, $CLASS ) );
-
-    if ( $var eq '$CLASS' ) {                               # Export method constants only if class is known
-      $METHOD_REF = $CLASS->can( $METHOD );
-      $METHOD     = undef unless( $METHOD_REF );
-    }
+    my $value = eval( "${ \$name }" ) or next;
+    readonly_on( ${ __PACKAGE__ . '::' . $name =~ s/^.//r } );
+    push( @EXPORT, $name );
+    $NOTE->( $FMT_SET_TO, $name, $constants{ $name }->( $value, $CLASS ) );
   }
 
   return;

diff --git a/lib/Test/Expander/Constants.pm b/lib/Test/Expander/Constants.pm
@@ -50,14 +50,16 @@ const our $REGEX_VERSION_NUMBER        => qr/^ \d+ (?: \. \d+ )* $/x;
 
 const our $TRUE                        => 1;
 
-const our %CONSTANTS_TO_EXPORT         => (
+const our %MOST_CONSTANTS_TO_EXPORT    => (
   '$CLASS'      => sub { $_[ 0 ] },
-  '$METHOD'     => sub { $_[ 0 ] },
-  '$METHOD_REF' => sub { '\&' . $_[ 1 ] . '::' . svref_2object( $_[ 0 ] )->GV->NAME },
   '$TEMP_DIR'   => sub { $_[ 0 ] },
   '$TEMP_FILE'  => sub { $_[ 0 ] },
   '$TEST_FILE'  => sub { $_[ 0 ] },
 );
+const our %REST_CONSTANTS_TO_EXPORT    => (
+  '$METHOD'     => sub { $_[ 0 ] },
+  '$METHOD_REF' => sub { '\&' . $_[ 1 ] . '::' . svref_2object( $_[ 0 ] )->GV->NAME },
+);
 
 push( our @EXPORT_OK, keys( %{ peek_our( 0 ) } ) );
 

diff --git a/t/Test/Expander/import.t b/t/Test/Expander/import.t
@@ -22,7 +22,7 @@ BEGIN {
 }
 
 use Scalar::Readonly          qw( readonly_off );
-use Test::Builder::Tester     tests => @functions + @variables + 12;
+use Test::Builder::Tester     tests => @functions + @variables + 14;
 
 use Test::Expander            -target   => 'Test::Expander',
                               -tempdir  => { CLEANUP => 1 },
@@ -196,3 +196,34 @@ $expected = undef;
 test_out( "ok 1 - $title" );
 is( $METHOD, $expected, $title );
 test_test( $title );
+
+$title    = "omitted '-method', '-target' => undef (return value)";
+$expected = undef;
+readonly_off( $CLASS );
+readonly_off( $METHOD );
+readonly_off( $METHOD_REF );
+readonly_off( $TEMP_DIR );
+readonly_off( $TEMP_FILE );
+readonly_off( $TEST_FILE );
+test_out(
+  join(
+    "\n",
+    sprintf( "# $FMT_SET_TO", '$CLASS',     $CLASS ),
+    sprintf( "# $FMT_SET_TO", '$TEMP_DIR',  $TEMP_DIR ),
+    sprintf( "# $FMT_SET_TO", '$TEMP_FILE', $TEMP_FILE ),
+    sprintf( "# $FMT_SET_TO", '$TEST_FILE', path( __FILE__ )->absolute ),
+    "ok 1 - $title",
+  )
+);
+{
+  my $mockImporter = mock 'Importer'  => ( override => [ import_into => sub {} ] );
+  my $mockTest2    = mock 'Test2::V0' => ( override => [ import      => sub {} ] );
+  is( dies { $CLASS->import( -method => undef, -target => undef ) }, $expected, $title );
+}
+test_test( $title );
+
+$title    = "omitted '-method', '-target' => undef (assigned method name)";
+$expected = undef;
+test_out( "ok 1 - $title" );
+is( $METHOD, $expected, $title );
+test_test( $title );