Added z_noexit_on_help; unique script pkg. names

Both changes support the move of testing to Capture::Tiny.
--z_noexit_on_help prevents pod2usage() from exiting the test process
early, and unique script package names keep the scripts from separate calls
to Text::PerlPP::Main in separate packages.

Author: Chris White

lib/Text/PerlPP.pm

@@ -11,6 +11,7 @@ use warnings;
 
 use Getopt::Long 2.5 qw(GetOptionsFromArray);
 use Pod::Usage;
+use Data::Dumper;
 
 # === Constants ===========================================================
 
@@ -58,6 +59,7 @@ use constant OB_STARTLINE	=> 2;
 
 # Internals
 my $Package = '';			# package name for the generated script
+my $PackageNum = 0;			# make sure each run has a unique package name
 my $RootSTDOUT;
 my $WorkingDir = '.';
 my %Opts;					# Parsed command-line options
@@ -616,6 +618,10 @@ my %CMDLINE_OPTS = (
 	SETS => ['s','|set:s%'],		# Extra data in %S, without text substitution
 	# --usage reserved
 	PRINT_VERSION => ['v','|version+'],
+
+	# Special-case for testing --- don't exit on --help &c.
+	NOEXIT_ON_HELP => ['z_noexit_on_help'],
+
 	# -? reserved
 );
 
@@ -645,22 +651,42 @@ sub parse_command_line {
 		# small POD below, which links to `perldoc perlpp`.
 
 	# Get options
+	my $ok =
 	GetOptionsFromArray($lrArgs, $hrOptsOut,		# destination hash
 		'usage|?', 'h|help', 'man',					# options we handle here
-		map { $_->[0] . $_->[1] } values %CMDLINE_OPTS,		# options strs
-		)
-	or pod2usage(-verbose => 0, -exitval => EXIT_PARAM_ERR, %docs);
-		# unknown opt
-
-	# Help, if requested
-	pod2usage(-verbose => 0, -exitval => EXIT_PROC_ERR, %docs) if have('usage');
-	pod2usage(-verbose => 1, -exitval => EXIT_PROC_ERR, %docs) if have('h');
-	pod2usage(-verbose => 2, -exitval => EXIT_PROC_ERR, %docs) if have('man');
+		map { $_->[0] . ($_->[1]//'') } values %CMDLINE_OPTS,		# options strs
+		);
+	my $noexit_on_help =
+		$hrOptsOut->{ $CMDLINE_OPTS{NOEXIT_ON_HELP}->[0] } // false;
+
+	if($noexit_on_help) {		# Report help during testing
+		# unknown opt --- error out.  false => processing should terminate.
+		pod2usage(-verbose => 0, -exitval => 'NOEXIT', %docs), return false unless $ok;
+
+		# Help, if requested
+		pod2usage(-verbose => 0, -exitval => 'NOEXIT', %docs), return false if have('usage');
+		pod2usage(-verbose => 1, -exitval => 'NOEXIT', %docs), return false if have('h');
+		pod2usage(-verbose => 2, -exitval => 'NOEXIT', %docs), return false if have('man');
+
+	} else {	# Normal usage
+		# unknown opt --- error out
+		pod2usage(-verbose => 0, -exitval => EXIT_PARAM_ERR, %docs) unless $ok;
+
+		# Help, if requested
+		pod2usage(-verbose => 0, -exitval => EXIT_PROC_ERR, %docs) if have('usage');
+		pod2usage(-verbose => 1, -exitval => EXIT_PROC_ERR, %docs) if have('h');
+		pod2usage(-verbose => 2, -exitval => EXIT_PROC_ERR, %docs) if have('man');
+	}
 
 	# Map the option names from GetOptions back to the internal names we use,
 	# e.g., $hrOptsOut->{EVAL} from $hrOptsOut->{e}.
 	my %revmap = map { $CMDLINE_OPTS{$_}->[0] => $_ } keys %CMDLINE_OPTS;
+	#say "revmap ", Dumper(\%revmap);
+	#say "hrOptsOut ", Dumper($hrOptsOut);
 	for my $optname (keys %$hrOptsOut) {
+		#say "\nOptname $optname";
+		#say "Value $hrOptsOut->{$optname}";
+		#say "Revmap $revmap{$optname}";
 		$hrOptsOut->{ $revmap{$optname} } = $hrOptsOut->{ $optname };
 	}
 
@@ -672,13 +698,16 @@ sub parse_command_line {
 	# Process other arguments.  TODO? support multiple input filenames?
 	$hrOptsOut->{INPUT_FILENAME} = $ARGV[0] // "";
 
+	return true;	# Go ahead and run
 } #parse_command_line()
 
 # === Main ================================================================
 
 sub Main {
 	my $lrArgv = shift // [];
-	parse_command_line $lrArgv, \%Opts;
+	unless(parse_command_line $lrArgv, \%Opts) {
+		return EXIT_OK;		# TODO report param err vs. proc err?
+	}
 
 	if($Opts{PRINT_VERSION}) {
 		print "PerlPP version $Text::PerlPP::VERSION\n";
@@ -694,6 +723,7 @@ sub Main {
 	$Package =~ s/^.*?([a-z_][a-z_0-9.]*).pl?$/$1/i;
 	$Package =~ s/[^a-z0-9_]/_/gi;
 		# $Package is not the whole name, so can start with a number.
+	$Package .= $PackageNum++;
 
 	StartOB();	# Output from here on will be included in the generated script
 

t/03-cmdline.t

@@ -13,17 +13,20 @@ my @testcases=(
 	['--version','',qr/\bversion\b/],
 
 	# Debug output
-	['-d','',qr/^package PPP_;/m],
+	['-d','',qr/^package PPP_[0-9]*;/m],
 	['-d', '<?= 2+2 ?>', qr{print\s+2\+2\s*;}],
 	['--debug', '<?= 2+2 ?>', qr{print\s+2\+2\s*;}],
 	['-E', '<?= 2+2 ?>', qr{print\s+2\+2\s*;}],
 
 	# Usage
-	['-h', '', qr/^Usage/],
-	['--help', '', qr/^Usage/],
+	['-h --z_noexit_on_help', '', qr/^Usage/],
+	['--help --z_noexit_on_help', '', qr/^Usage/],
 
 	# Eval at start of file
-	['-e \'my $foo=42;\'','<?= $foo ?>', qr/^42$/],
+	[['-e', 'my $foo=42;'],'<?= $foo ?>', qr/^42$/],
+	# TODO RESUME HERE: break down the command line arguments since the
+	# shell is no longer parsing them.  (Note that they will have to be
+	# re-quoted for use by the packed test.)
 	['--eval \'my $foo=42;\'','<?= $foo ?>', qr/^42$/],
 	['-d -e \'my $foo=42;\'','<?= $foo ?>', qr/^my \$foo=42;/m],
 	['--debug --eval \'my $foo=42;\'','<?= $foo ?>', qr/^print\s+\$foo\s*;/m],
@@ -115,16 +118,16 @@ for my $lrTest (@testcases) {
 	my ($opts, $testin, $out_re, $err_re) = @$lrTest;
 
 	my ($out, $err);
-	diag "$opts", " <<<'", $testin, "'\n";
+	diag $opts, " <<<'", $testin, "'\n";
 	run_perlpp $opts, \$testin, \$out, \$err;
-	diag "Done running";
+	#diag "Done running";
 
 	if(defined $out_re) {
-		diag "checking output";
+		#diag "checking output";
 		like($out, $out_re);
 	}
 	if(defined $err_re) {
-		diag "checking stderr";
+		#diag "checking stderr";
 		like($err, $err_re);
 	}
 	print STDERR "$err\n";

t/lib/PerlPPTest.pm

@@ -31,6 +31,7 @@ sub run_perlpp {
 	my $retval;
 
 	$lrArgs = [split(' ', $lrArgs)] if ref $lrArgs ne 'ARRAY';
+	say STDERR "args: ", Dumper($lrArgs);
 
 	if($ENV{PERLPP_PERLOPTS}) {
 		say STDERR "# running external perl";
@@ -41,23 +42,23 @@ sub run_perlpp {
 		# TODO figure out $?, retval, &c.
 
 	} else {
-		say STDERR "# running perlpp internal";
-		say STDERR "# redirecting stdin";
+		#say STDERR "# running perlpp internal";
+		#say STDERR "# redirecting stdin";
 		open local(*STDIN), '<', $refStdin or die $!;
-		say STDERR "# redirected stdin";
+		#say STDERR "# redirected stdin";
 
 		my @result;
-		say STDERR "# before capture";
+		#say STDERR "# before capture";
 		eval {
-		($$refStdout, $$refStderr, @result) = capture {
-			# Thanks to http://www.perlmonks.org/bare/?node_id=289391 by Zaxo
-			say STDERR "# running perlpp";
-			my $result = Text::PerlPP::Main($lrArgs);
-			say STDERR "# done running perlpp";
-			$result;
-		};
+			($$refStdout, $$refStderr, @result) = capture {
+				# Thanks to http://www.perlmonks.org/bare/?node_id=289391 by Zaxo
+				say STDERR "# running perlpp";
+				my $result = Text::PerlPP::Main($lrArgs);
+				say STDERR "# done running perlpp";
+				$result;
+			};
 		} or die "Capture failed: " . $@;
-		say STDERR "# after capture";
+		#say STDERR "# after capture";
 		close STDIN;
 		$retval = $result[0] if @result;
 	}