view release on metacpan or  search on metacpan

full_developer_test.pl.src  view on Meta::CPAN

   # --------------------------------------------------------------------------
   # This implements
   #   PL_FILES => { 'full_developer_test.pl.src' => 'full_developer_test.pl' }
   # from Makefile.PL ...
   # --------------------------------------------------------------------------
   # This is only true during "make".
   # --------------------------------------------------------------------------
   if ( defined $ARGV[0] ) {
      my $prog = basename ( $0, ".src" );
      if ( $prog eq $ARGV[0] ) {
         my $file = File::Spec->catfile ( dirname ($0), $prog );
         copy ( $0, $file ) or die ("Can't create file: $file\n");
         chmod ( 0755, $file );     # Executable by everyone!
         print STDERR "Created file: $file\n";
         exit 0;

      # Requesting that we run a specific test program in sub-dir "t" ...
      # Must enforce since "prove" always reports failure if not true!
      } elsif ( -f $ARGV[0] && -r _ ) {
         $one_test_prog = $one_fish_base = $ARGV[0];

         # Logic is from helper1234::turn_fish_on_off_for_advanced_config () ...
         $one_fish_base =~ s/[.]t$//;
         $one_fish_base =~ s/[.]pl$//;
         $one_fish_base .= ".fish.txt";
         $one_fish_base = basename ( $one_fish_base );

         # Can't use prove if the program isn't in the "t" sub-dir.
         if ( dirname ( $one_test_prog ) ne "t" ) {
            print STDERR "Program \"${one_test_prog}\" must reside in the \"t\" sub-directory!\n";
            exit 3;
         }

         $fail_test_msg = uc ($ARGV[1] || "");

      } elsif ( uc ($ARGV[0]) eq "BOTH" ) {
         $fail_test_msg = uc ($ARGV[0]);

      } elsif ( uc ($ARGV[0]) eq "DETAIL" ) {
         $fail_test_msg = uc ($ARGV[0]);

      } elsif ( uc ($ARGV[0]) eq "SUMMARY" ) {
         $fail_test_msg = uc ($ARGV[0]);

      # Something unexpected on the command line ...
      } else {
         print STDERR "Unknown program '$ARGV[0]'\n";
         exit 3;
      }
   }

   # --------------------------------------------------------------------------
   # If not building the *.pl file, lets run the requested tests ...
   # Each test will be run 2 times.  Resetting the special environment
   # variable between runs.  The 2nd run is much slower than the 1st run.
   # --------------------------------------------------------------------------
   # Locate the "make" variant & then run ${make} ...
   my $make = find_and_run_make ();

   my ( $fail_summary_flag, $fail_detail_flag ) = ( 0, 0 );
   if ( $fail_test_msg eq "BOTH" ) {
      $fail_summary_flag = $fail_detail_flag = 1;
   } elsif ( $fail_test_msg eq "DETAIL" ) {
      $fail_detail_flag = 1;
   } elsif ( $fail_test_msg eq "SUMMARY" ) {
      $fail_summary_flag = 1;
   }

   if ( $one_test_prog ) {
      run_specific_test ( $one_test_prog, $one_fish_base, $fail_summary_flag, $fail_detail_flag );

   } else {
      delete_old_fish_logs ();
      run_all_tests ( $make, $fail_summary_flag, $fail_detail_flag );   # Does via "make test".
   }

   exit (0);
}


# ==============================================================================
# Start of the functions called ...
# ==============================================================================

# Run the test suite in both configurations ...
sub run_all_tests
{
   my $make         = shift;
   my $summary_flag = shift;
   my $details_flag = shift;

   my ( $summary_msg, $detail_msg );

   my $t0 = time ();

   # Run the summary test ...
   eval {
      local $ENV{FAIL_TEST_99} = 1   if ( $summary_flag );
      run_make_test ( $make,  1, MAX, "=", "Fred::Fish::DBUG::OFF, just high level logs generated. (fast)" );
   };
   if ( $@ ) {
      $summary_msg = $@;
   }
   my $t1 = time ();

   # Run the detailed test ...
   eval {
      local $ENV{FAIL_TEST_99} = 1   if ( $details_flag );
      run_make_test ( $make,  0, MAX, "-", "Fred::Fish::DBUG::ON, providing detailed logging. (slow)" );
   };
   if ( $@ ) {
      $detail_msg = $@;
   }
   my $t2 = time ();

   print_status ( $summary_msg, $detail_msg );

   printf "Pass 1: %.1f second(s)\n", ($t1 - $t0);
   printf "Pass 2: %.1f second(s)\n", ($t2 - $t1);
   print "\n";

   return;
}


# Run a test suite in the requested mode ...
sub run_make_test
{
   my $make     = shift;    # Which make command to use.
   my $off_flag = shift;    # Which setting to use: 0, 1.
   my $num_fish = shift;    # The number of fish files to expect ...
   my $sep_char = shift;
   my $log_msg  = shift;

   my $mk = basename ($make);

   printf ("\n%s\n", ${sep_char}x50);
   print "Running '${mk} test' for ${log_msg} ...\n";
   printf ("%s\n\n", ${sep_char}x50);

   # Determine the test mode to use ...
   $ENV{FISH_OFF_FLAG} = ${off_flag};

   # Run the tests ...
   my $res = system ("${make} test");
   my $cnt = show_fish_logs ( ${off_flag} ? $fish_dir_summary : $fish_dir_details );

   # Check out the results ...
   if ( $res != 0 ) {
      die ("Failed one or more test cases!  FISH_OFF_FLAG == ${off_flag}  (${log_msg}!)\n\n");
   }
   if ( $cnt != ${num_fish} ) {
      die ("Failed final test case!  FISH_OFF_FLAG == ${off_flag}  (${log_msg}!)\n",
           "Wrong number of fish logs generated! (${cnt} vs ${num_fish})\n\n");
   }

   return;
}

# Run a single test in both modes using "prove" ...
sub run_specific_test
{
   my $prog         = shift;
   my $fish         = shift;   # The basename of the fish log file ...
   my $summary_flag = shift;
   my $details_flag = shift;


   my $log_s = File::Spec->catfile ($fish_dir_summary, $fish);
   my $log_d = File::Spec->catfile ($fish_dir_details, $fish);

   # Delte both log files ...
   unlink ( $log_s, $log_d );

   my ( $summary_msg, $detail_msg );

   my $prove = which_prove ( $prog );

   # Run the summary test ...
   eval {
      local $ENV{FAIL_TEST_99} = 1   if ( $summary_flag );
      run_that_test ( $prove, $prog, $log_s, 1, "=", "Fred::Fish::DBUG::OFF, just high level logs available. (fast)" );
   };
   if ( $@ ) {
      $summary_msg = $@;
   }

   # Run the detailed test ...
   eval {
      local $ENV{FAIL_TEST_99} = 1   if ( $details_flag );
      run_that_test ( $prove, $prog, $log_d, 0, "-", "Fred::Fish::DBUG, providing detailed logging. (slow)" );
   };
   if ( $@ ) {
      $detail_msg = $@;
   }

   print_status ( $summary_msg, $detail_msg );

   return;
}

sub run_that_test
{
   my $prove    = shift;     # Prove or Perl binary to use.
   my $prog     = shift;
   my $fish     = shift;
   my $off_flag = shift;     # Which setting to use: 0, 1.
   my $sep_char = shift;
   my $log_msg  = shift;

   my $p = basename ($prove);

   # Determine the test mode to use ...
   $ENV{FISH_OFF_FLAG} = ${off_flag};

   # Running the test via prove ...
   printf ("\n%s\n", ${sep_char}x50);
   print "Running '${p} -bv ${prog}' for ${log_msg} ...\n";
   printf ("%s\n\n", ${sep_char}x50);
   my $res = system ("${prove} -bv ${prog}");

   if ( $res != 0 ) {
      die ("Failed test case ($res)!  FISH_OFF_FLAG == ${off_flag}  (${log_msg}!)\n\n");
   }

   if ( -f $fish ) {
      print "Found fish file: ${fish}\n";
   } else {
      print "No fish file found: ${fish}\n";
   }

   return;
}


sub print_status
{
   my $summary = shift;
   my $details = shift;

   if ( $summary && $details ) {
      die ( "\n", $summary, $details );

   } elsif ( $summary ) {
      my $msg = "Detail test cases passed!\n\n";
      die ( "\n", $summary, $msg );

   } elsif ( $details ) {
      my $msg = "Summary test cases passed!\n\n";
      die ( "\n", $msg, $details );

   } else {
      print "\nAll tests ran OK!\n\n";
   }

   return;
}


# Lists the fish files generated by "make test" ...
sub show_fish_logs
{
   my $fish_dir = shift;

   print "\nThe fish logs for: FISH_OFF_FLAG == $ENV{FISH_OFF_FLAG} ...\n";

   my $wild = File::Spec->catfile ( $fish_dir, "*.fish.txt" );
   my $cnt = 0;

   foreach my $f ( bsd_glob ( $wild ) ) {
      print "   $f\n";
      ++$cnt;
   }

   print "Found ${cnt} fish logs ...\n\n";

   return ( $cnt );
}


# Cleans up after previous runs of this program ...
sub delete_old_fish_logs
{