t/postconfigure/06-data_get_PConfig_Temp.t

   1 #! perl
   2 # Copyright (C) 2007, Parrot Foundation.
   3 # $Id$
   4 # 06-data_get_PConfig_Temp.t
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More tests => 32;
  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=gen::makefiles}, q{--target=Makefile} ],
  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     'gen::makefiles', "command-line option '--step=gen::makefiles' has been stored in object" );
  77 is( $conf->options->{c}->{target},
  78     'Makefile', "command-line option '--target=Makefiles' has been stored in object" );
  79 is( $conf->options->{c}->{debugging},
  80     1, "command-line option '--debugging' has been stored in object" );
  81
  82 my $res = eval "no strict; use Parrot::Config::Generated; \\%PConfig";
  83 SKIP: {
  84     my $reason = <<REASON;
  85 If you have already completed configuration,
  86 you can call Parrot::Configure::Data::get_PConfig().
  87 You appear not to have completed configuration;
  88 hence, three tests are skipped.
  89 REASON
  90
  91     skip $reason, 3 unless defined $res;
  92
  93     eval { $conf->data()->get_PConfig(); };
  94     ok( ( defined $@ ) && ( !$@ ), "Parrot::Configure::get_PConfig() succeeded" );
  95
  96     eval { $conf->data()->get_PConfig_Temp(); };
  97     ok( ( defined $@ ) && ( !$@ ), "Parrot::Configure::get_PConfig_Temp() succeeded" );
  98    my $rv;
  99    my $stdout;
 100    capture ( sub {$rv = $conf->run_single_step( $args->{step}) }, \$stdout);
 101    ok( ( defined $@ ) && ( !$@ ), "Parrot::Configure::run_single_step() succeeded" );
 102 }
 103
 104 pass("Completed all tests in $0");
 105
 106 ################### DOCUMENTATION ###################
 107
 108 =head1 NAME
 109
 110 06-data_get_PConfig_Temp.t - test Parrot::Configure::Data::get_PConfig_Temp() once configuration has been completed
 111
 112 =head1 SYNOPSIS
 113
 114     % prove t/postconfigure/06-data_get_PConfig_Temp.t
 115
 116 =head1 DESCRIPTION
 117
 118 The files in this directory test functionality used by F<Configure.pl>.
 119 Certain of the modules C<use>d by F<Configure.pl> have functionality which is
 120 only meaningful I<after> F<Configure.pl> has actually been run and
 121 Parrot::Config::Generated has been created.  So certain tests need to be run
 122 when your Parrot filesystem is in a "pre-F<make>, post-F<Configure.pl>" state.
 123
 124 The tests in this file mimic the functionality of F<tools/dev/reconfigure.pl>
 125 and test C<Parrot::Configure::Data::get_PConfig()>.  What is 'slurped' here is
 126 an already created C<%Parrot::Config::PConfig>.
 127
 128 =head1 AUTHOR
 129
 130 James E Keenan
 131
 132 =head1 SEE ALSO
 133
 134 Parrot::Configure, F<Configure.pl>.
 135
 136 =cut
 137
 138 # Local Variables:
 139 #   mode: cperl
 140 #   cperl-indent-level: 4
 141 #   fill-column: 100
 142 # End:
 143 # vim: expandtab shiftwidth=4: