Skip to content

Commit 3b5b89a

Browse files
author
Chris White
committed
Bugfixes - tests run OK through 03-cmdline
1 parent 875c207 commit 3b5b89a

File tree

5 files changed

+54
-34
lines changed

5 files changed

+54
-34
lines changed

‎lib/Text/PerlPP.pm‎

Lines changed: 18 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -129,6 +129,9 @@ sub StartOB {
129129
if ( scalar @{$self->{OutputBuffers}} == 0 ) {
130130
$| = 1; # flush contents of STDOUT
131131
open( $self->{RootSTDOUT}, ">&STDOUT" ) or die $!; # dup filehandle
132+
#$self->{RootSTDOUT} = $fh;
133+
#undef $fh;
134+
#say STDERR "stdout in startob ", Dumper($self->{RootSTDOUT});
132135
}
133136
unshift( @{$self->{OutputBuffers}}, [ $mode, "", $lineno ] );
134137
close( STDOUT ); # must be closed before redirecting it to a variable
@@ -617,19 +620,19 @@ sub OutputResult {
617620
my $contents_ref = shift; # reference
618621
my $fname = shift; # "" or other false value => STDOUT
619622
my $proc;
620-
my $out_fd;
623+
my $out_fh;
621624

622625
for $proc ( @{$self->{Postprocessors}} ) {
623626
&$proc( $contents_ref );
624627
}
625628

626629
if ( $fname ) {
627-
open( $out_fd, ">", $fname ) or die $!;
630+
open( $out_fh, ">", $fname ) or die $!;
628631
} else {
629-
open( $out_fd, ">&STDOUT" ) or die $!;
632+
open( $out_fh, ">&STDOUT" ) or die $!;
630633
}
631-
print $out_fd $$contents_ref;
632-
close( $out_fd ) or die $!;
634+
print $out_fh $$contents_ref;
635+
close( $out_fh ) or die $!;
633636
} #OutputResult()
634637

635638
# === Command line parsing ================================================
@@ -744,14 +747,14 @@ sub Main {
744747
my $self = shift or die("Please use Text::PerlPP->new()->Main");
745748

746749
my $lrArgv = shift // [];
747-
say STDERR "\n## -----------------\n## argv:\n",
748-
(Dumper($lrArgv) =~ s/^/## /mgr);
749-
say STDERR "self ", Dumper($self);
750+
#say STDERR "\n## -----------------\n## argv:\n",
751+
# (Dumper($lrArgv) =~ s/^/## /mgr);
752+
#say STDERR "self ", Dumper($self);
750753
unless(_parse_command_line( $lrArgv, $self->{Opts} )) {
751754
return EXIT_OK; # TODO report param err vs. proc err?
752755
}
753756

754-
say STDERR "## opts:\n", (Dumper($self->{Opts}) =~ s/^/## /mgr);
757+
#say STDERR "## opts:\n", (Dumper($self->{Opts}) =~ s/^/## /mgr);
755758

756759
if($self->{Opts}->{PRINT_VERSION}) {
757760
print "PerlPP version $Text::PerlPP::VERSION\n";
@@ -836,9 +839,9 @@ sub Main {
836839
}
837840
keys %{$self->{Opts}->{SETS}};
838841

839-
say STDERR "\n# Defs_RE: $self->{Defs_RE}";
840-
say STDERR "# Defs_repl_text:\n", (Dumper($self->{Defs_repl_text})=~s/^/# /gmr);
841-
say STDERR "# Sets\n", (Dumper($self->{Sets})=~s/^/# /gmr);
842+
#say STDERR "\n# Defs_RE: $self->{Defs_RE}";
843+
#say STDERR "# Defs_repl_text:\n", (Dumper($self->{Defs_repl_text})=~s/^/# /gmr);
844+
#say STDERR "# Sets\n", (Dumper($self->{Sets})=~s/^/# /gmr);
842845
# Make the copy for runtime
843846
emit "my %S = (\n";
844847
for my $defname (keys %{$self->{Opts}->{SETS}}) {
@@ -860,9 +863,9 @@ sub Main {
860863
}
861864

862865
# The input file
863-
ProcessFile( $self->{Opts}->{INPUT_FILENAME} );
866+
$self->ProcessFile( $self->{Opts}->{INPUT_FILENAME} );
864867

865-
my $script = EndOB(); # The generated Perl script
868+
my $script = $self->EndOB(); # The generated Perl script
866869

867870
# --- Run it ---
868871
if ( $self->{Opts}->{DEBUG} ) {
@@ -880,7 +883,7 @@ sub Main {
880883
print STDERR $result;
881884
return EXIT_PROC_ERR;
882885
} else { # Save successful output
883-
OutputResult( \EndOB(), $self->{Opts}->{OUTPUT_FILENAME} );
886+
$self->OutputResult( \($self->EndOB()), $self->{Opts}->{OUTPUT_FILENAME} );
884887
}
885888
}
886889
return EXIT_OK;

‎t/02-readme.t‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,6 @@ use constant CMD => ($ENV{PERLPP_CMD} || 'perl -Iblib/lib blib/script/perlpp');
44
use rlib './lib';
55
use PerlPPTest;
66

7-
my ($in, $out, $err);
8-
97
my @testcases=( # In the order they are given in README.md
108
# [$in, $out, $err (if any)]
119

@@ -95,7 +93,11 @@ plan tests => scalar @testcases;
9593

9694
for my $lrTest (@testcases) {
9795
my ($testin, $refout, $referr) = @$lrTest;
98-
run3 CMD, \$testin, \$out, \$err;
96+
my ($in, $out, $err);
97+
98+
#run3 CMD, \$testin, \$out, \$err;
99+
run_perlpp [], \$testin, \$out, \$err;
100+
99101
if(defined $refout) {
100102
is($out, $refout);
101103
}

‎t/03-cmdline.t‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ my @testcases=(
7373
qr/^_foo bar foobar barfoo$/ ),
7474

7575
# Sets, which do not textually substitute
76-
do{L('-E -sfoo=42','<? my $foo; ?>foo',qr/^foo$/ )},
76+
do{L('-sfoo=42','<? my $foo; ?>foo',qr/^foo$/ )},
7777
do{L('-sfoo=42','<? my $foo; ?><?= $S{foo} ?>',qr/^42$/ )},
7878
[__LINE__, '--set foo=42','<? my $foo; ?>foo',qr/^foo$/ ],
7979
do{L('--set foo=42','<? my $foo; ?><?= $S{foo} ?>',qr/^42$/ )},
@@ -124,8 +124,8 @@ for my $lrTest (@testcases) {
124124
my ($where, $opts, $testin, $out_re, $err_re) = @$lrTest;
125125

126126
my ($out, $err);
127-
diag '=' x 70;
128-
diag $opts, " <<<'", $testin, "'\n";
127+
#diag '=' x 70;
128+
#diag $opts, " <<<'", $testin, "'\n";
129129
run_perlpp $opts, \$testin, \$out, \$err;
130130
#diag "Done running";
131131

@@ -137,7 +137,7 @@ for my $lrTest (@testcases) {
137137
#diag "checking stderr";
138138
like($err, $err_re, "stderr $where");
139139
}
140-
print STDERR "$err\n";
140+
#print STDERR "$err\n";
141141

142142
} # foreach test
143143

‎t/03-idempotency.t‎

Lines changed: 19 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -3,20 +3,31 @@
33
# Always uses the Text/PerlPP.pm in lib, for simplicity.
44
use rlib './lib';
55
use PerlPPTest;
6-
use constant CMD => ($ENV{PERLPP_CMD} || 'perl -Iblib/lib blib/script/perlpp')
7-
. ' lib/Text/PerlPP.pm';
8-
diag 'idempotency-test command: ' . CMD;
6+
#use constant CMD => ($ENV{PERLPP_CMD} || 'perl -Iblib/lib blib/script/perlpp')
7+
#. ' lib/Text/PerlPP.pm';
8+
#diag 'idempotency-test command: ' . CMD;
9+
10+
plan tests => 1;
11+
my $fn = $INC{'Text/PerlPP.pm'};
912

1013
my ($wholefile, $out);
1114

12-
$wholefile = do {
15+
$wholefile = eval {
1316
my $fh;
14-
open($fh, '<', 'lib/Text/PerlPP.pm') or die("Couldn't open");
17+
open($fh, '<', $fn) or die("Couldn't open $fn: $!");
1518
local $/;
1619
<$fh>;
1720
};
18-
19-
run3 CMD, undef, \$out;
20-
is($out, $wholefile);
21+
my $loaderr = $@;
22+
my $err;
23+
if($loaderr) {
24+
chomp $loaderr;
25+
fail("idempotency ($loaderr)");
26+
} else {
27+
run_perlpp [$fn], undef, \$out, \$err;
28+
is($out, $wholefile, 'leaves its own source unchanged');
29+
diag(substr($out,0,100));
30+
diag(substr($err,0,100));
31+
}
2132

2233
# vi: set ts=4 sts=0 sw=4 noet ai: #

‎t/lib/PerlPPTest.pm‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -31,19 +31,23 @@ our @EXPORT_OK = qw(get_perl_filename);
3131
# caller's filename:line number at the front of the list
3232
sub L {
3333
my (undef, $filename, $line) = caller;
34-
say STDERR "\n## L trace:\n",
35-
(Devel::StackTrace->new->as_string() =~ s/^/##/mgr);
34+
#say STDERR "\n## L trace:\n",
35+
# (Devel::StackTrace->new->as_string() =~ s/^/##/mgr);
3636
return ["$filename:$line", @_];
3737
} #L
3838

3939
# run_perlpp: Run perlpp
4040
# Args: $lrArgs, $refStdin, $refStdout, $refStderr
4141
sub run_perlpp {
42-
my ($lrArgs, $refStdin, $refStdout, $refStderr) = @_;
42+
my $lrArgs = shift;
43+
my $refStdin = shift // \(my $nullstdin);
44+
my $refStdout = shift // \(my $nullstdout);
45+
my $refStderr = shift // \(my $nullstderr);
46+
4347
my $retval;
4448

4549
$lrArgs = [shellwords($lrArgs)] if ref $lrArgs ne 'ARRAY';
46-
say STDERR "## args:\n", (Dumper($lrArgs) =~ s/^/##/mgr);
50+
#say STDERR "## args:\n", (Dumper($lrArgs) =~ s/^/##/mgr);
4751

4852
if($ENV{PERLPP_PERLOPTS}) {
4953
#say STDERR "# running external perl";

0 commit comments

Comments
 (0)