File nqp-test-log.diff of Package nqp-moarvm

Overview Repositories Revisions Requests Users Attributes Meta

File nqp-test-log.diff of Package nqp-moarvm

diff --git a/tools/templates/Makefile-backend-common.in b/tools/templates/Makefile-backend-common.in
index 085ad3c64..6558d0f30 100644
--- a/tools/templates/Makefile-backend-common.in
+++ b/tools/templates/Makefile-backend-common.in
@@ -171,7 +171,7 @@
 ## testing
 
 @backend_prefix@-test: @backend_prefix@-all
-	$(PROVE) -r --exec @q(@bpm(BUILD_RUNNER_BIN)@)@ @nfpl(t/nqp t/hll t/qregex t/p5regex t/qast t/@backend@ t/serialization t/nativecall)@ @bpm(EXTRA_TESTS)@
+	PERL5LIB=lib5 $(PROVE) --archive=make-test.tar -r --exec @q(@bpm(BUILD_RUNNER_BIN)@)@ @nfpl(t/nqp t/hll t/qregex t/p5regex t/qast t/@backend@ t/serialization t/nativecall)@ @bpm(EXTRA_TESTS)@ || { mkdir results && cd results && tar xf ../make-test.tar && find . -type f -exec echo '{}' \; -exec cat '{}' \; ; false ; }
 
 @backend_prefix@-test-loud: @backend_prefix@-all
 	$(PROVE) -r -v --exec @q(@bpm(BUILD_RUNNER_BIN)@)@ @nfpl(t/nqp t/hll t/qregex t/p5regex t/qast t/@backend@ t/serialization t/nativecall)@ @bpm(EXTRA_TESTS)@
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

Places

File nqp-test-log.diff of Package nqp-moarvm

Places