view release on metacpan or  search on metacpan

full_developer_test.pl.src  view on Meta::CPAN

#!/usr/bin/perl

# ------------------------------------------------------------------------
# This program is only for use by the developer of this module.
# ------------------------------------------------------------------------
# Running "make test" should be good enough for everyone else!
# ------------------------------------------------------------------------
# Only modify file: full_developer_test.pl.src
#              not: full_developer_test.pl
# Run "make" to generate the PL file!
# make does:   perl  full_developer_test.pl.src  full_developer_test.pl
# ------------------------------------------------------------------------
# Running:  full_developer_test.pl
# ------------------------------------------------------------------------
# It runs "make test" 2 times with changes to $ENV{FISH_OFF_FLAG}
#   1) FISH_OFF_FLAG = 1    Run tests using Fred::Fish::DBUG qw /OFF/
#   2) FISH_OFF_FLAG = 0    Run tests using Fred::Fish::DBUG qw /ON/
#
# If a "make test" fails, it won't run the next in the series!
#
# There will be fish logs generated in each case.  The only difference
# is when FISH_OFF_FLAG is set, Advanced::Config itself won't use fish.
# Only the test programs themselves will use it.  Which is how this
# module is expected to be run by normal users.
# It just proves that using Fred::Fish::DBUG "on" vs "off" doesn't change
# the behaviour of my module.
# ------------------------------------------------------------------------
# Running:  full_developer_test.pl t/<name>.t
# ------------------------------------------------------------------------
# Forces a "make" first.
# Runs just that one test program 2 times instead of the full "make test".
# Does this via "prove -bv t/<name>.t"
# Before each run it will reset FISH_OFF_FLAG.  It's just a quick and
# dirty way to fully debug individual test progs.
# ------------------------------------------------------------------------

use strict;
use warnings;

use ExtUtils::MakeMaker 6.30;
use File::Spec;
use Cwd 'abs_path';
use File::Basename;
use File::Copy;
use File::Glob qw (bsd_glob);

# The number of fish log files to locate for each 'make test' run!
use constant MAX => 28;

my $fish_dir_summary;
my $fish_dir_details;

BEGIN {
   eval {
      require Time::HiRes;
      Time::HiRes->import ( qw(time sleep) );
   };
}

# Main Program ...

{
   $fish_dir_summary = File::Spec->catdir ("t", "log_summary");
   $fish_dir_details = File::Spec->catdir ("t", "log_details");

   unless ( -d "t" ) {
      die ("No such sub-dir './t'.  Must run from the build dir!\n");
   }
   unless ( -d $fish_dir_summary ) {
      die ("No such sub-dir '${fish_dir_summary}'.  Must run from the build dir!\n");
   }
   unless ( -d $fish_dir_details ) {
      die ("No such sub-dir '${fish_dir_details}'.  Must run from the build dir!\n");
   }

   # Delete %ENV entry so t/99-failure.t will pass all it's tests!
   delete $ENV{FAIL_TEST_99};

   # Create %ENV entry so t/75-check_all_languages.t will fully write to fish.
   # Also used by t/76-check_all_languages2.t
   $ENV{FULL_75_TEST} = 1;

   my $fail_test_msg = "";

   my $one_test_prog;
   my $one_fish_base;

   # --------------------------------------------------------------------------
   # 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!

full_developer_test.pl.src  view on Meta::CPAN

   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
{
   my $wild_1 = File::Spec->catfile ( $fish_dir_summary, "*.fish.txt" );
   my $wild_2 = File::Spec->catfile ( $fish_dir_details, "*.fish.txt" );

   foreach my $f ( bsd_glob ( $wild_1 ), bsd_glob ( $wild_2 ) ) {
      unlink ( $f );
   }

   return;
}


# Tries to find out the proper 'make' program to use for your platform ...
# Then runs it.  If it exits with a non-zero status it assumes it's the
# wrong one and tries out the next one in the list!
sub find_and_run_make
{
   my $cmd;

   print "\nSearching for the correct 'make' variant to use ...\n\n";

   # Keep dmake last since Strawberry perl depreciated it in favor of gmake.
   # Assumes any depreciated make found will exit with a status of zero!
   foreach my $make ( "make", "gmake", "dmake" ) {
      $cmd = which ( $make );

      if ( defined $cmd ) {
         my $mk = basename ( $cmd );
         print "\nRunning '${mk}' ...\n";

         my $res = system ( $cmd );
         if ( $res == 0 ) {
            last;       # The command is good!
         } else {
            print "Failed '${mk}'.  Looking for the next make variant in the list.\n\n";
            $cmd = undef;
         }
      }
   }

   unless ( defined $cmd ) {
      die ("Can't locate a working 'make' program to run 'make test' with!\n");
   }

   print "Found: $cmd\n";

   return ($cmd);
}

# Tries to find out the proper 'prove' program to use for your platform ...
sub which_prove
{
   my $process = shift;

   my $cmd;

   print "\nSearching for the correct 'prove' variant to use ...\n\n";

   foreach my $prove ( "prove" ) {
      $cmd = which ( $prove );
      last  if ( defined $cmd );
   }

   unless ( defined $cmd ) {
      die ("Can't locate a 'prove' program to run 'prove -bv ${process}' with!\n");