Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[alpha] update README with Subversion->Github moves, tweak test_summa…

…ry.pl
  • Loading branch information...
commit fd0a1841c372875fd6d885fb8a768d8506a45ac4 1 parent 30e0ed3
Martin Berends mberends authored
Showing with 437 additions and 121 deletions.
  1. +39 −0 README
  2. +7 −0 Test.pm
  3. +391 −121 tools/test_summary.pl
39 README
View
@@ -57,6 +57,9 @@ Once you have a copy of Rakudo, build it as follows:
$ perl Configure.pl --gen-parrot
$ make
+Note: this no longer works. See "Loss of the Subversion Repositories"
+below for a workaround.
+
This will create a "perl6" or "perl6.exe" executable in the
current (rakudo) directory. Programs can then be run from
the build directory using a command like:
@@ -138,6 +141,42 @@ If you want to run the tests in parallel, you need to install a
fairly recent version of the Perl 5 module L<Test::Harness> (3.16
works for sure).
+=head3 Loss of the Subversion Repositories
+
+Since early 2010, Parrot and the Perl 6 test suite have moved from their
+respective Subversion repositories to Github. The Subversion servers
+are offline, so Rakudo's Configure.pl --gen-parrot and make testable
+procedures in Rakudo/alpha no longer work. Patches are welcome to adapt
+them to Git. In the meantime those wanting to build Rakudo/alpha should
+download a tarball from https://github.com/rakudo/rakudo/downloads or
+manually performs steps such as the following.
+
+ git clone git://github.com/rakudo/rakudo.git alpha
+ cd alpha
+ git checkout -b alpha --track remotes/origin/alpha
+ # The last Parrot 2.0.0 revision on which Rakudo/alpha was developed
+ # is r43487 from https://svn.parrot.org/parrot/trunk (now offline)
+ # which mapped to commit 8ebe2eaef15fc7724d67b953e7886f5d3db388ea
+ # according to the git log from https://github.com/parrot/parrot.
+ git clone git://github.com/parrot/parrot.git parrot
+ cd parrot
+ git reset --hard 8ebe2eaef15fc7724d67b953e7886f5d3db388ea
+ perl Configure.pl --prefix=`cd ..;pwd`/parrot_install
+ make install # Parrot
+ cd ..
+ perl Configure.pl --parrot-config=parrot_install/bin/parrot_config
+ make install # Rakudo
+ # The last Perl 6 spec tests on Rakudo/alpha were rev 29188 from
+ # http://svn.pugscode.org/pugs/t/spec (now offline) which mapped to
+ # commit 99adbfb2c7ddf7837994d59c48e18aafaee666ee according to the
+ # git log from https://github.com/perl6/roast.
+ git clone git://github.com/perl6/roast t/spec
+ cd t/spec
+ git reset --hard 99adbfb2c7ddf7837994d59c48e18aafaee666ee
+ cd ../..
+ # Optionally do some spectesting and benchmarking
+ time perl tools/test_summary.pl --timing
+
=head2 Where to get help or answers to questions
There are several mailing lists, IRC channels, and wikis available
7 Test.pm
View
@@ -13,6 +13,7 @@ our $todo_reason = '';
our $num_of_tests_planned;
our $no_plan = 1;
our $die_on_fail;
+our $perl6_test_times = ? %*ENV<PERL6_TEST_TIMES>;
our $GLOBAL::WARNINGS = 0;
@@ -40,6 +41,11 @@ multi sub plan($number_of_tests) is export(:DEFAULT) {
$no_plan = 0;
say '1..' ~ $number_of_tests;
+ # Emit two successive timestamps to measure the measurment overhead,
+ # and to eliminate cacheing bias, if it exists, from the first test.
+ say '# t=' ~ time() if $perl6_test_times;
+ say '# t=' ~ time() if $perl6_test_times;
+ # The time() function changed in later Rakudos to now.to-posix[0]
}
multi sub pass($desc) is export(:DEFAULT) {
@@ -242,6 +248,7 @@ sub proclaim($cond, $desc) {
print $todo_reason;
}
print "\n";
+ say '# t=' ~ time() if $perl6_test_times;
if !$cond && $die_on_fail && !$todo_reason {
die "Test failed. Stopping test";
512 tools/test_summary.pl
View
@@ -1,16 +1,18 @@
#! perl
-# Copyright (C) 2004-2009, The Perl Foundation.
+# Copyright (C) 2004-2010, The Perl Foundation.
# $Id$
## The "make spectest" target tells us how many tests we failed
-## (hopefully zero!), but doesn't say how many were actually passed.
+## (hopefully zero!), but doesn't say how many were actually passed.
## This script runs the spectest tests and summarizes
## passed, failed, todoed, skipped, executed and planned test results.
##
## Usage:
-## tools/test_summary.pl [testlist]
+## tools/test_summary.pl [--timing] [testlist]
##
+## The --timing option enables microsecond timing per test saved
+## in docs/test_summary.times.
## If supplied, C<testlist> identifies an alternate list of tests
## to use (e.g., t/localtest.data).
@@ -18,6 +20,13 @@
use warnings;
use Time::Local;
use Time::HiRes;
+use Getopt::Long;
+
+my $timing;
+GetOptions('timing', \$timing);
+my $benchmark;
+# Comment out the next line to skip benchmarking; see docs below
+$benchmark = Simple::Relative::Benchmarking::begin() if $timing;
# Build the list of test scripts to run in @tfiles
my $testlist = $ARGV[0] || 't/spectest.data';
@@ -35,8 +44,8 @@
# Fudge any Rakudo specific tests by running the fudgeall script
{
my $cmd = join ' ', $^X, 't/spec/fudgeall', 'rakudo', @tfiles;
- # Fudgeall prints the name of each test script, but changes the
- # name ending to .rakudo instead of .t if tests were fudged.
+ # Fudgeall prints the name of each test script, but changes the name
+ # ending to .rakudo instead of .t if tests were fudged.
print "$cmd\n";
@tfiles = split ' ', `$cmd`; # execute fudgeall, collect test names
}
@@ -57,7 +66,7 @@
# Prepare arrays and hashes to gather and accumulate test statistics
my @col = qw(pass fail todo skip plan spec);
-my @syn = qw(S02 S03 S04 S05 S06 S09 S10 S11 S12 S13 S14 S16 S17 S28 S29 S32 int);
+my @syn = qw(S02 S03 S04 S05 S06 S07 S09 S10 S11 S12 S13 S14 S16 S17 S19 S28 S29 S32 int);
my %syn; # number of test scripts per Synopsis
my %sum; # total pass/fail/todo/skip/test/plan per Synposis
my $syn;
@@ -69,23 +78,6 @@
}
$syn = ''; # to reliably trigger the display of column headings
-# start simple relative benchmarking
-my( %times, @interesting_times );
-if ( open( my $times, '<', 'docs/test_summary.times') ) {
- while ( <$times> ) {
- if (/^(.*),(\d+)-(\d+)-(\d+)\s(\d+):(\d+):(\d+),(.*)/) {
- my ( $testname, $year, $mon, $mday, $hour, $min, $sec, $realtime )
- = ( $1, $2, $3, $4, $5, $6, $7, $8 );
- my $timegm = timegm( $sec, $min, $hour, $mday, $mon-1, $year-1900 );
- $times{$testname} = [ $timegm, $realtime ];
- }
- }
- close $times or die $!;
-}
-my $total_start = Time::HiRes::time;
-$times{'test startup'} = [ time, 9999 ]; # ignore test startup from previous runs?
-open( my $times, '>', 'docs/test_summary.times.tmp') or die "cannot create docs/test_summary.times.tmp: $!";
-
# Execute all test scripts, aggregate the results, display the failures
$| = 1;
my ( @fail, @plan_hint );
@@ -94,7 +86,7 @@
my $th;
open($th, '<', $tfile) || die "Can't read $tfile: $!\n";
my ($pass,$fail,$todo,$skip,$plan,$abort,$bonus) = (0,0,0,0,0,0,0);
- my $no_plan = 0; # planless may be fine, but bad for statistics
+ my $no_plan = 0; # planless works, but is unhelpful for statistics
# http://www.shadowcat.co.uk/blog/matt-s-trout/a-cunning-no_plan/
while (<$th>) { # extract the number of tests planned
if (/^\s*plan\D*(\d+)/) { $plan = $1; last; }
@@ -102,7 +94,7 @@
}
close $th or die $!;
my $tname = $tname{$tfile};
- # repeat the column headings at the start of each Synopsis
+ # Repeat the column headings at the start of each Synopsis
if ( $syn ne substr($tname, 0, 3) ) {
$syn = substr($tname, 0, 3);
printf( "%s pass fail todo skip plan\n", ' ' x $max );
@@ -113,14 +105,29 @@
$syn{$syn}++;
printf "%s%s..", $tname, '.' x ($max - length($tname));
my $cmd = "./perl6 $tfile";
- my $realtime1 = Time::HiRes::time;
- my @results = split "\n", `$cmd`; # run the test, @result = all stdout
- my $realtime2 = Time::HiRes::time;
+ # Run the test, collecting all stdout in @results
+ my @results = split "\n", qx{$cmd};
my (%skip, %todopass, %todofail);
+ my ($time1, $time2, $testnumber, $test_comment ) = ( 0, 0, 0, '' );
+ my @times = (); my @comments = ();
for (@results) {
- # pass over the optional line containing "1..$planned"
- if (/^1\.\.(\d+)/) { $plan = $1 if $1 > 0; next; }
- # ignore lines not beginning with "ok $$test" or "not ok $test"
+ # Pass over the optional line containing "1..$planned"
+ if (/^1\.\.(\d+)/) { $plan = $1 if $1 > 0; next; }
+ # Handle lines containing timestamps
+ if (/^# t=(\d+\.\d+)/) {
+ # Calculate the execution time of each test
+ $time2 = $time1;
+ $time1 = $1;
+ my $microseconds = int( ($time1 - $time2) * 1_000_000 );
+ if ( $testnumber > 0 ) {
+ # Do this only if the timestamp was after a test result
+ $times[ $testnumber] = $microseconds;
+ $comments[$testnumber] = $test_comment;
+ $testnumber = 0; # must see require another "ok $n" first
+ }
+ next;
+ }
+ # Ignore lines not beginning with "ok $$test" or "not ok $test"
next unless /^(not )?ok +(\d+)/;
if (/#\s*SKIP\s*(.*)/i) { $skip++; $skip{$1}++; }
elsif (/#\s*TODO\s*(.*)/i) { $todo++;
@@ -129,7 +136,9 @@
else { $todofail{$reason}++ }
}
elsif (/^not ok +(.*)/) { $fail++; push @fail, "$tname $1"; }
- elsif (/^ok +\d+/) { $pass++; }
+ elsif (/^ok +(\d+) - (.*)$/) {
+ $pass++; $testnumber = $1; $test_comment = $2;
+ }
}
my $test = $pass + $fail + $todo + $skip;
if ($plan > $test) {
@@ -171,106 +180,58 @@
if ($bonus) {
printf " %3d tests more than planned were run\n", $bonus;
}
- # track simple relative benchmarking
- {
- my $testname = $tfile;
- $testname =~ s{^t/spec/}{};
- my $realtime = $realtime2 - $realtime1;
- if ( $realtime < $times{'test startup'}->[1] ) {
- $times{'test startup'} = [ time, $realtime ];
- }
- if ( not exists( $times{$testname} ) ) { $times{$testname} = [ time, $realtime ]; }
- my $datetime_old = $times{$testname}->[0];
- my $realtime_old = $times{$testname}->[1];
- my $diff_sec = abs($realtime - $times{$testname}->[1]);
- if ( $diff_sec >= 0.2 ) {
- push @interesting_times, [ $testname, $datetime_old, $realtime_old, time, $realtime, $diff_sec ];
- $times{$testname} = [ time, $realtime ];
- }
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($times{$tname}->[0]);
- printf $times "%s,%04d-%02d-%02d %02d:%02d:%02d,%g\n", $testname,
- $year+1900, $mon+1, $mday, $hour, $min, $sec, $times{$testname}->[1];
- }
+ defined $benchmark && $benchmark->log_script_times($tfile,\@times,\@comments);
} # for my $tfile (@tfiles)
-
-# finish simple relative benchmarking
-{
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime;
- printf $times "%s,%04d-%02d-%02d %02d:%02d:%02d,%g\n", 'test startup',
- $year+1900, $mon+1, $mday, $hour, $min, $sec, $times{'test startup'}->[1];
- close $times or die $!;
- rename 'docs/test_summary.times.tmp', 'docs/test_summary.times';
- my $total_time = Time::HiRes::time - $total_start;
-
- if ( @interesting_times ) {
- @interesting_times = map { $_->[0] } # Schwartzian Transform
- sort { $b->[1] <=> $a->[1] } # descending
- map { [$_, $$_[5]] } # absolute time difference
- @interesting_times;
- my $top_count = 20;
- $top_count = @interesting_times if $top_count > @interesting_times;
- @interesting_times = @interesting_times[0..$top_count-1];
- print "----------------\n";
- my $test_startup = $times{'test startup'}->[1];
- printf "Minimum test startup %.2fs. Total time %d minute(s).\n",
- $test_startup, $total_time/60;
- for my $interesting ( @interesting_times ) {
- my( $testname, $dt1, $realtime1, $dt2, $realtime2, $diff_sec ) = @$interesting;
- my $change = $realtime1 < $realtime2 ? 'slower' : 'faster';
- # The percentage difference is from the previous child user time minus
- # the presumed startup time. Without a check it can divide by zero.
- my $diff_pct = 100;
- if ( $realtime1 != $test_startup ) {
- $diff_pct = 100 * ($realtime2-$realtime1) / ( $realtime1 - $test_startup );
- }
- my $ago = int($dt2 - $dt1);
- my $unit = 'second'; $unit.='s' if $ago!=1;
- my $units = [ ['minute',60],['hour',60],['day',24],['week',7] ];
- for my $refunit ( @$units ) {
- last if $ago < $$refunit[1];
- $ago = int($ago/$$refunit[1]);
- $unit = $$refunit[0];
- $unit.='s' if $ago!=1;
- }
-# if ($ago>60) {
-# $ago=int($ago/60); $unit='minute'; $unit.='s' if $ago!=1;
-# if ($ago>60) {
-# $ago=int($ago/60); $unit='hour'; $unit.='s' if $ago!=1;
-# if ($ago>24) {
-# $ago=int($ago/24); $unit='day'; $unit.='s' if $ago!=1;
-# if ($ago>7) {
-# $ago=int($ago/7); $unit='week'; $unit.='s' if $ago!=1;
-# }
-# }
-# }
-# }
- printf "%-38s %.2fs %s (%.1f%%) than %d %s ago\n",
- $testname, $diff_sec, $change, $diff_pct, $ago, $unit;
- }
- }
-}
+defined $benchmark && $benchmark->end(); # finish simple relative benchmarking
# Calculate plan totals from test scripts grouped by Synopsis and overall.
# This ignores any test list and processes all unfudged files in t/spec/.
# Implementing 'no_plan' or 'plan *' in test scripts makes this total
# inaccurate.
for my $syn (sort keys %syn) {
- my $ackcmd = "ack ^plan t/spec/$syn* -wH"; # some systems use ack-grep
- my @results = `$ackcmd`; # gets an array of all the plan lines
- my $spec = 0;
- for (@results) {
- my ($fn, undef, $rest) = split /:/, $_;
- if (exists $plan_per_file{$fn}) {
- $spec += $plan_per_file{$fn}
- } else {
- # unreliable because some tests use expressions
- $spec += $1 if $rest =~ /^\s*plan\s+(\d+)/;
+ my $grepcmd = "grep ^plan t/spec/$syn*/* -rHn"; # recurse, always say filename, include line number for troubleshooting
+ my @grep_output = `$grepcmd`; # gets an array of all the plan lines
+ my $total_tests_planned_per_synopsis = 0;
+ for (@grep_output) {
+ # Most test scripts have a conventional 'plan 42;' or so near
+ # the beginning which is what we need. Unfortunately some have
+ # 'plan $x*$y;' or so, which we cannot dynamically figure out.
+
+ # Example grep output: t/spec/S02-names/our.t:4:plan 10;
+ # Extract the filename and plan count from that if possible.
+ if ( m/ ^ ([^:]*) : \d+ : plan (.*) $ /x ) {
+ my ( $filename, $planexpression ) = ( $1, $2 );
+ my $script_planned_tests = 0;
+ if ( $filename =~ m/\.t$/ ) {
+ if ( $planexpression =~ m/ ^ \s* (\d+) \s* ; $ /x ) {
+ # A conventional 'plan 42;' type of line
+ $script_planned_tests = $1;
+ }
+ else {
+ # It is some other plan argument, either * or variables.
+ # A workaround is to get the actual number of tests run
+ # from the output and just assume is the same number,
+ # but sometimes that is missing too.
+ if ( exists $plan_per_file{$filename} ) {
+ $script_planned_tests = $plan_per_file{$filename};
+ }
+ }
+ }
+ $total_tests_planned_per_synopsis += $script_planned_tests;
}
}
- $sum{"$syn-spec"} = $spec;
- $sum{'spec'} += $spec;
+ $sum{"$syn-spec"} = $total_tests_planned_per_synopsis;
+ $sum{'spec'} += $total_tests_planned_per_synopsis;
}
+# Planless testing (eg 'plan *;') is useless for static analysis, making
+# tools jump through hoops to calculate the number of planned tests.
+# This part display hints about the scripts that could easily be edited
+# make life easier on the reporting side.
+# A test suite author can follow the hints and write the automatically
+# counted number of tests into the test script, changing it back from
+# planless to planned.
+
if (@plan_hint) {
print "----------------\n";
foreach (@plan_hint) {
@@ -314,3 +275,312 @@
else {
print "No failures!\n";
}
+
+# End of main program
+
+#-------------------- Simple Relative Benchmarking ---------------------
+
+package Simple::Relative::Benchmarking;
+
+sub begin { # this constructor starts simple relative benchmarking
+ my $timings = shift || 5; # number of timings to keep (default 5)
+ my $self = {};
+ my @test_history;
+ $self->{'Timings'} = $timings;
+ $self->{'Last_test_loaded'} = '';
+
+ if ( open( $self->{'file_in'}, '<', 'docs/test_summary.times') ) {
+ my $file_in = $self->{'file_in'};
+ my $line = <$file_in>; chomp $line;
+ if ( $line =~ m/{"test_.+":\[/i ) { # should be Test_history
+ $line = <$file_in>; chomp $line;
+ while ( $line =~ m/\s\s(.+\d\d\d\d-\d\d-\d\d.\d\d:\d\d:\d\d.+)/ ) {
+ my $history_line = $1;
+ $history_line =~ s/,$//; # trim possible trailing comma
+ push @test_history, $history_line;
+ $line = <$file_in>; chomp $line;
+ } # ends on the ' ],' line after the test_history
+ $line = <$file_in>; chomp $line;
+ # if ( $line =~ m/ "test_microseconds":{/i ) {
+ # warn "begin reached 'test_microseconds'\n";
+ # }
+ }
+ }
+ open( $self->{'file_out'}, '>', 'docs/test_summary.times.tmp') or die "cannot create docs/test_summary.times.tmp: $!";
+ my $parrot_version = qx{./perl6 -e'print \$*VM<config><revision>'};
+ my $rakudo_version = qx{git log --pretty=oneline --abbrev-commit --max-count=1 .}; chomp $rakudo_version;
+ $rakudo_version =~ s/^([0-9a-f])+\.\.\./$1/; # delete possible ...
+ $rakudo_version =~ s/\\/\\\\/g; # escape all backslashes
+ $rakudo_version =~ s/\"/\\\"/g; # escape all double quotes
+ my $file_out = $self->{'file_out'};
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time());
+ push @test_history, sprintf("[\"%4d-%02d-%02d %02d:%02d:%02d\",%d,\"%s\"]",
+ $year+1900, $mon+1, $mday, $hour, $min, $sec,
+ $parrot_version, $rakudo_version );
+ # Delete the oldest test test_history if there are too many.
+ while ( @test_history > $self->{'Timings'} ) { shift @test_history; }
+ print $file_out qq!{"test_history":[\n!;
+ print $file_out " " . join(",\n ",@test_history) . "\n ],\n";
+ print $file_out qq! "test_microseconds":{!;
+ # tell Test.pm to output per-test timestamps
+ $ENV{'PERL6_TEST_TIMES'} = 'true';
+ return bless $self;
+}
+
+# Track simple relative benchmarking. Called after running each test script.
+sub log_script_times {
+ my $self = shift;
+ my $test_name = shift;
+ my $ref_times = shift;
+ my $ref_comments = shift;
+ # Make local arrays of the execution times in microseconds, and test
+ # comments (or descriptions). Since tests are being added to and
+ # removed from the test suite, test numbers change over time. The
+ # comments are sometimes empty or duplicated, but they are the only
+ # way to correlate test results if the test suite is edited.
+ my (@times) = @$ref_times;
+ my (@comments) = @$ref_comments;
+ shift @times; # offset by 1: the first result becomes $times[0];
+ shift @comments;
+ for ( my $i=0; $i<=@times; $i++ ) {
+ if ( not defined $comments[$i] ) { $comments[$i] = ''; }
+ $comments[$i] =~ s/\\/\\\\/g; # escape all backslashes
+ $comments[$i] =~ s/\"/\\\"/g; # escape all double quotes
+ }
+ my ( $line );
+ my $file_in = $self->{'file_in'};
+ my $file_out = $self->{'file_out'};
+ $test_name =~ s{^t/spec/}{}; # eg 'S02-literals/numeric.t'
+ my $test_separator;
+ if ( $self->{'Last_test_loaded'} eq '' ) {
+ $test_separator = "\n";
+ }
+ else {
+ $test_separator = ",\n";
+ }
+ while ( not eof($file_in) and $self->{'Last_test_loaded'} lt $test_name ) {
+ $line = <$file_in>; chomp $line;
+ if ( $line =~ m/^\s\s"(.+)":.$/ ) {
+ $self->{'Last_test_loaded'} = $1;
+ }
+ }
+ my @logged_results;
+ if ( not eof($file_in) and $self->{'Last_test_loaded'} eq $test_name ) {
+ my $line = <$file_in>; chomp $line;
+ while ( not eof($file_in) and $line =~ m/^\s\s\s\[(\d+),\[(.+?)\],?/ ) {
+ my $test_number = $1;
+ my @timings = split /,/ , $2;
+ $logged_results[$test_number-1] = [ @timings ];
+ $line = <$file_in>; chomp $line;
+ }
+ }
+ my $microseconds = [];
+ my $testcount = @times;
+ for ( my $test_number=0; $test_number<$testcount; $test_number++) {
+ unless ( defined($times[$test_number]) ) { $times[$test_number] = 0; }
+ my ( @times_in_file );
+ if ( defined @{$logged_results[$test_number]} ) {
+ @times_in_file = ( @{$logged_results[$test_number]} );
+ }
+ push @times_in_file, $times[$test_number];
+ if ( not defined( $times_in_file[0] ) ) { shift @times_in_file; }
+ # Delete the oldest test timings if there are too many.
+ while ( @times_in_file > $self->{'Timings'} ) { shift @times_in_file; }
+ $$microseconds[$test_number] = [ @times_in_file ];
+ }
+ my $test_number = 1; # start from number 1 again
+ print $file_out
+ $test_separator .
+ qq' "$test_name":[\n' .
+ join(",\n", map {' ['.$test_number++.',['.join(',',@$_).'],"'.$comments[$test_number-2].'"]'} @$microseconds) .
+ qq'\n ]';
+}
+
+sub end {
+ my $self = shift;
+ my $file_in = $self->{'file_in'};
+ my $file_out = $self->{'file_out'};
+ print $file_out "\n }\n}\n";
+ close $file_out or warn $!;
+ close $file_in or warn $!;
+ unlink 'docs/test_summary.times';
+ rename 'docs/test_summary.times.tmp', 'docs/test_summary.times';
+}
+
+package main;
+
+=pod
+
+=head1 NAME
+
+tools/test_summary.pl -- run spectests and make statistical reports
+
+=head1 DESCRIPTION
+
+This test harness written in Perl 5, runs the Perl 6 specification test
+suite. It uses the same Test Anything Protocol (TAP) as for example
+L<TAP::Harness>, but does not depend those modules.
+
+The names of the tests are listed in t/spectest.data, or another file
+whose name is passed on the command line.
+
+=head2 OUTPUT
+
+The harness prints the name of each test script before running it.
+After completion it prints the total number of tests passed, failed,
+to do, skipped, and planned. The descriptions of any tests failed,
+skipped or left to do are also listed.
+
+After running all the tests listed, the harness prints a set of
+subtotals per Synopsis.
+
+If you set the REV environment variable (with the first 7 characters of
+a Rakudo commit id), the harness prints an additional set of grand
+totals suitable for adding to F<docs/spectest_progress.csv>.
+
+=head1 SIMPLE RELATIVE BENCHMARKING
+
+Too little information can mislead, hence this self deprecating title.
+For example, these measurements overlook variation in test times
+('jitter'), kernel versus user process times, and measurement overheads.
+But these results are better than no information at all.
+
+If activated, this tool logs the most recent 5 timings in microseconds
+in F<docs/test_summary.times> in a specific JSON format, for later
+analysis. Measurement and logging add less than 2% to the testing time
+and makes a log file of about 2.5MB.
+
+=head2 Methods
+
+=head3 begin
+
+Accepts an optional parameter, the number of timings per test to keep.
+Creates a temporary file for new results, and returns an object that
+updates the log file. (F<begin> acts as the constructor).
+
+=head3 log_script_times
+
+Takes these parameters: test script name, reference to an array of times
+in microseconds, reference to an array of test description strings.
+Appends the results to the temporary log file.
+
+=head3 end
+
+Closes and renames the temporary log file.
+
+=head2 Timing results file
+
+All results are stored in F<docs/test_summary.times> in a specific JSON
+format. With 35000 test result lines and 5 runs it occupies just under
+2.5 MB.
+
+Here is an example with a few semi fictitious results:
+
+ {"test_history":[
+ ["2010-05-05 10:15:45",46276,"925629d Make $x does (R1, R2) work."],
+ ["2010-05-07 08:58:07",46276,"5713af2 run two more test files"],
+ ["2010-05-08 18:08:43",46405,"ab23221 bump PARROT_REVISION"],
+ ["2010-05-09 05:53:25",46405,"c49d32b run S04-phasers/rvalues.t"],
+ ["2010-05-10 00:44:46",46405,"118f4aa Overhaul sqrt for Numeric / Real."]
+ ],
+ "test_microseconds":{
+ "S02-builtin_data_types/anon_block.rakudo":[
+ [1,[6139,7559,6440,6289,5520],"The object is-a 'Sub()'"],
+ [2,[6610,6599,6690,6580,6010],"sub { } works"]
+ ],
+ "S02-builtin_data_types/array.rakudo":[
+ [1,[9100,8889,9739,9140,9169],"for 1, 2, 3 does 3 iterations"],
+ [2,[5650,5599,6119,9819,5140],"for (1, 2, 3).item 3 iterations"],
+ [3,[3920,3770,4190,4410,3350],"for [1, 2, 3] does one iteration"]
+ ]
+ }
+ }
+
+The "test_history" section lists the starting times for all the runs of
+F<tools/test_summary.pl> that are recorded in the file. Then the
+"test_microseconds" records show each test filename, possibly fudged,
+followed by the test numbers, followed by the times obtained from each
+run. If a test has fewer than the usual number of timings, the timings
+will be from the most recent test runs.
+
+The file is read and written by custom code and not a JSON module, to
+reduce dependencies. Altering the file format might cause reading to
+fail and could result in data loss. General purpose JSON parsers should
+be able to read the data. For example the following ranks the tests
+from best speedup to worst slowdown.
+
+ #!/usr/bin/perl
+ use File::Slurp qw( slurp );
+ use JSON;
+ my $log_text = slurp('docs/test_summary.times');
+ my $log = JSON->new->decode( $log_text );
+ # Flatten the data structure to a 2-D array of nonzero test times
+ my @timings;
+ my $script_hash = $$log{'test_microseconds'};
+ for my $script_name ( sort keys %$script_hash ) {
+ my $test_list = $$script_hash{$script_name};
+ for my $t ( @$test_list ) {
+ my $times_count = @{$$t[1]};
+ if ( $times_count >= 2 and ${$$t[1]}[$times_count-1] > 0 ) {
+ push @timings, [$script_name, $$t[0], $$t[2], ${$$t[1]}[$times_count-2], ${$$t[1]}[$times_count-1] ];
+ }
+ }
+ }
+ # Sort the timings into improved/worsened order with a Schwartzian transform
+ my @z; for my $t ( @timings ) { push @z, ($$t[4]-$$t[3])/$$t[4]; }
+ my @sorted = @timings[ sort { $z[$a] <=> $z[$b] } 0..$#timings ];
+ # Display the results: quicker is minus, slower is plus.
+ for my $s ( @sorted ) {
+ printf "%+3.0f%% %6d %6d %s:%d:%s\n",
+ ($$s[4]-$$s[3])*100/$$s[3], $$s[3], $$s[4], $$s[0], $$s[1], $$s[2];
+ } # %change, prev-time, latest-time, script, test-num, test-desc
+
+A second example shows another way to read the results file, and ranks
+the tests from most to least consistent in execution time.
+
+ #!/usr/bin/perl
+ use JSON;
+ my $log_text = qx{$^X -MExtUtils::Command -e cat docs/test_summary.times};
+ my $log = JSON->new->decode( $log_text );
+ # Flatten the data structure to a 2-D array of nonzero test times
+ my @timings;
+ my $script_hash = $$log{'test_microseconds'};
+ for my $script_name ( sort keys %$script_hash ) {
+ my $test_list = $$script_hash{$script_name};
+ for my $t ( @$test_list ) {
+ my $times_count = @{$$t[1]};
+ if ( $times_count >= 2 and ${$$t[1]}[$times_count-1] > 0 ) {
+ my $min = my $max = ${$$t[1]}[0];
+ for my $i (1..$times_count-1) {
+ $min = ${$$t[1]}[$i] if $min > ${$$t[1]}[$i];
+ $max = ${$$t[1]}[$i] if $max < ${$$t[1]}[$i];
+ }
+ push @timings, [$script_name, $$t[0], $$t[2], $min, $max ] if $min > 0;
+ }
+ }
+ }
+ # Sort the timings into most/least consistent order by Schwartzian transform
+ my @z; for my $t ( @timings ) { push @z, ($$t[4]-$$t[3])/$$t[3]; }
+ my @sorted = @timings[ sort { $z[$a] <=> $z[$b] } 0..$#timings ];
+ # Display the results from most to least consistent
+ for my $s ( @sorted ) {
+ printf "%3.1f%% %6d %6d %s:%d:%s\n",
+ ($$s[4]-$$s[3])*100/$$s[3], $$s[3], $$s[4], $$s[0], $$s[1], $$s[2];
+ } # %difference, min-time, max-time, script, test-num, test-desc
+
+=head2 TODO
+
+Detect changes in number of tests or descriptions of tests in each
+test script, and discard all previous results for that script if there
+has been a change. Consider whether to log total execution time per
+test script.
+
+Analyse and report useful results, such as the slowest n tests.
+
+Parse the `say now` output as well as `print pir::__time()`.
+
+=head1 SEE ALSO
+
+The L<perlperf> module. The L<http://json.org/> site.
+
+=cut
Please sign in to comment.
Something went wrong with that request. Please try again.