implement subtest skipping, add test plan wherever possible

Changes

@@ -1,5 +1,9 @@
 Changelog for Test-Expander
 
+2.1.2 2023-10-03
+    - Stringify directory containing test file before replacement of slash with double colon avoiding blessed value
+      in $CLASS in case there is no one double colon.
+
 2.1.5 2023-08-02
     - Skip assignment and export of $TEST_FILE variable if the command line option '-e' is used.
 

lib/Test/Expander.pm

@@ -9,28 +9,60 @@ use warnings
   FATAL    => qw( all ),
   NONFATAL => qw( deprecated exec internal malloc newline portable recursion );
 
+use Getopt::Long qw( GetOptions :config posix_default );
+use Test2::API   qw( context );
+use Test2::Tools::Basic;
+use Test2::Tools::Subtest;
 use Const::Fast;
 use File::chdir;
 use File::Temp       qw( tempdir tempfile );
 use Importer;
 use Path::Tiny       qw( cwd path );
 use Scalar::Readonly qw( readonly_on );
-use Test2::Tools::Basic;
 use Test2::Tools::Explain;
-use Test2::V0        qw();
 
 use Test::Expander::Constants qw(
   $DIE $FALSE
-  $FMT_INVALID_DIRECTORY $FMT_INVALID_ENV_ENTRY $FMT_INVALID_VALUE $FMT_KEEP_ENV_VAR $FMT_NEW_FAILED
-  $FMT_NEW_SUCCEEDED $FMT_REPLACEMENT $FMT_REQUIRE_DESCRIPTION $FMT_REQUIRE_IMPLEMENTATION $FMT_SEARCH_PATTERN
-  $FMT_SET_ENV_VAR $FMT_SET_TO $FMT_SKIP_ENV_VAR $FMT_UNKNOWN_OPTION $FMT_USE_DESCRIPTION $FMT_USE_IMPLEMENTATION
-  $MSG_ERROR_WAS $MSG_UNEXPECTED_EXCEPTION
+  $FMT_INVALID_DIRECTORY $FMT_INVALID_ENV_ENTRY $FMT_INVALID_VALUE $FMT_INVALID_SUBTEST_NUMBER $FMT_KEEP_ENV_VAR
+  $FMT_NEW_FAILED $FMT_NEW_SUCCEEDED $FMT_REPLACEMENT $FMT_REQUIRE_DESCRIPTION $FMT_REQUIRE_IMPLEMENTATION
+  $FMT_SEARCH_PATTERN $FMT_SET_ENV_VAR $FMT_SET_TO $FMT_SKIP_ENV_VAR $FMT_UNKNOWN_OPTION $FMT_USE_DESCRIPTION
+  $FMT_USE_IMPLEMENTATION $MSG_ERROR_WAS $MSG_UNEXPECTED_EXCEPTION
   $NOTE
   $REGEX_ANY_EXTENSION $REGEX_CLASS_HIERARCHY_LEVEL $REGEX_TOP_DIR_IN_PATH $REGEX_VERSION_NUMBER
   $TRUE
   %MOST_CONSTANTS_TO_EXPORT %REST_CONSTANTS_TO_EXPORT
 );
 
+my ( @subtest_excluded_by_name, @subtest_excluded_by_number );
+
+sub _subtest_selection {
+  my $error;
+  GetOptions(
+    'exclude_name|subtest=s' => sub {
+      ( undef, my $opt_value ) = @_;
+      push( @subtest_excluded_by_name, eval { qr/$opt_value/ } ? $opt_value : "\Q$opt_value\E" );
+    },
+    'exclude_number=s' => sub {
+      ( undef, my $opt_value ) = @_;
+      $error = sprintf( $FMT_INVALID_SUBTEST_NUMBER, $opt_value ) if $opt_value !~ m{^ \d+ (?: / \d+ )* $}x;
+      push( @subtest_excluded_by_number, $opt_value );
+    },
+  );
+  die( $error) if $error;
+
+  my $subtest_buffered_orig = \&Test2::Tools::Subtest::subtest_buffered;
+  my $subtest_streamed_orig = \&Test2::Tools::Subtest::subtest_streamed;
+  no warnings qw( redefine );
+  *Test2::Tools::Subtest::subtest_buffered = sub { _subtest_conditional( $subtest_buffered_orig, @_ ) };
+  *Test2::Tools::Subtest::subtest_streamed = sub { _subtest_conditional( $subtest_streamed_orig, @_ ) };
+
+  return;
+}
+
+BEGIN { _subtest_selection() }
+
+use Test2::V0 qw();
+
 readonly_on( $VERSION );
 
 our ( $CLASS, $METHOD, $METHOD_REF, $TEMP_DIR, $TEMP_FILE, $TEST_FILE );
@@ -161,7 +193,7 @@ sub _determine_testee {
   unless ( exists( $options->{ -target } ) ) {              # Try to determine class / module autmatically
     my ( $test_root ) = $test_file =~ $REGEX_TOP_DIR_IN_PATH;
     my $testee        = path( $test_file )->relative( $test_root )->parent;
-    $options->{ -target } = $testee =~ s{/}{::}gr if grep { path( $_ )->child( $testee . '.pm' )->is_file } @INC;
+    $options->{ -target } = "$testee" =~ s{/}{::}gr if grep { path( $_ )->child( $testee . '.pm' )->is_file } @INC;
   }
   if ( defined( $options->{ -target } ) ) {
     $CLASS = $options->{ -target };
@@ -361,6 +393,26 @@ sub _set_env_hierarchically {
   return _set_env_hierarchically( $class, $env_found, $new_env );
 }
 
+sub _subtest_conditional {
+  my ( $orig_subtest, $name, @rest ) = @_;
+
+  my $ctx    = context();
+  my $number = join( '/', map { $_->count } @{ $ctx->stack } );
+  if (
+    ( grep { $name   =~ /$_/ } @subtest_excluded_by_name ) ||
+    ( grep { $number eq $_   } @subtest_excluded_by_number )
+  ) {
+    $ctx->skip( 'SKIP forced by ' . __PACKAGE__ );
+    $ctx->release;
+  }
+  else {
+    $orig_subtest->( $name, @rest );
+    $ctx->release;
+  }
+
+  return;
+}
+
 sub _use_imports {
   my ( $imports ) = @_;
 

lib/Test/Expander/Constants.pm

@@ -25,6 +25,7 @@ const our $FALSE                       => 0;
 const our $FMT_INVALID_DIRECTORY       => "Invalid directory name / expression '%s' supplied with option '-lib'%s\n";
 const our $FMT_INVALID_ENV_ENTRY       => "Erroneous line %d of '%s' containing '%s': %s\n";
 const our $FMT_INVALID_VALUE           => "Option '%s' passed along with invalid value '%s'\n";
+const our $FMT_INVALID_SUBTEST_NUMBER  => "\nInvalid subtest number to exclude: '%s'\n";
 const our $FMT_KEEP_ENV_VAR            => "Keep environment variable '%s' containing '%s' because it is not reassigned in file '%s'";
 const our $FMT_NEW_FAILED              => '%s->new died.%s';
 const our $FMT_NEW_SUCCEEDED           => "An object of class '%s' isa '%s'";

t/.perlcriticrc

@@ -226,8 +226,8 @@ add_themes = critic
 [Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines]
 add_themes = critic
 
-[Perl::Critic::Policy::Subroutines::ProtectPrivateSubs]
-add_themes = critic
+#[Perl::Critic::Policy::Subroutines::ProtectPrivateSubs]
+#add_themes = critic
 
 [Perl::Critic::Policy::Subroutines::RequireArgUnpacking]
 add_themes                  = critic
@@ -268,10 +268,10 @@ add_themes = critic
 add_themes       = critic
 max_chain_length = 3
 
-[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers]
+#[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers]
 # Not yet configured completely.
-add_themes     = critic
-allowed_values = -1 0 1
+#add_themes     = critic
+#allowed_values = -1 0 1
 
 [Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators]
 add_themes = critic

t/Test/Expander/NoCLASS/NoMETHOD.t

@@ -5,6 +5,6 @@ use warnings
 
 use Test::Expander;
 
-ok( !exists( $main::{ CLASS } ), 'there is no class corresponding to this test file' );
+plan( 1 );
 
-done_testing();
+ok( !exists( $main::{ CLASS } ), 'there is no class corresponding to this test file' );

t/Test/Expander/NoCLASS/NoMETHOD_only.t

@@ -5,7 +5,7 @@ use warnings
 
 use Test::Expander -target => 'Test::Expander';
 
+plan( 2 );
+
 ok(  exists( $main::{ CLASS } ),  'there is a class corresponding to this test file' );
 ok( !exists( $main::{ METHOD } ), 'there is no method corresponding to this test file' );
-
-done_testing();

t/Test/Expander/_determine_testee.t

@@ -5,8 +5,8 @@ use warnings
 
 use Test::Expander -method => undef;
 
+plan( 3 );
+
 ok(  exists( $main::{ CLASS  } ),   'class determined' );
 ok( !exists( $main::{ METHOD } ),   'no method determined' );
 ok( !exists( $ENV{ NEW_ENV_VAR } ), 'environment variable unset due to undefined value from .env file' );
-
-done_testing();

t/Test/Expander/_parse_options.t

@@ -5,6 +5,6 @@ use warnings
 
 use Test::Expander -target => undef;
 
-ok( !exists( $main::{ CLASS } ), 'no class determined' );
+plan( 1 );
 
-done_testing();
+ok( !exists( $main::{ CLASS } ), 'no class determined' );

t/Test/Expander/_set_env.t

@@ -10,6 +10,8 @@ use File::chdir;
 use Test::Expander -tempdir => {}, -srand => time;
 use Test::Expander::Constants qw( $FMT_INVALID_ENV_ENTRY );
 
+plan( 12 );
+
 $METHOD     //= '_set_env';
 $METHOD_REF //= $CLASS->can( $METHOD );
 can_ok( $CLASS, $METHOD );
@@ -33,6 +35,7 @@ $test_path->child( $class_path )->mkpath;
   path( $test_file )->touch;
 
   subtest '1st env variable filled from a variable, 2nd one kept from %ENV, 3rd one ignored' => sub {
+    plan( 2 );
     our $var  = 'abc';
     my $name  = 'ABC';
     my $value = '$' . __PACKAGE__ . '::var';
@@ -46,6 +49,7 @@ $test_path->child( $class_path )->mkpath;
   };
 
   subtest 'env variable filled by a self-implemented sub' => sub {
+    plan( 2 );
     my $name  = 'ABC';
     my $value = __PACKAGE__ . "::testEnv( lc( '$name' ) )";
     $env_file->spew( "$name = $value" );
@@ -58,6 +62,7 @@ $test_path->child( $class_path )->mkpath;
   };
 
   subtest "env variable filled by a 'File::Temp::tempdir'" => sub {
+    plan( 3 );
     my $name  = 'ABC';
     my $value = 'File::Temp::tempdir';
     $env_file->spew( "$name = $value" );
@@ -71,6 +76,7 @@ $test_path->child( $class_path )->mkpath;
   };
 
   subtest 'env file does not exist' => sub {
+    plan( 2 );
     $env_file->remove;
     %ENV = ( XXX => 'yyy' );
 
@@ -81,6 +87,7 @@ $test_path->child( $class_path )->mkpath;
   };
 
   subtest 'directory structure does not correspond to class hierarchy' => sub {
+    plan( 2 );
     $env_file->remove;
     %ENV = ( XXX => 'yyy' );
 
@@ -91,6 +98,7 @@ $test_path->child( $class_path )->mkpath;
   };
 
   subtest 'multiple levels of env files, cascade usage of their entries, overwrite entry' => sub {
+    plan( 2 );
     path( $env_file->parent->parent . '.env' )->spew( "C = '0'" );
     path( $env_file->parent         . '.env' )->spew( "A = '1'\nB = '2'\nD = \$ENV{ A } . \$ENV{ C }" );
     $env_file->spew( "C = '3'" );
@@ -107,6 +115,7 @@ $test_path->child( $class_path )->mkpath;
   };
 
   subtest 'env file with invalid syntax' => sub {
+    plan( 1 );
     my $name  = 'ABC';
     my $value = 'abc->';
     $env_file->spew( "$name = $value" );
@@ -116,6 +125,7 @@ $test_path->child( $class_path )->mkpath;
   };
 
   subtest 'env file with undefined values' => sub {
+    plan( 1 );
     my $name  = 'ABC';
     my $value = '$undefined';
     $env_file->spew( "$name = $value" );
@@ -125,6 +135,4 @@ $test_path->child( $class_path )->mkpath;
   };
 }
 
-done_testing();
-
 sub testEnv { return $_[ 0 ] }                               ## no critic (RequireArgUnpacking)

t/Test/Expander/_subtest_conditional.t

@@ -0,0 +1,35 @@
+use strict;
+use warnings
+  FATAL    => qw( all ),
+  NONFATAL => qw( deprecated exec internal malloc newline once portable redefine recursion uninitialized );
+
+use Test::Expander;
+
+my $subtestSkipped;
+my $mockTest2API = mock 'Test2::API::Context' => (
+  override => [ skip => sub { ok( $subtestSkipped, 'subtest skipped' ) } ]
+);
+
+plan( 3 );
+
+subtest 'no subtest excluded' => sub {
+  plan( 2 );
+  $subtestSkipped = 0;
+  lives_ok { $METHOD_REF->( sub { ok( !$subtestSkipped, 'original subtest executed' ) }, 'NAME' ) } 'no changes';
+};
+
+subtest 'exclude subtest by number' => sub {
+  plan( 2 );
+  local @ARGV = ( '--exclude_number' => '1/0' );
+  Test::Expander::_subtest_selection();
+  $subtestSkipped = 1;
+  lives_ok { $METHOD_REF->( sub { ok( !$subtestSkipped, 'original subtest executed' ) }, 'NAME' ) } 'executed';
+};
+
+subtest 'exclude subtest by name' => sub {
+  plan( 2 );
+  local @ARGV = ( '--exclude_name' => '[A-Z]' );
+  Test::Expander::_subtest_selection();
+  $subtestSkipped = 1;
+  lives_ok { $METHOD_REF->( sub { ok( !$subtestSkipped, 'original subtest executed' ) }, 'NAME' ) } 'executed';
+};

t/Test/Expander/_subtest_selection.t

@@ -0,0 +1,32 @@
+use strict;
+use warnings
+  FATAL    => qw( all ),
+  NONFATAL => qw( deprecated exec internal malloc newline once portable redefine recursion uninitialized );
+
+use Test2::V0 -target => 'Test::Expander';
+
+use Test::Expander::Constants qw( $FMT_INVALID_SUBTEST_NUMBER );
+
+plan( 4 );
+
+{
+  local @ARGV = ( '--exclude_name' => 'valid RegEx' );
+  is( Test::Expander::_subtest_selection(), undef, 'exclude subtest by valid RegEx' );
+}
+
+{
+  local @ARGV = ( '--exclude_name' => '[invalid RegEx' );
+  is( Test::Expander::_subtest_selection(), undef, 'exclude subtest by invalid RegEx' );
+}
+
+{
+  local @ARGV = ( '--exclude_number' => '1/0/2' );
+  is( Test::Expander::_subtest_selection(), undef, 'exclude subtest by valid number' );
+}
+
+Test2::Tools::Subtest::subtest_streamed 'enforced usage of subtest_streamed for better test coverage' => sub {
+  plan( 1 );
+  local @ARGV = ( '--exclude_number' => '1/0/' );
+  my $expected = sprintf( $FMT_INVALID_SUBTEST_NUMBER, '1/0/' );
+  like( dies { Test::Expander::_subtest_selection() }, qr/$expected/, 'exclude subtest by invalid number' );
+};

t/Test/Expander/_use_imports.t

@@ -1,5 +1,3 @@
-## no critic (ProtectPrivateSubs)
-
 use strict;
 use warnings
   FATAL    => qw( all ),