summaryrefslogtreecommitdiff
path: root/dist
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2009-09-28 16:30:53 +0100
committerNicholas Clark <nick@ccl4.org>2009-09-29 11:12:38 +0100
commit2d99478739a24349cd74c9af7ec0da283ad4d42e (patch)
treea031f779facd2892c9732ca8e85763b8c9e8ff80 /dist
parent5a4811be25e2c4fa466997f8fc1ac08c1abddb9e (diff)
downloadperl-2d99478739a24349cd74c9af7ec0da283ad4d42e.tar.gz
Move SelfLoader from ext/ to dist/
Diffstat (limited to 'dist')
-rw-r--r--dist/SelfLoader/lib/SelfLoader.pm435
-rw-r--r--dist/SelfLoader/t/01SelfLoader.t217
-rw-r--r--dist/SelfLoader/t/02SelfLoader-buggy.t46
3 files changed, 698 insertions, 0 deletions
diff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
new file mode 100644
index 0000000000..047f7768e8
--- /dev/null
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -0,0 +1,435 @@
+package SelfLoader;
+use 5.008;
+use strict;
+our $VERSION = "1.17";
+
+# The following bit of eval-magic is necessary to make this work on
+# perls < 5.009005.
+use vars qw/$AttrList/;
+BEGIN {
+ if ($] > 5.009004) {
+ eval <<'NEWERPERL';
+use 5.009005; # due to new regexp features
+# allow checking for valid ': attrlist' attachments
+# see also AutoSplit
+$AttrList = qr{
+ \s* : \s*
+ (?:
+ # one attribute
+ (?> # no backtrack
+ (?! \d) \w+
+ (?<nested> \( (?: [^()]++ | (?&nested)++ )*+ \) ) ?
+ )
+ (?: \s* : \s* | \s+ (?! :) )
+ )*
+}x;
+
+NEWERPERL
+ }
+ else {
+ eval <<'OLDERPERL';
+# allow checking for valid ': attrlist' attachments
+# (we use 'our' rather than 'my' here, due to the rather complex and buggy
+# behaviour of lexicals with qr// and (??{$lex}) )
+our $nested;
+$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
+our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
+$AttrList = qr{ \s* : \s* (?: $one_attr )* }x;
+OLDERPERL
+ }
+}
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(AUTOLOAD);
+sub Version {$VERSION}
+sub DEBUG () { 0 }
+
+my %Cache; # private cache for all SelfLoader's client packages
+
+# in croak and carp, protect $@ from "require Carp;" RT #40216
+
+sub croak { { local $@; require Carp; } goto &Carp::croak }
+sub carp { { local $@; require Carp; } goto &Carp::carp }
+
+AUTOLOAD {
+ our $AUTOLOAD;
+ print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if DEBUG;
+ my $SL_code = $Cache{$AUTOLOAD};
+ my $save = $@; # evals in both AUTOLOAD and _load_stubs can corrupt $@
+ unless ($SL_code) {
+ # Maybe this pack had stubs before __DATA__, and never initialized.
+ # Or, this maybe an automatic DESTROY method call when none exists.
+ $AUTOLOAD =~ m/^(.*)::/;
+ SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
+ $SL_code = $Cache{$AUTOLOAD};
+ $SL_code = "sub $AUTOLOAD { }"
+ if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
+ croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
+ }
+ print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if DEBUG;
+
+ {
+ no strict;
+ eval $SL_code;
+ }
+ if ($@) {
+ $@ =~ s/ at .*\n//;
+ croak $@;
+ }
+ $@ = $save;
+ defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
+ delete $Cache{$AUTOLOAD};
+ goto &$AUTOLOAD
+}
+
+sub load_stubs { shift->_load_stubs((caller)[0]) }
+
+sub _load_stubs {
+ # $endlines is used by Devel::SelfStubber to capture lines after __END__
+ my($self, $callpack, $endlines) = @_;
+ no strict "refs";
+ my $fh = \*{"${callpack}::DATA"};
+ use strict;
+ my $currpack = $callpack;
+ my($line,$name,@lines, @stubs, $protoype);
+
+ print STDERR "SelfLoader::load_stubs($callpack)\n" if DEBUG;
+ croak("$callpack doesn't contain an __DATA__ token")
+ unless defined fileno($fh);
+ # Protect: fork() shares the file pointer between the parent and the kid
+ if(sysseek($fh, tell($fh), 0)) {
+ open my $nfh, '<&', $fh or croak "reopen: $!";# dup() the fd
+ close $fh or die "close: $!"; # autocloses, but be paranoid
+ open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
+ close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ }
+ $Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
+
+ local($/) = "\n";
+ while(defined($line = <$fh>) and $line !~ m/^__END__/) {
+ if ($line =~ m/^\s*sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$AttrList)?)/) {
+ push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+ $protoype = $2;
+ @lines = ($line);
+ if (index($1,'::') == -1) { # simple sub name
+ $name = "${currpack}::$1";
+ } else { # sub name with package
+ $name = $1;
+ $name =~ m/^(.*)::/;
+ if (defined(&{"${1}::AUTOLOAD"})) {
+ \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+ die 'SelfLoader Error: attempt to specify Selfloading',
+ " sub $name in non-selfloading module $1";
+ } else {
+ $self->export($1,'AUTOLOAD');
+ }
+ }
+ } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared
+ push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+ $self->_package_defined($line);
+ $name = '';
+ @lines = ();
+ $currpack = $1;
+ $Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
+ if (defined(&{"${1}::AUTOLOAD"})) {
+ \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+ die 'SelfLoader Error: attempt to specify Selfloading',
+ " package $currpack which already has AUTOLOAD";
+ } else {
+ $self->export($currpack,'AUTOLOAD');
+ }
+ } else {
+ push(@lines,$line);
+ }
+ }
+ if (defined($line) && $line =~ /^__END__/) { # __END__
+ unless ($line =~ /^__END__\s*DATA/) {
+ if ($endlines) {
+ # Devel::SelfStubber would like us to capture the lines after
+ # __END__ so it can write out the entire file
+ @$endlines = <$fh>;
+ }
+ close($fh);
+ }
+ }
+ push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+ no strict;
+ eval join('', @stubs) if @stubs;
+}
+
+
+sub _add_to_cache {
+ my($self,$fullname,$pack,$lines, $protoype) = @_;
+ return () unless $fullname;
+ carp("Redefining sub $fullname")
+ if exists $Cache{$fullname};
+ $Cache{$fullname} = join('', "\n\#line 1 \"sub $fullname\"\npackage $pack; ", @$lines);
+ #$Cache{$fullname} = join('', "package $pack; ",@$lines);
+ print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if DEBUG;
+ # return stub to be eval'd
+ defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
+}
+
+sub _package_defined {}
+
+1;
+__END__
+
+=head1 NAME
+
+SelfLoader - load functions only on demand
+
+=head1 SYNOPSIS
+
+ package FOOBAR;
+ use SelfLoader;
+
+ ... (initializing code)
+
+ __DATA__
+ sub {....
+
+
+=head1 DESCRIPTION
+
+This module tells its users that functions in the FOOBAR package are to be
+autoloaded from after the C<__DATA__> token. See also
+L<perlsub/"Autoloading">.
+
+=head2 The __DATA__ token
+
+The C<__DATA__> token tells the perl compiler that the perl code
+for compilation is finished. Everything after the C<__DATA__> token
+is available for reading via the filehandle FOOBAR::DATA,
+where FOOBAR is the name of the current package when the C<__DATA__>
+token is reached. This works just the same as C<__END__> does in
+package 'main', but for other modules data after C<__END__> is not
+automatically retrievable, whereas data after C<__DATA__> is.
+The C<__DATA__> token is not recognized in versions of perl prior to
+5.001m.
+
+Note that it is possible to have C<__DATA__> tokens in the same package
+in multiple files, and that the last C<__DATA__> token in a given
+package that is encountered by the compiler is the one accessible
+by the filehandle. This also applies to C<__END__> and main, i.e. if
+the 'main' program has an C<__END__>, but a module 'require'd (_not_ 'use'd)
+by that program has a 'package main;' declaration followed by an 'C<__DATA__>',
+then the C<DATA> filehandle is set to access the data after the C<__DATA__>
+in the module, _not_ the data after the C<__END__> token in the 'main'
+program, since the compiler encounters the 'require'd file later.
+
+=head2 SelfLoader autoloading
+
+The B<SelfLoader> works by the user placing the C<__DATA__>
+token I<after> perl code which needs to be compiled and
+run at 'require' time, but I<before> subroutine declarations
+that can be loaded in later - usually because they may never
+be called.
+
+The B<SelfLoader> will read from the FOOBAR::DATA filehandle to
+load in the data after C<__DATA__>, and load in any subroutine
+when it is called. The costs are the one-time parsing of the
+data after C<__DATA__>, and a load delay for the _first_
+call of any autoloaded function. The benefits (hopefully)
+are a speeded up compilation phase, with no need to load
+functions which are never used.
+
+The B<SelfLoader> will stop reading from C<__DATA__> if
+it encounters the C<__END__> token - just as you would expect.
+If the C<__END__> token is present, and is followed by the
+token DATA, then the B<SelfLoader> leaves the FOOBAR::DATA
+filehandle open on the line after that token.
+
+The B<SelfLoader> exports the C<AUTOLOAD> subroutine to the
+package using the B<SelfLoader>, and this loads the called
+subroutine when it is first called.
+
+There is no advantage to putting subroutines which will _always_
+be called after the C<__DATA__> token.
+
+=head2 Autoloading and package lexicals
+
+A 'my $pack_lexical' statement makes the variable $pack_lexical
+local _only_ to the file up to the C<__DATA__> token. Subroutines
+declared elsewhere _cannot_ see these types of variables,
+just as if you declared subroutines in the package but in another
+file, they cannot see these variables.
+
+So specifically, autoloaded functions cannot see package
+lexicals (this applies to both the B<SelfLoader> and the Autoloader).
+The C<vars> pragma provides an alternative to defining package-level
+globals that will be visible to autoloaded routines. See the documentation
+on B<vars> in the pragma section of L<perlmod>.
+
+=head2 SelfLoader and AutoLoader
+
+The B<SelfLoader> can replace the AutoLoader - just change 'use AutoLoader'
+to 'use SelfLoader' (though note that the B<SelfLoader> exports
+the AUTOLOAD function - but if you have your own AUTOLOAD and
+are using the AutoLoader too, you probably know what you're doing),
+and the C<__END__> token to C<__DATA__>. You will need perl version 5.001m
+or later to use this (version 5.001 with all patches up to patch m).
+
+There is no need to inherit from the B<SelfLoader>.
+
+The B<SelfLoader> works similarly to the AutoLoader, but picks up the
+subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
+There is a maintenance gain in not needing to run AutoSplit on the module
+at installation, and a runtime gain in not needing to keep opening and
+closing files to load subs. There is a runtime loss in needing
+to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and
+another view of these distinctions can be found in that module's
+documentation.
+
+=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle.
+
+This section is only relevant if you want to use
+the C<FOOBAR::DATA> together with the B<SelfLoader>.
+
+Data after the C<__DATA__> token in a module is read using the
+FOOBAR::DATA filehandle. C<__END__> can still be used to denote the end
+of the C<__DATA__> section if followed by the token DATA - this is supported
+by the B<SelfLoader>. The C<FOOBAR::DATA> filehandle is left open if an
+C<__END__> followed by a DATA is found, with the filehandle positioned at
+the start of the line after the C<__END__> token. If no C<__END__> token is
+present, or an C<__END__> token with no DATA token on the same line, then
+the filehandle is closed.
+
+The B<SelfLoader> reads from wherever the current
+position of the C<FOOBAR::DATA> filehandle is, until the
+EOF or C<__END__>. This means that if you want to use
+that filehandle (and ONLY if you want to), you should either
+
+1. Put all your subroutine declarations immediately after
+the C<__DATA__> token and put your own data after those
+declarations, using the C<__END__> token to mark the end
+of subroutine declarations. You must also ensure that the B<SelfLoader>
+reads first by calling 'SelfLoader-E<gt>load_stubs();', or by using a
+function which is selfloaded;
+
+or
+
+2. You should read the C<FOOBAR::DATA> filehandle first, leaving
+the handle open and positioned at the first line of subroutine
+declarations.
+
+You could conceivably do both.
+
+=head2 Classes and inherited methods.
+
+For modules which are not classes, this section is not relevant.
+This section is only relevant if you have methods which could
+be inherited.
+
+A subroutine stub (or forward declaration) looks like
+
+ sub stub;
+
+i.e. it is a subroutine declaration without the body of the
+subroutine. For modules which are not classes, there is no real
+need for stubs as far as autoloading is concerned.
+
+For modules which ARE classes, and need to handle inherited methods,
+stubs are needed to ensure that the method inheritance mechanism works
+properly. You can load the stubs into the module at 'require' time, by
+adding the statement 'SelfLoader-E<gt>load_stubs();' to the module to do
+this.
+
+The alternative is to put the stubs in before the C<__DATA__> token BEFORE
+releasing the module, and for this purpose the C<Devel::SelfStubber>
+module is available. However this does require the extra step of ensuring
+that the stubs are in the module. If this is done I strongly recommend
+that this is done BEFORE releasing the module - it should NOT be done
+at install time in general.
+
+=head1 Multiple packages and fully qualified subroutine names
+
+Subroutines in multiple packages within the same file are supported - but you
+should note that this requires exporting the C<SelfLoader::AUTOLOAD> to
+every package which requires it. This is done automatically by the
+B<SelfLoader> when it first loads the subs into the cache, but you should
+really specify it in the initialization before the C<__DATA__> by putting
+a 'use SelfLoader' statement in each package.
+
+Fully qualified subroutine names are also supported. For example,
+
+ __DATA__
+ sub foo::bar {23}
+ package baz;
+ sub dob {32}
+
+will all be loaded correctly by the B<SelfLoader>, and the B<SelfLoader>
+will ensure that the packages 'foo' and 'baz' correctly have the
+B<SelfLoader> C<AUTOLOAD> method when the data after C<__DATA__> is first
+parsed.
+
+=head1 AUTHOR
+
+C<SelfLoader> is maintained by the perl5-porters. Please direct
+any questions to the canonical mailing list. Anything that
+is applicable to the CPAN release can be sent to its maintainer,
+though.
+
+Author and Maintainer: The Perl5-Porters <perl5-porters@perl.org>
+
+Maintainer of the CPAN release: Steffen Mueller <smueller@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This package has been part of the perl core since the first release
+of perl5. It has been released separately to CPAN so older installations
+can benefit from bug fixes.
+
+This package has the same copyright and license as the perl core:
+
+ Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
+
+ All rights reserved.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of either:
+
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+
+ b) the "Artistic License" which comes with this Kit.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
+ the GNU General Public License or the Artistic License for more details.
+
+ You should have received a copy of the Artistic License with this
+ Kit, in the file named "Artistic". If not, I'll be glad to provide one.
+
+ You should also have received a copy of the GNU General Public License
+ along with this program in the file named "Copying". If not, write to the
+ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307, USA or visit their web page on the internet at
+ http://www.gnu.org/copyleft/gpl.html.
+
+ For those of you that choose to use the GNU General Public License,
+ my interpretation of the GNU General Public License is that no Perl
+ script falls under the terms of the GPL unless you explicitly put
+ said script under the terms of the GPL yourself. Furthermore, any
+ object code linked with perl does not automatically fall under the
+ terms of the GPL, provided such object code only adds definitions
+ of subroutines and variables, and does not otherwise impair the
+ resulting interpreter from executing any standard Perl script. I
+ consider linking in C subroutines in this manner to be the moral
+ equivalent of defining subroutines in the Perl language itself. You
+ may sell such an object file as proprietary provided that you provide
+ or offer to provide the Perl source, as specified by the GNU General
+ Public License. (This is merely an alternate way of specifying input
+ to the program.) You may also sell a binary produced by the dumping of
+ a running Perl script that belongs to you, provided that you provide or
+ offer to provide the Perl source as specified by the GPL. (The
+ fact that a Perl interpreter and your code are in the same binary file
+ is, in this case, a form of mere aggregation.) This is my interpretation
+ of the GPL. If you still have concerns or difficulties understanding
+ my intent, feel free to contact me. Of course, the Artistic License
+ spells all this out for your protection, so you may prefer to use that.
+
+=cut
diff --git a/dist/SelfLoader/t/01SelfLoader.t b/dist/SelfLoader/t/01SelfLoader.t
new file mode 100644
index 0000000000..68c12296d9
--- /dev/null
+++ b/dist/SelfLoader/t/01SelfLoader.t
@@ -0,0 +1,217 @@
+BEGIN {
+ chdir 't' if -d 't';
+ $dir = "self-$$";
+ $sep = "/";
+
+ if ($^O eq 'MacOS') {
+ $dir = ":" . $dir;
+ $sep = ":";
+ }
+
+ unshift @INC, $dir;
+ unshift @INC, '../lib';
+
+ print "1..20\n";
+
+ # First we must set up some selfloader files
+ mkdir $dir, 0755 or die "Can't mkdir $dir: $!";
+
+ open(FOO, ">$dir${sep}Foo.pm") or die;
+ print FOO <<'EOT';
+package Foo;
+use SelfLoader;
+
+sub new { bless {}, shift }
+sub foo;
+sub bar;
+sub bazmarkhianish;
+sub a;
+sub never; # declared but definition should never be read
+1;
+__DATA__
+
+sub foo { shift; shift || "foo" };
+
+sub bar { shift; shift || "bar" }
+
+sub bazmarkhianish { shift; shift || "baz" }
+
+package sheep;
+sub bleat { shift; shift || "baa" }
+__END__
+sub never { die "D'oh" }
+EOT
+
+ close(FOO);
+
+ open(BAR, ">$dir${sep}Bar.pm") or die;
+ print BAR <<'EOT';
+package Bar;
+use SelfLoader;
+
+@ISA = 'Baz';
+
+sub new { bless {}, shift }
+sub a;
+sub with_whitespace_in_front;
+
+1;
+__DATA__
+
+sub a { 'a Bar'; }
+sub b { 'b Bar' }
+
+ sub with_whitespace_in_front {
+ "with_whitespace_in_front Bar"
+}
+
+__END__ DATA
+sub never { die "D'oh" }
+EOT
+
+ close(BAR);
+};
+
+
+package Baz;
+
+sub a { 'a Baz' }
+sub b { 'b Baz' }
+sub c { 'c Baz' }
+
+
+package main;
+use Foo;
+use Bar;
+
+$foo = new Foo;
+
+print "not " unless $foo->foo eq 'foo'; # selfloaded first time
+print "ok 1\n";
+
+print "not " unless $foo->foo eq 'foo'; # regular call
+print "ok 2\n";
+
+# Try an undefined method
+eval {
+ $foo->will_fail;
+};
+if ($@ =~ /^Undefined subroutine/) {
+ print "ok 3\n";
+} else {
+ print "not ok 3 $@\n";
+}
+
+# Used to be trouble with this
+eval {
+ my $foo = new Foo;
+ die "oops";
+};
+if ($@ =~ /oops/) {
+ print "ok 4\n";
+} else {
+ print "not ok 4 $@\n";
+}
+
+# Pass regular expression variable to autoloaded function. This used
+# to go wrong in AutoLoader because it used regular expressions to generate
+# autoloaded filename.
+"foo" =~ /(\w+)/;
+print "not " unless $1 eq 'foo';
+print "ok 5\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 6\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 7\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 8\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 9\n";
+
+# Check nested packages inside __DATA__
+print "not " unless sheep::bleat() eq 'baa';
+print "ok 10\n";
+
+# Now check inheritance:
+
+$bar = new Bar;
+
+# Before anything is SelfLoaded there is no declaration of Foo::b so we should
+# get Baz::b
+print "not " unless $bar->b() eq 'b Baz';
+print "ok 11\n";
+
+# There is no Bar::c so we should get Baz::c
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 12\n";
+
+# check that subs with whitespace in front work
+print "not " unless $bar->with_whitespace_in_front() eq 'with_whitespace_in_front Bar';
+print "ok 13\n";
+
+# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
+# effect
+print "not " unless $bar->a() eq 'a Bar';
+print "ok 14\n";
+
+print "not " unless $bar->b() eq 'b Bar';
+print "ok 15\n";
+
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 16\n";
+
+
+
+# Check that __END__ is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+ $foo->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+ print "ok 17\n";
+} else {
+ print "not ok 17 $@\n";
+}
+
+# Try to read from the data file handle
+{
+ local $SIG{__WARN__} = sub { my $warn = shift; };
+ my $foodata = <Foo::DATA>;
+ close Foo::DATA;
+ if (defined $foodata) {
+ print "not ok 18 # $foodata\n";
+ } else {
+ print "ok 18\n";
+ }
+}
+
+# Check that __END__ DATA is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+ $bar->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+ print "ok 19\n";
+} else {
+ print "not ok 19 $@\n";
+}
+
+# Try to read from the data file handle
+my $bardata = <Bar::DATA>;
+close Bar::DATA;
+if ($bardata ne "sub never { die \"D'oh\" }\n") {
+ print "not ok 20 # $bardata\n";
+} else {
+ print "ok 20\n";
+}
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
+rmdir "$dir";
+}
diff --git a/dist/SelfLoader/t/02SelfLoader-buggy.t b/dist/SelfLoader/t/02SelfLoader-buggy.t
new file mode 100644
index 0000000000..7845d05228
--- /dev/null
+++ b/dist/SelfLoader/t/02SelfLoader-buggy.t
@@ -0,0 +1,46 @@
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+use SelfLoader;
+print "1..1\n";
+
+# this script checks that errors on self-loaded
+# subroutines that affect $@ are reported
+
+eval { buggy(); };
+unless ($@ =~ /^syntax error/) {
+ print "not ";
+}
+print "ok 1 - syntax errors are reported\n";
+
+__END__
+
+sub buggy
+{
+ +>*;
+}
+
+
+# RT 40216
+#
+# by Bo Lindbergh <blgl@hagernas.com>, at Aug 22, 2006 5:42 PM
+#
+# In the example below, there's a syntax error in the selfloaded
+# code for main::buggy. When the eval fails, SelfLoader::AUTOLOAD
+# tries to report this with "croak $@;". Unfortunately,
+# SelfLoader::croak does "require Carp;" without protecting $@,
+# which gets clobbered. The program then dies with the
+# uninformative message " at ./example line 3".
+#
+# #! /usr/local/bin/perl
+# use SelfLoader;
+# buggy();
+# __END__
+# sub buggy
+# {
+# +>*;
+# }