#!/usr/bin/perl -w
########################################################################
# Copyright 2004-2006 by Malcolm Nooning
# This program does not impose any
# licensing restrictions on files generated by their execution, in
# accordance with the 8th article of the Artistic License:
#
# "Aggregation of this Package with a commercial distribution is
# always permitted provided that the use of this Package is embedded;
# that is, when no overt attempt is made to make this Package's
# interfaces visible to the end user of the commercial distribution.
# Such use shall not be construed as a distribution of this Package."
#
# Therefore, you are absolutely free to place any license on the resulting
# executable(s), as long as the packed 3rd-party libraries are also available
# under the Artistic License.
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# See F<LICENSE>.
#
#
########################################################################
our $VERSION = 0.17;
########################################################################
# Prior to each test
# . Remove any possible files that could exist from a previous
# invocation of the test. If a file cannot be removed, report
# the failure and move on to the next test.
#
# During each test
# . After any file is created, check for it's existence to make
# sure it is there.
# . If a file cannot be created report the failure and move on
# to the next test.
#
# After each test
# . Do not do anything. If a test should cause a fault we
# want to leave any work product (files) for postmortem analysis.
# . Maybe we want to print result verbiage?
#
# Windows versus Unix
# . For each test, the command to "system" or pipe, path, etc.,
# will be determined by the type of OS.
# For example,
# if Unix, use "./tmp1/foo1". For windows, use "temp\\foo1".
#
# Note when the expected result is just "hello":
# "if ($result =~ m/hello/) {...
# versus
# chomp($result);
# "if ($result eq "hello") {...
# The $result can have the string "hello" in it and
# also contain extraneous or other error strings, so
# don't match for hello. Chomp and do an "eq".
#
########################################################################
use Test::More tests => 34;
use Cwd qw(chdir cwd);
use Config;
use File::Copy;
use File::Path;
use File::Spec;
use File::Basename;
use POSIX qw(uname);
use POSIX qw(EXIT_SUCCESS EXIT_FAILURE);
use Getopt::Long;
use strict;
########################################################################
# Home grown perl modules go here
use prior_to_test;
use pipe_a_command;
use test_in_further_subdir;
use remove_file_and_try_executable_again;
########################################################################
our ($PERL, $PAR, $PP);
our ($RUN_PP, $RUN_PAR);
########################################################################
# The module prior_to_test creates these four subdirs underneath
# whatever test subdir it is to work with. They are created for
# general use whether the current test uses them or not.
########################################################################
our $SUBDIR1 = "subdir1";
our $SUBDIR2 = "subdir2";
our $SUBDIR3 = "subdir3";
our $SUBDIR4 = "subdir4";
########################################################################
########################################################################
our $os = (uname())[0];
our $no_win32_exe = 0;
if ($os =~ m/^Win/i) {
eval {
require Win32::Exe;
Win32::Exe->import();
require Win32::Exe::IconFile;
Win32::Exe::IconFile->import;
};
$no_win32_exe = $@; # EVAL_ERROR
}
########################################################################
my $TRUE = 1;
my $FALSE = 0;
#########################################################################
sub how_many_cache_dirs {
my ($par_scratch_dir, $num_cache_dirs_ref, $message_ref, $verbose) = @_;
my $file;
my $count = 0;
$$num_cache_dirs_ref = 0;
$$message_ref = "";
if ( -e($par_scratch_dir) ) {
if (!(opendir(DIR, "$par_scratch_dir"))) {
$$message_ref = "hmcd_msg020: Cannot opendir $par_scratch_dir:$!:\n";
return(EXIT_FAILURE);
}
#....................................
while ($file = readdir(DIR)) {
next if ( $file =~ m/^\.{1,2}$/ );
$count++ if ($file =~ m/cache|temp/);
print ("Incremented cache count for $file\n") if $verbose;
}
#....................................
if (!(closedir(DIR))) {
$$message_ref = "hmcd_msg030: Cannot closedir $par_scratch_dir:$!:\n";
return(EXIT_FAILURE);
}
$$num_cache_dirs_ref = $count;
return (EXIT_SUCCESS);
} else {
return (EXIT_SUCCESS);
}
}
#########################################################################
sub deltree {
my ($dir, $level, $message_ref, $ignore_errors) = @_;
my $file = "";
my $error = EXIT_SUCCESS;
my $dir_handle = 'DIR_';
my $type = "";
$ignore_errors = 0 if (!defined($ignore_errors));
#.............................................................
# Since we are deleting entire directories here, we really
# want to double check parameters.
#.............................................................
$type = ref(\$dir);
if ($type !~ m/SCALAR/i) {
print ("deltree_msg040: PROGRAMMING ERROR\n");
print ("dir $dir is type $type\n");
die("Please research and fix ... Exiting\n");
}
#.................
$type = ref(\$level);
if ($type !~ m/SCALAR/i) {
print ("deltree_msg042: PROGRAMMING ERROR\n");
print ("level $level is type $type\n");
die("Please research and fix ... Exiting\n");
}
#.................
$type = ref($message_ref);
if ($type !~ m/SCALAR/i) {
print ("deltree_msg044: PROGRAMMING ERROR\n");
print ("message ref is type $type\n");
die("Please research and fix ... Exiting\n");
}
if ($level !~ m/^\d+$/) {
print ("deltree_msg046: PROGRAMMING ERROR\n");
print ("level $level is not all digits\n");
die("Please research and fix ... Exiting\n");
}
#.............................................................
if (!(-e($dir))) {
# Nothing to remove
return (EXIT_SUCCESS);
}
no strict; # The symbolic dir handles cause strict complaints
# Level is to prevent duplicate file handle names.
if ( defined($level) ) {
$level++;
} else {
$level = 0;
}
$dir_handle = $dir_handle . $level;
if (!(opendir ($dir_handle, "$dir"))) {
$$message_ref = "deltree_msg048: Could not read $dir:$!:\n";
print ("$$message_ref\n");
return(EXIT_FAILURE);
}
# Foreach file in directory...
foreach $file (readdir($dir_handle)) {
next if $file =~ /^\.+$/; # Skip . or ..
if (-d File::Spec->catfile($dir, $file)) {
$error = deltree(File::Spec->catfile($dir, $file), $level, $message_ref); # Recursion!
if (!$ignore_errors) {
return ($error) if ($error == EXIT_FAILURE);
}
} else {
if (!(unlink File::Spec->catfile($dir, $file))) {
if (!$ignore_errors) {
$$message_ref =
"deltree_msg050:Could not delete $dir/$file :$!:\n" .
"If it appears to be a permissions problem, it could " .
"be that another PAR application is running.\n" .
"This particular test attempts to remove all par cache " .
"directories. That cannot happen if a cache is in use\n";
return(EXIT_FAILURE);
}
}
}
}
if (!(closedir($dir_handle))) {
$$message_ref = "deltree_msg052:Could not close dir $dir/$file :$!:\n";
return (EXIT_FAILURE);
}
if (!(rmdir ($dir))) {
if (!$ignore_errors) {
$$message_ref =
"deltree_msg054:Couldn\'t remove directory \'$dir\' :$!:\n";
return (EXIT_FAILURE);
}
}
use strict;
return(EXIT_SUCCESS);
}
########################################################################
sub find_par_temp_base {
my ($verbose) = @_;
#################################################################
# Originally taken from par.pl:_set_par_temp. The lines
# containing $Config{_delim} were replaced by
# File::Spec->catdir(whatever, whatever);
#################################################################
my $path = "";
my $par_temp = "";
my $progname = "";
my $username = "";
my $stmpdir = "";
my $mtime = "";
my $ctx = "";
if ($ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/) {
$par_temp = $1;
return $par_temp;
}
foreach $path (
(map $ENV{$_}, qw( TMPDIR TEMP TMP )),
qw( C:\\TEMP /tmp . )
) {
next unless $path and -d $path and -w $path;
$username = defined(&Win32::LoginName)
? &Win32::LoginName()
: $ENV{USERNAME} || $ENV{USER} || 'SYSTEM';
$stmpdir = File::Spec->catdir($path, "par-".unpack("H*", $username));
last;
}
print ("fptb_msg062: stmpdir is $stmpdir\n") if $verbose;
return ($stmpdir);
}
########################################################################
sub okay_response {
my ($we_top) = @_;
$we_top->destroy;
}
########################################################################
sub after_test {
my ($test_number, $error, $message, $verbose) = @_;
if ($error == EXIT_SUCCESS) {
print ("Test $test_number PASSED\n") if $verbose;
} else {
print ("Test $test_number FAILED: \n$message\n") if $verbose;
}
}
#########################################################################
sub create_file {
my ($test_file, $verbiage, $verbose, $message_ref, $top_of_file_text) = @_;
$$message_ref = "";
if (!(open(OUTFILE, ">$test_file"))) {
$$message_ref = "\n\[CF01\]Cannot open file $test_file:$!:\n";
return (EXIT_FAILURE);
}
if (defined($top_of_file_text) && ($top_of_file_text ne "") ) {
print OUTFILE $top_of_file_text;
}
if ($verbiage ne "") {
print OUTFILE ("print \"${verbiage}\";");
}
if (!(close(OUTFILE))) {
$$message_ref = "\n\[CF02\]Cannot close file $test_file:$!:\n";
return (EXIT_FAILURE);
}
print ("\n\[CF03\]Created file $test_file\n") if $verbose;
return (EXIT_SUCCESS);
}
#########################################################################
sub pp_hello_1 {
my ($test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp hello'
# The command should: # Pack 'hello' into executable 'a.exe'
#
# . Create the file "hello" with the code that will
# print out the word "hello".
# . system pp hello
# a.exe will be created on windows
# . pipe 'a' and collect the results.
#
# Success if the result is "hello", failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $test_file = $test_dir . "/$hello_pl_file";
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg070: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($test_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg072: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP \"$hello_pl_file\" ";
if (system("$cmd")) {
$$message_ref = "\namsg074: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_o_hello_hello_dot_pl {
my ($test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -o hello hello.pl'
# The command should: # Pack 'hello.pl' into executable 'hello.exe'
# (The .exe assumes windows)
# . Create hello.pl with the code that will print out the word "hello".
# . system pp -o hello hello.pl
# . pipe the hello executable and collect the results.
#
# Success if the result is "hello", failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $test_file = File::Spec->catfile($test_dir, $hello_pl_file);
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg076: sub $test_name_string: cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($test_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg078: sub $test_name_string: $$message_ref";
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" ";
if (system("$cmd")) {
$$message_ref = "\namsg080: sub $test_name_string: cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_o_foo_foo_dot_pl_bar_dot_pl {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$foo_pl_file,
$bar_pl_file,
$foo_executable,
$bar_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
#Test
#----
# Goal: # Test of 'pp -o foo foo.pl bar.pl'
# ----
# The command should: Pack 'foo.pl' and 'bar.pl' into 'foo'
#
# Outline
# -------
# . Create foo.pl with the code that will print out the word "hello foo".
# . Create bar.pl with the code that will print out the word "hello bar".
# . system pp -o foo foo.pl bar.pl
# . pipe ./foo and collect the results. It should be "hello foo".
# . Copy foo to bar
# . pipe ./bar and collect the results. It should be "hello bar".
#
#Success if both "hello foo" and "hello bar" were appropriately collected.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg082: sub $test_name_string: " .
"cannot chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($foo_pl_file, "hello foo", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg083: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$error = create_file($bar_pl_file, "hello bar", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg084: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -o $foo_executable \"$foo_pl_file\" \"$bar_pl_file\" ";
if (system("$cmd")) {
$$message_ref = "\namsg085: sub $test_name_string: cannot system $cmd)\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$foo_executable,
"hello foo",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $foo_executable?\n";
return ($error);
}
#.................................................................
if(!(copy("$foo_executable", "$bar_executable"))) {
$$message_ref = "\namsg086: sub $test_name_string: cannot " .
"copy $foo_executable to $bar_executable\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$bar_executable,
"hello bar",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nIs there a $bar_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_p_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_dot_par,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -p hello'
# The command should: Create a PAR hello, 'a.par'
#
# . Create file "hello" with the code that will print out the word "hello".
# . system pp -p hello
# . pipe './par a' and collect the results. It should be "hello".
#
# Success if "hello" was collected. Failure otherwise
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $test_file = $hello_pl_file;
my $pipe_command_string = "$RUN_PAR ";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg088: sub $test_name_string cannot chdir " .
"$test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($test_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg089: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -p \"$test_file\"";
# This should produce $a_default_dot_par
if (system("$cmd")) {
$$message_ref = "\namsg090: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_dot_par,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_dot_par?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_p_minus_o_hello_dot_par_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_par_file_with_dot_par,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -p -o file.par file'
# The command should: Create a PAR file, 'file.par'
#
# . Create file "hello" with the code that will print out the word "hello".
# . system pp -p -o hello.par hello
# . pipe './par hello.par' and collect the results. It should
# be hello.
# . pipe './par hello' and collect the results. It should
# once again be "hello".
# Success if "hello" was collected both times. Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $test_file = $hello_pl_file;
my $pipe_command_string = "$RUN_PAR ";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg095: sub $test_name_string cannot chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($test_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg096: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -p -o \"$hello_par_file_with_dot_par\" \"$test_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg097: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_par_file_with_dot_par,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n";
return ($error);
}
#.................................................................
$pipe_command_string = "$RUN_PAR hello";
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
"", # We don't want the sub to try
# to chmod +x anything.
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_o_hello_file_dot_par {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_par_file_with_dot_par,
$hello_par_file_no_dot_par,
$hello_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -o hello file.par'
# The command should: Pack 'file.par' to executable 'hello'
#
# . Create file file.pl with the code that will print out the word "hello".
# . system pp -p -o file.par file.pl
# This will create the par file file.par
# . pipe './par file.par' and collect the results. It should
# be hello.
# . pipe './par file' and collect the results. It should
# once again be "hello".
# . system pp -o file file.par
# This will pack file.par into file.exe (Assuming windows)
# . pipe 'file' and collect the results. It should again be "hello"
#
# Success if "hello" was collected all three times. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $test_file = $hello_pl_file;
my $pipe_command_string = "$RUN_PAR ";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg098: sub $test_name_string cannot chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($test_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg099: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
# Create a par file
$cmd = "$RUN_PP -p -o \"$hello_par_file_with_dot_par\" \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg100: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $hello_par_file_with_dot_par\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_par_file_with_dot_par,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n";
return ($error);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string . 'hello',
"", # We don't want the sub to try
# to chmod +x anything.
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_par_file_with_dot_par?\n";
return ($error);
}
#.................................................................
$cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" ";
if (system("$cmd")) {
$$message_ref = "\namsg102: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $hello_executable\n");
}
}
#.................................................................
$pipe_command_string = "";
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_S_minus_o_hello_file {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_par_file_with_dot_par,
$hello_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -S -o hello hello.pl'
# The command should: Create a PAR file, 'hello.par'
# Pack 'hello.par' to executable 'hello'
#
# . Create file "hello.pl" with the code that will print out the
# word "hello".
# . system pp -S -o hello hello.pl
# This will create the par file hello.par, and also pack hello.par
# into the executable "hello.exe". (Assuming windows)
# . pipe './par hello.par' and collect the results. It should
# be "hello".
# . pipe './par hello' and collect the results. It should be "hello".
# . pipe the created executable and collect the results. It
# should again be "hello"
#
# Success if "hello" was collected all three times. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "$RUN_PAR ";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg105: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($hello_pl_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg106: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -S -o \"$hello_executable\" \"$hello_pl_file\" ";
if (system("$cmd")) {
$$message_ref = "\namsg107: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $hello_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
$pipe_command_string = "$RUN_PAR hello";
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
"", # We don't want the sub to try
# to chmod +x anything.
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable " .
"and hello.par?\n";
return ($error);
}
#.................................................................
$pipe_command_string = "";
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_p_minus_o_out_dot_par_file {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -p -o out.par file'
# The command should: Create 'out.par' from 'file'
# Same as the test for 'pp -p -o file.par file'
# except here we have renaming.
#
# . Create file "file" with the code that will print out the word "hello".
# . system pp -p -o out.par file
# . pipe './par out.par' and collect the results. It should
# be "hello".
#
# Success if "hello" was collected. Failure otherwise
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "$RUN_PAR ";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg110: sub $test_name_string cannot chdir " .
"$test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($hello_pl_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg111: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -p -o out.par \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg112: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created out.par\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'out.par',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce out.par?\n";
return ($error);
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_B_with_small_minus_p_tests {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -B -p -o out.par hello.pl'
# The command should: Create 'out.par' from 'file'
# Same as the test for 'pp -p -o file.par file'
# except here we bundle core modules.
#
#
# Since -B is the default except with -p or -P, the only way it
# seemed relevent was to test was by testing -B with -p, and by
# testing -B with -P. I did. -B or it's absense seems to mean
# nothing when creating either a .par file
# The file sizes with and without the -B within mere bytes
# of each other.
#
# Anyone know a way to really test -B?
#
# The four tests were:
# pp -p -o out.par hello.pl
# pp -B -p -o out.par hello.pl
#
# Again, the "-B" does not seem to have relevence.
#
# What I will do for now is to include the four tests and execute
# the generated .par and just check for "hello" being printed out.
# I will do this even though it is a do-nothing test. At least it
# shows that the -B does not harm anything.
#
#
# WARNING: This tests only tests that the generated files produces
# are okay. It does not check anything else.
#
#
# . Create the file hello.pl with the code that will print out the word
# "hello" and use strict.
# . system pp -B -p -o out_par_B.par hello.pl
# This creates out.par and bundles the core modules.
# . system pp -p -o out_par.par hello.pl
# This creates out.par
# . pipe './par out_par.par', './par out_par_B.par'
#
# After all of the above, success if "hello" was collected each time.
# Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "$RUN_PAR ";
my $cmd = "";
my $sub_test = 0;
my $top_of_created_file_text = "use strict;\n";
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
print ("\n\nI will do test $test_name_string even though it DOES NOT \n");
print ("REALLY TEST ANYTHING. At least it may show that the -B \n");
print ("switch does not harm anything.\n\n");
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg115: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($hello_pl_file,
"hello",
$verbose,
$message_ref,
$top_of_created_file_text);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg116: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -p -o out_par.par \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg117: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created out_par.par\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'out_par.par',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce out_par.par?\n";
return ($error);
}
#.................................................................
$cmd = "$RUN_PP -B -p -o out_par_B.par \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg118: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created out_par_B.par\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'out_par_B.par',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce out_par_B.par?\n";
return ($error);
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_B_with_large_minus_P_tests {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Test of 'pp -B -P -o out.pl hello.pl'
# The command should: Create 'out.pl' from 'file'
# Same as the test for 'pp -P -o file.pl file'
# except here we bundle core modules.
#
#
# Since -B is the default except with -p or -P, the only way it
# seemed relevent was to test was by testing -B with -p, and by
# testing -B with -P. I did. -B or it's absense seems to mean
# nothing when creating either a .pl file
# The file sizes with and without the -B within mere bytes
# of each other.
#
# Anyone know a way to really test -B?
#
# The four tests I tried were:
# pp -P -o out.pl hello.pl
# pp -B -P -o out.pl hello.pl
#
# Again, the "-B" does not seem to have relevence.
#
# What I will do for now is to include the four tests and execute
# the generated .pl and just check for "hello" being printed out.
# I will do this even though it is a do-nothing test. At least it
# shows that the -B does not harm anything.
#
#
# WARNING: This tests only tests that the generated files produces
# are okay. It does not check anything else.
#
#
# . Create the file hello.pl with the code that will print out the word
# "hello" and use strict.
# . system pp -B -P -o out_pl_B.pl hello.pl
# This creates out_pl_B.pl and bundles the core modules.
# . system pp -P -o out_pl.pl hello.pl
# This creates out.pl
# . pipe 'perl out_pl.pl', 'perl out_pl_B.pl'
#
# After all of the above, success if "hello" was collected each time.
# Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "\"$PERL\" ";
my $cmd = "";
my $sub_test = 0;
my $top_of_created_file_text = "use strict;\n";
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
print ("\n\nI will do test $test_name_string even though it DOES NOT \n");
print ("REALLY TEST ANYTHING. At least it may show that the -B \n");
print ("switch does not harm anything.\n\n");
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg120: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($hello_pl_file,
"hello",
$verbose,
$message_ref,
$top_of_created_file_text);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg121: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -P -o out_pl.pl \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg122: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created out_pl.pl\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'out_pl.pl',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce out_pl.pl?\n";
return ($error);
}
#.................................................................
$cmd = "$RUN_PP -B -P -o out_pl_B.pl \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg125: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created out_pl_B.pl\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'out_pl_B.pl',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce out_pl_B.pl?\n";
}
#.................................................................
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_e_print_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -e "print \"hello\n\";"
# ----
# The command should: Create 'a.exe' if windows
#
# Outline
# -------
# . system pp -e "print \"hello\n\";"
# . pipe 'a' and collect the results
# Success if "hello" was collected. Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg130: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -e \"print qq[hello\n];\"";
if (system("$cmd")) {
$$message_ref = "\namsg131: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_p_minus_e_print_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -p -e "print \"hello\n\";"
# ----
# The command should: Create 'a.par'
#
# Outline
# -------
# system pp -p -e "print \"hello\n\";"
# pipe 'par a.par' and collect the results
#
# Success if "hello" was collected. Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "$RUN_PAR ";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg135: sub $test_name_string cannot" .
" chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -p -e \"print qq[hello\n];\"";
if (system(" $cmd ")) {
$$message_ref = "\namsg136: sub $test_name_string Cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created a.par\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
"a.par",
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce a.par?\n";
return ($error);
}
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce a.par?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_P_minus_e_print_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -P -e "print \"hello\n\";"
# ----
# The command should: Create perl script 'a.pl'
#
# Outline
# -------
# system pp -P -e "print \"hello\n\";"
# pipe 'perl a.pl' and collect the results
#
# Success if "hello" was collected. Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "\"$PERL\" ";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg138: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -P -e \"print qq[hello\n];\"";
if (system(" $cmd ")) {
$$message_ref = "\namsg139: sub $test_name_string Cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created a.par\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'a.pl',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce a.pl?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_c_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -c hello
# ----
# The command should: Create executable 'a.exe'
#
# WARNING: This tests only tests that the executable produced
# is okay. It does not check anything else.
#
# Outline
# -------
# Create a file that will print "hello".
# system pp -c hello
# pipe 'a' and collect the results
#
# Success if "hello" was collected. Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg150: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($hello_pl_file,
"hello",
$verbose,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg151: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -c \"$hello_pl_file\" ";
if (system(" $cmd ")) {
$$message_ref = "\namsg152: sub $test_name_string Cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_x_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -x hello
# ----
# The command should: Create executable 'a.exe'
# Also it will check dependencies
# from "perl hello" during execution
#
# WARNING: This tests only tests that the executable produced
# is okay. It does not check anything else.
#
# Outline
# -------
# Create a file that will print "hello".
# system pp -x hello
# pipe 'a' and collect the results
#
# Success if "hello" was collected. Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg155: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($hello_pl_file,
"hello",
$verbose,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg156: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -x \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg157: sub $test_name_string Cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_n_minus_x_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -n -x hello
# ----
# The command should: Create executable 'a.exe'
# Also it will check dependencies
# from "perl hello" during execution
#
# WARNING: This tests only tests that the executable produced
# is okay. It does not check anything else.
#
# Outline
# -------
# Create a file that will print "hello".
# system pp -n -x hello
# pipe 'a' and collect the results
#
# Success if "hello" was collected. Failure otherwise.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg160: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
$error = create_file($hello_pl_file,
"hello",
$verbose,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg161: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
$cmd = "$RUN_PP -n -x \"$hello_pl_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg162: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_I_foo_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -I /foo hello.pl
# ----
# The command should:
# Add the given directory to the perl library file search path.
#
# Outline
# -------
# . Create a temp dir "hidden_dir" that Perl and PP would not know about.
# . Create a module in it called hidden_print.pm that has a
# subroutine called "hidden_print", that takes in a string
# to print.
# . Put the new module in the new temp dir.
# . Create a file foo in the current dir with code that will
# invoke hidden_print
# . system 'pp foo.pl'
# The file a.exe is created on windows.
# . pipe 'a'
# The result should be something like: "Can't locate hidden_print"
# . system pp -I "hidden_dir" foo.pl
# Once again, a.exe is created on windows
# . pipe 'a' and collect the results.
# . The result should be "hello"
# . Copy the a.exe to a different subdirectory
# . chdir to the new subdirectory
# . pipe a.exe
# . The result should be "hello"
# . Remove the hidden_print file.
# . pipe 'a' again and collect the results.
# It should still pass.
#
# Success if as described above. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $hidden_dir = File::Spec->catdir($test_dir, $SUBDIR1);
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $TRUE;
#..............................................
my $foo_top_of_file_text = '
use hidden_print;
hidden_print("hello");
';
#..............................................
#..............................................
my $hidden_top_of_file_text = '
package hidden_print;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("hidden_print");
sub hidden_print {
my ($text_to_print) = shift;
print ("$text_to_print\n");
}
1;
';
#..............................................
$$message_ref = "";
#..........................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg165: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($hidden_dir, "hidden_print\.pm"),
"",
$verbose,
$message_ref,
$hidden_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg166: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($test_dir, "foo\.pl"),
"",
$verbose,
$message_ref,
$foo_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg168: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg169: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
####################################################
##### This SHOULD fail, so don't return
##### return ($error) if ($error == EXIT_FAILURE);
###################################################
$$message_ref = ""; # Wipe out the nasty messages from the
# last pipe command.
print ("\n"); # To add a line after the above expected error messages.
#.................................................................
$cmd = "$RUN_PP -I \"$hidden_dir\" foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg170: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#..........................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
File::Spec->catfile($test_dir, "foo.pl"), # File to remove
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
return ($error);
}
#########################################################################
sub pp_minus_lib_foo_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp --lib /foo hello.pl
# ----
# The command should:
# Add the given directory to the perl library file search path.
#
# Outline
# -------
# First, to give an outline of the directories and files this
# test will create.
# -----------------------------------------------------
# | current working test dir/foo.pl |
# | foo.pl has "use hidden_print;" |
# |-----------------------------------------------------|
# | current working test dir/$SUBDIR1/hidden_print.pm |
# | hidden_print.pm prints the string passed in. |
# -----------------------------------------------------
#
# . In a dir $SUBDIR1 that PP would not know about, create
# a module called hidden_print.pm that has a subroutine
# called "hidden_print", that takes in a string to
# print, and prints it.
# . In the current directory, create a file foo.pl that invokes
# hidden_print with the text "hello".
# . system pp --lib $SUBDIR1 foo.pl
# An a.exe is created on windows
# . pipe 'a' and collect the results.
# . The result should be "hello"
#
# Success if as described above. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1);
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $TRUE;
#..............................................
my $foo_top_of_file_text = '
use hidden_print;
hidden_print("hello");
';
#..............................................
my $hidden_print_top_of_file_text = '
package hidden_print;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("hidden_print");
sub hidden_print {
my ($text_to_print) = shift;
print ("$text_to_print");
}
1;
';
#..............................................
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg172: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($foo_dir, "hidden_print\.pm"),
"",
$verbose,
$message_ref,
$hidden_print_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg174: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($test_dir, "foo\.pl"),
"",
$verbose,
$message_ref,
$foo_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg176: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg178: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
########################################################
##### This SHOULD fail, so don't do the usual return
##### return ($error) if ($error == EXIT_FAILURE);
########################################################
$$message_ref = ""; # Wipe out the nasty messages from the
# last pipe command.
print ("\n"); # To add a line after the above expected error messages.
#.................................................................
$cmd = "$RUN_PP --lib \"$foo_dir\" foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg180: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#..........................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
File::Spec->catfile($foo_dir, "hidden_print\.pm"),
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
return ($error);
}
#########################################################################
sub pp_minus_I_foo_minus_I_bar_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -I /foo -I bar hello.pl
# ----
# The command should:
# Add the given directory to the perl library file search path.
#
# Outline
# -------
# First, to give an outline of the directories and files this
# test will create.
# ----------------------------------------------------------
# | current working test dir/foo.pl |
# | foo.pl has "use hidden_print_caller; " |
# |----------------------------------------------------------|
# | current working test dir/$SUBDIR1/hidden_print_caller.pm |
# | hidden_print_caller.pm has "use hidden_print;" |
# |----------------------------------------------------------|
# | current working test dir/$SUBDIR2/hidden_print.pm |
# | hidden_print.pm prints the string passed in. |
# ----------------------------------------------------------
#
# . In subdir $SUBDIR1, create
# . Create a module in $SUBDIR2 called hidden_print.pm that
# has a subroutine called "hidden_print", that takes in a
# string to print, and prints it.
# . Create a module in $SUBDIR1 called hidden_print_caller.pm
# that has a routine called hidden_print_caller that
# takes in a string to print, and invokes hidden_print to print it.
# . In the current directory, create a file foo.pl that invokes
# hidden_print_caller with the text "hello".
# . system 'pp foo.pl'
# The file a.exe is created on windows.
# . pipe 'a'
# The result should be: Nothing.
# . system pp -I foo -I bar foo.pl
# Once again, a.exe is created on windows
# . pipe 'a' and collect the results.
# . The result should be "hello"
# . Copy a.exe to a different directory
# . chdir to the directory.
# . pipe 'a.exe' and collect the results.
# . The result should be "hello"
#
# Success if as described above. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1);
my $bar_dir = File::Spec->catdir($test_dir, $SUBDIR2);
my $foo_dir_file = File::Spec->catfile($foo_dir, "hidden_print_caller\.pm");
my $bar_dir_file = File::Spec->catfile($bar_dir, "hidden_print\.pm");
my $foo_file = File::Spec->catfile($test_dir, "foo\.pl");
my $further_subdir = "";
my $further_file = "";
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $TRUE;
#..............................................
my $foo_top_of_file_text = '
use hidden_print_caller;
hidden_print_caller("hello");
';
#..............................................
#..............................................
my $hidden_print_caller_top_of_file_text = '
package hidden_print_caller;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("hidden_print_caller");
use hidden_print;
sub hidden_print_caller {
my ($text_to_print) = shift;
hidden_print ("$text_to_print");
}
1;
';
#..............................................
#..............................................
my $hidden_print_top_of_file_text = '
package hidden_print;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("hidden_print");
sub hidden_print {
my ($text_to_print) = shift;
print ("$text_to_print");
}
1;
';
#..............................................
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg182: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $bar_dir_file,
"",
$verbose,
$message_ref,
$hidden_print_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg184: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $foo_dir_file,
"",
$verbose,
$message_ref,
$hidden_print_caller_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg186: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $foo_file,
"",
$verbose,
$message_ref,
$foo_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg188: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP \"$foo_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg190: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("\namsg192: sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
########################################################
##### This SHOULD fail, so don't do the usual return
##### return ($error) if ($error == EXIT_FAILURE);
########################################################
$$message_ref = ""; # Wipe out the nasty messages from the
# last pipe command.
print ("\n"); # To add a line after the above expected error messages.
#.................................................................
$cmd = "$RUN_PP -I \"$foo_dir\" -I \"$bar_dir\" \"$foo_file\"";
if (system("$cmd")) {
$$message_ref = "\namsg194: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$bar_dir_file,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_lib_foo_minus_lib_bar_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp --lib /foo --lib bar hello.pl
# ----
# The command should:
# Add the given directory to the perl library file search path.
#
# Outline
# -------
# First, to give an outline of the directories and files this
# test will create.
# ----------------------------------------------------------
# | current working test dir/foo.pl |
# | foo.pl has "use hidden_print_caller;" |
# |----------------------------------------------------------|
# | current working test dir/$SUBDIR1/hidden_print_caller.pm |
# | hidden_print_caller.pm has "use hidden_print;" |
# |----------------------------------------------------------|
# | current working test dir/$SUBDIR2/hidden_print.pm |
# | hidden_print.pm prints the string passed in. |
# ----------------------------------------------------------
#
# . Create a module in $SUBDIR2 called hidden_print.pm that
# has a subroutine called "hidden_print", that takes in a
# string to print, and prints it.
# . Create a module in $SUBDIR1 called hidden_print_caller.pm
# that has a routine called hidden_print_caller that
# takes in a string to print, and invokes hidden_print to print it.
# . In the current directory, create a file foo.pl that invokes
# hidden_print_caller with the text "hello".
# . system pp --lib foo --lib bar foo.pl
# Once again, a.exe is created on windows
# . pipe 'a' and collect the results.
# . The result should be "hello"
#
# Success if as described above. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1);
my $bar_dir = File::Spec->catdir($test_dir, $SUBDIR2);
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $TRUE;
#..............................................
my $foo_top_of_file_text = '
use hidden_print_caller;
hidden_print_caller("hello");
';
#..............................................
#..............................................
my $hidden_print_caller_top_of_file_text = '
package hidden_print_caller;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("hidden_print_caller");
use hidden_print;
sub hidden_print_caller {
my ($text_to_print) = shift;
hidden_print ("$text_to_print");
}
1;
';
#..............................................
#..............................................
my $hidden_print_top_of_file_text = '
package hidden_print;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("hidden_print");
sub hidden_print {
my ($text_to_print) = shift;
print ("$text_to_print");
}
1;
';
#..............................................
my $further_subdir = "";
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg196: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($bar_dir, "hidden_print\.pm"),
"",
$verbose,
$message_ref,
$hidden_print_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg198: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($foo_dir, "hidden_print_caller\.pm"),
"",
$verbose,
$message_ref,
$hidden_print_caller_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg200: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($test_dir, "foo\.pl"),
"",
$verbose,
$message_ref,
$foo_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg202: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg204: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
########################################################
##### This SHOULD fail, so don't do the usual return
##### return ($error) if ($error == EXIT_FAILURE);
########################################################
$$message_ref = ""; # Wipe out the nasty messages from the
# last pipe command.
print ("\n"); # To add a line after the above expected error messages.
#.................................................................
$cmd = "$RUN_PP --lib \"$foo_dir\"" .
' --lib ' . "\"$bar_dir\"" . ' foo.pl';
if (system("$cmd")) {
$$message_ref = "\namsg206: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
File::Spec->catfile($test_dir, "foo\.pl"),
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_M_foo_hidden_print_foo {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -M module foo.pl
# The command should: Add the given module
#
# Outline
# -------
# -----------------------------------------------------
# | current working test dir/foo.pl |
# | foo.pl has "use hidden_print;" |
# |-----------------------------------------------------|
# | current working test dir/$SUBDIR1/hidden_print.pm |
# | hidden_print.pm prints the string passed in. |
# | It is "package hidden_print;" |
# -----------------------------------------------------
#
# . Create $SUBDIR1/hidden_print.pm that has a subroutine
# called "hidden_print", that takes in a string to
# print, and prints it.
# . In the current directory, create a file foo.pl that invokes
# hidden_print with the text "hello".
# . system pp foo.pl
# An a.exe is created on windows
# . pipe the created executable and collect the results.
# There will be error
# messages on the screen, and the results will be: nothing.
# . system pp -M $SUBDIR1::hidden_print foo.pl
# An a.exe is created on windows
# . pipe the created executable and collect the results.
# . The result should be "hello"
# . Remove the included module
# . Once again, pipe the created executable
# The result should still be hello.
# Success if as described above. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1);
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $hidden_print_file = File::Spec->catfile($foo_dir, "hidden_print\.pm");
my $print_cannot_locate_message = $FALSE;
#..............................................
my $foo_top_of_file_text = '
use ' . $SUBDIR1 . '::hidden_print;
hidden_print("hello");
';
#..............................................
my $hidden_print_top_of_file_text = '
package ' . $SUBDIR1 . '::hidden_print;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("hidden_print");
sub hidden_print {
my ($text_to_print) = shift;
print ("$text_to_print");
}
1;
';
#..............................................
my $further_subdir = "";
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg208: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $hidden_print_file,
"",
$verbose,
$message_ref,
$hidden_print_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg210: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($test_dir, "foo\.pl"),
"",
$verbose,
$message_ref,
$foo_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg212: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg214: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#..........................................................
$cmd = "$RUN_PP -M ${SUBDIR1}::hidden_print foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg216: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$hidden_print_file,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
return ($error);
#.................................................................
}
#########################################################################
sub pp_minus_M_foo_minus_M_bar_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of pp -M hidden1 -M hidden2 foo.pl
# The command should: Add the given modules
#
# Outline
# -------
# -----------------------------------------------------
# | current working test dir/foo.pl |
# | foo.pl has "use foo_1;" |
# | "use bar_1;" |
# | foo_1; |
# | bar_1; |
# |-----------------------------------------------------|
# | current working test dir/$SUBDIR1/foo_1.pm |
# | foo_1.pm will print "hello_foo" |
# |-----------------------------------------------------|
# | current working test dir/$SUBDIR2/bar_1.pm |
# | bar_1.pm will print "hello_bar" |
# -----------------------------------------------------
#
# . Create $SUBDIR1/foo_1.pm that has a subroutine called "foo_1",
# that prints hello_foo.
# . Create $SUBDIR2/bar_1.pm that has a subroutine called "bar_1",
# that prints hello_bar.
# . In the current directory, create a file foo.pl that invokes
# foo_1 and bar_1.
# . system pp foo.pl
# An a.exe is created on windows
# . pipe 'a' and collect the results. There will be error
# messages on the screen, and the results will be: nothing.
# . system pp -M $SUBDIR1::foo_1 -M $SUBDIR2::bar_1 foo.pl
# An a.exe is created on windows
# . pipe 'a' and collect the results.
# . The result contain "hello_foo" and "hello_bar".
#
# Success if as described above. Failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $foo_dir = File::Spec->catdir($test_dir, $SUBDIR1);
my $bar_dir = File::Spec->catdir($test_dir, $SUBDIR2);
my $subdir_foo_file = File::Spec->catfile($foo_dir, "foo_1\.pm");
my $print_cannot_locate_message = $FALSE;
#..............................................
my $foo_top_of_file_text = '
use ' . $SUBDIR1 . '::foo_1;
use ' . $SUBDIR2 . '::bar_1;
foo_1;
bar_1;
';
#..............................................
my $foo_1_top_of_file_text = '
package ' . $SUBDIR1 . '::foo_1;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("foo_1");
sub foo_1 {
print ("hello_foo");
}
1;
';
#..............................................
my $bar_1_top_of_file_text = '
package ' . $SUBDIR2 . '::bar_1;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("bar_1");
sub bar_1 {
print ("hello_bar");
}
1;
';
#..............................................
my $further_subdir = "";
$$message_ref = "";
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg230: sub $test_name_string cannot" .
" chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $subdir_foo_file,
"",
$verbose,
$message_ref,
$foo_1_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg232: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($bar_dir, "bar_1\.pm"),
"",
$verbose,
$message_ref,
$bar_1_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg234: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($test_dir, "foo\.pl"),
"",
$verbose,
$message_ref,
$foo_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg236: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg238: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello_foohello_bar",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
$cmd = "$RUN_PP -M ${SUBDIR1}::foo_1 -M ${SUBDIR2}::bar_1 foo.pl";
if (system("$cmd")) {
$$message_ref = "\namsg240: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello_foohello_bar",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$a_default_executable,
"hello_foohello_bar",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$subdir_foo_file,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello_foohello_bar",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
return ($error);
#.................................................................
}
#########################################################################
#########################################################################
sub pp_minus_X_module_foo {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$foo_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of 'pp -X Foo::Bar foo'
# ----
# The command should: Exclude a module (notice space after -X)
#
# Outline
# -------
# . Create the perl file test_X_foo_bar with code that will utilize
# the module "basename". That is, use File::Basename;
# . Have the line "print basename($^X)" in the perl file
# to invoke basename.
# . system "pp -X File::Basename test_X_foo_bar".
# . pipe the created 'a' and collect the results.
# .
# Success if the first result is "perl.exe" on Windows, and success
# if it fails to give "perl.exe" the second time.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
#..............................................
my $foo_top_of_file_text = '
use File::Basename;
my $basename = basename($^X);
print $basename;
';
#..............................................
my $further_subdir = "";
#..............................................
$$message_ref = "";
print ("\n\nI will do test $test_name_string even though it DOES NOT \n");
print ("REALLY TEST ANYTHING. At least it may show that the -X \n");
print ("switch does not harm anything.\n\n");
#..............................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg270: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($test_dir, $foo_pl_file),
"",
$verbose,
$message_ref,
$foo_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg282: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP \"" . File::Spec->catfile($test_dir, $foo_pl_file) . '"';
if (system("$cmd")) {
$$message_ref = "\namsg284: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
'perl',
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#.................................................................
$cmd = "$RUN_PP -X File::Basename \""
. File::Spec->catfile($test_dir, $foo_pl_file) . '"';
if (system("$cmd")) {
$$message_ref = "\namsg286: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n");
}
}
#.................................................................
# Note: If Basename were really excluded this would fail.
# But it doesn't!!!
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
'perl',
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
return ($error);
}
#########################################################################
sub pp_minus_r_hello {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of 'pp -r hello.pl'
# ----
# The command should: Pack hello.pl into a.exe, and then run a.exe
# after packaging it.
#
# Outline
# -------
# . Create the perl file hello.pl with code that will print "hello".
# . pipe "pp -r hello.pl" and collect the results.
#
# Success if "hello", failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
#..............................................
my $hello_top_of_file_text = '
print "hello";
';
#..............................................
$$message_ref = "";
#..............................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg300: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $hello_pl_file,
"",
$verbose,
$message_ref,
$hello_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg302: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$pipe_command_string = "$RUN_PP -r \"$hello_pl_file\"";
$cmd = $pipe_command_string; # Just to keep our code
# template here consistent.
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
"", # No separate executable name this time
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
#.................................................................
return ($error);
}
#########################################################################
sub pp_minus_r_hello_a_b_c {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of 'pp -r hello.pl a b c'
# ----
# The command should: Pack hello.pl into a.exe, and then run a.exe
# after packaging it. The a b c are parameters.
#
# Outline
# -------
# . Create the perl file hello.pl with code that will print "hello".
# . pipe "pp -r hello.pl" and collect the results.
#
# Success if "hello", failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
#..............................................
my $hello_top_of_file_text = '
print "hello $ARGV[0] $ARGV[1] $ARGV[2]";
';
#..............................................
$$message_ref = "";
#..............................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg304: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $hello_pl_file,
"",
$verbose,
$message_ref,
$hello_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg306: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$pipe_command_string =
"$RUN_PP -r \"$hello_pl_file\" \"one\" \"two\" \"three\"";
$cmd = $pipe_command_string; # Just to keep our code
# template here consistent.
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
"", # No separate executable name this time
"hello one two three",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
#.................................................................
return ($error);
}
#########################################################################
sub pp_hello_to_log_file {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of 'pp hello.pl --log=c' and 'pp -L c hello.pl'
# ----
# The command should: Pack hello.pl into a.exe, and then run a.exe
# after packaging it. The a b c are parameters.
#
# Outline
# -------
# . Create the perl file hello.pl with code that will print "hello".
# . pipe "pp hello.pl --log=c" and collect the results.
#
# THIS IS A DO-NOTHING TEST ... SO FAR ...
# At least it will show that --log=c does no harm
#
# Success if "hello", failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $log_file = 'c.txt';
my $print_cannot_locate_message = $FALSE;
#..............................................
my $hello_top_of_file_text = '
print "hello";
';
#..............................................
$$message_ref = "";
print ("\n\nI will do test $test_name_string even though it DOES NOT \n");
print ("REALLY TEST ANYTHING. At least it may show that the --log=c \n");
print ("switch does not harm anything.\n\n");
#..............................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg308: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $hello_pl_file,
"",
$verbose,
$message_ref,
$hello_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg310: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP hello.pl -v --log=$log_file";
if (system("$cmd")) {
$$message_ref = "\namsg312: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n");
}
}
#..........................................................
if (-e($log_file) && (-s($log_file) > 10)) {
if ($verbose) {
print ("The log file $log_file has lines in it\n");
}
} else {
$$message_ref =
"sub ${test_name_string}_$sub_test command $cmd \n" .
"did not produce file $log_file or $log_file does not have " .
"more than 10 bytes in it\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return ($error);
}
#..........................................................
if (!(unlink($a_default_executable))) {
$$message_ref =
"Test ${test_name_string}_$sub_test " .
"cannot remove file $a_default_executable\n";
return(EXIT_FAILURE);
}
#..........................................................
$log_file = 'd.txt';
$cmd = "$RUN_PP -L $log_file -v hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg314: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n");
}
}
#..........................................................
if (-e($log_file) && (-s($log_file) > 10)) {
if ($verbose) {
print ("The log file $log_file has lines in it\n");
}
} else {
$$message_ref =
"sub ${test_name_string}_$sub_test command $cmd \n" .
"did not produce file $log_file or $log_file does not have " .
"more than 10 bytes in it\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
#.................................................................
return ($error);
}
#########################################################################
sub pp_name_four_ways {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of four ways to name the created executable
# ----
#
# % pp hello.pl (produces default a.exe on windows)
# % pp -o output1.exe hello.pl
# % pp --output output2.exe hello.pl
# % pp --output=output3.exe hello.pl
#
# . Create the file hello.pl that will print "hello".
# . system "pp hello.pl"
# . system "pp -o output1.exe hello.pl"
# . system "--output output2.exe hello.pl"
# . system "--output=output3.exe hello.pl"
# . pipe each of the three executables, one at a time,
# and collect the results. Each should be "hello".
# . Get the size of the executables.
# . Compare the sizes. They should all be the same size.
#
# Success if "hello" in each case, failure otherwise.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
#..............................................
my $hello_top_of_file_text = '
print "hello";
';
#..............................................
$$message_ref = "";
#..............................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg320: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( $hello_pl_file,
"",
$verbose,
$message_ref,
$hello_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg322: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg324: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/$a_default_executable\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$a_default_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg326: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP -o output1.exe hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg328: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/output1.exe\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'output1.exe',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP --output output2.exe hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg340: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/output2.exe\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'output2.exe',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce output2.exe?\n";
return (EXIT_FAILURE);
}
#..........................................................
$cmd = "$RUN_PP --output=output3.exe hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg342: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/output3.exe\n");
}
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
'output3.exe',
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $a_default_executable?\n";
}
#..........................................................
return ($error);
}
#########################################################################
sub pp_minus_v_tests {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$a_default_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test -v with no arguements, with some other parameter, too,
# in many different ways.\
#
# pp -v 1 hello.pl > v_1.txt
# pp -v 2 hello.pl > v_2.txt
# pp -v 3 hello.pl > v_3.txt
#
# pp -v hello.pl > v.txt
# pp -vv hello.pl > vv.txt
# pp -vvv hello.pl > vvv.txt
#
# pp -o hello.exe -v hello.pl > o_v.txt
# pp -o hello.exe -vv hello.pl > o_vv.txt
# pp -o hello.exe -vvv hello.pl > o_vvv.txt
#
# pp -o hello.exe -v 1 hello.pl > o_v_1.txt
# pp -o hello.exe -v 2 hello.pl > o_v_2.txt
# pp -o hello.exe -v 3 hello.pl > o_v_3.txt
#
# pp -v 1 hello.pl -o hello.exe > v_1_h_o.txt
# pp -v 2 hello.pl -o hello.exe > v_2_h_o.txt
# pp -v 3 hello.pl -o hello.exe > v_3_h_o.txt
#
# . Create the file hello.pl with the code that will print out "hello".
# . For each of the above shown five sets of three commands:
# . "system" the commands, which capture the outputs in the
# shown .txt files.
# . Examine the three created text files for each set of five,
# for the patterns shown below.
#
# For v 1
# pp:\s+Packing\s+hello.pl
# pp:\s+ Running.*parl\w*.exe
# For v 2
# pp:\s+Packing\s+hello.pl
# pp:\s+Writing\s+PAR\s+on
# pp:\s+ Running.*parl\w*.exe
# For v 3
# pp:\s+Packing\s+hello.pl
# pp:\s+Writing\s+PAR\s+on
# pp:.* making\s+MANIFEST
# pp:\s+ Running.*parl\w*.exe
#
#
# . pipe the created executable and collect the results.
# . If the created text file has an "o" in it,
# pipe hello.exe on Windows.
# Otherwise pipe just a.exe on windows.
#
# Hello should be the result in each case.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "";
my $cmd = "";
my $at_least_one_line_not_found = $FALSE;
my $MODULUS = 3;
my $max_command_strings = "";
my $i;
my $command_string = "";
my $text_file_to_examine = "";
my $modulus_result = "";
my @expected_lines = ();
my $line = "";
my $all_lines = ();
my $test_and_sub_test = "00_00";
my $file_to_send_to_pipe = "";
my @converted_array = ();
my $print_cannot_locate_message = $FALSE;
#..............................................
my $hello_top_of_file_text = '
print "hello";
';
#..............................................
my @command_strings = (
"$RUN_PP -v 1 hello.pl > v_1.txt",
"$RUN_PP -v 2 hello.pl > v_2.txt",
"$RUN_PP -v 3 hello.pl > v_3.txt",
"$RUN_PP -v hello.pl > v.txt",
"$RUN_PP -vv hello.pl > vv.txt",
"$RUN_PP -vvv hello.pl > vvv.txt",
"$RUN_PP -o hello.exe -v hello.pl > o_v.txt",
"$RUN_PP -o hello.exe -vv hello.pl > o_vv.txt",
"$RUN_PP -o hello.exe -vvv hello.pl > o_vvv.txt",
"$RUN_PP -o hello.exe -v 1 hello.pl > o_v_1.txt",
"$RUN_PP -o hello.exe -v 2 hello.pl > o_v_2.txt",
"$RUN_PP -o hello.exe -v 3 hello.pl > o_v_3.txt",
"$RUN_PP -v 1 hello.pl -o hello.exe > v_1_h_o.txt",
"$RUN_PP -v 2 hello.pl -o hello.exe > v_2_h_o.txt",
"$RUN_PP -v 3 hello.pl -o hello.exe > v_3_h_o.txt",
);
if ($os !~ m/^Win|cygwin/i) {
@converted_array = ();
foreach $command_string (@command_strings) {
$command_string =~ s/hello.exe/hello.out/g;
push(@converted_array, ($command_string));
}
@command_strings = ();
push(@command_strings, @converted_array);
}
my @text_files_to_examine = (
'v_1.txt',
'v_2.txt',
'v_3.txt',
'v.txt',
'vv.txt',
'vvv.txt',
'o_v.txt',
'o_vv.txt',
'o_vvv.txt',
'o_v_1.txt',
'o_v_2.txt',
'o_v_3.txt',
'v_1_h_o.txt',
'v_2_h_o.txt',
'v_3_h_o.txt',
);
my @results_to_expect_v = (
'pp:\s+Packing\s+hello.pl',
'pp:\s+Running.*parl\w*\.exe',
);
my @results_to_expect_vv = (
'pp:\s+Packing\s+hello.pl',
'pp:\s+Writing\s+PAR\s+on',
'pp:\s+Running.*parl\w*\.exe',
);
my @results_to_expect_vvv = (
'pp:\s+Packing\s+hello.pl',
'pp:\s+Writing\s+PAR\s+on',
'pp:.*ing\s+MANIFEST',
'pp:\s+Running.*parl\w*\.exe',
);
#............. Remove the ".exe" parts if not Windows
if ($os !~ m/^Win|cygwin/i) {
@converted_array = ();
foreach $line (@results_to_expect_v) {
$line =~ s/parl\\w\*\\\.exe/\\bparl\\w*\\b/g;
push(@converted_array, ($line));
}
@results_to_expect_v = @converted_array;
}
if ($os !~ m/^Win|cygwin/i) {
@converted_array = ();
foreach $line (@results_to_expect_vv) {
$line =~ s/parl\\w\*\\\.exe/\\bparl\\w*\\b/g;
push(@converted_array, ($line));
}
@results_to_expect_vv = @converted_array;
}
if ($os !~ m/^Win|cygwin/i) {
@converted_array = ();
foreach $line (@results_to_expect_vvv) {
$line =~ s/parl\\w\*\\\.exe/\\bparl\\w*\\b/g;
push(@converted_array, ($line));
}
@results_to_expect_vvv = @converted_array;
}
#..........................................................
$max_command_strings = @command_strings;
$$message_ref = "";
#..........................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg344: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#..........................................................
$error = create_file( File::Spec->catfile($test_dir, $hello_pl_file),
"",
$verbose,
$message_ref,
$hello_top_of_file_text,
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\nsub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#..........................................................
for ($i = 0; $i < $max_command_strings; $i++) {
@expected_lines = ();
$all_lines = ();
$at_least_one_line_not_found = $FALSE;
$test_and_sub_test = $test_number . '_' . $i;
$text_file_to_examine = $text_files_to_examine[$i];
if ($verbose) {
print ("\n\nAbout to test $test_and_sub_test: ");
print ("$test_name_string\n\n");
print ("Text file to examine is $text_file_to_examine\n");
}
#..........................................................
# Remove any executables from prior iterations
if ($text_file_to_examine =~ m/o/) {
$file_to_send_to_pipe = $hello_executable;
if (-e($hello_executable)) {
# Remove any executables from prior sub tests
if (!(unlink($hello_executable))) {
$$message_ref = "\namsg346: " .
"Test $test_and_sub_test: $test_name_string " .
"cannot remove file $hello_executable\n";
return(EXIT_FAILURE);
}
} # exists
} else {
if (-e($a_default_executable)) {
# Remove any executables from prior sub tests
if (!(unlink($a_default_executable))) {
$$message_ref = "\namsg348: " .
"Test $test_and_sub_test: $test_name_string " .
"cannot remove file $a_default_executable\n";
return(EXIT_FAILURE);
}
} # exists
$file_to_send_to_pipe = $a_default_executable;
}
#..........................................................
$cmd = $command_strings[$i];
if (system("$cmd")) {
$$message_ref = "\namsg350: sub ${test_name_string}_$test_and_sub_test" .
" cannot system $cmd\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string ");
print ("Hopefully, \"$cmd\" created $test_dir/");
if ($text_file_to_examine =~ m/o/) {
print ("$hello_executable\n");
} else {
print ("$a_default_executable\n");
}
}
}
#..........................................................
if ( ($i % $MODULUS) == 0) {
push(@expected_lines, (@results_to_expect_v));
} elsif ( ($i % $MODULUS) == 1) {
push(@expected_lines, (@results_to_expect_vv));
} else {
push(@expected_lines, (@results_to_expect_vvv));
}
#..........................................................
# Get the results from the created text file.
$text_file_to_examine = $text_files_to_examine[$i];
if (-e($text_file_to_examine)) {
if (open (FH, "$text_file_to_examine")) {
# Slurp in all the lines of the file at once
local $/; $all_lines = <FH>;
if (!(close(FH))) {
$$message_ref = "\namsg352: " .
"Something is wrong with test $test_name_string " .
"in directory $test_dir\n" .
"File $text_file_to_examine exists, and I opened it, " .
"but now I cannot close it.\n" .
"Cannot continue with test $test_name_string\n";
return (EXIT_FAILURE);
}
} else {
$$message_ref = "\namsg354: " .
"Something is wrong with test $test_name_string " .
"in directory $test_dir\n" .
"File $text_file_to_examine exists but I cannot open it.\n" .
"Cannot continue with test $test_name_string\n";
return (EXIT_FAILURE);
}
} else {
$$message_ref = "\namsg356: " .
"Something is wrong with test $test_name_string " .
"in directory $test_dir\n" .
"Command $cmd did not create file $text_file_to_examine\n" .
"Cannot continue with test $test_name_string\n";
return (EXIT_FAILURE);
}
#..........................................................
# By this time, I have opened the text file, extracted
# all of the lines into $all_lines, and closed the file.
#..........................................................
foreach $line (@expected_lines) {
if ($all_lines !~ m!$line!gm) {
$at_least_one_line_not_found = $TRUE;
print ("Line $line does not match\n") if ($verbose);
}
}
#..........................................................
if ($at_least_one_line_not_found) {
$$message_ref = "\namsg358: " .
"Something is wrong with test $test_name_string " .
"in directory $test_dir\n" .
"Command $cmd did provide the expected results in file " .
"$text_file_to_examine.\n I expected matches to regexp \n" .
"@expected_lines" .
"\nbut instead got \n$all_lines\n" .
"Cannot continue with test $test_name_string\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("Test $test_name_string, command $cmd, \n");
print ("file $text_file_to_examine ");
print ("had the expected results. \.\.\. passed so far ");
print ("\.\.\.\n");
}
}
#..........................................................
# Now to see if the created executable works
$error = pipe_a_command
(
$test_number,
$i,
$test_name_string,
$test_dir,
$pipe_command_string,
$file_to_send_to_pipe,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
" Test $test_and_sub_test \n" . $$message_ref .
"\nDid $cmd produce $file_to_send_to_pipe?\n";
return ($error);
}
#.................................................................
} # for $i
#..........................................................
return (EXIT_SUCCESS);
}
#########################################################################
sub pp_minus_V {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test -V and of --version
# ----
#
# Outline
# -------
# . pipe "pp -V" and collect the results.
# . The string
# "Such use shall not be construed as a distribution"
# should be part of what was collected.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string_big_V = "$RUN_PP -V";
my $pipe_command_string_minus_minus = "$RUN_PP --version";
my $sub_test = 0;
my $expected_string =
"Such use shall not be construed as a distribution";
my $cmd = "";
my $print_cannot_locate_message = $FALSE;
#..........................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg360: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$cmd = $pipe_command_string_big_V; # Keeps template the same
# as possible.
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string_big_V,
"",
$expected_string,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $expected_string?\n";
return (EXIT_FAILURE);
}
#.................................................................
$cmd = $pipe_command_string_minus_minus; # Keeps template the
# same as possible.
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string_minus_minus,
"",
$expected_string,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $expected_string?\n";
return (EXIT_FAILURE);
}
#.................................................................
return ($error);
#.................................................................
}
#########################################################################
sub pp_help_tests {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of 'pp -h' and of 'pp --help'
# ----
# The help screen should be shown.
#
# Outline
# -------
# . pipe "pp -h" and collect the results
# . The string "PAR Packager" should have been collected.
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $pipe_command_string = "$RUN_PP -h";
my $sub_test = 0;
my $expected_string = 'PAR Packager';
my $print_cannot_locate_message = $FALSE;
#..........................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg370: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
"",
$expected_string,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
"\nTest ${test_number}_$sub_test \n" . $$message_ref;
return ($error);
}
#.................................................................
$pipe_command_string = "$RUN_PP --help";
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
"",
$expected_string,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
"\nTest ${test_number}_$sub_test \n" . $$message_ref;
}
return ($error);
#.................................................................
}
#########################################################################
sub test_par_clean {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test PAR_GLOBAL_CLEAN with different parameters
# ----
# Notes: PAR_GLOBAL_CLEAN overides -C. If you set
# PAR_GLOBAL_CLEAN to 1 or 0, -C doesn't do anything.
# If -C does work, it creates temp-pid dirs, not
# cache-sha1 dirs (important for how_many_cache_dirs()).
#
# Outline
# -------
# . Compute the name of the par scratchpad directory.
# . Try to delete each PAR cache directory
# . Skip over the ones that cannot be deleted. It usually
# means that they are in use. i.e. another PAR application
# is running.
# . $leftover = Count of the cache directories that are left.
#
# . Create hello.pl with the code that will print out the word "hello".
# .
# . Set PAR_GLOBAL_CLEAN = 0
# . system pp -o hello hello.pl
# . pipe the hello executable and collect the results.
# . Success if "hello"
# . There should be 2 + $leftover cache directories.
# .
# . Again, remove the cache dirs that we can, and
# count up $left_over_cache_dirs.
# . Set PAR_GLOBAL_CLEAN = 1
# . Rerun (system and pipe) the above test
# . There should be 0 + $leftover cache directories.
# .
# . Again, remove the cache dirs that we can, and
# count up $left_over_cache_dirs.
# . Test when perl was built as shared library
# . Set PAR_GLOBAL_CLEAN = 0
# . system pp -d -o hello hello.pl
# . Pipe the hello executable and collect the results.
# . Success if "hello"
# . There should be 2 + $leftover cache directories.
#
# . Again, remove the cache dirs that we can, and
# count up $left_over_cache_dirs.
# . Test when perl was built as shared library
# . Set PAR_GLOBAL_CLEAN = 1
# . Rerun (system and pipe) the above test
# . There should be 0 + $leftover cache directories.
# .
# . Again, remove the cache dirs that we can, and
# count up $left_over_cache_dirs.
# . Set PAR_GLOBAL_CLEAN = 0
# . system pp -C -o hello hello.pl
# . pipe the hello executable and collect the results.
# . Success if "hello"
# . There should be 0 + $leftover cache directories.
# .
# . Again, remove the cache dirs that we can, and
# count up $left_over_cache_dirs.
# . Set PAR_GLOBAL_CLEAN = 1
# . Rerun the above system and pipe test
# . There should be 0 + $leftover cache directories.
# .
# . Again, remove the cache dirs that we can, and
# count up $left_over_cache_dirs.
# . Test when perl was built as shared library
# . Set PAR_GLOBAL_CLEAN = 0
# . system pp -C -d -o hello hello.pl
# . Since PAR_GLOBAL_CLEAN exists, the -C will do NOTHING!
# Hence a cache dir will be produced.
# . Delete PAR_GLOBAL_CLEAN
# . pipe the hello executable and collect the results.
# . Since PAR_GLOBAL_CLEAN does not exist, the -C will
# have its expected effect, and NOT produce a cache.
# . Success if "hello"
# . There should be 1 + $leftover cache directories.
# .
# . Again, remove the cache dirs that we can, and
# count up $left_over_cache_dirs.
# . Test when perl was built as shared library
# . Set PAR_GLOBAL_CLEAN = 1
# . Rerun (system and pipe) the above test
# . There should be 0 + $leftover cache directories.
# .
# . Reset Set PAR_GLOBAL_CLEAN to 0 so as to not interfere
# with future tests.
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $sub_test = 0;
my $test_file = $hello_pl_file;
my $pipe_command_string = "";
my $cmd = "";
my $number_of_cache_dirs = 0;
my $message = "";
my $par_scratch_dir = find_par_temp_base($verbose);
my $print_cannot_locate_message = $FALSE;
my $ignore_errors = $TRUE;
my $left_over_cache_dirs = 0;
my $should_be_cache_dirs = 0;
#..........................................................
$$message_ref = "";
#..........................................................
print ("\namsg445: Removing $par_scratch_dir caches\n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
if ($error) {
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests.
return(EXIT_FAILURE);
}
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg446: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
print ("\namsg447: There are $left_over_cache_dirs cache dirs left\n") if $verbose;
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg448: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return (EXIT_FAILURE);
}
print ("amsg450:chdir to $test_dir\n") if ($verbose);
#.................................................................
$error = create_file($test_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg451: sub $test_name_string: $$message_ref";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return (EXIT_FAILURE);
}
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 0;
#.................................................................
$cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("\namsg452: About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg453:sub $test_name_string cannot system $cmd\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return (EXIT_FAILURE);
}
print ("amsg454: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg455:Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
#.................................................................
$error = how_many_cache_dirs($par_scratch_dir,
\$number_of_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg456: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
$should_be_cache_dirs = 2 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg457:There should be no more than $should_be_cache_dirs " .
"cache dirs, \n but there are $number_of_cache_dirs instead\n";
return(EXIT_FAILURE);
}
#.................................................................
#######################
# Next sub test
#######################
#.................................................................
print ("amsg458: Removing $par_scratch_dir caches\n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
if ($error) {
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests.
return(EXIT_FAILURE);
}
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg460: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 1;
#.................................................................
$cmd = "$RUN_PP -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("\namsg461: About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg462:sub $test_name_string cannot system $cmd\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return (EXIT_FAILURE);
}
print ("amsg463: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg466:Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
#.................................................................
$error = how_many_cache_dirs($par_scratch_dir,
\$number_of_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg470: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
$should_be_cache_dirs = 0 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg472:There should be no more than $should_be_cache_dirs " .
"cache dirs, \nbut there are $number_of_cache_dirs instead\n";
return(EXIT_FAILURE);
}
#.................................................................
#######################
# Next sub test
#######################
#.................................................................
print ("amsg474:Removing $par_scratch_dir caches\n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
if ($error) {
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests.
return(EXIT_FAILURE);
}
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg480: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
#.................................................................
if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) {
# Perl was built as shared library, so the -d option is valid.
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 0;
#.................................................................
$cmd = "$RUN_PP -d -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("\namsg482: About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg484: sub $test_name_string " .
"cannot system $cmd\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return (EXIT_FAILURE);
}
print ("amsg485: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg486:Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
#.................................................................
$error = how_many_cache_dirs($par_scratch_dir,
\$number_of_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg487: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
$should_be_cache_dirs = 2 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg488:There should be no more than $should_be_cache_dirs " .
"cache dirs\nbut there are $number_of_cache_dirs instead\n";
return(EXIT_FAILURE);
}
#.................................................................
} # shared lib
#######################
# Next sub test
#######################
#.................................................................
print ("amsg489:Removing $par_scratch_dir caches\n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs, # This is what we want
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg490: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
#.................................................................
if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) {
# Perl was built as shared library, so the -d option is valid.
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 1;
#.................................................................
$cmd = "$RUN_PP -d -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("\namsg491: About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg492:sub $test_name_string " .
"cannot system $cmd\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return (EXIT_FAILURE);
}
print ("amsg493: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg494: Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
#.................................................................
$error = how_many_cache_dirs($par_scratch_dir,
\$number_of_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg498: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
$should_be_cache_dirs = 0 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg500:There should be no more than $should_be_cache_dirs " .
"cache dirs, \nbut there are $number_of_cache_dirs instead\n";
return(EXIT_FAILURE);
}
#.................................................................
} # Perl was built as shared library
#######################
# Next sub test
#######################
#.................................................................
print ("amsg502: Removing $par_scratch_dir caches\n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
if ($error) {
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests.
return(EXIT_FAILURE);
}
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg504: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 0;
#.................................................................
# Careful! The -C should clean the cache
$cmd = "$RUN_PP -C -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("\namsg505: About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg506:sub $test_name_string " .
"cannot system $cmd\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return (EXIT_FAILURE);
}
print ("amsg508: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
# This, too, should clean the cache due to the -C flag.
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg510: Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
$should_be_cache_dirs = 0 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg511: There should be no more than $should_be_cache_dirs " .
"cache dirs\nbut there are $number_of_cache_dirs instead\n";
return(EXIT_FAILURE);
}
#.................................................................
#######################
# Next sub test
#######################
#.................................................................
print ("amsg518: Removing $par_scratch_dir caches\n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
if ($error) {
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests.
return(EXIT_FAILURE);
}
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg520: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 1;
#.................................................................
$cmd = "$RUN_PP -C -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("\bamsg521: About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg522:sub $test_name_string " .
"cannot system $cmd\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return (EXIT_FAILURE);
}
print ("amsg524: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg526: Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
#.................................................................
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg530: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
$should_be_cache_dirs = 0 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg532:There should be no more than $should_be_cache_dirs " .
"cache dirs, \nbut there are $number_of_cache_dirs instead\n";
return(EXIT_FAILURE);
}
#.................................................................
#######################
# Next sub test
#######################
#.................................................................
print ("amsg534: Removing $par_scratch_dir caches \n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
if ($error) {
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests.
return(EXIT_FAILURE);
}
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg536: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
print ("\namsg537: There are $left_over_cache_dirs cache dirs\n") if $verbose;
#.................................................................
if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) {
# Perl was built as shared library, so the -d option is valid.
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 0;
#.................................................................
###################################################################
# Here, $ENV{PAR_GLOBAL_CLEAN} exists, so -C will do NOTHING!!!
# Hence we will get a cache from the system command
###################################################################
$cmd = "$RUN_PP -C -d -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("About to $cmd with PAR_GLOBAL_CLEAN = 0\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg538:sub $test_name_string " .
"cannot system $cmd\n";
return (EXIT_FAILURE);
}
print ("amsg540: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
delete $ENV{PAR_GLOBAL_CLEAN};
###################################################################
# Here, $ENV{PAR_GLOBAL_CLEAN} does NOT exist, so -C WILL work!!!
# Hence we will NOT get a cache from the piped command
###################################################################
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
$ENV{PAR_GLOBAL_CLEAN} = 0;
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg542: Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
#.................................................................
$error = how_many_cache_dirs($par_scratch_dir,
\$number_of_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg546: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
$should_be_cache_dirs = 1 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg548:There should be no more than $should_be_cache_dirs \n" .
"cache dirs,\nbut there are $number_of_cache_dirs instead\n" .
"\$left_over_cache_dirs is $left_over_cache_dirs\n";
return(EXIT_FAILURE);
}
#.................................................................
}
#######################
# Next sub test
#######################
#.................................................................
print ("amsg550: Removing $par_scratch_dir caches\n") if $verbose;
$error = deltree($par_scratch_dir, 0, $message_ref, $ignore_errors);
if ($error) {
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests.
return(EXIT_FAILURE);
}
$error = how_many_cache_dirs($par_scratch_dir,
\$left_over_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg552: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
print ("\namsg553: There are $left_over_cache_dirs cache dirs\n") if $verbose;
#.................................................................
$ENV{PAR_GLOBAL_CLEAN} = 1;
# Since $ENV{PAR_GLOBAL_CLEAN} is 1, the -C should do NOTHING.
#.................................................................
#.................................................................
if ( $Config{useshrplib} and ($Config{useshrplib} ne 'false') ) {
# Perl was built as shared library, so the -d option is valid.
#.................................................................
$cmd = "$RUN_PP -C -d -o \"$hello_executable\" \"$hello_pl_file\" ";
print ("About to $cmd with PAR_GLOBAL_CLEAN = 1\n") if ($verbose);
if (system("$cmd")) {
$$message_ref = "\namsg554:sub $test_name_string " .
"cannot system $cmd\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return (EXIT_FAILURE);
}
print ("amsg556: sub $test_name_string did $cmd \n") if ($verbose);
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
"hello",
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\namsg558: Did $cmd produce $hello_executable?\n";
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
return ($error);
}
#.................................................................
$error = how_many_cache_dirs($par_scratch_dir,
\$number_of_cache_dirs,
$message_ref,
$verbose);
if ($error == EXIT_FAILURE) {
$$message_ref = $$message_ref .
"\namsg562: Error from call to how_many_cache_dirs\n";
$ENV{PAR_GLOBAL_CLEAN} = 0;
return ($error);
}
$should_be_cache_dirs = 0 + $left_over_cache_dirs;
if ($number_of_cache_dirs > $should_be_cache_dirs) {
$$message_ref =
"\namsg564:There should be no more than $should_be_cache_dirs " .
"cache dirs, \nbut there are $number_of_cache_dirs instead\n";
return(EXIT_FAILURE);
}
$ENV{PAR_GLOBAL_CLEAN} = 0; # Do not interfere with future tests
#.................................................................
return(EXIT_SUCCESS);
#.................................................................
}
}
#########################################################################
#########################################################################
sub pp_gui_tests {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$orig_dir,
$hello_pl_file,
$hello_executable,
$verbose,
$message_ref,
$no_win32_exe,
) = @_;
#--------------------------------------------------------------------
# Goal: Test of 'pp --gui -o hello.exe hello.pl'
# ----
#
# Outline
# -------
# . Create the file hello.pl with code that will print "hello".
# . Build the out.exe with
# pp --gui -o out.exe hello.pl
# . Test the out.exe for gui. We can use Win32::Exe
# itself to inspect the GUI of the resulting
# exe, so the snippet below should do:
#
# my $exe = Win32::Exe->new('out.exe');
# is($exe->Subsystem, 'windows');
# Success if true in both cases, failure otherwise. #
#
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $cmd = "$RUN_PP --gui -o $hello_executable $hello_pl_file";
my $sub_test = 0;
my $file_to_copy = "";
my $exe = "";
my $FALSE = 0;
my $test_file = $hello_pl_file;
my $print_cannot_locate_message = $FALSE;
print ("orig_dir is $orig_dir\n") if $verbose;
#..........................................................
if ($os !~ m/^Win/i) {
print ("Test $test_name_string not done on OS: $os\n");
return(EXIT_SUCCESS);
} else {
if ($no_win32_exe) {
print ("Test $test_name_string not run because ");
print ("Win32-Exe is not present\n");
return (EXIT_SUCCESS);
}
}
#..........................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg566: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
if ($verbose) {
print ("chdir to $test_dir\n");
}
#.................................................................
$error = create_file($test_file, "hello", $verbose, $message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\npgt_msg570: sub $test_name_string: $$message_ref";
return (EXIT_FAILURE);
}
#.................................................................
if (system("$cmd")) {
$$message_ref = "\namsg572: sub $test_name_string cannot system $cmd:$!:\n";
return (EXIT_FAILURE);
} else {
if ($verbose) {
print ("sub $test_name_string did $cmd ");
}
}
#.................................................................
$exe = Win32::Exe->new($hello_executable);
if ($exe->Subsystem ne 'windows') {
$$message_ref = $$message_ref . "amsg576: sub $test_name_string " .
": exe->Subsystem is not windows\n";
return (EXIT_FAILURE)
}
return (EXIT_SUCCESS);
#.................................................................
}
########################################################################
sub create_small_minus_a_pl_file {
my ($test_name_string,
$sub_test,
$verbose,
$hello_pl_file,
$modified_fqpn,
$message_ref) = @_;
$$message_ref = "";
my $error;
if ($verbose) {
print ("amsg580: sub create_small_minus_a_pl_file has \n");
print ("test_name_string is $test_name_string\n");
print ("sub_test is $sub_test\n");
print ("hello_pl_file is $hello_pl_file\n");
print ("modified_fqpn is $modified_fqpn\n");
}
#......................................................................
my $pl_verbiage =
'#!/usr/bin/perl' . "\n" .
'use PAR;' . "\n" .
'my $line;' . "\n" .
"\n" .
'my $text = "";' . "\n" .
'$text = PAR::read_file("' . quotemeta($modified_fqpn) . '");' . "\n" .
"\n" .
'print($text);' . "\n" .
"\n";
#......................................................................
$error = create_file($hello_pl_file,
"",
$verbose,
$message_ref,
$pl_verbiage);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg582: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
return(EXIT_SUCCESS);
}
#########################################################################
sub pp_test_small_minus_a {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test the small -a flag
# ----
#
# Outline
# -------
# First Pass Outline
# ------------------
# . Run two groups of tests, four total subtests
# ........................................................................
# . my $text = PAR::read_file("a/small_a/text");
# . Test the above line to work with
# pp -o hello.exe -a c:\a\small_a\text hello.pl
# or
# pp -o hello.exe -a c:/a/small_a/text hello.pl
# or
# pp -o hello.exe -a "c:/a/small_a/text;a/small_a/text" hello.pl
#
# . my $text = PAR::read_file("/a/small_a/text");
# . Test the above line to work with
# pp -o hello.exe -a "c:/a/small_a/text;/a/small_a/text" hello.pl
# ........................................................................
#
# Detailed Outline
# ----------------
# Note: "fqpn" means "fully qualified path name"
# Examples: Assume the text file c:\a\small_a\text
# $orig_fqpn = c:\a\small_a\text
# This is the original fqpn
# $forward_fqpn = c:/a/small_a/text
# This is the original fqpn with forward slashes
# $forward_with_slash_fqpn = /a/small_a/text
# This is forward_fqpn with no drive letter or colon
# $forward_no_slash_fqpn = a/small_a/text
# This is forward_fqpn with no drive letter,colon or first slash
# ..............................................................
# Preliminary things to be done:
# . Create the file $textfile, with a line of text ("hello").
# . Create $expected_results = "hello from open hello"
# . Create (As shown in Examples just above)
# . $orig_fqpn
# . $forward_fqpn,
# . $forward_with_slash_fqpn
# . $forward_no_slash_fqpn
# ..................
# . Create hello.pl file to look like this:
# my $text = PAR::read_file("$modified_fqpn");
# print($text);
# ..................
#
# ..............................................................
# First test group
# . Obtain $modified_fqpn = $forward_no_slash_fqpn,
# Test 1
# . system (pp -o hello.exe -a $orig_fqpn hello.pl);
# . Run hello.exe
# . Delete $textfile and run hello.exe again
# . Copy to, and run, hello.exe from a different directory
#
# Test 2
# . Recreate $textfile
# . system (pp -o hello.exe -a $forward_fqpn hello.pl);
# . Run hello.exe
# . Delete $textfile and run hello.exe again
# . Copy to, and run, hello.exe from a different directory
#
# Test 3
# . Recreate $textfile
# . system (pp -o hello.exe -a "$forward_fqpn;$forward_no_slash_fqpn" hello.pl);
# . Run hello.exe
# . Delete $textfile and run hello.exe again
# . Copy to, and run, hello.exe from a different directory
#
# ..............................................................
# Second test group
# . Obtain $modified_fqpn = $forward_with_slash_fqpn,
# Test 4
# . Make all of the slashes to be forward slashes.
# . Recreate $textfile
# . system (pp -o hello.exe -a "$forward_fqpn;$forward_with_slash_fqpn" hello.pl);
# . Run hello.exe
# . Delete $textfile and run hello.exe again
# . Copy to, and run, hello.exe from a different directory
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $test_file = $hello_pl_file;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
my $message = "";
my $expected_results = "hello";
my $textfile = File::Spec->catdir($test_dir, "text");
my $orig_fqpn = $textfile;
my $forward_fqpn;
my $forward_with_slash_fqpn;
my $forward_no_slash_fqpn;
my $modified_fqpn;
($forward_fqpn = $textfile) =~ s!\\!\/!g;
($forward_with_slash_fqpn = $forward_fqpn) =~ s!^\w:!!;
($forward_no_slash_fqpn = $forward_with_slash_fqpn) =~ s!^\/!!;
$modified_fqpn = $forward_no_slash_fqpn;
#.................................................................
if ($verbose) {
$message =
"\$textfile = $textfile\n" .
"\$orig_fqpn = $orig_fqpn\n" .
"\$forward_fqpn = $forward_fqpn\n" .
"\$forward_with_slash_fqpn = $forward_with_slash_fqpn\n" .
"\$forward_no_slash_fqpn = $forward_no_slash_fqpn\n" .
"\$$modified_fqpn = $modified_fqpn\n"
; #
print $message;
}
#.................................................................
$$message_ref = "";
#.................................................................
# Sub Test 1
#.................................................................
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg590: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($textfile, "", $verbose, $message_ref, "hello");
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg592: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$error = create_small_minus_a_pl_file ($test_name_string,
$sub_test,
$verbose,
$hello_pl_file,
$modified_fqpn,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg594: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -o $hello_executable -a \"$orig_fqpn\" hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg596: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$textfile,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
#.................................................................
# Sub Test 2
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg598: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($textfile, "", $verbose, $message_ref, "hello");
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg600: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -o $hello_executable -a \"$forward_fqpn\" hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg602: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$textfile,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR2,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
#.................................................................
# Sub Test 3
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg604: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($textfile, "", $verbose, $message_ref, "hello");
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg606: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -o $hello_executable -a \"$forward_fqpn;$forward_no_slash_fqpn\" hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg608: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$textfile,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR3,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
#.................................................................
# Second test group
# Sub Test 4
#.................................................................
$modified_fqpn = $forward_with_slash_fqpn;
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg610: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($textfile, "", $verbose, $message_ref, "hello");
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg614: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$error = create_small_minus_a_pl_file ($test_name_string,
$sub_test,
$verbose,
$hello_pl_file,
$modified_fqpn,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg616: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -o $hello_executable -a \"$forward_fqpn;$forward_with_slash_fqpn\" hello.pl";
if (system("$cmd")) {
$$message_ref = "\namsg618: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$textfile,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR4,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
#.................................................................
return (EXIT_SUCCESS);
#.................................................................
}
########################################################################
sub create_large_minus_a_pl_file {
my ($test_name_string,
$sub_test,
$verbose,
$hello_pl_file,
$all_text_files,
$message_ref) = @_;
$$message_ref = "";
my $error;
if ($verbose) {
print ("amsg630: sub create_large_minus_a_pl_file has \n");
print ("test_name_string is $test_name_string\n");
print ("sub_test is $sub_test\n");
print ("hello_pl_file is $hello_pl_file\n");
print ("all_text_files is $all_text_files\n");
}
$all_text_files =~ s!^\w:!!;
$all_text_files =~ s!^\\!!;
$all_text_files =~ s!\\\\!\/!g;
#......................................................................
my $pl_verbiage =
'#!/usr/bin/perl -w' . "\n" .
"\n" .
'use PAR;' . "\n" .
'use strict;' . "\n" .
"\n" .
'my @files = split "[\r\n]+", PAR::read_file("' . quotemeta($all_text_files) . '");' . "\n" .
"\n" .
'my $file = "";' . "\n" .
'my $text = "";' . "\n" .
'my $accumulated_text = "";' . "\n" .
'foreach $file (@files) {' . "\n" .
' $file =~ s!^\w:!!; ' . "\n" .
' $file =~ s!^\\\\!!;' . "\n" .
' $file =~ s!\\\\!\/!g;' . "\n" .
' $file =~ s!^\\/!!g;' . "\n" .
"\n" .
' $text = PAR::read_file("$file");' . "\n" .
' chomp($text);' . "\n" .
' $accumulated_text = $accumulated_text . $text;' . "\n" .
'}' . "\n" .
'print $accumulated_text;'
;
#......................................................................
$error = create_file($hello_pl_file,
"",
$verbose,
$message_ref,
$pl_verbiage);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg632: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
print ("\namsg634: sub create_large_minus_a_pl_file was successful\n") if $verbose;
return(EXIT_SUCCESS);
}
#########################################################################
sub pp_test_large_minus_A {
my (
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
$message_ref,
) = @_;
#--------------------------------------------------------------------
# Goal: Test the large -A flag
# ----
# First Pass Outline
# ------------------
# ........................................................................
# . my $text = PAR::read_file("path/list_file");
# . Test the above line to work with
# pp -o hello.exe -A list_file -a list_file hello.pl
# or
# pp -o hello.exe -A c:\path\list_file -a c:\path\list_file hello.pl
# or
# pp -o hello.exe -A c:/path/list_file -a c:\path\list_file hello.pl
# Note for PAR::read_file("path/list_file"): "path" does NOT
# contain the drive letter, colon or leading slash!!!
# ........................................................................
#
#
# Outline
# -------
# . Create the files (text1, text2) with a different line of
# text ("hello01", "hello02") in each.
# . Create a fourth text file, all_text_files, and
# list the full path names of the first two files in it.
#
# . Create the file hello.pl that will
# . PAR::read_file the file all_text_files and get the names
# of the two files.
# . For each of the two files,
# . Strip any leading drive letter and colon
# . Strip any leading back slash.
# . Convert remaining back slashes to forward slashes
# . PAR::read_file the file and get it's contents.
# . Print the acumulated contents
#
# . system (pp -o hello.exe -A list_file -a list_file hello.pl)
# . Run hello
# . Delete all text files.
# . Run hello again
# . Copy hello to a different directory and run it again
#
# . system (pp -o hello.exe -A c:\path\list_file -a c:\path\list_file hello.pl)
# . Run hello
# . Delete all text files.
# . Run hello again
# . Copy hello to a different directory and run it again
#
# . system (pp -o hello.exe -A c:/path/list_file -a c:/path/list_file hello.pl)
# . Run hello
# . Delete all text files.
# . Run hello again
# . Copy hello to a different directory and run it again
#
#--------------------------------------------------------------------
my $error = EXIT_FAILURE;
my $test_file = $hello_pl_file;
my $pipe_command_string = "";
my $cmd = "";
my $sub_test = 0;
my $print_cannot_locate_message = $FALSE;
my $all_text_files = "all_text_files";
my $all_text_files_fqpn = File::Spec->catdir($test_dir, $all_text_files);
my $expected_results = "hello01hello02";
# Note: The fully qualified path name must be given for PAR::read_file
my $textfile01 = File::Spec->catdir($test_dir, "text01");
my $textfile02 = File::Spec->catdir($test_dir, "text02");
my $all_text_files_verbiage = "$textfile01\n$textfile02\n";
#.................................................................
$$message_ref = "";
#.................................................................
if (!(chdir("$test_dir"))) {
$$message_ref = "\namsg638: sub $test_name_string cannot " .
"chdir $test_dir\n:$!:\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($textfile01, "", $verbose, $message_ref, "hello01");
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg640: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file($textfile02, "", $verbose, $message_ref, "hello02");
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg642: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file( $all_text_files_fqpn, "",
$verbose,
$message_ref,
"$textfile01\n$textfile02",
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg644 sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$error = create_large_minus_a_pl_file ($test_name_string,
$sub_test,
$verbose,
$hello_pl_file,
$all_text_files,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg646: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -o $hello_executable -A $all_text_files " .
" -a $all_text_files " .
" $hello_pl_file";
print ("\namsg648: About to system $cmd\n") if $verbose;
if (system("$cmd")) {
$$message_ref = "\namsg649: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$all_text_files,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
# Sub Test
#.................................................................
$error = create_large_minus_a_pl_file ($test_name_string,
$sub_test,
$verbose,
$hello_pl_file,
$all_text_files_fqpn,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg650: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file( $all_text_files_fqpn, "",
$verbose,
$message_ref,
"$textfile01\n$textfile02",
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg652 sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$cmd = "$RUN_PP -o $hello_executable -A \"$all_text_files_fqpn\" " .
" -a \"$all_text_files_fqpn\" " .
" $hello_pl_file";
print ("\namsg654: About to system $cmd\n") if $verbose;
if (system("$cmd")) {
$$message_ref = "\namsg656: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$all_text_files_fqpn,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
#.................................................................
# Sub Test
#.................................................................
$error = create_large_minus_a_pl_file ($test_name_string,
$sub_test,
$verbose,
$hello_pl_file,
$all_text_files_fqpn,
$message_ref);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg658: sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$error = create_file( $all_text_files_fqpn, "",
$verbose,
$message_ref,
"$textfile01\n$textfile02",
);
if ($error == EXIT_FAILURE) {
$$message_ref = "\namsg670 sub $test_name_string: " . $$message_ref;
return (EXIT_FAILURE);
}
#.................................................................
$all_text_files_fqpn =~ s!\\!\/!g;
$cmd = "$RUN_PP -o $hello_executable -A \"$all_text_files_fqpn\" " .
" -a \"$all_text_files_fqpn\" " .
" $hello_pl_file";
print ("\namsg672: About to system $cmd\n") if $verbose;
if (system("$cmd")) {
$$message_ref = "\namsg674: sub $test_name_string cannot system $cmd\n";
return (EXIT_FAILURE);
}
#.................................................................
$error = pipe_a_command
(
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
print ("About to remove a file and try executable again\n") if ($verbose);
$error = remove_file_and_try_executable_again
(
$all_text_files_fqpn,
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
if ($error == EXIT_FAILURE) {
return ($error);
}
#.................................................................
print ("About to test in a different subdir\n") if ($verbose);
$error = test_in_further_subdir (
$test_number,
$sub_test++,
$test_name_string,
$test_dir,
$SUBDIR1,
$pipe_command_string,
$hello_executable,
$expected_results,
$os,
$verbose,
$message_ref,
$print_cannot_locate_message,
);
#.................................................................
if ($error == EXIT_FAILURE) {
$$message_ref =
$$message_ref . "\nDid $cmd produce $hello_executable?\n";
return ($error);
}
#.................................................................
#.................................................................
return ($error);
#.................................................................
}
#########################################################################
#########################################################################
##################### Beginning - Start of Main #########################
#########################################################################
my $startdir = "";
my $answer = "";
my $orig_dir = cwd;
my $test_name_string = "";
my $test_number = 1;
my $error = EXIT_SUCCESS;
my $message = "";
my $test_dir = "";
my $verbose = "";
my $debug_log = "";
my $debug = $FALSE;
GetOptions( "verbose" => \$verbose,
"debug" => \$debug,
"startdir=s" => \$startdir,
"perl_location=s" => \$PERL,
"par_location=s" => \$PAR,
"pp_location=s" => \$PP,
);
$verbose = 0 if (!defined($verbose) or ($verbose eq ""));
$PERL ||= $^X;
if (!(-e($PERL))) {
print ("The perl executable \"$PERL\" does not exist\n");
exit(EXIT_FAILURE);
}
###############################################################
# Examples for Posix os, hostname, release, version, hardware
#
# Example from Unix:
# os FreeBSD,
# hostname my_machine_name
# release 4.3-RELEASE
# version FreeBSD 4.3-RELEASE #0: Sat Apr
# hardware i386
# Example from windows 2000:
# os Windows NT
# hostname my_machine_name
# release 5.0
# version Build 2195 (Service Pack 2)
# hardware x86
#
# os examples: could match Win, CYGWIN_NT, FreeBSD, SunOS, Linux
#
###############################################################
if (!$PAR) {
foreach my $dir ( split(/\Q$Config{path_sep}\E/, $ENV{PATH}) ) {
$PAR = File::Spec->catfile($dir, 'par.pl');
last if -f $PAR;
}
}
if (!(-f($PAR))) {
print ("amsg5000: The par executable \"$PAR\" does not exist\n");
exit(EXIT_FAILURE);
}
$RUN_PP = "\"$PERL\" \"$PP\"";
$RUN_PAR = "\"$PERL\" \"$PAR\"";
my $_out = $Config{_exe} || '.out';
my $hello_pl_file = "hello.pl";
my $foo_pl_file = "foo.pl";
my $bar_pl_file = "bar.pl";
my $hello_par_file_with_dot_par = "hello.par";
my $hello_par_file_no_dot_par = "hello";
my $a_default_dot_par = "a.par";
my $a_default_executable = "a$_out";
my $hello_executable = "hello$_out";
my $foo_executable = "foo$_out";
my $bar_executable = "bar$_out";
if ($startdir eq "") {
$startdir = File::Spec->catdir($orig_dir, 'pp_switch_tests');
}
File::Path::rmtree([$startdir]) if -d $startdir;
# Clean up after us.
END {
chdir(File::Spec->tmpdir);
File::Path::rmtree([$startdir]);
}
if ($debug) {
# Open up a debug log to log the tests that passed
$debug_log = File::Spec->catfile($startdir, "debug.log");
if(!(open (DEBUG, ">$debug_log"))) {
die ("Cannot open debug log $debug_log:$!:\n");
}
}
#SKIP: {
# $test_number = 31;
# skip("Skipping tests for brevity " . "$test_number \n", 30);
########################### Next Test 001 ##################################
$test_name_string = "pp_hello_1";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error = pp_hello_1( $test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 002 ##################################
$test_name_string = "pp_minus_o_hello_hello_dot_pl";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_o_hello_hello_dot_pl
($test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
\$message);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 003 ##################################
$test_name_string = "pp_minus_o_foo_foo_dot_pl_bar_dot_pl";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_o_foo_foo_dot_pl_bar_dot_pl
(
$test_name_string,
$os,
$test_number,
$test_dir,
$foo_pl_file,
$bar_pl_file,
$foo_executable,
$bar_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 004 ##################################
$test_name_string = "pp_minus_p_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_p_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_dot_par,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 005 ##################################
$test_name_string = "pp_minus_p_minus_o_hello_dot_par_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_p_minus_o_hello_dot_par_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_par_file_with_dot_par,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 006 ##################################
$test_name_string = "pp_minus_o_hello_file_dot_par";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_o_hello_file_dot_par
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_par_file_with_dot_par,
$hello_par_file_no_dot_par,
$hello_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 007 ##################################
$test_name_string = "pp_minus_S_minus_o_hello_file";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_S_minus_o_hello_file
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_par_file_with_dot_par,
$hello_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 008 ##################################
$test_name_string = "pp_minus_p_minus_o_out_dot_par_file";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_p_minus_o_out_dot_par_file
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 009 ##################################
$test_name_string = "pp_minus_B_with_small_minus_p_tests";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_B_with_small_minus_p_tests
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 010 ##################################
$test_name_string = "pp_minus_B_with_large_minus_P_tests";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_B_with_large_minus_P_tests
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 011 ##################################
$test_name_string = "pp_minus_e_print_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_e_print_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 012 ##################################
$test_name_string = "pp_minus_p_minus_e_print_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_p_minus_e_print_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 013 ##################################
$test_name_string = "pp_minus_P_minus_e_print_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_P_minus_e_print_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 014 ##################################
$test_name_string = "pp_minus_c_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_c_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 015 ##################################
$test_name_string = "pp_minus_x_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_x_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
print ("\n\n"); # To get by some "hello" print outs that interfere
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 016 ##################################
$test_name_string = "pp_minus_n_minus_x_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_n_minus_x_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
print ("\n\n"); # To get by some "hello" print outs that interfere
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 017 ##################################
$test_name_string = "pp_minus_I_foo_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_I_foo_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 018 ##################################
$test_name_string = "pp_minus_I_foo_minus_I_bar_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_I_foo_minus_I_bar_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 019 ##################################
$test_name_string = "pp_minus_lib_foo_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_lib_foo_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 020 ##################################
$test_name_string = "pp_minus_lib_foo_minus_lib_bar_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_lib_foo_minus_lib_bar_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 021 ##################################
$test_name_string = "pp_minus_M_foo_hidden_print_foo";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_M_foo_hidden_print_foo
(
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 022 ##################################
$test_name_string = "pp_minus_M_foo_minus_M_bar_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_M_foo_minus_M_bar_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 023 ##################################
$test_name_string = "pp_minus_X_module_foo";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_X_module_foo
(
$test_name_string,
$os,
$test_number,
$test_dir,
$foo_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 024 ##################################
$test_name_string = "pp_minus_r_hello";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_r_hello
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 025 ##################################
$test_name_string = "pp_minus_r_hello_a_b_c";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_r_hello_a_b_c
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 026 ##################################
$test_name_string = "pp_hello_to_log_file";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_hello_to_log_file
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 027 ##################################
$test_name_string = "pp_name_four_ways";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_name_four_ways
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 028 ##################################
$test_name_string = "pp_minus_v_tests";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_v_tests
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$a_default_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 029 ##################################
$test_name_string = "pp_minus_V";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_minus_V
(
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 030 ##################################
$test_name_string = "pp_help_tests";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_help_tests
(
$test_name_string,
$os,
$test_number,
$test_dir,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
# } # SKIP
########################### Next Test 031 ##################################
$test_name_string = "test_par_clean";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
test_par_clean
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
# XXX
TODO: {
todo_skip("Not yet clean", 1);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
}
########################### Next Test 032 ##################################
$test_name_string = "pp_gui_tests";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_gui_tests
(
$test_name_string,
$os,
$test_number,
$test_dir,
$orig_dir,
$hello_pl_file,
$hello_executable,
$verbose,
\$message,
$no_win32_exe,
);
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 033 ##################################
$test_name_string = "pp_test_small_minus_a";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_test_small_minus_a
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################### Next Test 034 ##################################
$test_name_string = "pp_test_large_minus_A";
$error = prior_to_test($test_number,
$startdir,
$os,
\$test_dir,
$verbose,
\$message);
if ($error == EXIT_FAILURE) {
$message = "\nCannot run test $test_name_string due to\n" .
"prior_to_test: Test $test_number : $message\n";
die($message);
}
if ($verbose) {
print ("About to run test $test_number: $test_name_string ");
print ("in directory $test_dir\n");
}
$error =
pp_test_large_minus_A
(
$test_name_string,
$os,
$test_number,
$test_dir,
$hello_pl_file,
$hello_executable,
$verbose,
\$message,
);
if ($debug) {
if ($error) {
print DEBUG ("\n\nTest $test_number: $test_name_string FAILED\n");
print DEBUG ("$message\n");
} else {
print DEBUG ("\n\nTest $test_number: $test_name_string PASSED\n");
}
}
after_test($test_number++, $error, $message, $verbose);
ok ($error == EXIT_SUCCESS, "$test_name_string" . " $message");
print ("\n\n\n") if ($error == EXIT_FAILURE);
########################################################################
if ($debug) {
close(DEBUG) or die ("At end of test: Cannot close file $debug_log:$!:\n");
}