view release on metacpan or  search on metacpan

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

=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::Spec;
use Fatal qw(mkdir chdir);

=begin internals

=head2 Tests over the __END__ test section for real modules

=head3 run_perl($filename)

Runs Perl on $filename, returning what we got on stdout / stderr.
$? is also set.

=cut

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;
}

=head2 read_file($file)

=head2 write_file($file, @lines)

Like in L<File::Slurp>.

=cut

sub read_file {
  my ($filename) = @_;
  defined(my $file = IO::File->new($filename, "<")) or die <<"MESSAGE";
Cannot open $filename for reading: $!.
MESSAGE
  return wantarray? <$file> : join("", <$file>);
}

sub write_file {
  my ($filename, @contents) = @_;
  defined(my $file = IO::File->new($filename, ">")) or die <<"MESSAGE";
Cannot open $filename for writing: $!.
MESSAGE
  ($file->print(join("", @contents)) and $file->close()) or die <<"MESSAGE";
Cannot write into $filename: $!.
MESSAGE
}

=end internals

=cut

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);