The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
use warnings;

use Test::More 1.0 'no_plan';

BEGIN {
	use File::Spec::Functions qw(rel2abs catfile);
	my $file = rel2abs( catfile( qw( t lib setup_common.pl) ) );
	require $file;
	}

use Data::Dumper;

my $class = 'Module::Release';

use_ok( $class );

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Are the subroutines defined?
{
my @subs = qw(
	set_perl
	perls
	add_a_perl
	remove_a_perl
	reset_perls
	get_perl
	_looks_like_perl
	);

can_ok( $class, @subs );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Test _looks_like_perl
{
my $mock = bless { perl => $^X }, $class;
ok(   $mock->_looks_like_perl( $^X ), "\$^X looks like perl" );
ok( ! $mock->_looks_like_perl( 'blib' ), "blib doesn't look like perl" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Test the main perl
{
my $mock = bless { perl => $^X }, $class;
is( $mock->get_perl, $^X, "main perl is the one in \$^X" );
}

{
my $foo = 'foo';

my $mock = bless { perl => $foo }, $class;
is( $mock->get_perl, $foo, "main perl is '$foo' to start" );

# set it to a real perl
{
my $old_perl = $mock->set_perl( $^X );
is( $old_perl, $foo, "old perl is '$foo'" );
is( $mock->get_perl, $^X, "main perl is the one in \$^X" );
}

# try setting it to a non-perl
{
my $r = eval { $mock->set_perl( $foo ); 1 };
ok( ! defined $r, "Trying to set to non-perl croaks" );
is( $mock->get_perl, $^X, "main perl is still \$^X" );
}

}

(my $pX = $^X) =~ s,.*/,,;

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Test the perls
{
my $mock = bless { perls => { $^X => $] } }, $class;

{
my @perls = $mock->perls;
is( scalar @perls, 1, "There is only one perl" );
}

{
$mock->remove_a_perl( $^X );
my @perls = $mock->perls;
is( scalar @perls, 0, "There are no perls" );
}

{
$mock->add_a_perl( $^X );
my @perls = $mock->perls;
is( scalar @perls, 1, "There are no perls" );
(my $p0 = $perls[0]) =~ s,.*/,,;
is( $p0, $pX, "The reset perl is the one in \$^X" );

# Adding the same thing shouldn't do anything
$mock->add_a_perl( $^X );
@perls = $mock->perls;
is( scalar @perls, 1, "There are no perls" );
($p0 = $perls[0]) =~ s,.*/,,;
is( $p0, $pX, "The reset perl is the one in \$^X" );

# Adding something not executable shouldn't do anything
$mock->turn_quiet_on;
$mock->add_a_perl( 'README' );
@perls = $mock->perls;
is( scalar @perls, 1, "There are no perls" );
($p0 = $perls[0]) =~ s,.*/,,;
is( $p0, $pX, "The reset perl is the one in \$^X" );

# Adding something is executable but not perl shouldn't do anything
{
my $trial_file = 'exe';

open my($fh), ">", $trial_file;
close $fh;
ok( -e $trial_file, "Trail exe file exists" );

chmod 0755, $trial_file;

SKIP: {
	skip "Couldn't make executable file: $!", 2 unless -x $trial_file;
	$mock->add_a_perl( $trial_file );
	@perls = $mock->perls;
	is( scalar @perls, 1, "There are no perls" );
	($p0 = $perls[0]) =~ s,.*/,,;
	is( $p0, $pX, "The reset perl is the one in \$^X" );
	}

unlink $trial_file;
}
}

{
$mock->remove_a_perl( $^X );
my @perls = $mock->perls;
is( scalar @perls, 0, "There are no perls" );
}

{
my @perls = $mock->perls;
is( scalar @perls, 0, "There are no perls" );

$mock->reset_perls;
@perls = $mock->perls;
is( scalar @perls, 1, "There is one perls" );
(my $p0 = $perls[0]) =~ s,.*/,,;
is( $p0, $pX, "The reset perl is the one in \$^X" );
}

}