Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Test::AutoLoader

by ChemBoy (Priest)
on Jul 19, 2005 at 19:25 UTC ( [id://476242]=sourcecode: print w/replies, xml ) Need Help??
Category: Testing
Author/Contact Info ChemBoy (chemboy@perlmonk.org), working on his employer's time, with permission (hence the copyright notice).
Description:

Never seen the error message Can't locate auto/MyModule/split_function.al in @INC (or better, auto/MyModule/split_fu.al)before? Then you probably don't need this module. If you have, and it's because of an uncaught compile-time error somewhere after the __END__ of your module, then this might be a helpful addition to your test scripts.

If nobody tells me it's stupid or duplicative, I may post this to CPAN some day soon, so if there are glaring errors or weaknesses, this would be a great time to point them out.

# (c) Copyright 2005 Neurogen Corporation, all rights reserved.
package Test::AutoLoader;

use 5.006; # for 'warnings'
use strict;
use warnings;
use Exporter;
BEGIN{*import = \&Exporter::import};
use File::Spec;
use Test::Builder;

our @EXPORT = ('autoload_ok');
our $VERSION = 0.02;

# Lifted fairly directly from AutoLoader.pm
my ($is_dosish, $is_epoc,$is_vms, $is_macos);
BEGIN {
    $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
    $is_epoc = $^O eq 'epoc';
    $is_vms = $^O eq 'VMS';
    $is_macos = $^O eq 'MacOS';
}

sub autoload_ok {
    my ($package,@subnames) = @_;
    my $Test = Test::Builder->new;
    # initialize the special vars here?  (if we make this part of Test
+::More)
    unless ($package) {
        return $Test->ok(0,"Can't test autoload of empty package")
    }
    my $test_label = "Autoload of $package" .
      (@subnames ? " (listed subroutines)" : " (all files)");
    (my $pkg = $package) =~ s#::#/#g;
    my $dirname;
    my (@ok,@nok);

    if (defined($dirname = $INC{"$pkg.pm"})) {
        if ($is_macos) {
            $pkg =~ tr#/#:#;
            $dirname =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg#s;
        } else {
            $dirname =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg#s;
        }
    }
    unless (defined $dirname and -d $dirname && -r _ ) {
        $Test->ok(0,$test_label);
        my $diag = "Unable to find valid autoload directory for $packa
+ge";
        $diag .= " (perhaps you forgot to load '$package'?)"
          if !defined $dirname;
        $Test->diag($diag);
        return;
    }
    my @filenames = map "$_.al", @subnames;
    if (!@filenames ) {
        unless (opendir AUTOLOAD, $dirname) {
            $Test->ok(0,$test_label); 
            $Test->diag("Can't open $dirname: $!");
            return;
        }
        @filenames = grep /.+\.al\z/, readdir AUTOLOAD;
        closedir AUTOLOAD or $Test->diag("Unable to close $dirname: $!
+");
    }

    foreach my $filename (@filenames) {
        my $full_path = File::Spec->catfile($dirname,$filename);
        # also lifted directly from AutoLoader.pm, then tweaked
        unless ($full_path =~ m|^/|s) {
            if ($is_dosish && $full_path !~ m{^([a-z]:)?[\\/]}is) {
                $full_path = "./$full_path";
            } elsif ($is_epoc && $full_path !~ m{^([a-z?]:)?[\\/]}is) 
+{
                $full_path = "./$full_path";
            } elsif ($is_vms) {
                # XXX todo by VMSmiths
                $full_path = "./$full_path";
            } elsif (!$is_macos) {
                $full_path = "./$full_path";
            }
        }
        local ($@,$!,$?);
        if (my $ret = do $full_path) {
            push @ok, $filename;
        } else {
            my $err = $!
              || $@ && "Compile error"
              || "false return value";
            push @nok, [$filename,$err];
        }
    }
    if (@nok) {
        $Test->ok(0,$test_label);
        $Test->diag(map "    couldn't load $_->[0]: $_->[1]\n", @nok);
        return 0;
    } elsif(@ok) {
        return $Test->ok(1,$test_label);
    } else {
        $Test->ok(0,$test_label);
        $Test->diag("No autoloaded files found");
        return 0;
    }
}
no warnings 'void';
"I pass the test.  I will diminish, and go into the West, and remain G
+aladriel"
__END__


=head1 NAME

Test::AutoLoader - a testing utility for autosplit/autoloaded modules.

=head1 SYNOPSIS

  use Test::AutoLoader;
  use Test::More tests => 3;
  
  use_ok("My::Module"); # from Test::More
  autoload_ok("My::Module","mysub","sub_two); # test only the listed s
+ubs
  autoload_ok("My::Module"); # tests all '.al' files found for the mod
+ule

=head1 DESCRIPTION

This single-purpose module attempts to eliminate uncaught syntax
errors or other obvious goofs in subroutines that are autosplit, and
hence not looked at by C<perl -c Module.pm>.  Ideally, this module
will become unnecessary as you reach full coverage of those
subroutines in your unit tests.  Until that happy day, however, this
should provide a quick and dirty backstop for embarrassing typos.

Test::AutoLoader is built on Test::Builder, and should interoperate
smoothly with other such modules (e.g. Test::Simple, Test::More).

=head1 EXPORT

=head2 autoload_ok

Very much like the 'use_ok' subroutine (see L<Test::More>).  If passed
only a module name, it will find all subroutine definitions in the
"auto" directory and attempt to compile them.  If passed a list of
subroutine names, it will look for and attempt to compile those (and o
+nly
those).  Any files that cannot be found (if specified directly), read,
+ and
compiled will be listed in the diagnostic output for the failed test.

=head1 AUTHOR

ChemBoy (chemboy@perlmonk.org)

=head1 COPYRIGHT AND LICENSE

This module is copyright (c) 2005 Neurogen Corporation, Branford,
Connecticut, USA.  It may be distributed under the terms of the GNU
General Public License.

=head1 SEE ALSO

L<perl>, L<Test::More>, L<AutoLoader>.

=cut

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://476242]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (6)
As of 2024-04-16 22:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found