xref: /openbsd/gnu/usr.bin/perl/dist/SelfLoader/t/01SelfLoader.t (revision b39c5158)

BEGIN {
    $dir = "self-$$";
    $sep = "/";

    if ($^O eq 'MacOS') {
	$dir = ":" . $dir;
	$sep = ":";
    }

    unshift @INC, $dir;

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