view release on metacpan or  search on metacpan

inc/My/Module/Build.pm  view on Meta::CPAN

__END__

use Test::More "no_plan";

########### Dependent graph stuff ################

# We keep the tests in a separate package so that if we later decide
# to refactor the dependent graph stuff into a standalone
# Module::Build plug-in, a simple cut-n-paste operation will do the
# job.
do {
    # We re-route the process of creating a Module::Build object to
    # a fake package, so as not to make Module::Build itself part
    # of the tests over the dependent graph stuff:
    local @My::Module::Build::ISA=qw(Fake::Module::Build);

    package Fake::Module::Build;

    sub new { bless {}, shift }

    # Various stuff that is being called by My::Module::Build as part
    # of this test, and that we therefore need to stub out:
    no warnings "redefine";
    local *My::Module::Build::maintainer_mode_enabled = sub { 0 };
    local *My::Module::Build::subclass = sub {
        my ($self, %opts) = @_;
        eval <<'HEADER' . $opts{code}; die $@ if $@;

package Fake::Subclass;
BEGIN { our @ISA=qw(My::Module::Build); }

HEADER
        return "Fake::Subclass";
    };

    sub notes {
        my ($self, $k, @v) = @_;
        if (@v) { $self->{notes}->{$k} = $v[0]; }
        return $self->{notes}->{$k};
    }

    # "batch" version of ->prompt()
    our %answers = ("Install module foo?" => 1);
    sub prompt {
        my ($self, $question) = @_;
        die "Unexpected question $question" if
            (! exists $answers{$question});
        return delete $answers{$question}; # Will not answer twice
        # the same question
    }

    package main_screen; # Do not to pollute the namespace of "main" with
    # the "use" directives below - Still keeping refactoring in mind.

    BEGIN { *write_file = \&My::Module::Build::write_file;
            *read_file  = \&My::Module::Build::read_file; }

    use Test::More;
    use Fatal qw(mkdir chdir);

    local @ARGV = qw(--noinstall-everything);

    my $define_options =
        My::Tests::Below->pod_code_snippet("option-graph");
    $define_options =~ s/\.\.\.//g;
    my $builder = eval $define_options; die $@ if $@;

    isa_ok($builder, "Fake::Module::Build",
           "construction of builder successful");

    is(scalar keys %My::Module::Build::declared_options,
       2, "Number of declarations seen");

    is(scalar(keys %answers), 0, "All questions have been asked");
    ok(! $builder->notes("option:install_everything"),
          "note install_everything");
    ok($builder->notes("option:install_module_foo"),
          "note install_module_foo");
    ok(! $builder->option_value("install_everything"),
          "install_everything");
    ok($builder->option_value("install_module_foo"),
          "install_module_foo");

    # Some whitebox testing here:
    is($builder->_option_type("install_everything"), "boolean",
       "implicit typing");
    is($builder->_option_type("install_module_foo"), "boolean",
       "explicit typing");
}; # End of fixture for option graph tests

####################### Main test suite ###########################

use File::Copy qw(copy);
use File::Spec::Functions qw(catfile catdir);
use IO::Pipe;
BEGIN { *write_file = \&My::Module::Build::write_file;
        *read_file  = \&My::Module::Build::read_file; }

# Probably wise to add this in real test suites too:
use Fatal qw(mkdir chdir copy);

mkdir(my $fakemoduledir = My::Tests::Below->tempdir() . "/Fake-Module");

my $sample_Build_PL = My::Tests::Below->pod_code_snippet("synopsis");

$sample_Build_PL =~ s/^(.*Acme::Pony.*)$/#$1/m; # As we say in french,
    # faut pas _que_ deconner non plus.
my $ordinary_arguments = <<'ORDINARY_ARGUMENTS';
      module_name         => 'Fake::Module',
      license             => 'perl',
      dist_author         => 'Octave Hergebelle <hector@tdlgb.org>',
      dist_version_from   => 'lib/Fake/Module.pm',
      dist_abstract       => 'required for Module::Build 0.2805, sheesh',
      requires            => {
        'Module::Build' => 0,
      },
      create_makefile_pl  => 'passthrough',
ORDINARY_ARGUMENTS
ok($sample_Build_PL =~
   s/^(.*##.*ordinary.*arguments.*)$/$ordinary_arguments/m,
   "substitution 1 in synopsis");