view release on metacpan or  search on metacpan

inc/My/Tests/Below.pm  view on Meta::CPAN

                    qq' for label $snipkey at line $.\n' if
                        (exists $self->{podsnippets}{$snipkey});
                die qq'Badly nested "=for My::Tests::Below" directives'.
                    qq' at line $.\n' if (defined $insnippet);
                $self->{podsnippets}{$snipkey}->{lineno} = $. + 1;
                $insnippet = $snipkey;
            }
        } elsif (m/^=for\s+My::Tests::Below/) {
            die qq'Parse error in "=for My::Tests::Below"'.
                qq' directive at line $.\n';
        } else {
            $self->{podsnippets}{$insnippet}->{text} .= $_ if (defined $insnippet);
        };

        next if (defined($packline) && $. <= $packline); # Be sure to
        # catch the first marker *after* the require directive, and
        # mind the self-test case too.

        next SOURCELINE unless (m/^__(END|DATA)__\s+$/);

=item I<Line counting for the debugger>

You can step through the test using a GUI debugger (e.g. perldb in
Emacs) because the line numbers are appropriately translated.

=cut

        $self->{testsuite}="#line ".($.+1)." \"$self->{packfilename}\"\n".
            $self->{testsuite};
        last SOURCELINE;
    }

=item I<Tests always start in package main>

The perlmodlib idiomatics puts you either in C<main> or in the package
where the eval was called from, depending on the version of Perl.

=cut

    $self->{testsuite}="package main;\n" . $self->{testsuite};

    return $self;
}

## Actually runs the test suite in an eval.
sub run {
    my ($self) = @_;

=item I<Tested package is available for "use">

As shown in L</SYNOPSIS>, one can invoke "use MyPackage;" at the top
of the test suite and this will not cause the package under test to be
reloaded from the filesystem. The import() semantics of MyPackage, if
any, will work as normal.

=cut

    local %INC = %INC;
    if (defined $self->{package} && defined $self->{packfilename}) {
        # Heuristics needed here. $self->{packfilename} is a filename,
        # say /path/to/lib/Foo/Bar.pm, and we want to set
        # $INC{"Foo/Bar.pm"} so we must weed out /path/to/lib
        # wisely. $self->{package} is "Foo::Bar" most of the time but
        # may also be "Foo::Bar::SubPackage", "Foo" (if Foo::Bar is a
        # mixin to Foo) or even "Un::Related". In the latter case
        # we're out of luck and we leave %INC unmolested.
        for(my $package = $self->{package};
            $package; $package =~ s/(::|^)[^:]*$//) {
            my $filename = $package;
            $filename =~ s|::|/|g;
#warn "Considering $filename against $self->{packfilename}";
            next unless ($self->{packfilename} =~
                         m{(\Q$filename\E(?:/.*|\.pm)$)});
#warn "Inhibiting load of $1";
            $INC{$1} = $self->{packfilename}; last;
        }
    };


=item I<%ENV is standardized>

When running under C<require My::Tests::Below>, %ENV is reset to a
sane value to avoid freaky side effects when eg the locales are weird
and this influences some shell tool fired up by the test suite.  The
original contents of %ENV is stashed away in %main::ENVorig in case it
is actually needed.

=cut

    local %main::ENVorig; %main::ENVorig = %ENV;
    $ENV{PATH} =~ m|^(.*)$|; # Untaints
    local %ENV = (
            "PATH"  => $1,
            "DEBUG" => $ENV{"DEBUG"} ? 1 : 0,
           );

    eval $self->{testsuite};

    die $@ if $@;
}

=back

=head1 CLASS METHODS

=over

=item I<tempdir()>

This class method returns the path of a temporary test directory
created using L<File::Temp/tempdir>. This directory is set to be
destroyed when the test finishes, except if the DEBUG environment
variable is set. This class method is idempotent: calling it several
times in a row always returns the same directory.

=cut

{
    my $cached;
    sub tempdir {
        return $cached if defined $cached;