t/postconfigure/05-trace.t

   1 #! perl
   2 # Copyright (C) 2007, Parrot Foundation.
   3 # $Id$
   4 # 05-trace.t
   5
   6 use strict;
   7 use warnings;
   8 no warnings 'once';
   9 use Carp;
  10 use Test::More;
  11 if ( ( -e qq{./lib/Parrot/Config/Generated.pm} )
  12     and ( -e qq{./.configure_trace.sto} ) )
  13 {
  14     plan tests => 40;
  15 }
  16 else {
  17     plan skip_all =>
  18         q{Tests irrelevant unless configuration completed with tracing requested};
  19 }
  20 use lib qw( lib );
  21 use Parrot::Config;
  22 use_ok('Parrot::Configure::Trace');
  23 $Storable::Eval = 1;
  24 use Parrot::Configure::Step::List qw( get_steps_list );
  25
  26 my $obj;
  27
  28 eval { $obj = Parrot::Configure::Trace->new( [ storable => '.configure_trace.sto', ] ); };
  29 like(
  30     $@,
  31     qr/^Constructor correctly failed due to non-hashref argument/,
  32     "Correctly failed due to argument other than hash ref"
  33 );
  34
  35 eval { $obj = Parrot::Configure::Trace->new( { storable => 'somestrangename.sto', } ); };
  36 like(
  37     $@,
  38     qr/^Unable to retrieve storable file of configuration step data/,
  39     "Correctly failed due to non-existent config data file"
  40 );
  41
  42 ok( $obj = Parrot::Configure::Trace->new(), "Constructor returned true" );
  43 isa_ok( $obj, q{Parrot::Configure::Trace} );
  44
  45 my $steps        = $obj->list_steps();
  46 my $steps_number = scalar( @{$steps} );
  47 is( ref($steps), q{ARRAY}, "list_steps() correctly returned array ref" );
  48
  49 # Sanity check!
  50 my @PConfig_steps = split /\s+/, $PConfig{configuration_steps};
  51 is_deeply(
  52     $steps,
  53     [ @PConfig_steps ],
  54     "list_steps() returned same as \$Parrot::Config::PConfig{configuration_steps}"
  55 );
  56
  57 my $index = $obj->index_steps();
  58 is( ref($index), q{HASH}, "index_steps() correctly returned hash ref" );
  59 is( scalar( keys %{$index} ),
  60     $steps_number, "list_steps() and index_steps() return same number of elements" );
  61
  62 my ( $attr, $trig, $bad );
  63
  64 $attr = $obj->trace_options_c( { attr => 'yacc', } );
  65 is( ref($attr), q{ARRAY}, "trace_options_c() correctly returned array ref" );
  66 is( scalar( @{$attr} ),
  67     $steps_number, "trace_options_c() and list_steps() return same number of elements" );
  68
  69 $attr = $obj->trace_options_c(
  70     {
  71         attr    => 'yacc',
  72         verbose => 1,
  73     }
  74 );
  75 is( ref($attr), q{ARRAY}, "trace_options_c() correctly returned array ref" );
  76 is( scalar( @{$attr} ),
  77     $steps_number, "trace_options_c() and list_steps() return same number of elements" );
  78 $bad = 0;
  79
  80 foreach my $el ( @{$attr} ) {
  81     $bad++ unless ref($el) eq 'HASH';
  82 }
  83 is( $bad, 0, "With 'verbose', each element in array returned by trace_options_c() is hash ref" );
  84
  85 $trig = $obj->trace_options_triggers( { trig => 'yacc', } );
  86 is( ref($trig), q{ARRAY}, "trace_options_triggers() correctly returned array ref" );
  87 is( scalar( @{$trig} ),
  88     $steps_number, "trace_options_triggers() and list_steps() return same number of elements" );
  89
  90 $trig = $obj->trace_options_triggers(
  91     {
  92         trig    => 'yacc',
  93         verbose => 1,
  94     }
  95 );
  96 is( ref($trig), q{ARRAY}, "trace_options_triggers() correctly returned array ref" );
  97 is( scalar( @{$trig} ),
  98     $steps_number, "trace_options_triggers() and list_steps() return same number of elements" );
  99 $bad = 0;
 100
 101 foreach my $el ( @{$trig} ) {
 102     $bad++ unless ref($el) eq 'HASH';
 103 }
 104 is( $bad, 0,
 105     "With 'verbose', each element in array returned by trace_options_triggers() is hash ref" );
 106
 107 $attr = $obj->trace_data_c( { attr => 'yacc', } );
 108 is( ref($attr), q{ARRAY}, "trace_data_c() correctly returned array ref" );
 109 is( scalar( @{$attr} ),
 110     $steps_number, "trace_data_c() and list_steps() return same number of elements" );
 111
 112 $attr = $obj->trace_data_c(
 113     {
 114         attr    => 'yacc',
 115         verbose => 1,
 116     }
 117 );
 118 is( ref($attr), q{ARRAY}, "trace_data_c() correctly returned array ref" );
 119 is( scalar( @{$attr} ),
 120     $steps_number, "trace_data_c() and list_steps() return same number of elements" );
 121 $bad = 0;
 122
 123 my $list_diff_steps;
 124 $list_diff_steps = $obj->diff_data_c( { attr => 'ccflags' } );
 125 is(ref($list_diff_steps), 'ARRAY', "diff_data_c returned array ref");
 126 for (my $i=0; $i <= $#$list_diff_steps; $i++) {
 127     $bad++ if ref($list_diff_steps->[$i]) ne 'HASH';
 128 }
 129 is($bad, 0, "Output of diff_data_c() is ref to array of hashrefs");
 130 $bad = 0;
 131
 132 $list_diff_steps = $obj->diff_data_c( { attr => 'inc' } );
 133 is(ref($list_diff_steps), 'ARRAY', "diff_data_c returned array ref");
 134 for (my $i=0; $i <= $#$list_diff_steps; $i++) {
 135     $bad++ if ref($list_diff_steps->[$i]) ne 'HASH';
 136 }
 137 is($bad, 0, "Output of diff_data_c() is ref to array of hashrefs");
 138 $bad = 0;
 139
 140 foreach my $el ( @{$attr} ) {
 141     $bad++ unless ref($el) eq 'HASH';
 142 }
 143 is( $bad, 0, "With 'verbose', each element in array returned by trace_data_c() is hash ref" );
 144
 145 $trig = $obj->trace_data_triggers( { trig => 'yacc', } );
 146 is( ref($trig), q{ARRAY}, "trace_data_triggers() correctly returned array ref" );
 147 is( scalar( @{$trig} ),
 148     $steps_number, "trace_data_triggers() and list_steps() return same number of elements" );
 149
 150 $trig = $obj->trace_data_triggers(
 151     {
 152         trig    => 'yacc',
 153         verbose => 1,
 154     }
 155 );
 156 is( ref($trig), q{ARRAY}, "trace_data_triggers() correctly returned array ref" );
 157 is( scalar( @{$trig} ),
 158     $steps_number, "trace_data_triggers() and list_steps() return same number of elements" );
 159 $bad = 0;
 160
 161 foreach my $el ( @{$trig} ) {
 162     $bad++ unless ref($el) eq 'HASH';
 163 }
 164 is( $bad, 0,
 165     "With 'verbose', each element in array returned by trace_data_triggers() is hash ref" );
 166
 167 my @state;
 168 my $test_step = 'gen::makefiles';
 169 ok( $state[0] = $obj->get_state_at_step($index->{$test_step}),
 170     "get_state_at_step() returned true" );
 171 ok( $state[1] = $obj->get_state_at_step($test_step),
 172     "get_state_at_step() returned true" );
 173 is_deeply( $state[0], $state[1],
 174     "Numeric and string arguments gave same result" );
 175
 176 my $state;
 177 eval { $state = $obj->get_state_at_step(0); };
 178 like(
 179     $@,
 180     qr/^Must supply positive integer as step number/,
 181     "Correctly failed due to non-positive argument"
 182 );
 183
 184 eval { $state = $obj->get_state_at_step(1000000); };
 185 like(
 186     $@,
 187     qr/^Must supply positive integer as step number/,
 188     "Correctly failed due to non-existent step"
 189 );
 190
 191 eval { $state = $obj->get_state_at_step(q{init::something}); };
 192 like( $@, qr/^Must supply valid step name/, "Correctly failed due to non-existent step" );
 193
 194 pass("Completed all tests in $0");
 195
 196 ################### DOCUMENTATION ###################
 197
 198 =head1 NAME
 199
 200 05-trace.t - test Parrot::Configure::Trace
 201
 202 =head1 SYNOPSIS
 203
 204     % prove t/postconfigure/05-trace.t
 205
 206 =head1 DESCRIPTION
 207
 208 The files in this directory test functionality used by F<Configure.pl>.
 209 Certain of the modules C<use>d by F<Configure.pl> have functionality which is
 210 only meaningful I<after> F<Configure.pl> has actually been run and
 211 Parrot::Config::Generated has been created.  So certain tests need to be run
 212 when your Parrot filesystem is in a "pre-F<make>, post-F<Configure.pl>" state.
 213
 214 The tests in this file test Parrot::Configure::Trace methods.
 215
 216 =head1 AUTHOR
 217
 218 James E Keenan
 219
 220 =head1 SEE ALSO
 221
 222 Parrot::Configure::Trace, Parrot::Configure, Parrot::Configure::Options, F<Configure.pl>.
 223
 224 =cut
 225
 226 # Local Variables:
 227 #   mode: cperl
 228 #   cperl-indent-level: 4
 229 #   fill-column: 100
 230 # End:
 231 # vim: expandtab shiftwidth=4: