view release on metacpan or  search on metacpan

lib/Test/LectroTest/FailureRecorder.pm  view on Meta::CPAN

such failures exist, the array will be empty.
Each failure is represented by a hash containing the inputs that
caused the failure.

If the recorder's storage file does not exist or cannot be
opened for reading, this method dies.  Thus, you should call
it from within an C<eval> block.

=cut

sub get_failures_for_property {
    my ($self, $property_name) = @_;
    [ map $_->[1], grep { $_->[0] eq $property_name } @{$self->_store} ];
}

=pod

=head2 record_failure_for_property(I<propname>, I<input-hashref>)

  my $recorder->record_failure_for_property(
     "property name",
     $input_hashref_from_counterexample
  );

Adds a failure record for the property named I<propname>.  The
record captures the counterexample represented by the I<input-hashref>.
The record is immediately appended to the recorder's storage file.

Returns 1 upon success; dies otherwise.

If the recorder's storage file cannot be opened for writing, this
method dies.  Thus, you should call it from within an C<eval> block.

=cut

sub record_failure_for_property {
    my ($self, $property_name, $input_hash) = @_;
    my $file = $self->{file};
    my $rec  = [ $property_name, $input_hash ];
    local $\ = "\n\n";
    local $Data::Dumper::Indent   = 0;
    local $Data::Dumper::Purity   = 1;
    local $Data::Dumper::Terse    = 1;
    local $Data::Dumper::Deepcopy = 1;
    local $Data::Dumper::Useqq    = 1;
    open my $fh, ">>$file" or die "could not open $file for appending: $!";
    print $fh
        '# ', scalar gmtime, "\n",
        '# ', $self->_platform, "\n",
        Dumper( $rec );
    close $fh;
    push @{$self->{cache}}, $rec if $self->{cache};
    1;
}

sub _platform {
    shift->{platform} ||= do {
        # first try to grab version line from `perl -v`
        eval {
            local $_ = `$^X -v`;
            $_ && /^This is perl,(.*)/im && "perl$1";
        }
        # if that fails, build our own version line
        ||
        sprintf("perl v%vd on %s", $^V,
                # if uname works, get the platform info from it
                eval {
                    require POSIX;
                    if (my @u = POSIX::uname()) {
                        return "@{[grep defined, @u[0,4,2,3]]}";
                    }
                }
                # otherwise, use the less informative Perl OS-name variable
                ||
                $^O
        );
    };
}

1;



=head1 SEE ALSO

L<Test::LectroTest::TestRunner> explains the internal testing apparatus,
which uses the failure recorders to record and play back failures for
regression testing.

=head1 AUTHOR

Tom Moertel (tom@moertel.com)

=head1 COPYRIGHT and LICENSE

Copyright (c) 2004-13 by Thomas G Moertel.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut