t/postconfigure/02-data_get_PConfig.t

   1 #! perl
   2 # Copyright (C) 2007, Parrot Foundation.
   3 # $Id$
   4 # 02-data_get_PConfig.t
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More tests => 30;
  10 use Carp;
  11 use lib qw( lib );
  12 use Parrot::Configure;
  13 use Parrot::Configure::Options qw( process_options );
  14 use_ok(
  15     'Parrot::Configure::Step::List', qw|
  16         get_steps_list
  17         |
  18 );
  19 use IO::CaptureOutput qw | capture |;
  20
  21 $| = 1;
  22 is( $|, 1, "output autoflush is set" );
  23
  24 my $args = process_options(
  25     {
  26         argv => [q{--step=inter::make}],
  27         mode => q{reconfigure},
  28     }
  29 );
  30 ok( defined $args, "process_options returned successfully" );
  31 my %args = %$args;
  32
  33 my $conf = Parrot::Configure->new;
  34 ok( defined $conf, "Parrot::Configure->new() returned okay" );
  35 isa_ok( $conf, "Parrot::Configure" );
  36
  37 my $newconf = Parrot::Configure->new;
  38 ok( defined $newconf, "Parrot::Configure->new() returned okay" );
  39 isa_ok( $newconf, "Parrot::Configure" );
  40 is( $conf, $newconf, "Parrot::Configure object is a singleton" );
  41
  42 # Since these tests peek into the Parrot::Configure object, they will break if
  43 # the structure of that object changes.  We retain them for now to delineate
  44 # our progress in testing the object.
  45 foreach my $k (qw| steps options data |) {
  46     ok( defined $conf->$k, "Parrot::Configure object has $k key" );
  47 }
  48 is( ref( $conf->steps ), q{ARRAY}, "Parrot::Configure object 'steps' key is array reference" );
  49 is( scalar @{ $conf->steps },
  50     0, "Parrot::Configure object 'steps' key holds empty array reference" );
  51 foreach my $k (qw| options data |) {
  52     isa_ok( $conf->$k, "Parrot::Configure::Data" );
  53 }
  54
  55 can_ok( "Parrot::Configure", qw| data | );
  56 can_ok( "Parrot::Configure", qw| options | );
  57 can_ok( "Parrot::Configure", qw| steps | );
  58 can_ok( "Parrot::Configure", qw| add_step | );
  59 can_ok( "Parrot::Configure", qw| add_steps | );
  60 can_ok( "Parrot::Configure", qw| run_single_step | );
  61 can_ok( "Parrot::Configure", qw| runsteps | );
  62 can_ok( "Parrot::Configure", qw| _run_this_step | );
  63
  64 $conf->add_step( $args->{step} );
  65 my @confsteps = @{ $conf->steps };
  66 isnt( scalar @confsteps, 0,
  67     "Parrot::Configure object 'steps' key holds non-empty array reference" );
  68 my $nontaskcount = 0;
  69 foreach my $k (@confsteps) {
  70     $nontaskcount++ unless $k->isa("Parrot::Configure::Task");
  71 }
  72 is( $nontaskcount, 0, "Each step is a Parrot::Configure::Task object" );
  73
  74 $conf->options->set( %{$args} );
  75 is( $conf->options->{c}->{step},
  76     'inter::make', "command-line option '--step=inter::make' has been stored in object" );
  77 is( $conf->options->{c}->{debugging},
  78     1, "command-line option '--debugging' has been stored in object" );
  79
  80 my $res = eval "no strict; use Parrot::Config; \\%PConfig";
  81 SKIP: {
  82     my $reason = <<REASON;
  83 If you have already completed configuration,
  84 you can call Parrot::Configure::Data::get_PConfig().
  85 You appear not to have completed configuration;
  86 hence, two tests are skipped.
  87 REASON
  88
  89     skip $reason, 2 unless defined $res;
  90
  91     eval { $conf->data()->get_PConfig(); };
  92     ok( ( defined $@ ) && ( !$@ ), "Parrot::Configure::get_PConfig() succeeded" );
  93     my $rv;
  94     my $stdout;
  95     capture ( sub {$rv = $conf->run_single_step( $args->{step})}, \$stdout  );
  96     ok( ( defined $@ ) && ( !$@ ), "Parrot::Configure::run_single_step() succeeded" );
  97 }
  98
  99 pass("Completed all tests in $0");
 100
 101 ################### DOCUMENTATION ###################
 102
 103 =head1 NAME
 104
 105 02-data_get_PConfig.t - test Parrot::Configure::Data::get_PConfig() once configuration has been completed
 106
 107 =head1 SYNOPSIS
 108
 109     % prove t/postconfigure/02-data_get_PConfig.t
 110
 111 =head1 DESCRIPTION
 112
 113 The files in this directory test functionality used by F<Configure.pl>.
 114 Certain of the modules C<use>d by F<Configure.pl> have functionality which is
 115 only meaningful I<after> F<Configure.pl> has actually been run and
 116 Parrot::Config::Generated has been created.  So certain tests need to be run
 117 when your Parrot filesystem is in a "pre-F<make>, post-F<Configure.pl>" state.
 118
 119 The tests in this file mimic the functionality of F<tools/dev/reconfigure.pl>
 120 and test C<Parrot::Configure::Data::get_PConfig()>.  What is 'slurped' here is an
 121 already created C<%Parrot::Config::PConfig>.
 122
 123 =head1 AUTHOR
 124
 125 James E Keenan
 126
 127 =head1 SEE ALSO
 128
 129 Parrot::Configure, F<Configure.pl>.
 130
 131 =cut
 132
 133 # Local Variables:
 134 #   mode: cperl
 135 #   cperl-indent-level: 4
 136 #   fill-column: 100
 137 # End:
 138 # vim: expandtab shiftwidth=4: