view release on metacpan or  search on metacpan

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

        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");
my $remainder = <<'REMAINDER';
$builder->create_build_script();
1;
REMAINDER
ok($sample_Build_PL =~ s/^(.*##.*remainder.*)$/$remainder/m,
   "Substitution 2 in synopsis");
write_file("$fakemoduledir/Build.PL", $sample_Build_PL);

mkdir("$fakemoduledir/lib");
mkdir("$fakemoduledir/lib/Fake");

=begin this_pod_is_not_mine

=cut

my $fakemodule = <<'FAKE_MODULE';
#!perl -w

# (C) DOMQ

use strict;
package Fake::Module;

our $VERSION = '0.42';

=head1 NAME

Fake::Module - This module is for testing My::Module::Build.pm

=head1 SYNOPSIS

Hey, gimme a break, this is a *bogus* package for Pete's sake!

=sorry, you're right

=cut the schizoid POD freakiness now will you? This is not M-x doctor!

# Good.

package Fake::Module::Ancillary::Class;

1;

__END__