1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A $dir = "self-$$";
1N/A $sep = "/";
1N/A
1N/A if ($^O eq 'MacOS') {
1N/A $dir = ":" . $dir;
1N/A $sep = ":";
1N/A }
1N/A
1N/A @INC = $dir;
1N/A push @INC, '../lib';
1N/A
1N/A print "1..19\n";
1N/A
1N/A # First we must set up some selfloader files
1N/A mkdir $dir, 0755 or die "Can't mkdir $dir: $!";
1N/A
1N/A open(FOO, ">$dir${sep}Foo.pm") or die;
1N/A print FOO <<'EOT';
1N/Apackage Foo;
1N/Ause SelfLoader;
1N/A
1N/Asub new { bless {}, shift }
1N/Asub foo;
1N/Asub bar;
1N/Asub bazmarkhianish;
1N/Asub a;
1N/Asub never; # declared but definition should never be read
1N/A1;
1N/A__DATA__
1N/A
1N/Asub foo { shift; shift || "foo" };
1N/A
1N/Asub bar { shift; shift || "bar" }
1N/A
1N/Asub bazmarkhianish { shift; shift || "baz" }
1N/A
1N/Apackage sheep;
1N/Asub bleat { shift; shift || "baa" }
1N/A
1N/A__END__
1N/Asub never { die "D'oh" }
1N/AEOT
1N/A
1N/A close(FOO);
1N/A
1N/A open(BAR, ">$dir${sep}Bar.pm") or die;
1N/A print BAR <<'EOT';
1N/Apackage Bar;
1N/Ause SelfLoader;
1N/A
1N/A@ISA = 'Baz';
1N/A
1N/Asub new { bless {}, shift }
1N/Asub a;
1N/A
1N/A1;
1N/A__DATA__
1N/A
1N/Asub a { 'a Bar'; }
1N/Asub b { 'b Bar' }
1N/A
1N/A__END__ DATA
1N/Asub never { die "D'oh" }
1N/AEOT
1N/A
1N/A close(BAR);
1N/A};
1N/A
1N/A
1N/Apackage Baz;
1N/A
1N/Asub a { 'a Baz' }
1N/Asub b { 'b Baz' }
1N/Asub c { 'c Baz' }
1N/A
1N/A
1N/Apackage main;
1N/Ause Foo;
1N/Ause Bar;
1N/A
1N/A$foo = new Foo;
1N/A
1N/Aprint "not " unless $foo->foo eq 'foo'; # selfloaded first time
1N/Aprint "ok 1\n";
1N/A
1N/Aprint "not " unless $foo->foo eq 'foo'; # regular call
1N/Aprint "ok 2\n";
1N/A
1N/A# Try an undefined method
1N/Aeval {
1N/A $foo->will_fail;
1N/A};
1N/Aif ($@ =~ /^Undefined subroutine/) {
1N/A print "ok 3\n";
1N/A} else {
1N/A print "not ok 3 $@\n";
1N/A}
1N/A
1N/A# Used to be trouble with this
1N/Aeval {
1N/A my $foo = new Foo;
1N/A die "oops";
1N/A};
1N/Aif ($@ =~ /oops/) {
1N/A print "ok 4\n";
1N/A} else {
1N/A print "not ok 4 $@\n";
1N/A}
1N/A
1N/A# Pass regular expression variable to autoloaded function. This used
1N/A# to go wrong in AutoLoader because it used regular expressions to generate
1N/A# autoloaded filename.
1N/A"foo" =~ /(\w+)/;
1N/Aprint "not " unless $1 eq 'foo';
1N/Aprint "ok 5\n";
1N/A
1N/Aprint "not " unless $foo->bar($1) eq 'foo';
1N/Aprint "ok 6\n";
1N/A
1N/Aprint "not " unless $foo->bar($1) eq 'foo';
1N/Aprint "ok 7\n";
1N/A
1N/Aprint "not " unless $foo->bazmarkhianish($1) eq 'foo';
1N/Aprint "ok 8\n";
1N/A
1N/Aprint "not " unless $foo->bazmarkhianish($1) eq 'foo';
1N/Aprint "ok 9\n";
1N/A
1N/A# Check nested packages inside __DATA__
1N/Aprint "not " unless sheep::bleat() eq 'baa';
1N/Aprint "ok 10\n";
1N/A
1N/A# Now check inheritance:
1N/A
1N/A$bar = new Bar;
1N/A
1N/A# Before anything is SelfLoaded there is no declaration of Foo::b so we should
1N/A# get Baz::b
1N/Aprint "not " unless $bar->b() eq 'b Baz';
1N/Aprint "ok 11\n";
1N/A
1N/A# There is no Bar::c so we should get Baz::c
1N/Aprint "not " unless $bar->c() eq 'c Baz';
1N/Aprint "ok 12\n";
1N/A
1N/A# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
1N/A# effect
1N/Aprint "not " unless $bar->a() eq 'a Bar';
1N/Aprint "ok 13\n";
1N/A
1N/Aprint "not " unless $bar->b() eq 'b Bar';
1N/Aprint "ok 14\n";
1N/A
1N/Aprint "not " unless $bar->c() eq 'c Baz';
1N/Aprint "ok 15\n";
1N/A
1N/A
1N/A
1N/A# Check that __END__ is honoured
1N/A# Try an subroutine that should never be noticed by selfloader
1N/Aeval {
1N/A $foo->never;
1N/A};
1N/Aif ($@ =~ /^Undefined subroutine/) {
1N/A print "ok 16\n";
1N/A} else {
1N/A print "not ok 16 $@\n";
1N/A}
1N/A
1N/A# Try to read from the data file handle
1N/Amy $foodata = <Foo::DATA>;
1N/Aclose Foo::DATA;
1N/Aif (defined $foodata) {
1N/A print "not ok 17 # $foodata\n";
1N/A} else {
1N/A print "ok 17\n";
1N/A}
1N/A
1N/A# Check that __END__ DATA is honoured
1N/A# Try an subroutine that should never be noticed by selfloader
1N/Aeval {
1N/A $bar->never;
1N/A};
1N/Aif ($@ =~ /^Undefined subroutine/) {
1N/A print "ok 18\n";
1N/A} else {
1N/A print "not ok 18 $@\n";
1N/A}
1N/A
1N/A# Try to read from the data file handle
1N/Amy $bardata = <Bar::DATA>;
1N/Aclose Bar::DATA;
1N/Aif ($bardata ne "sub never { die \"D'oh\" }\n") {
1N/A print "not ok 19 # $bardata\n";
1N/A} else {
1N/A print "ok 19\n";
1N/A}
1N/A
1N/A# cleanup
1N/AEND {
1N/Areturn unless $dir && -d $dir;
1N/Aunlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
1N/Armdir "$dir";
1N/A}