Skip to content

Commit 3296bfc

Browse files
author
Chris White
committed
Updated test infrastructure
- Added TestcaseList - PerlPPTest::run_perlpp: pass arg list (rather than string) to run3 - Cleaned up environment variables in Makefile
1 parent 807b08e commit 3296bfc

File tree

4 files changed

+65
-10
lines changed

4 files changed

+65
-10
lines changed

MANIFEST

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,10 @@ pack.PL Script to make the packed version
99
README
1010
README.md The tutorial
1111
t/00-load.t
12-
t/01-basic.t
13-
t/01-readme.t
14-
t/02-cmdline.t
12+
t/01-capture.t
13+
t/02-basic.t
14+
t/02-readme.t
15+
t/03-cmdline.t
1516
t/03-idempotency.t
1617
t/04-include.t
1718
t/05-external-command.t
@@ -21,5 +22,7 @@ t/a.txt
2122
t/b.txt
2223
t/c.txt
2324
t/included.txt
25+
t/lib/PerlPPTest.pm The test kit
26+
t/lib/TestcaseList.pm Helper library for autonumbering testcases
2427
t/multiline.txt
2528
t/unclosed.txt

Makefile.PL

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,11 +17,10 @@ authortest:
1717
\tRELEASE_TESTING=1 prove -l xt"
1818
1919
testhere: # Run the tests from lib rather than blib
20-
\texport PERLPP_CMD="\\\"$secure_perl_path\\\" -Ilib bin/perlpp"; \\
2120
\tperl -Ilib -e 'use Test::Harness "runtests"; runtests \@ARGV;' -- t/*.t
2221
2322
testpacked: pack # Test the packed version
24-
\texport PERLPP_NOUSE=1 PERLPP_PERLOPTS="blib/perlpp"; \\
23+
\tPERLPP_NOUSE=1 PERLPP_PERLOPTS="blib/perlpp" \\
2524
\tperl -e 'use Test::Harness "runtests"; runtests \@ARGV;' -- t/*.t
2625
EOT
2726
} #postamble

t/lib/PerlPPTest.pm

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -51,12 +51,17 @@ sub run_perlpp {
5151
#say STDERR "## args:\n", (Dumper($lrArgs) =~ s/^/##/mgr);
5252

5353
if($ENV{PERLPP_PERLOPTS}) {
54-
#say STDERR "# running external perl";
55-
$retval = run3(
56-
join(' ', get_perl_filename(), $ENV{PERLPP_PERLOPTS},
57-
@$lrArgs),
58-
$refStdin, $refStdout, $refStderr);
54+
#my $cmd = join(' ', get_perl_filename(), $ENV{PERLPP_PERLOPTS},
55+
# @$lrArgs);
56+
my $cmd = [get_perl_filename(), shellwords($ENV{PERLPP_PERLOPTS}),
57+
@$lrArgs];
58+
#say STDERR '# running external perl: {', join('|',@$cmd), '}';
59+
$retval = run3($cmd, $refStdin, $refStdout, $refStderr);
60+
#say STDERR "# returned $retval; status $?";
5961
# TODO figure out $?, retval, &c.
62+
# TODO tell the caller if the user hit Ctl-C on the inner perl
63+
# invocation so the caller can abort if desired.
64+
# That seems to be status 2, on my test system.
6065

6166
} else {
6267
#say STDERR "# running perlpp internal";

t/lib/TestcaseList.pm

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
#!perl
2+
# TestcaseList.pm: Automatically number a list, e.g., of testcases.
3+
# Copyright (c) 2018 Chris White.
4+
# Dual-licensed Artistic 2 or CC-BY 4.0 Intl.
5+
# Modified from https://stackoverflow.com/a/50516105/2877364 by
6+
# https://stackoverflow.com/users/2877364/cxw
7+
8+
package TestcaseList;
9+
use 5.010001;
10+
use strict;
11+
use warnings;
12+
13+
# Constructor
14+
sub new { # call as $class->new(__LINE__); each element is one line
15+
my $class = shift;
16+
my $self = bless {lnum => shift // 0, arr => []}, $class;
17+
18+
# Make a loader that adds an item and returns itself --- not $self
19+
$self->{loader} = sub { $self->L(@_); return $self->{loader} };
20+
# TODO add a skip() method callable on the loader
21+
22+
return $self;
23+
}
24+
25+
# Accessors
26+
sub size { return scalar @{ shift->{arr} }; }
27+
sub last { return shift->size-1; } # $#
28+
sub arr { return shift->{arr}; }
29+
30+
# Loading
31+
sub load { goto &{ shift->{loader} } } # kick off loading
32+
33+
sub L { # Push a new record with the next line number on the front
34+
my $self = shift;
35+
push @{ $self->{arr} }, [++$self->{lnum}, @_];
36+
return $self;
37+
} #L
38+
39+
sub add { # just add it
40+
my $self = shift;
41+
++$self->{lnum}; # keep it consistent
42+
push @{ $self->{arr} }, [@_];
43+
return $self;
44+
} #add
45+
46+
1;
47+
48+
# vi: set ts=4 sts=0 sw=4 noet ai: #

0 commit comments

Comments
 (0)