File rakudo-test-log.diff of Package rakudo
diff --git a/tools/templates/Makefile-backend-common.in b/tools/templates/Makefile-backend-common.in
index 57396c6df..0688cbe59 100644
--- a/tools/templates/Makefile-backend-common.in
+++ b/tools/templates/Makefile-backend-common.in
@@ -126,7 +126,7 @@
@backend_prefix@-stresstest: @backend_prefix@-stresstest@bpm(HARNESS_TYPE)@
@backend_prefix@-coretest5: @backend_prefix@-all
- @bpm(HARNESS5)@ $(COMMON_TEST_DIRS) @bsm(SPECIFIC_TEST_DIRS)@
+ PERL5LIB=lib5 @bpm(HARNESS5)@ --archive=make-test.tar $(COMMON_TEST_DIRS) @bsm(SPECIFIC_TEST_DIRS)@ || { mkdir results && cd results && tar xf ../make-test.tar && find . -type f -exec echo '{}' \; -exec cat '{}' \; ; false ; }
# Run the spectests that we know work.
@backend_prefix@-spectest5: @backend_prefix@-testable $(SPECTEST_DATA)
diff --git a/lib5/TAP/Harness/Archive.pm b/lib5/TAP/Harness/Archive.pm
new file mode 100644
index 000000000..23810ba2d
--- /dev/null
+++ b/lib5/TAP/Harness/Archive.pm
@@ -0,0 +1,450 @@
+package TAP::Harness::Archive;
+use warnings;
+use strict;
+use base 'TAP::Harness';
+use Cwd ();
+use File::Basename ();
+use File::Temp ();
+use File::Spec ();
+use File::Path ();
+use File::Find ();
+use Archive::Tar ();
+use TAP::Parser ();
+use YAML::Tiny ();
+use TAP::Parser::Aggregator ();
+
+=head1 NAME
+
+TAP::Harness::Archive - Create an archive of TAP test results
+
+=cut
+
+our $VERSION = '0.18';
+
+=head1 SYNOPSIS
+
+ use TAP::Harness::Archive;
+ my $harness = TAP::Harness::Archive->new(\%args);
+ $harness->runtests(@tests);
+
+=head1 DESCRIPTION
+
+This module is a direct subclass of L<TAP::Harness> and behaves
+in exactly the same way except for one detail. In addition to
+outputting a running progress of the tests and an ending summary
+it can also capture all of the raw TAP from the individual test
+files or streams into an archive file (C<.tar> or C<.tar.gz>).
+
+=head1 METHODS
+
+All methods are exactly the same as our base L<TAP::Harness> except
+for the following.
+
+=head2 new
+
+In addition to the options that L<TAP::Harness> allow to this method,
+we also allow the following:
+
+=over
+
+=item archive
+
+This is the name of the archive file to generate. We use L<Archive::Tar>
+in the background so we only support C<.tar> and C<.tar.gz> archive file
+formats. This can optionally be an existing directory that will have
+the TAP archive's contents deposited therein without any file archiving
+(no L<Archive::Tar> involved).
+
+=item extra_files
+
+This is an array reference to extra files that you want to include in the TAP
+archive but which are not TAP files themselves. This is useful if you want to
+include some log files that contain useful information about the test run.
+
+=item extra_properties
+
+This is a hash reference of extra properties that you've collected during your
+test run. Some things you might want to include are the Perl version, the system's
+architecture, the operating system, etc.
+
+=back
+
+=cut
+
+my (%ARCHIVE_TYPES, @ARCHIVE_EXTENSIONS);
+BEGIN {
+ %ARCHIVE_TYPES = (
+ 'tar' => 'tar',
+ 'tar.gz' => 'tar.gz',
+ 'tgz' => 'tar.gz',
+ );
+ @ARCHIVE_EXTENSIONS = map { ".$_" } keys %ARCHIVE_TYPES;
+}
+
+sub new {
+ my ($class, $args) = @_;
+ $args ||= {};
+
+ # these can't be passed on to Test::Harness
+ my $archive = delete $args->{archive};
+ my $extra_files = delete $args->{extra_files};
+ my $extra_props = delete $args->{extra_properties};
+
+ $class->_croak("You must provide the name of the archive to create!")
+ unless $archive;
+
+ my $self = $class->SUPER::new($args);
+
+ my $is_directory = -d $archive ? 1 : 0;
+ if ($is_directory) {
+ $self->{__archive_is_directory} = $is_directory;
+ $self->{__archive_tempdir} = $archive;
+ } else {
+ my $format = $class->_get_archive_format_from_filename($archive);
+
+ # if it's not a format we understand, or it's not a directory
+ $class->_croak("Archive is not a known format type!")
+ unless $format && $ARCHIVE_TYPES{$format};
+
+ $self->{__archive_file} = $archive;
+ $self->{__archive_format} = $format;
+ $self->{__archive_tempdir} = File::Temp::tempdir();
+ }
+
+ # handle any extra files
+ if($extra_files) {
+ ref $extra_files eq 'ARRAY'
+ or $class->_croak("extra_files must be an array reference!");
+ foreach my $file (@$extra_files) {
+ $class->_croak("extra_file $file does not exist!") unless -e $file;
+ $class->_croak("extra_file $file is not readable!") unless -r $file;
+ }
+ $self->{__archive_extra_files} = $extra_files;
+ }
+
+ if($extra_props) {
+ ref $extra_props eq 'HASH'
+ or $class->_croak("extra_properties must be a hash reference!");
+ $self->{__archive_extra_props} = $extra_props;
+ }
+
+ return $self;
+}
+
+sub _get_archive_format_from_filename {
+ my ($self, $filename) = @_;
+
+ # try to guess it if we don't have one
+ my (undef, undef, $suffix) = File::Basename::fileparse($filename, @ARCHIVE_EXTENSIONS);
+ $suffix =~ s/^\.//;
+ return $ARCHIVE_TYPES{$suffix};
+}
+
+=head2 runtests
+
+Takes the same arguments as L<TAP::Harness>'s version and returns the
+same thing (a L<TAP::Parser::Aggregator> object). The only difference
+is that in addition to the normal test running and progress output
+we also create the TAP Archive when it's all done.
+
+=cut
+
+sub runtests {
+ my ($self, @files) = @_;
+
+ # tell TAP::Harness to put the raw tap someplace we can find it later
+ my $dir = $self->{__archive_tempdir};
+ $ENV{PERL_TEST_HARNESS_DUMP_TAP} = $dir;
+
+ # get some meta information about this run
+ my %meta = (
+ file_order => \@files,
+ start_time => time(),
+ );
+
+ my $aggregator = $self->SUPER::runtests(@files);
+
+ $meta{stop_time} = time();
+
+ my @parsers = $aggregator->parsers;
+ for ( my $i = 0; $i < @parsers; $i++ ) {
+ $parsers[ $i ] = {
+ start_time => $parsers[ $i ]->start_time,
+ end_time => $parsers[ $i ]->end_time,
+ description => $files[ $i ],
+ };
+ }
+ $meta{file_attributes} = \@parsers;
+
+ my $cwd = Cwd::getcwd();
+ my $is_dir = $self->{__archive_is_directory};
+ my ($archive, $output_file);
+ if( $is_dir ) {
+ $output_file = $self->{__archive_tempdir};
+ } else {
+ $output_file = $self->{__archive_file};
+
+ # go into the dir so that we can reference files
+ # relatively and put them in the archive that way
+ chdir($dir) or $self->_croak("Could not change to directory $dir: $!");
+
+ unless (File::Spec->file_name_is_absolute($output_file)) {
+ $output_file = File::Spec->catfile($cwd, $output_file);
+ }
+
+ # create the archive
+ $archive = Archive::Tar->new();
+ $archive->add_files($self->_get_all_tap_files);
+ chdir($cwd) or $self->_croak("Could not return to directory $cwd: $!");
+ }
+
+ # add in any extra files
+ if(my $x_files = $self->{__archive_extra_files}) {
+ my @rel_x_files;
+ foreach my $x_file (@$x_files) {
+ # handle both relative and absolute file names
+ my $rel_file;
+ if( File::Spec->file_name_is_absolute($x_file) ) {
+ $rel_file = File::Spec->abs2rel($x_file, $cwd);
+ } else {
+ $rel_file = $x_file;
+ }
+ push(@rel_x_files, $rel_file);
+ }
+ $archive->add_files(@rel_x_files) unless $is_dir;
+ $meta{extra_files} = \@rel_x_files;
+ }
+
+ # add any extra_properties to the meta
+ if(my $extra_props = $self->{__archive_extra_props}) {
+ $meta{extra_properties} = $extra_props;
+ }
+
+ # create the YAML meta file
+ my $yaml = YAML::Tiny->new();
+ $yaml->[0] = \%meta;
+ if( $is_dir ) {
+ my $meta_file = File::Spec->catfile($output_file, 'meta.yml');
+ open(my $out, '>', $meta_file) or die "Could not create meta.yml: $!";
+ print $out $yaml->write_string;
+ close($out);
+ } else {
+ $archive->add_data('meta.yml', $yaml->write_string);
+ $archive->write($output_file, $self->{__archive_format} eq 'tar.gz') or die $archive->error;
+ # be nice and clean up
+ File::Path::rmtree($dir);
+ }
+
+ print "\nTAP Archive created at $output_file\n" unless $self->verbosity < -1;
+
+ return $aggregator;
+}
+
+sub _get_all_tap_files {
+ my ($self, $dir, $meta) = @_;
+ $dir ||= $self->{__archive_tempdir};
+ my @files;
+ my %x_files;
+ if($meta && $meta->{extra_files}) {
+ %x_files = map { $_ => 1 } @{$meta->{extra_files}};
+ }
+
+ File::Find::find(
+ {
+ no_chdir => 1,
+ wanted => sub {
+ return if /^\./;
+ return if -d;
+ my $rel_name = File::Spec->abs2rel($_, $dir);
+ return if $rel_name eq 'meta.yml';
+ push(@files, $rel_name) unless $x_files{$rel_name};
+ },
+ },
+ $dir
+ );
+ return @files;
+}
+
+=head2 aggregator_from_archive
+
+This class method will return a L<TAP::Parser::Aggregator> object
+when given a TAP Archive to open and parse. It's pretty much the reverse
+of creating a TAP Archive from using C<new> and C<runtests>.
+
+It takes a hash of arguments which are as follows:
+
+=over
+
+=item archive
+
+The path to the archive file. This can also be a directory if you created
+the archive as a directory. This is required.
+
+=item parser_callbacks
+
+This is a hash ref containing callbacks for the L<TAP::Parser> objects
+that are created while parsing the TAP files. See the L<TAP::Parser>
+documentation for details about these callbacks.
+
+=item made_parser_callback
+
+This callback is executed every time a new L<TAP::Parser> object
+is created. It will be passed the new parser object, the name
+of the file to be parsed, and also the full (temporary) path of that file.
+
+=item meta_yaml_callback
+
+This is a subroutine that will be called if we find and parse a YAML
+file containing meta information about the test run in the archive.
+The structure of the YAML file will be passed in as an argument.
+
+=back
+
+ my $aggregator = TAP::Harness::Archive->aggregator_from_archive(
+ {
+ archive => 'my_tests.tar.gz',
+ parser_callbacks => {
+ plan => sub { warn "Nice to see you plan ahead..." },
+ unknown => sub { warn "Your TAP is bad!" },
+ },
+ made_parser_callback => sub {
+ my ($parser, $file, $full_path) = @_;
+ warn "$file is temporarily located at $full_path\n";
+ }
+
+ }
+ );
+
+=cut
+
+sub aggregator_from_archive {
+ my ($class, $args) = @_;
+ my $meta;
+
+ my $file = Cwd::abs_path( $args->{archive} )
+ or $class->_croak("You must provide the path to the archive!");
+
+ my $is_directory = -d $file;
+
+ # extract the files out into a temporary directory
+ my $dir = $is_directory ? $file : File::Temp::tempdir();
+ my $cwd = Cwd::getcwd();
+ chdir($dir) or $class->_croak("Could not change to directory $dir: $!");
+ my @files;
+
+ Archive::Tar->new()->extract_archive($file) unless $is_directory;
+ my @tap_files;
+
+ # do we have a meta.yml file in the archive?
+ my $yaml_file = File::Spec->catfile($dir, 'meta.yml');
+ if( -e $yaml_file) {
+
+ # parse it into a structure
+ if ($YAML::Tiny::VERSION < 1.57) {
+ $meta = YAML::Tiny->new()->read($yaml_file);
+ die "Could not read YAML $yaml_file: " . YAML::Tiny->errstr if YAML::Tiny->errstr;
+ } else {
+ $meta = eval {
+ YAML::Tiny->new()->read($yaml_file);
+ };
+ if ($@) {
+ die "Could not read YAML $yaml_file: ".$@;
+ }
+ }
+
+ if($args->{meta_yaml_callback}) {
+ $args->{meta_yaml_callback}->($meta);
+ }
+ $meta = $meta->[0];
+
+ if($meta->{file_order} && ref $meta->{file_order} eq 'ARRAY') {
+ foreach my $file (@{$meta->{file_order}}) {
+ push(@tap_files, $file) if -e $file;
+ }
+ }
+ }
+
+ # if we didn't get the files from the YAML file, just find them all
+ unless(@tap_files) {
+ @tap_files = $class->_get_all_tap_files($dir, $meta);
+ }
+
+ # now create the aggregator
+ my $aggregator = TAP::Parser::Aggregator->new();
+ foreach my $tap_file (@tap_files) {
+ open(my $fh, $tap_file) or die "Could not open $tap_file for reading: $!";
+ my $parser = TAP::Parser->new({source => $fh, callbacks => $args->{parser_callbacks}});
+ if($args->{made_parser_callback}) {
+ $args->{made_parser_callback}->($parser, $tap_file, File::Spec->catfile($dir, $tap_file));
+ }
+ $parser->run;
+ $aggregator->add($tap_file, $parser);
+ }
+
+ # be nice and clean up
+ chdir($cwd) or $class->_croak("Could not return to directory $cwd: $!");
+ File::Path::rmtree($dir) unless $is_directory;
+
+ return $aggregator;
+}
+
+=head1 AUTHOR
+
+Michael Peters, C<< <mpeters at plusthree.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-tap-harness-archive at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=TAP-Harness-Archive>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc TAP::Harness::Archive
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/TAP-Harness-Archive>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/TAP-Harness-Archive>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=TAP-Harness-Archive>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/TAP-Harness-Archive>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=over
+
+=item * A big thanks to Plus Three, LP (L<http://www.plusthree.com>) for sponsoring my work on this module and other open source pursuits.
+
+=item * Andy Armstrong
+
+=back
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Michael Peters, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of TAP::Harness::Archive
