view release on metacpan or  search on metacpan

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

  =cut

  package Zoinx;

  sub new {
      bless {}, "Zoinx";
  }

  require My::Tests::Below unless caller;

=for My::Tests::Below "reflection is a fun thing" end

=for great "justice"

  __END__

then C<< My::Tests::Below->pod_data_snippet("create-zoinx") >> would
return "\nmy $zoinx = new Zoinx;\n\n".

The syntax of the C<=for My::Tests::Below> POD markup lines obeys the
following rules:

=over

=item *

the first token after C<My::Tests::Below> is a double-quoted string
that contains the unique label of the POD snippet (passed as the first
argument to I<pod_data_snippet()>);

=item *

the second token is either C<begin> and C<end>, which denote the start
and end of the snippet as shown above. Nesting is forbidden (for now).

=back

=cut

sub pod_data_snippet {
	my ($self, $name)=@_; $self = $singleton if ! ref $self;

	local $_ = $self->{podsnippets}{$name}->{text};
	return unless defined;

    my $ragamount;
    foreach my $line (split m/\n/s) {
        next if $line =~ m/^\t/; # tab width is treated as infinite to
        # cut through the whole mess
        next if $line eq ""; # Often authors leave empty lines to
        # delimit paragraphs in SYNOPSIS, count them as undefined
        # length as well

        $line =~ m/^( *)/; my $spaceamount = length($1);
        $ragamount = $spaceamount if ((!defined $ragamount) ||
                                       ($ragamount > $spaceamount));
    }

    s/^[ ]{$ragamount}//gm;
	m/^(.*)$/s; return $1; # Untainted
}

=item I<pod_code_snippet($snippetname)>

Works like L</pod_data_snippet>, except that an adequate #line is
prepended for the benefit of the debugger. You can thus single-step
inside your POD documentation, yow! Using the above sample .pm file
(see L</pod_data_snippet>), you could do something like this in the
test trailer:

=for My::Tests::Below "POD testing example" begin

  my $snippet = My::Tests::Below->pod_code_snippet("create-zoinx");

  # Munging $snippet a bit before running it (e.g. with regexp
  # replaces) is par for the course.

  my $zoinx = eval $snippet;
  die $@ if $@; # If snippet fails, we want to know

  # Optionally proceed to test the outcome of the snippet:

  is(ref($zoinx), "Zoinx", '$zoinx is a Zoinx');

=for My::Tests::Below "POD testing example" end

=cut

sub pod_code_snippet {
    my ($self, $name) = @_; $self = $singleton if ! ref $self;
    return "#line " . $self->{podsnippets}{$name}->{lineno} .
        " \"$self->{packfilename}\"\n" .
            $self->pod_data_snippet($name);
}

=back

=head1 SEE ALSO

L<My::Module::Build> knows how to remove I<My::Tests::Below>
suites at "make" or "./Build code" time, so as not to burden the
compiled package with the test suite.

While I am (obviously) partial to putting tests at the bottom of the
package, I also occasionally make use of classic C<t/*.t> tests; in
particular I use the same C<t/maintainer/*.t> tests in all my CPAN
modules.

=head1 BUGS

The purpose of this package is mostly a duplicate of L<Test::Inline>
and/or L<Pod::Tests>, but I cannot join either of these efforts in the
current state of CPAN affairs (I<Pod::Tests> is not maintained, and as
stated L<above|/"Why not use Test::Inline then?"> I<Test::Inline> is
not adequate for many reasons). What I could do, however, is to
standardize on similar POD markup for snippets - but the corresponding
features are being reimplemented in I<Test::Inline> as of version
2.103 (see
F<http://search.cpan.org/~adamk/Test-Inline-2.103/lib/Test/Inline.pm#TO_DO>).
So I'll just wait and see.

=cut

1;

__END__

# Yes, even this module has a
######################## TEST SUITE ###################################

use strict;
use Test::More tests => 11;
use IO::File;
use IO::Handle;
use IPC::Open3;
use File::Slurp qw(read_file write_file);
use File::Spec;
use Fatal qw(mkdir chdir read_file write_file);

###### Tests over the __END__ test section for real modules

# Runs Perl on $filename, returning what we got on stdout / stderr.
# $? is also set.
sub run_perl {
    my ($filename) = @_;
    my ($stdin, $stdout) = map { new IO::Handle } (1..2);
    my ($perl) = ($^X =~ m/^(.*)$/); # Untainted
    my $pid = open3($stdin, $stdout, $stdout,
          $perl, (map { -I => $_ } @INC), '-Tw', $filename);
    $stdin->close();
    my $retval = join('', <$stdout>);
    $stdout->close();
    waitpid($pid, 0); # Sets $?
    return $retval;
}

my $fakemoduledir = My::Tests::Below->tempdir() . "/Fake-Module";
mkdir($fakemoduledir);

mkdir(File::Spec->catdir($fakemoduledir, "Fake"));
my $fakemodule = File::Spec->catfile($fakemoduledir, "Fake", "Module.pm");
write_file($fakemodule, <<'FAKEMODULE');
#!perl -Tw

package Fake::Module;
use strict;

use base 'Exporter';
our @EXPORT = qw(zoinx);

sub zoinx {1}

package Fake::Module::Sub;

require My::Tests::Below unless (caller());

1;

__END__

use Fake::Module;

print "1..2\n";
if (__PACKAGE__ eq "main") {
   print "ok 1 # In package 'main' for tests\n";
} else {
   print "not ok 1 # Package should be main but is ".__PACKAGE__."\n";
}

zoinx();

print "ok 2 # Symbol zoinx is imported\n";

0; # Should not cause suite to fail, unlike perlmodlib
FAKEMODULE

my $result = run_perl($fakemodule);
is($?, 0, "Exited with return code 0\n");
like($result, qr/ok 1/, "Test result #1");
like($result, qr/ok 2/, "Test result #2");

write_file($fakemodule, <<'BUGGY_MODULE_WITH_TEST_MORE');
#!perl -Tw

package Fake::Module;
use strict;