From d3242fa6800ae0df927b0d16182639361d304503 Mon Sep 17 00:00:00 2001 From: Jurij Fajnberg Date: Sun, 9 Jul 2023 11:59:36 +0200 Subject: [PATCH] fix $METHOD / $METHOD_REF determination --- lib/Test/Expander.pm | 38 ++++++++++++++++++++++------------ lib/Test/Expander/Constants.pm | 8 ++++--- t/Test/Expander/import.t | 33 ++++++++++++++++++++++++++++- 3 files changed, 62 insertions(+), 17 deletions(-) diff --git a/lib/Test/Expander.pm b/lib/Test/Expander.pm index dc26dea..7ff070f 100644 --- 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 index dcaaeba..90d1755 100644 --- 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 index 1607e6e..7ac6bc3 100644 --- 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 );