RFC-patchset. in TEST, support linux's perf stat --repeat N ./perl ... t/foo.t #14205
Comments
From @jimchi folks, (apologies if copy-paste was bad idea) Ive prepared a patchset which lets us run all tests under linux's perf stat. perf stat output is similar to that provided by valgrind --tool=cachegrind but it is very cheap to invoke, since it uses modern CPU performance heres a run on my athlon-64, a less-than-bleading-edge desktop from 2009. A hot new i7 or xeon or AMD chip probably has many more measurements available. Performance counter stats for './perl base/cond.t': 2.077911 task-clock # 0.640 CPUs utilized 2 context-switches # 0.963 K/sec 1 cpu-migrations # 0.481 K/sec 519 page-faults # 0.250 M/sec 2,753,978 cycles # 1.325 GHz 1,725,265 stalled-cycles-frontend # 62.65% frontend cycles idle 2,405,122 stalled-cycles-backend # 87.33% backend cycles idle 3,278,429 instructions # 1.19 insns per cycle # 0.73 stalled <not counted> branches <not counted> branch-misses 0.003244748 seconds time elapsed Because perf stat --repeat N also computes std-deviation for each this patch makes that feature available. ./perl TEST -v -lxperf=10 re/pat_rt_report.t perf stat --repeat 10 -- ./perl -I.. -MTestInit re/pat_rt_report.t ./perl -I.. -MTestInit re/pat_rt_report.t Performance counter stats for './perl -I.. -MTestInit 98.749506 task-clock # 0.001 CPUs 68 context-switches # 0.686 K/sec 10 cpu-migrations # 0.097 K/sec 2,956 page-faults # 0.030 M/sec 254,477,657 cycles # 2.577 GHz 75,556,485 stalled-cycles-frontend # 29.69% frontend 62,921,965 stalled-cycles-backend # 24.73% backend 241,522,257 instructions # 0.95 insns per cycle # 0.31 stalled 53,147,072 branches # 538.201 M/sec 2,451,318 branch-misses # 4.61% of all 141.101988701 seconds time elapsed I think theres some value in those stdev numbers, likely showing that: with this much noise, you must discount any measured performance 0001-t-TEST-add-w-to-shebang-fix-a-used-once-warning.patch 1 shows almost no fallout, surprising it wasnt done before. 2,4,9 are self-corrections to old errs. 5 minor comments on vars, mech, true even wo further patches. 6 does option handling before $do_nothing returns, so that harness can enable test behavior -options it already has access to via the There is probly some clash-of-options that needs resolution 7 adds new -lxperf(.+) option and mechanism to wrap tests in "perf actually using --repeat 3 will break due to TAP 13 strict interpretation. So its BOLD in adding something that would break if used (but its not 8 fixup <$results> processing loop code that squawks about --repeat 3 runs 3 did some pre-cleanup work to try to minimize this patch, but 8 is 8 is bold in even touching the fine-til-now code, and for fixing it for TEST, but not for test_harness, which passes the subtests [16:16:24] ../cpan/Test-Harness/t/nested.t but finally fails, like: Parse errors: Plan (1..660) must be at the beginning or end of the TAP output 10 isnt recently tested but left in as todo 11 is BOLD in arguing that we could use require "test-feature" in parts of TEST that do "developer-tests". The valgrind specific code is a fitting case, its rarely run, and by few individuals. This could be taken as a reason to remove it entirely, but instead we could separate it out so its easier to review, enhance, extend, and make more useful. Theres no reason why it should be written in a primitive style, thats for TEST's hotpath. alrightee, that should do it. COPY PASTING FOR CASUAL REVIEW, ATTACHING FOR SIMPLE BRANCH & APPLY TESTING [jimc@groucho perl]$ cat test-perf.patch Adding -w should be ok, despite peculiar code style; it avoids lib/FileHandle.t | 2 +- Inline Patchdiff --git a/lib/FileHandle.t b/lib/FileHandle.t
index f4a8800..3c6f593 100644
--- a/lib/FileHandle.t
+++ b/lib/FileHandle.t
@@ -29,7 +29,7 @@ my $fh = (new FileHandle "./TEST", O_RDONLY
ok(defined($fh), "create new handle O_RDONLY");
my $buffer = <$fh>;
-is($buffer, "#!./perl\n", "Got expected first line via handle");
+is($buffer, "#!./perl -w\n", "Got expected first line via handle");
ungetc $fh ord 'A';
my $buf;
diff --git a/t/TEST b/t/TEST
index 9772490..15d59b7 100755
--- a/t/TEST
+++ b/t/TEST
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -w
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for. (This comment is
@@ -108,7 +108,7 @@ my %skip = (
);
-if ($::do_nothing) {
+if ($::do_nothing || $::do_nothing) { # set by harness b4 requiring us
return 1;
}
-- 1.8.3.1 From a9f81eefbc93277decccf9b956bb4ebd10552c19 Mon Sep 17 00:00:00 2001 commit c96083e added our @found inside sub _find_tests, $ perl -cw -Ilib -Mstrict t/TEST No point in arguing, hoist decl out to file scope. t/TEST | 3 ++- Inline Patchdiff --git a/t/TEST b/t/TEST
index 15d59b7..8026c53 100755
--- a/t/TEST
+++ b/t/TEST
@@ -163,7 +163,8 @@ if ($show_elapsed_time) { require Time::HiRes }
my %timings = (); # testname => [@et] pairs if $show_elapsed_time.
# Roll your own File::Find!
-sub _find_tests { our @found=(); push @ARGV, _find_files('\.t$', $_[0]) }
+our @found;
+sub _find_tests { @found = (); push @ARGV, _find_files('\.t$', $_[0]) }
sub _find_files {
my($patt, @dirs) = @_;
for my $dir (@dirs) {
--
From ba22a3ed7d42620606f811c1a3ad5eb00c4d972a Mon Sep 17 00:00:00 2001 $failure handling in <$results> processing loop does not need extra t/TEST | 14 ++++++-------- Inline Patchdiff --git a/t/TEST b/t/TEST
index 8026c53..9ad23a9 100755
--- a/t/TEST
+++ b/t/TEST
@@ -531,7 +531,7 @@ EOT
my $grind_ct = 0; # count of non-empty valgrind reports
my $total_files = @tests;
my $good_files = 0;
- my $tested_files = 0;
+ my $tested_files = 0;
my $totmax = 0;
my %failed_tests;
my $toolnm; # valgrind, cachegrind, perf
@@ -567,7 +567,7 @@ EOT
my $results = _run_test($test, $type);
- my $failure;
+ my $failure = "";
my $next = 0;
my $seen_leader = 0;
my $seen_ok = 0;
@@ -660,7 +660,7 @@ EOT
}
close $results;
- if (not defined $failure) {
+ if (not $failure) {
$failure = 'FAILED--no leader found' unless $seen_leader;
}
@@ -669,13 +669,11 @@ EOT
if ($type eq 'deparse' && !$ENV{KEEP_DEPARSE_FILES}) {
unlink "./$test.dp";
}
- if (not defined $failure and $next != $max) {
+ if (not $failure and $next != $max) {
$failure="FAILED--expected $max tests, saw $next";
}
- if( !defined $failure # don't mask a test failure
- and $? )
- {
+ if (not $failure and $? ) { # don't mask a test failure
$failure = "FAILED--non-zero wait status: $?";
}
@@ -692,7 +690,7 @@ EOT
}
}
- if (defined $failure) {
+ if ($failure) {
print "${te}$failure\n";
$::bad_files = $::bad_files + 1;
if ($test =~ /^base/ && ! defined &DynaLoader::boot_DynaLoader) {
--
From 8b42821106e92c87e47718373ded25c8b1e7fab2 Mon Sep 17 00:00:00 2001 Commit 0978c4bed computed a timestamp string as part of an output t/TEST | 10 +++++++--- Inline Patchdiff --git a/t/TEST b/t/TEST
index 9ad23a9..c540869 100755
--- a/t/TEST
+++ b/t/TEST
@@ -122,6 +122,12 @@ $| = 1;
@ARGV = grep($_,@ARGV) if $^O eq 'VMS';
our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
+{ # create timestamp for any reports written, so theyre corelatable
+ my @dt = localtime;
+ $dt[5] += 1900; $dt[4] += 1; # fix year, month
+ $::tstamp = sprintf("%d-%.2d%.2d-%.2d%.2d-%.2d-$$", @dt[5,4,3,2,1,0]);
+}
+
# Cheesy version of Getopt::Std. We can't replace it with that, because we
# can't rely on require working.
{
@@ -788,9 +794,7 @@ SHRDLU_5
# relative path must account for that, ie ../../perf
# points to dir next to source tree.
require Storable;
- my @dt = localtime;
- $dt[5] += 1900; $dt[4] += 1; # fix year, month
- my $fn = "$show_elapsed_time/".join('-', @dt[5,4,3,2,1]).".ttimes";
+ my $fn = "$show_elapsed_time/$::tstamp.ttimes";
Storable::store({ perf => \%timings,
gather_conf_platform_info(),
total => $tot,
--
From 4ee55210d525327bf679462f0d2990f73b3253e1 Mon Sep 17 00:00:00 2001 Add comments to var declarations, to help clarify loop operation. t/TEST | 10 +++++----- Inline Patchdiff --git a/t/TEST b/t/TEST
index c540869..b5bf9bc 100755
--- a/t/TEST
+++ b/t/TEST
@@ -574,11 +574,11 @@ EOT
my $results = _run_test($test, $type);
my $failure = "";
- my $next = 0;
- my $seen_leader = 0;
- my $seen_ok = 0;
- my $trailing_leader = 0;
- my $max;
+ my $next = 0; # ++ after each ok M
+ my $seen_leader = 0; # set after "1..N"
+ my $seen_ok = 0; # set after "ok M"
+ my $trailing_leader = 0; # set after "1..N" if $seen_ok
+ my $max; # set to N after "1..N"
my %todo;
while (<$results>) {
next if /^\s*$/; # skip blank lines
--
From d651d8c4685ed2c99e4892cbaad5cd2a49ab8619 Mon Sep 17 00:00:00 2001 As explained in commit c537bcd, $do_nothing's purpose is to prevent This patch moves TEST's $do_nothing check after its option-handling TODO: With TEST's option handling done even for $do_nothing cases, it - harness does selective option scanning before requiring TEST. It - both -v and -torture are implemented by TEST and harness, and mean - use of $TEST::verbose (or are namespaces also to be avoided?) t/TEST | 9 ++++----- Inline Patchdiff --git a/t/TEST b/t/TEST
index b5bf9bc..c61cda2 100755
--- a/t/TEST
+++ b/t/TEST
@@ -107,11 +107,6 @@ my %skip = (
'.svn' => 1,
);
-
-if ($::do_nothing || $::do_nothing) { # set by harness b4 requiring us
- return 1;
-}
-
$| = 1;
# for testing TEST only
@@ -150,6 +145,10 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
@ARGV = @argv;
}
+if ($::do_nothing || $::do_nothing) { # set by harness b4 requiring us
+ return 1;
+}
+
chdir 't' if -f 't/TEST';
if (-f 'TEST' && -f 'harness' && -d '../lib') {
@INC = '../lib';
--
From c30213f0fe6a3d2f452a86f82439fb85b8770e25 Mon Sep 17 00:00:00 2001 With this patch, TEST can run each test-script under linux's perf t]$ ./perl -I../lib TEST -lxperf "perf stat" output is comparable to that of "valgrind --tool=cachegrind" export TEST_OPTS=-lxperf Given this small runtime cost, porters might be inclined to use it and EXAMPLES: Performance counter stats for './perl base/cond.t': 2.077911 task-clock # 0.640 CPUs utilized 0.003244748 seconds time elapsed perf stat --repeat N also computes std-deviation for each measurement ./perl TEST -v -lxperf=10 re/pat_rt_report.t Performance counter stats for './perl -I.. -MTestInit 98.749506 task-clock # 0.001 CPUs utilized 141.101988701 seconds time elapsed The patch has 3 parts: An addition to TEST:_cmd() which wraps the test invocation inside a Option-parsing code, which handles several option forms: $ENV{TEST_OPTS} is split on /;/ and prepended to @ARGV before option export TEST_OPTS="-v;-lxperf=reps=3:rptdir=$HOME/perl/perfdata" NOTES: Test script output under perf stat --repeat 4 violates the "plan just "The plan cannot appear in the middle of the output, only at perf stat --repeat N causes perf to compute std-deviation(s) for each The -opts option passthru to perf stat allows "-x," to cause perf stat TODO Probable rework of -lxperf option parsing Using reps=2 yields "FAILED--seen duplicate leader" on every test. The command wrapper template is pretty minimal and constrained; the TEST_OPTS is split on ';', -lxperf is split on ':' into k=v pairs. Performance counter stats for './perl base/cond.t' (3 runs): t/TEST | 33 ++++++++++++++++++++++++++++++++- Inline Patchdiff --git a/t/TEST b/t/TEST
index c61cda2..fd07c6b 100755
--- a/t/TEST
+++ b/t/TEST
@@ -113,6 +113,9 @@ $| = 1;
#BEGIN { require '../lib/strict.pm'; "strict"->import() };
#BEGIN { require '../lib/warnings.pm'; "warnings"->import() };
+# allow setting -options from env
+unshift @ARGV, split /;/, $ENV{TEST_OPTS} if $ENV{TEST_OPTS};
+
# remove empty elements due to insertion of empty symbols via "''p1'" syntax
@ARGV = grep($_,@ARGV) if $^O eq 'VMS';
our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
@@ -123,12 +126,22 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
$::tstamp = sprintf("%d-%.2d%.2d-%.2d%.2d-%.2d-$$", @dt[5,4,3,2,1,0]);
}
+# wrapper template for linux perf
+our %cmdwrap = (
+ tool => "perf", # path
+ cmd => "stat", # others possible, none tried
+ rptdir => $ENV{PWD}, # typically ./t, better if absolute
+ name => "", # $::tstamp prefixed implicitly
+ # reps => 1 #
+ opts => "", # pass-thru to perf stat: 'opts=-x,' gives CSV
+ );
+
# Cheesy version of Getopt::Std. We can't replace it with that, because we
# can't rely on require working.
{
my @argv = ();
foreach my $idx (0..$#ARGV) {
- push( @argv, $ARGV[$idx] ), next unless $ARGV[$idx] =~ /^-(\S+)$/;
+ push( @argv, $ARGV[$idx] ), next unless $ARGV[$idx] =~ /^-(\S+?)(?:=(.+))?$/;
$::benchmark = 1 if $1 eq 'benchmark';
$::core = 1 if $1 eq 'core';
$::verbose = 1 if $1 eq 'v';
@@ -141,6 +154,16 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
$::deparse_opts = $1;
_process_deparse_config();
}
+ if ($1 eq 'lxperf') {
+ die "perf only available on linux" unless $^O eq 'linux';
+ $::perf = 1;
+ next unless $2;
+ # $2 is either Reps or : delimited $k=$v pairs
+ my (@v) = split /:/, $2;
+ $cmdwrap{reps} = $v[0] if @v == 1 and $v[0] =~ /^\d+$/;
+ # parse as $k=$v to override %cmdwrap defaults
+ m/(.+?)=(.+)/ and $cmdwrap{$1} = $2 for @v;
+ }
}
@ARGV = @argv;
}
@@ -308,6 +331,14 @@ sub _cmd {
}
$perl = "$valgrind_exe $vg_opts $perl";
}
+ if ($::perf) {
+ my $ofile = "$cmdwrap{rptdir}/$::tstamp$cmdwrap{name}.perf";
+ my $wrapper = "$cmdwrap{tool} $cmdwrap{cmd} "
+ . ( defined $cmdwrap{reps} && $cmdwrap{reps} > 0
+ ? "--repeat $cmdwrap{reps}" : "" )
+ . " --append -o $ofile $cmdwrap{opts} -- ";
+ $perl = "$wrapper $perl";
+ }
my $args = "$options->{testswitch} $options->{switch}
From acfd39ca5d655d2aa4afd5317ef116e5c844373b Mon Sep 17 00:00:00 2001 Support use of the --repeat=3 option of linux's perf stat. This When a test script is run (under linux perf with --repeat=N), the Current legal TAP is essentially either: print "ok $_\n" for 1..N; # 1A The big simplification here is that under --repeat, leading vs - "1..N" plans are only allowed before any tests, or after all of - $plan = undef initially, updated to N when "1..N" is 1st seen. - $next=0 when "1..N" is seen [2]. - when 2nd+ "1..N" plans are seen, they are allowed if they agree on N. - The change to if (defined $plan) accepts "1..0" as legal (ie SKIPs). - $seen_leader and $trailing_leader are thus obsolete, replaced where - $seen_ok was used with $seen_leader to reset $next (test-count). - $max is also taken right from "1..N", replaced with <some-expr>($plan) NOTES: [1]: this patch allows BOTH 1A then 1B to run successfully, but not 1B - On "1..N" occurrences: - post-loop tests: TODO: This patch supports --repeat N in t/TEST only; harness is strict wrt comp/use.t ........................................................ Sort whats reported in summary data; unique tests or repeated tests ? t/TEST | 87 +++++++++++++++++++++++++++++++----------------------------------- Inline Patchdiff --git a/t/TEST b/t/TEST
index fd07c6b..1b5dd09 100755
--- a/t/TEST
+++ b/t/TEST
@@ -568,7 +568,7 @@ EOT
my $total_files = @tests;
my $good_files = 0;
my $tested_files = 0;
- my $totmax = 0;
+ my $totmax = 0; # += $plan after <$results> consumed. includes --repeats
my %failed_tests;
my $toolnm; # valgrind, cachegrind, perf
@@ -604,11 +604,10 @@ EOT
my $results = _run_test($test, $type);
my $failure = "";
- my $next = 0; # ++ after each ok M
- my $seen_leader = 0; # set after "1..N"
- my $seen_ok = 0; # set after "ok M"
- my $trailing_leader = 0; # set after "1..N" if $seen_ok
- my $max; # set to N after "1..N"
+ my $plan = undef; # the N in "1..N"
+ my $next = 0; # ++ after each "ok M", reset on "1..N"
+ my $nextreps = 0; # ++ after each "ok M"
+ my $Reps = 0; # ++ when "1..N" seen
my %todo;
while (<$results>) {
next if /^\s*$/; # skip blank lines
@@ -624,47 +623,45 @@ EOT
print $_;
}
unless (/^\#/) {
- if ($trailing_leader) {
- # shouldn't be anything following a postfix 1..n
- $failure = 'FAILED--extra output after trailing 1..n';
- last;
- }
if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) {
- if ($seen_leader) {
- $failure = 'FAILED--seen duplicate leader';
- last;
- }
- $max = $1;
- %todo = map { $_ => 1 } split / /, $3 if $3;
- $totmax = $totmax + $max;
- $tested_files = $tested_files + 1;
- if ($seen_ok) {
- # 1..n appears at end of file
- $trailing_leader = 1;
- if ($next != $max) {
- $failure = "FAILED--expected $max tests, saw $next";
+
+ # a "1..N" plan, maybe todos also
+ if (!$plan) {
+ $plan = $1;
+ } else {
+ # allow another plan agreeing on N
+ if ($1 != $plan) {
+ $failure = "latest plan disagrees: $1 != $plan\n";
last;
}
}
- else {
- $next = 0;
+ unless ($next == 0 or $next == $plan) {
+ $failure = "plan seen in middle of tests: $next\n";
+ last;
}
- $seen_leader = 1;
+ $Reps = $Reps + 1;
+ $next = 0; # reset for next "1..N" plan check
+
+ $totmax = $totmax + $plan;
+ $tested_files = $tested_files + 1;
+
+ # if $Reps>1, this work is redone $Reps-1 times, trivial extra.
+ # assume todos match, since plans do.
+ %todo = map { $_ => 1 } split / /, $3 if $3;
+ next;
}
else {
- if (/^(not )?ok(?: (\d+))?[^\#]*(\s*\#.*)?/) {
- unless ($seen_leader) {
- unless ($seen_ok) {
- $next = 0;
- }
- }
- $seen_ok = 1;
+ if (/^(not )?ok(?:\s+(\d+))?[^\#]*(\s*\#.*)?/) {
$next = $next + 1;
- my($not, $num, $extra, $istodo) = ($1, $2, $3, 0);
- $num = $next unless $num;
-
- if ($num == $next) {
+ $nextreps = $nextreps + 1;
+ my ($not, $num, $extra, $istodo) = ($1, $2, $3, 0);
+ $num = $next unless $num; # tolerate un-numbered
+ if ($num != $next) {
+ $failure ="FAILED--expected test $next, saw test $num";
+ last;
+ }
+ else {
# SKIP is essentially the same as TODO for t/TEST
# this still conforms to TAP:
# http://testanything.org/wiki/index.php/TAP_specification
@@ -676,10 +673,6 @@ EOT
last;
}
}
- else {
- $failure ="FAILED--expected test $next, saw test $num";
- last;
- }
}
elsif (/^Bail out!\s*(.*)/i) { # magic words
die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
@@ -697,7 +690,7 @@ EOT
close $results;
if (not $failure) {
- $failure = 'FAILED--no leader found' unless $seen_leader;
+ $failure = "FAILED--no plan found next:$next" unless defined $plan;
}
_check_valgrind(\$toolnm, \$grind_ct, \$test);
@@ -705,8 +698,8 @@ EOT
if ($type eq 'deparse' && !$ENV{KEEP_DEPARSE_FILES}) {
unlink "./$test.dp";
}
- if (not $failure and $next != $max) {
- $failure="FAILED--expected $max tests, saw $next";
+ if (not $failure and $nextreps != $Reps * $plan) {
+ $failure="FAILED--expected $Reps * $plan tests, saw $nextreps";
}
if (not $failure and $? ) { # don't mask a test failure
@@ -738,7 +731,7 @@ EOT
$failed_tests{$test} = 1;
}
else {
- if ($max) {
+ if ($plan) {
my ($elapsed, $etms) = ("", 0);
if ( $show_elapsed_time ) {
$etms = (Time::HiRes::time() - $test_start_time) * 1000;
@@ -768,6 +761,8 @@ EOT
}
else {
die "FAILED--no tests were run for some reason.\n";
+ # forex: ./perl TEST run/dtrace.t
+ # 1..0 # Skip no dtrace
}
}
else {
--
From d9f883dd51b0749fcb2a25a1cfad88436c694beb Mon Sep 17 00:00:00 2001 Commit 8e03ad8 wrote the tests' timing data to a Storable file t/TEST | 12 ++++++------ Inline Patchdiff --git a/t/TEST b/t/TEST
index 1b5dd09..f29d9e9 100755
--- a/t/TEST
+++ b/t/TEST
@@ -814,13 +814,13 @@ SHRDLU_5
print "$tot\n";
if ($good_files) {
if (-d $show_elapsed_time) {
- # HARNESS_TIMER = <a-directory>. Save timings etc to
- # storable file there. NB: the test cds to ./t/, so
- # relative path must account for that, ie ../../perf
- # points to dir next to source tree.
+ # HARNESS_TIMER = <a-directory>. Save a storable file of
+ # timings data into the dir. NB: the test cds to ./t/, so
+ # relative path must account for that, or better, just
+ # give an abs-path.
require Storable;
my $fn = "$show_elapsed_time/$::tstamp.ttimes";
- Storable::store({ perf => \%timings,
+ Storable::store({ times => \%timings,
gather_conf_platform_info(),
total => $tot,
}, $fn);
@@ -859,7 +859,7 @@ sub gather_conf_platform_info {
load => [ grep chomp, `uptime` ],
},
host => (grep chomp, `hostname -f`),
- version => '0.03', # bump for conf, platform, or data collection changes
+ version => '0.031', # bump for conf, platform, or data collection changes
);
}
-- 1.8.3.1 From 2c86dc105ab67b46e636728d5387226703347e47 Mon Sep 17 00:00:00 2001 Recent addition of -w on shebang exposed 2 uninitialized vars, due to 1. make test.valgrind Since 2 is rather non-obvious, clarify with comment here and in code. TODO: this patch is old, and either needs to be revalidated, or t/TEST | 4 +++- Inline Patchdiff --git a/t/TEST b/t/TEST
index f29d9e9..1f02596 100755
--- a/t/TEST
+++ b/t/TEST
@@ -879,10 +879,12 @@ sub _check_valgrind {
warn "$0: Failed to open '$Valgrind_Log': $!\n";
}
}
+ # todo: precede if clause with $ENV{VG_OPTS} &&
if ($ENV{VG_OPTS} =~ /(cachegrind)/ or $$toolnm =~ /(perf)/) {
$$toolnm = $1;
if ($$toolnm eq 'perf') {
- # append perfs subcommand, not just stat
+ # TBD: need VG_TEST=--help to pass test.valgrind when
From 4f036d1a02062ca62a5351b2c96f0f151402043d Mon Sep 17 00:00:00 2001 This patch creates an empty t/TestValgrind.pm file, and requires it I propose that the "no require allowed" rule appply to code reached Code used only for special case testing, like "make test.valgrind", or A broken require is not something seen until the statement is executed make test.valgrind If this argument is accepted, it looks simple to move the VALGRIND MANIFEST | 1 + Inline Patchdiff --git a/MANIFEST b/MANIFEST
index 356a73f..42a7e85 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5467,6 +5467,7 @@ t/run/switchx3.aux Data for switchx.t
t/run/switchx.aux Data for switchx.t
t/run/switchx.t Test the -x switch
t/TEST The regression tester
+t/TestValgrind.pm make test.valgrind support
t/test.pl Simple testing library
t/test_pl/can_isa_ok.t Tests for the simple testing library
t/test_pl/_num_to_alpha.t Tests for the simple testing library
diff --git a/t/TEST b/t/TEST
index 1f02596..dc018ce 100755
--- a/t/TEST
+++ b/t/TEST
@@ -172,6 +172,10 @@ if ($::do_nothing || $::do_nothing) { # set by
+if ($ENV{PERL_VALGRIND}) { Inline Patchdiff --git a/t/TestValgrind.pm b/t/TestValgrind.pm
new file mode 100644
index 0000000..0afc604
--- /dev/null
+++ b/t/TestValgrind.pm
@@ -0,0 +1 @@
+1;
--
[jimc@groucho perl]$ |
From @jimctest-perf.patchFrom 79eceb6119bd51361a0b399f896dfa868cd14e56 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Fri, 19 Oct 2012 13:22:39 -0600
Subject: [PATCH 01/11] t/TEST: add -w to shebang, fix a used-once warning
Adding -w should be ok, despite peculiar code style; it avoids
require, unlike "use strict". Added risk of perl brokenness seems
vanishingly small. Fix one used-once warning thus exposed, and one
test in FileHandle.t surprised by t/TEST's new '-w' in the shebang.
---
lib/FileHandle.t | 2 +-
t/TEST | 4 ++--
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/lib/FileHandle.t b/lib/FileHandle.t
index f4a8800..3c6f593 100644
--- a/lib/FileHandle.t
+++ b/lib/FileHandle.t
@@ -29,7 +29,7 @@ my $fh = (new FileHandle "./TEST", O_RDONLY
ok(defined($fh), "create new handle O_RDONLY");
my $buffer = <$fh>;
-is($buffer, "#!./perl\n", "Got expected first line via handle");
+is($buffer, "#!./perl -w\n", "Got expected first line via handle");
ungetc $fh ord 'A';
my $buf;
diff --git a/t/TEST b/t/TEST
index 9772490..15d59b7 100755
--- a/t/TEST
+++ b/t/TEST
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -w
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for. (This comment is
@@ -108,7 +108,7 @@ my %skip = (
);
-if ($::do_nothing) {
+if ($::do_nothing || $::do_nothing) { # set by harness b4 requiring us
return 1;
}
--
1.8.3.1
From a9f81eefbc93277decccf9b956bb4ebd10552c19 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Fri, 19 Oct 2012 21:29:39 -0600
Subject: [PATCH 02/11] t/TEST: move our @found out to its real scope
commit c96083ea8213 added our @found inside sub _find_tests,
but testing with strict exposes probs:
$ perl -cw -Ilib -Mstrict t/TEST
Variable "@found" is not imported at t/TEST line 198.
Variable "@found" is not imported at t/TEST line 202.
Global symbol "@found" requires explicit package name at t/TEST line 198.
Global symbol "@found" requires explicit package name at t/TEST line 202.
No point in arguing, hoist decl out to file scope.
---
t/TEST | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/t/TEST b/t/TEST
index 15d59b7..8026c53 100755
--- a/t/TEST
+++ b/t/TEST
@@ -163,7 +163,8 @@ if ($show_elapsed_time) { require Time::HiRes }
my %timings = (); # testname => [@et] pairs if $show_elapsed_time.
# Roll your own File::Find!
-sub _find_tests { our @found=(); push @ARGV, _find_files('\.t$', $_[0]) }
+our @found;
+sub _find_tests { @found = (); push @ARGV, _find_files('\.t$', $_[0]) }
sub _find_files {
my($patt, @dirs) = @_;
for my $dir (@dirs) {
--
1.8.3.1
From ba22a3ed7d42620606f811c1a3ad5eb00c4d972a Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Sun, 7 Oct 2012 11:10:16 -0600
Subject: [PATCH 03/11] t/TEST: $failure doesnt need to use defined
$failure handling in <$results> processing loop does not need extra
subtlety of defined-ness checks - just give it an initial (false)
value, and check for truth.
---
t/TEST | 14 ++++++--------
1 file changed, 6 insertions(+), 8 deletions(-)
diff --git a/t/TEST b/t/TEST
index 8026c53..9ad23a9 100755
--- a/t/TEST
+++ b/t/TEST
@@ -531,7 +531,7 @@ EOT
my $grind_ct = 0; # count of non-empty valgrind reports
my $total_files = @tests;
my $good_files = 0;
- my $tested_files = 0;
+ my $tested_files = 0;
my $totmax = 0;
my %failed_tests;
my $toolnm; # valgrind, cachegrind, perf
@@ -567,7 +567,7 @@ EOT
my $results = _run_test($test, $type);
- my $failure;
+ my $failure = "";
my $next = 0;
my $seen_leader = 0;
my $seen_ok = 0;
@@ -660,7 +660,7 @@ EOT
}
close $results;
- if (not defined $failure) {
+ if (not $failure) {
$failure = 'FAILED--no leader found' unless $seen_leader;
}
@@ -669,13 +669,11 @@ EOT
if ($type eq 'deparse' && !$ENV{KEEP_DEPARSE_FILES}) {
unlink "./$test.dp";
}
- if (not defined $failure and $next != $max) {
+ if (not $failure and $next != $max) {
$failure="FAILED--expected $max tests, saw $next";
}
- if( !defined $failure # don't mask a test failure
- and $? )
- {
+ if (not $failure and $? ) { # don't mask a test failure
$failure = "FAILED--non-zero wait status: $?";
}
@@ -692,7 +690,7 @@ EOT
}
}
- if (defined $failure) {
+ if ($failure) {
print "${te}$failure\n";
$::bad_files = $::bad_files + 1;
if ($test =~ /^base/ && ! defined &DynaLoader::boot_DynaLoader) {
--
1.8.3.1
From 8b42821106e92c87e47718373ded25c8b1e7fab2 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Fri, 19 Oct 2012 13:43:11 -0600
Subject: [PATCH 04/11] t/TEST: add a common timestamp
Commit 0978c4bed computed a timestamp string as part of an output
filename, make it available for others.
---
t/TEST | 10 +++++++---
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/t/TEST b/t/TEST
index 9ad23a9..c540869 100755
--- a/t/TEST
+++ b/t/TEST
@@ -122,6 +122,12 @@ $| = 1;
@ARGV = grep($_,@ARGV) if $^O eq 'VMS';
our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
+{ # create timestamp for any reports written, so theyre corelatable
+ my @dt = localtime;
+ $dt[5] += 1900; $dt[4] += 1; # fix year, month
+ $::tstamp = sprintf("%d-%.2d%.2d-%.2d%.2d-%.2d-$$", @dt[5,4,3,2,1,0]);
+}
+
# Cheesy version of Getopt::Std. We can't replace it with that, because we
# can't rely on require working.
{
@@ -788,9 +794,7 @@ SHRDLU_5
# relative path must account for that, ie ../../perf
# points to dir next to source tree.
require Storable;
- my @dt = localtime;
- $dt[5] += 1900; $dt[4] += 1; # fix year, month
- my $fn = "$show_elapsed_time/".join('-', @dt[5,4,3,2,1]).".ttimes";
+ my $fn = "$show_elapsed_time/$::tstamp.ttimes";
Storable::store({ perf => \%timings,
gather_conf_platform_info(),
total => $tot,
--
1.8.3.1
From 4ee55210d525327bf679462f0d2990f73b3253e1 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Fri, 19 Oct 2012 21:26:35 -0600
Subject: [PATCH 05/11] t/TEST: comment some of the <$results> loop vars
Add comments to var declarations, to help clarify loop operation.
---
t/TEST | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/t/TEST b/t/TEST
index c540869..b5bf9bc 100755
--- a/t/TEST
+++ b/t/TEST
@@ -574,11 +574,11 @@ EOT
my $results = _run_test($test, $type);
my $failure = "";
- my $next = 0;
- my $seen_leader = 0;
- my $seen_ok = 0;
- my $trailing_leader = 0;
- my $max;
+ my $next = 0; # ++ after each ok M
+ my $seen_leader = 0; # set after "1..N"
+ my $seen_ok = 0; # set after "ok M"
+ my $trailing_leader = 0; # set after "1..N" if $seen_ok
+ my $max; # set to N after "1..N"
my %todo;
while (<$results>) {
next if /^\s*$/; # skip blank lines
--
1.8.3.1
From d651d8c4685ed2c99e4892cbaad5cd2a49ab8619 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Sat, 16 Nov 2013 11:32:44 -0700
Subject: [PATCH 06/11] t/TEST: move do_nothing test after option-handling code
As explained in commit c537bcda1, $do_nothing's purpose is to prevent
TEST from actually running the tests, so that it can be required by
harness, and its routines reused.
This patch moves TEST's $do_nothing check after its option-handling
code, allowing those options to be used to alter the behavior of the
TEST subroutines when called by harness, the same as when they're
called from TEST::main.
TODO: With TEST's option handling done even for $do_nothing cases, it
consumes all options before harness sees them, so harness options -v
and -torture are broken. There are multiple ways to handle it, all
needing some consensus:
- harness does selective option scanning before requiring TEST. It
could either consume its options or pass them thru once it handles
them.
- both -v and -torture are implemented by TEST and harness, and mean
qualitatively the same thing. OTOH, any consumers of the respective
outputs may care about differences. Simply, could rename one of
each option to avoid the conflict.
- use of $TEST::verbose (or are namespaces also to be avoided?)
---
t/TEST | 9 ++++-----
1 file changed, 4 insertions(+), 5 deletions(-)
diff --git a/t/TEST b/t/TEST
index b5bf9bc..c61cda2 100755
--- a/t/TEST
+++ b/t/TEST
@@ -107,11 +107,6 @@ my %skip = (
'.svn' => 1,
);
-
-if ($::do_nothing || $::do_nothing) { # set by harness b4 requiring us
- return 1;
-}
-
$| = 1;
# for testing TEST only
@@ -150,6 +145,10 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
@ARGV = @argv;
}
+if ($::do_nothing || $::do_nothing) { # set by harness b4 requiring us
+ return 1;
+}
+
chdir 't' if -f 't/TEST';
if (-f 'TEST' && -f 'harness' && -d '../lib') {
@INC = '../lib';
--
1.8.3.1
From c30213f0fe6a3d2f452a86f82439fb85b8770e25 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Sun, 7 Oct 2012 20:22:08 -0600
Subject: [PATCH 07/11] t/TEST: add -lxperf option to run tests under linux's
perf stat
With this patch, TEST can run each test-script under linux's perf
stat. Since previous patch honors options for $do_nothing / requires,
harness can use perf stat too.
t]$ ./perl -I../lib TEST -lxperf
t]$ ./perl harness -lxperf
"perf stat" output is comparable to that of "valgrind --tool=cachegrind"
but it takes very little extra CPU to run:
export TEST_OPTS=-lxperf
time make test time make test
-------------- --------------
real 25m41.122s real 26m30.719s
user 18m28.773s user 18m43.286s
sys 1m12.705s sys 1m33.398s
Given this small runtime cost, porters might be inclined to use it and
inspect the data. There may be some core regression tests that are
useful for benchmarking purposes.
EXAMPLES:
Performance counter stats for './perl base/cond.t':
2.077911 task-clock # 0.640 CPUs utilized
2 context-switches # 0.963 K/sec
1 cpu-migrations # 0.481 K/sec
519 page-faults # 0.250 M/sec
2,753,978 cycles # 1.325 GHz
1,725,265 stalled-cycles-frontend # 62.65% frontend cycles idle
2,405,122 stalled-cycles-backend # 87.33% backend cycles idle
3,278,429 instructions # 1.19 insns per cycle
# 0.73 stalled cycles per insn [52.13%]
<not counted> branches
<not counted> branch-misses
0.003244748 seconds time elapsed
perf stat --repeat N also computes std-deviation for each measurement
it does, so this patch makes that feature available. Std-dev will
tell us when performance differences are lost in the noise.
./perl TEST -v -lxperf=10 re/pat_rt_report.t
perf stat --repeat 10 -- ./perl -I.. -MTestInit re/pat_rt_report.t
./perl -I.. -MTestInit re/pat_rt_report.t
Performance counter stats for './perl -I.. -MTestInit re/pat_rt_report.t' (10 runs):
98.749506 task-clock # 0.001 CPUs utilized ( +- 23.68% )
68 context-switches # 0.686 K/sec ( +- 82.04% )
10 cpu-migrations # 0.097 K/sec ( +- 17.44% )
2,956 page-faults # 0.030 M/sec ( +- 23.22% )
254,477,657 cycles # 2.577 GHz ( +- 26.02% ) [50.43%]
75,556,485 stalled-cycles-frontend # 29.69% frontend cycles idle ( +- 19.50% ) [50.93%]
62,921,965 stalled-cycles-backend # 24.73% backend cycles idle ( +- 25.21% ) [51.50%]
241,522,257 instructions # 0.95 insns per cycle
# 0.31 stalled cycles per insn ( +- 34.07% ) [50.96%]
53,147,072 branches # 538.201 M/sec ( +- 31.19% ) [50.18%]
2,451,318 branch-misses # 4.61% of all branches ( +- 11.32% ) [49.95%]
141.101988701 seconds time elapsed ( +- 99.91% )
The patch has 3 parts:
An addition to TEST:_cmd() which wraps the test invocation inside a
"perf stat ..." as shown above, using a %cmdwrap template.
Option-parsing code, which handles several option forms:
1) -lxperf
writes file "$tstamp.perf" into ./t (after `cd $t && ...`)
2) -lxperf=4
adds "--repeat 4" to perf stat invocation.
3) -lxperf=(key=val) pairs
known key=value pairs (with =defaults given)
- tool=perf # path to tool
- cmd=stat # todo try others, perf record, etc
- reps=1 #
- rptdir # write reports to a separate data-repo, safe from git clean -dxf
- name # to convey branch-name and/or config-info, tstamp is prefixed,
- opts # passthru options to perf-stat
$ENV{TEST_OPTS} is split on /;/ and prepended to @ARGV before option
handling, so the following export will affect both make jobs.
export TEST_OPTS="-v;-lxperf=reps=3:rptdir=$HOME/perl/perfdata"
make test
make test_harness
NOTES:
Test script output under perf stat --repeat 4 violates the "plan just
once" rule of TAPv13 spec. It could be extended:
"The plan cannot appear in the middle of the output, only at
beginning or end. Multiple sets of (plan + tests) are allowed, if
all plans agree"
perf stat --repeat N causes perf to compute std-deviation(s) for each
measure. 1st example below is w/o repeat, 2nd with it, corresponding
to the TEST and harness examples above. I dont know how to read into
the numbers, but theres value in having them; they provide some
estimate of "noise-floor" on performance for a given test.
The -opts option passthru to perf stat allows "-x," to cause perf stat
to emit CSV output. This is easier to parse than the human readable
output, but doesnt include the computed/normalized values, nor the
name that the "Performance counter stats" (see examples) are for.
TODO
Probable rework of -lxperf option parsing
- no way now to get output to STDOUT, only to file. maybe not worth having
- keep (k=v:)+ form
- use name="%B-%G-%T.perf" by default "$branch-$sha1st6-$timestamp.perf"
- use wr=1 to save file
- dir=$HOME/perfruns (shorten rptdir)
Using reps=2 yields "FAILED--seen duplicate leader" on every test.
Fixing this requires changes to TEST's <results> processing loop. The
reps handling sub-option code is in this patch because it serves as a
test-case for further changes to optional behavior.
The command wrapper template is pretty minimal and constrained; the
output file name is "$dir/$timestamp$name.perfstat", chosen to match
with $timestamp.ttimes so that both file-types are browsable as a pair.
TEST_OPTS is split on ';', -lxperf is split on ':' into k=v pairs.
There may be scenarios where these delimiters are inconvenient, or the
simplistic parse is brittle.
Performance counter stats for './perl base/cond.t' (3 runs):
---
t/TEST | 33 ++++++++++++++++++++++++++++++++-
1 file changed, 32 insertions(+), 1 deletion(-)
diff --git a/t/TEST b/t/TEST
index c61cda2..fd07c6b 100755
--- a/t/TEST
+++ b/t/TEST
@@ -113,6 +113,9 @@ $| = 1;
#BEGIN { require '../lib/strict.pm'; "strict"->import() };
#BEGIN { require '../lib/warnings.pm'; "warnings"->import() };
+# allow setting -options from env
+unshift @ARGV, split /;/, $ENV{TEST_OPTS} if $ENV{TEST_OPTS};
+
# remove empty elements due to insertion of empty symbols via "''p1'" syntax
@ARGV = grep($_,@ARGV) if $^O eq 'VMS';
our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
@@ -123,12 +126,22 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
$::tstamp = sprintf("%d-%.2d%.2d-%.2d%.2d-%.2d-$$", @dt[5,4,3,2,1,0]);
}
+# wrapper template for linux perf
+our %cmdwrap = (
+ tool => "perf", # path
+ cmd => "stat", # others possible, none tried
+ rptdir => $ENV{PWD}, # typically ./t, better if absolute
+ name => "", # $::tstamp prefixed implicitly
+ # reps => 1 #
+ opts => "", # pass-thru to perf stat: 'opts=-x,' gives CSV
+ );
+
# Cheesy version of Getopt::Std. We can't replace it with that, because we
# can't rely on require working.
{
my @argv = ();
foreach my $idx (0..$#ARGV) {
- push( @argv, $ARGV[$idx] ), next unless $ARGV[$idx] =~ /^-(\S+)$/;
+ push( @argv, $ARGV[$idx] ), next unless $ARGV[$idx] =~ /^-(\S+?)(?:=(.+))?$/;
$::benchmark = 1 if $1 eq 'benchmark';
$::core = 1 if $1 eq 'core';
$::verbose = 1 if $1 eq 'v';
@@ -141,6 +154,16 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
$::deparse_opts = $1;
_process_deparse_config();
}
+ if ($1 eq 'lxperf') {
+ die "perf only available on linux" unless $^O eq 'linux';
+ $::perf = 1;
+ next unless $2;
+ # $2 is either Reps or : delimited $k=$v pairs
+ my (@v) = split /:/, $2;
+ $cmdwrap{reps} = $v[0] if @v == 1 and $v[0] =~ /^\d+$/;
+ # parse as $k=$v to override %cmdwrap defaults
+ m/(.+?)=(.+)/ and $cmdwrap{$1} = $2 for @v;
+ }
}
@ARGV = @argv;
}
@@ -308,6 +331,14 @@ sub _cmd {
}
$perl = "$valgrind_exe $vg_opts $perl";
}
+ if ($::perf) {
+ my $ofile = "$cmdwrap{rptdir}/$::tstamp$cmdwrap{name}.perf";
+ my $wrapper = "$cmdwrap{tool} $cmdwrap{cmd} "
+ . ( defined $cmdwrap{reps} && $cmdwrap{reps} > 0
+ ? "--repeat $cmdwrap{reps}" : "" )
+ . " --append -o $ofile $cmdwrap{opts} -- ";
+ $perl = "$wrapper $perl";
+ }
my $args = "$options->{testswitch} $options->{switch} $options->{utf8}";
$cmd = $perl . _quote_args($args) . " $test $redir";
--
1.8.3.1
From acfd39ca5d655d2aa4afd5317ef116e5c844373b Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Wed, 20 Nov 2013 11:43:57 -0700
Subject: [PATCH 08/11] t/TEST: simplify <$results> processing loop. - TAP13.1+
Support use of the --repeat=3 option of linux's perf stat. This
basically means extending the TAPv13 spec (or t/TEST's implementation)
to allow repeated (ie R) plan executions (ie R occurrences of "1..N"
plus the preceding or following N * "ok"s), as long as all R plans
have the same N.
When a test script is run (under linux perf with --repeat=N), the
value of R is unavailable in the output; it is transparent other than
the repetition itself. But we woundnt want it anyway; TAP readers
dont need to handle a new kind of input. If we just allow R
repetitions of 1..N tests, we get loose coupling and dont care if
--repeat=5 were given.
Current legal TAP is essentially either:
print "ok $_\n" for 1..N; # 1A
print "1..N\n";
# OR [1]
print "1..N\n"; # 1B
print "ok $_\n" for 1..N;
The big simplification here is that under --repeat, leading vs
trailing "1..N"s are an irrelevant detail.
- "1..N" plans are only allowed before any tests, or after all of
them, ie ($next==0 or $next==$plan). We just verify this when
"1..N" is seen in test output.
- $plan = undef initially, updated to N when "1..N" is 1st seen.
- $next=0 when "1..N" is seen [2].
- when 2nd+ "1..N" plans are seen, they are allowed if they agree on N.
- The change to if (defined $plan) accepts "1..0" as legal (ie SKIPs).
- $seen_leader and $trailing_leader are thus obsolete, replaced where
needed by "if ($plan)", which is set only when "1..N" is seen.
- $seen_ok was used with $seen_leader to reset $next (test-count).
now handled in [2]
- $max is also taken right from "1..N", replaced with <some-expr>($plan)
NOTES:
[1]: this patch allows BOTH 1A then 1B to run successfully, but not 1B
followed by 1A; the latter would fail on N+1 th test, because the
now-trailing "1..N" failed to reset $next. This is an unimportant
corner case and doesnt warrant cluttering details in the code.
We are running maintained regression tests here, not logic bombs.
- On "1..N" occurrences:
$Reps++ to count repeats (tested at end)
reset $next = 0 after validating it [1]
$nextreps++, like $next w/o reset.
- post-loop tests:
change ($next == $max) test to ($nextreps == $Reps * $plan),
which avoids the now resetting $next.
TODO:
This patch supports --repeat N in t/TEST only; harness is strict wrt
"only 1 plan", ala TAPv13, so make test_harness complains as follows,
and fails the tests.
comp/use.t ........................................................ All 84 subtests passed
comp/retainedlines.t .............................................. All 75 subtests passed
comp/cmdopt.t ..................................................... All 44 subtests passed
Sort whats reported in summary data; unique tests or repeated tests ?
Reduce $totmax vs $max vs $Reps a bit, extra/redundant state is not helpful.
---
t/TEST | 87 +++++++++++++++++++++++++++++++-----------------------------------
1 file changed, 41 insertions(+), 46 deletions(-)
diff --git a/t/TEST b/t/TEST
index fd07c6b..1b5dd09 100755
--- a/t/TEST
+++ b/t/TEST
@@ -568,7 +568,7 @@ EOT
my $total_files = @tests;
my $good_files = 0;
my $tested_files = 0;
- my $totmax = 0;
+ my $totmax = 0; # += $plan after <$results> consumed. includes --repeats
my %failed_tests;
my $toolnm; # valgrind, cachegrind, perf
@@ -604,11 +604,10 @@ EOT
my $results = _run_test($test, $type);
my $failure = "";
- my $next = 0; # ++ after each ok M
- my $seen_leader = 0; # set after "1..N"
- my $seen_ok = 0; # set after "ok M"
- my $trailing_leader = 0; # set after "1..N" if $seen_ok
- my $max; # set to N after "1..N"
+ my $plan = undef; # the N in "1..N"
+ my $next = 0; # ++ after each "ok M", reset on "1..N"
+ my $nextreps = 0; # ++ after each "ok M"
+ my $Reps = 0; # ++ when "1..N" seen
my %todo;
while (<$results>) {
next if /^\s*$/; # skip blank lines
@@ -624,47 +623,45 @@ EOT
print $_;
}
unless (/^\#/) {
- if ($trailing_leader) {
- # shouldn't be anything following a postfix 1..n
- $failure = 'FAILED--extra output after trailing 1..n';
- last;
- }
if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) {
- if ($seen_leader) {
- $failure = 'FAILED--seen duplicate leader';
- last;
- }
- $max = $1;
- %todo = map { $_ => 1 } split / /, $3 if $3;
- $totmax = $totmax + $max;
- $tested_files = $tested_files + 1;
- if ($seen_ok) {
- # 1..n appears at end of file
- $trailing_leader = 1;
- if ($next != $max) {
- $failure = "FAILED--expected $max tests, saw $next";
+
+ # a "1..N" plan, maybe todos also
+ if (!$plan) {
+ $plan = $1;
+ } else {
+ # allow another plan agreeing on N
+ if ($1 != $plan) {
+ $failure = "latest plan disagrees: $1 != $plan\n";
last;
}
}
- else {
- $next = 0;
+ unless ($next == 0 or $next == $plan) {
+ $failure = "plan seen in middle of tests: $next\n";
+ last;
}
- $seen_leader = 1;
+ $Reps = $Reps + 1;
+ $next = 0; # reset for next "1..N" plan check
+
+ $totmax = $totmax + $plan;
+ $tested_files = $tested_files + 1;
+
+ # if $Reps>1, this work is redone $Reps-1 times, trivial extra.
+ # assume todos match, since plans do.
+ %todo = map { $_ => 1 } split / /, $3 if $3;
+ next;
}
else {
- if (/^(not )?ok(?: (\d+))?[^\#]*(\s*\#.*)?/) {
- unless ($seen_leader) {
- unless ($seen_ok) {
- $next = 0;
- }
- }
- $seen_ok = 1;
+ if (/^(not )?ok(?:\s+(\d+))?[^\#]*(\s*\#.*)?/) {
$next = $next + 1;
- my($not, $num, $extra, $istodo) = ($1, $2, $3, 0);
- $num = $next unless $num;
-
- if ($num == $next) {
+ $nextreps = $nextreps + 1;
+ my ($not, $num, $extra, $istodo) = ($1, $2, $3, 0);
+ $num = $next unless $num; # tolerate un-numbered
+ if ($num != $next) {
+ $failure ="FAILED--expected test $next, saw test $num";
+ last;
+ }
+ else {
# SKIP is essentially the same as TODO for t/TEST
# this still conforms to TAP:
# http://testanything.org/wiki/index.php/TAP_specification
@@ -676,10 +673,6 @@ EOT
last;
}
}
- else {
- $failure ="FAILED--expected test $next, saw test $num";
- last;
- }
}
elsif (/^Bail out!\s*(.*)/i) { # magic words
die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
@@ -697,7 +690,7 @@ EOT
close $results;
if (not $failure) {
- $failure = 'FAILED--no leader found' unless $seen_leader;
+ $failure = "FAILED--no plan found next:$next" unless defined $plan;
}
_check_valgrind(\$toolnm, \$grind_ct, \$test);
@@ -705,8 +698,8 @@ EOT
if ($type eq 'deparse' && !$ENV{KEEP_DEPARSE_FILES}) {
unlink "./$test.dp";
}
- if (not $failure and $next != $max) {
- $failure="FAILED--expected $max tests, saw $next";
+ if (not $failure and $nextreps != $Reps * $plan) {
+ $failure="FAILED--expected $Reps * $plan tests, saw $nextreps";
}
if (not $failure and $? ) { # don't mask a test failure
@@ -738,7 +731,7 @@ EOT
$failed_tests{$test} = 1;
}
else {
- if ($max) {
+ if ($plan) {
my ($elapsed, $etms) = ("", 0);
if ( $show_elapsed_time ) {
$etms = (Time::HiRes::time() - $test_start_time) * 1000;
@@ -768,6 +761,8 @@ EOT
}
else {
die "FAILED--no tests were run for some reason.\n";
+ # forex: ./perl TEST run/dtrace.t
+ # 1..0 # Skip no dtrace
}
}
else {
--
1.8.3.1
From d9f883dd51b0749fcb2a25a1cfad88436c694beb Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Thu, 21 Nov 2013 16:22:09 -0700
Subject: [PATCH 09/11] t/TEST: change timings Storable key: perf -> times, a
better description
Commit 8e03ad8f6c wrote the tests' timing data to a Storable file
using 'perf' as the storage key, but now that we can capture real perf
stat data during make test, the old name is misleading - change it to
"times" to better describe its origin and character.
---
t/TEST | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/t/TEST b/t/TEST
index 1b5dd09..f29d9e9 100755
--- a/t/TEST
+++ b/t/TEST
@@ -814,13 +814,13 @@ SHRDLU_5
print "$tot\n";
if ($good_files) {
if (-d $show_elapsed_time) {
- # HARNESS_TIMER = <a-directory>. Save timings etc to
- # storable file there. NB: the test cds to ./t/, so
- # relative path must account for that, ie ../../perf
- # points to dir next to source tree.
+ # HARNESS_TIMER = <a-directory>. Save a storable file of
+ # timings data into the dir. NB: the test cds to ./t/, so
+ # relative path must account for that, or better, just
+ # give an abs-path.
require Storable;
my $fn = "$show_elapsed_time/$::tstamp.ttimes";
- Storable::store({ perf => \%timings,
+ Storable::store({ times => \%timings,
gather_conf_platform_info(),
total => $tot,
}, $fn);
@@ -859,7 +859,7 @@ sub gather_conf_platform_info {
load => [ grep chomp, `uptime` ],
},
host => (grep chomp, `hostname -f`),
- version => '0.03', # bump for conf, platform, or data collection changes
+ version => '0.031', # bump for conf, platform, or data collection changes
);
}
--
1.8.3.1
From 2c86dc105ab67b46e636728d5387226703347e47 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Thu, 5 Dec 2013 19:29:15 -0700
Subject: [PATCH 10/11] t/TEST: suppress 2 uninitialized envars under make
test.valgrind
Recent addition of -w on shebang exposed 2 uninitialized vars, due to
VG_OPTS envar added in commit 11b1a7c9, which added glue to reuse
t/TEST's support for make test.valgrind to run linux perf. The 2
use-cases are:
1. make test.valgrind
2. export VG_OPTS='stat -o perf-stat --append --'
export VALGRIND=/usr/bin/perf
export VG_TEST=--help
make test.valgrind
Since 2 is rather non-obvious, clarify with comment here and in code.
TODO: this patch is old, and either needs to be revalidated, or
perhaps rethought; use-case 2 is mostly obsoleted by -lxperf option,
but case 1 still holds.
---
t/TEST | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/t/TEST b/t/TEST
index f29d9e9..1f02596 100755
--- a/t/TEST
+++ b/t/TEST
@@ -879,10 +879,12 @@ sub _check_valgrind {
warn "$0: Failed to open '$Valgrind_Log': $!\n";
}
}
+ # todo: precede if clause with $ENV{VG_OPTS} &&
if ($ENV{VG_OPTS} =~ /(cachegrind)/ or $$toolnm =~ /(perf)/) {
$$toolnm = $1;
if ($$toolnm eq 'perf') {
- # append perfs subcommand, not just stat
+ # TBD: need VG_TEST=--help to pass test.valgrind when VALGRIND=/usr/bin/perf
+ # VG_OPTS='stat -o perf-stat --append --' is also needed to run perf this way.
my ($sub) = split /\s/, $ENV{VG_OPTS};
$$toolnm .= "-$sub";
}
--
1.8.3.1
From 4f036d1a02062ca62a5351b2c96f0f151402043d Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Thu, 5 Dec 2013 21:28:50 -0700
Subject: [PATCH 11/11] t/TEST: RFC start to separate out valgrind test
support.
This patch creates an empty t/TestValgrind.pm file, and requires it
from t/TEST when ENV{PERL_VALGRIND} is set. As such its seeks to
reinterpret the comments at the top of t/TEST.
I propose that the "no require allowed" rule appply to code reached
from "make test" without options.
Code used only for special case testing, like "make test.valgrind", or
with options passed in via $ENV{TEST_OPTS}, need not be constrained
like this.
A broken require is not something seen until the statement is executed
and throws an error. There is nothing special about require at
parse-time that must be avoided, unless we're more than typically
paranoid.
make test.valgrind
/bin/sh -e ./runtests choose
./perl TEST
sh -c valgrind --log-fd=3 --suppressions=perl.supp --leak-check=yes --leak-resolution=high --show-reachable=yes --num-callers=50 --track-origins=yes ./perl -I.. -MTestInit porting/podcheck.t 3>podcheck.t.valgrind-current
valgrind --log-fd=3 --suppressions=perl.supp --leak-check=yes --leak-resolution=high --show-reachable=yes --num-callers=50 --track-origins=yes ./perl -I.. -MTestInit porting/podcheck.t
If this argument is accepted, it looks simple to move the VALGRIND
related code blocks into new subroutines in the now-empty
TestValgrind.pm file, and call them appropriately.
---
MANIFEST | 1 +
t/TEST | 4 ++++
t/TestValgrind.pm | 1 +
3 files changed, 6 insertions(+)
create mode 100644 t/TestValgrind.pm
diff --git a/MANIFEST b/MANIFEST
index 356a73f..42a7e85 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5467,6 +5467,7 @@ t/run/switchx3.aux Data for switchx.t
t/run/switchx.aux Data for switchx.t
t/run/switchx.t Test the -x switch
t/TEST The regression tester
+t/TestValgrind.pm make test.valgrind support
t/test.pl Simple testing library
t/test_pl/can_isa_ok.t Tests for the simple testing library
t/test_pl/_num_to_alpha.t Tests for the simple testing library
diff --git a/t/TEST b/t/TEST
index 1f02596..dc018ce 100755
--- a/t/TEST
+++ b/t/TEST
@@ -172,6 +172,10 @@ if ($::do_nothing || $::do_nothing) { # set by harness b4 requiring us
return 1;
}
+if ($ENV{PERL_VALGRIND}) {
+ require TestValgrind;
+}
+
chdir 't' if -f 't/TEST';
if (-f 'TEST' && -f 'harness' && -d '../lib') {
@INC = '../lib';
diff --git a/t/TestValgrind.pm b/t/TestValgrind.pm
new file mode 100644
index 0000000..0afc604
--- /dev/null
+++ b/t/TestValgrind.pm
@@ -0,0 +1 @@
+1;
--
1.8.3.1
|
From @tonycozOn Mon Nov 03 15:35:51 2014, yoduh wrote:
Fine, another solution would be to just remove the our in each case,
I don't think breaking harness is acceptable.
This would fail to detect a bug where a test script output its test output twice, even without --repeat=N If we're running with --repeat=N we're doing performance testing, perhaps an option to send the test output to /dev/null instead would be better. Tony |
|
The RT System itself - Status changed from 'new' to 'open' |
From @jhiI decided to take the leap and apply this set, on the principle that more perfomance (tooling) is good. Even though I seem to lack the 'perf' tool in any Linux box I can access. If there are problems, we can hammer them down. |
From @tonycozOn Thu Nov 06 18:07:30 2014, jhi wrote:
As you asked on IRC, here are some of the problems, most of which Jim mentions: - it breaks -v and -torture for harness: tony@mars:.../perl/t$ ./perl harness -v io/semctl.t - TEST now accepts duplicate TAP, which can potentially be caused by a bug: tony@mars:.../perl/t$ cat badtap.t - the patches were submitted as RFC, some discussion might be useful first. Tony |
From @jhiOn Thursday-201411-06, 22:27, Tony Cook via RT wrote:
Sorry, pulled the trigger too fast. I now reverted the whole thing. |
From @nwc10On Fri, Nov 07, 2014 at 06:41:48AM -0500, Jarkko Hietaniemi wrote:
I continue to feel strongly that if such features belong anywhere, it's in t/TEST needs to be reliable, and the best way to achieve that is KISS. t/harness can do the clever stuff. If anything, this also means that we should migrate existing funky stuff from Nicholas Clark |
Migrated from rt.perl.org#123119 (status was 'open')
Searchable as RT123119$
The text was updated successfully, but these errors were encountered: