t/steps/auto_pack-01.t

   1 #! perl
   2 # Copyright (C) 2007, The Perl Foundation.
   3 # $Id$
   4 # auto_pack-01.t
   5
   6 use strict;
   7 use warnings;
   8 use Test::More tests => 33;
   9 use Carp;
  10 use lib qw( lib t/configure/testlib );
  11 use_ok('config::init::defaults');
  12 use_ok('config::auto::pack');
  13 use Parrot::BuildUtil;
  14 use Parrot::Configure;
  15 use Parrot::Configure::Options qw( process_options );
  16 use Parrot::Configure::Test qw( test_step_thru_runstep);
  17 use IO::CaptureOutput qw( capture );
  18
  19 my $args = process_options( {
  20     argv            => [],
  21     mode            => q{configure},
  22 } );
  23
  24 my $conf = Parrot::Configure->new();
  25
  26 test_step_thru_runstep($conf, q{init::defaults}, $args);
  27
  28 my ($task, $step_name, $step, $ret);
  29 my $pkg = q{auto::pack};
  30
  31 $conf->add_steps($pkg);
  32 $conf->options->set(%{$args});
  33
  34 $task = $conf->steps->[-1];
  35 $step_name   = $task->step;
  36
  37 $step = $step_name->new();
  38 ok(defined $step, "$step_name constructor returned defined value");
  39 isa_ok($step, $step_name);
  40 ok($step->description(), "$step_name has description");
  41
  42 my $longsize_orig = $conf->data->get_p5('longsize');
  43 my $use64bitint_orig = $conf->data->get_p5('use64bitint');
  44
  45 ##### _set_format() #####
  46
  47 {
  48     my $type = q{intvalsize};
  49     my $size = 8;
  50     my $longsize = 8;
  51     $conf->data->set_p5( longsize => 8 );
  52     my $format = auto::pack::_set_format( $conf, $type, $size, $longsize );
  53     is( $format, q{l!}, "Got expected format size: $format" );
  54     $conf->data->set_p5( longsize => $longsize_orig );
  55 }
  56
  57 {
  58     my $type = q{intvalsize};
  59     my $size = 4;
  60     my $longsize = 8;
  61     $conf->data->set_p5( longsize => 8 );
  62     my $format = auto::pack::_set_format( $conf, $type, $size, $longsize );
  63     is( $format, q{l}, "Got expected format size: $format" );
  64     $conf->data->set_p5( longsize => $longsize_orig );
  65 }
  66
  67 {
  68     my $type = q{intvalsize};
  69     my $size = 8;
  70     my $longsize = 16;
  71     $conf->data->set_p5( longsize => 16 );
  72     my $format = auto::pack::_set_format( $conf, $type, $size, $longsize );
  73     is( $format, q{q}, "Got expected format size: $format" );
  74     $conf->data->set_p5( longsize => $longsize_orig );
  75 }
  76
  77 {
  78     my $type = q{intvalsize};
  79     my $size = 16;
  80     my $longsize = 8;
  81     $conf->data->set_p5( longsize => undef );
  82     $conf->data->set_p5( use64bitint => 'define');
  83     my $format = auto::pack::_set_format( $conf, $type, $size, $longsize );
  84     is( $format, q{q}, "Got expected format size: $format" );
  85     $conf->data->set_p5( longsize => $longsize_orig );
  86     $conf->data->set_p5( use64bitint => $use64bitint_orig );
  87 }
  88
  89 {
  90     my ($stdout, $stderr);
  91     my $type = q{intvalsize};
  92     my $size = 23;
  93     my $longsize = 8;
  94     my $format;
  95     capture(
  96         sub { $format =
  97             auto::pack::_set_format( $conf, $type, $size, $longsize ); },
  98         \$stdout,
  99         \$stderr,
 100     );
 101     ok( ! defined $format, "Format size undef, as expected");
 102     like($stderr,
 103         qr/Configure\.pl:  Unable to find a suitable packtype for $type/,
 104         "Got expected warning re format size"
 105     );
 106 }
 107
 108 {
 109     my ($stdout, $stderr);
 110     my $type = q{intvalsize};
 111     my $size = 16;
 112     my $longsize = 16;
 113     $conf->data->set_p5( longsize => 32 );
 114     my $format;
 115     capture(
 116         sub { $format =
 117             auto::pack::_set_format( $conf, $type, $size, $longsize ); },
 118         \$stdout,
 119         \$stderr,
 120     );
 121     ok( ! defined $format, "Format size undef, as expected");
 122     like($stderr,
 123         qr/Configure\.pl:  Unable to find a suitable packtype for $type/,
 124         "Got expected warning re format size"
 125     );
 126     $conf->data->set_p5( longsize => $longsize_orig );
 127 }
 128
 129 ##### _pack_test() #####
 130
 131 {
 132     my $format = q{Y};
 133     my $type = q{intvalsize};
 134     my $size = 4;
 135     my $test;
 136     my ($stdout, $stderr);
 137     capture(
 138         sub { $format =
 139             auto::pack::_pack_test( $format, $type, $size, $test ); },
 140         \$stdout,
 141         \$stderr,
 142     );
 143     like($stderr,
 144         qr/Configure\.pl:  Unable to find a functional packtype for $type/,
 145         "Got expected warning from _pack_test()"
 146     );
 147 }
 148
 149 {
 150     my $format = q{l!};
 151     my $type = q{intvalsize};
 152     my $size = 4;
 153     my $test = q{abcd};
 154     my ($stdout, $stderr, $ret);
 155     capture(
 156         sub { $ret = auto::pack::_pack_test( $format, $type, $size, $test ) },
 157         \$stdout,
 158         \$stderr,
 159     );
 160     is( $ret, $format, "Got expected format" );
 161     ok(! $stderr, "Nothing on STDERR, as expected" );
 162 }
 163
 164 {
 165     my $format = q{l!};
 166     my $type = q{intvalsize};
 167     my $size = 4;
 168     my $test = q{abcde};
 169     my ($stdout, $stderr, $ret);
 170     capture(
 171         sub { $ret = auto::pack::_pack_test( $format, $type, $size, $test ) },
 172         \$stdout,
 173         \$stderr,
 174     );
 175     like($stderr,
 176         qr/Configure\.pl:  Unable to find a functional packtype for $type/,
 177         "Got expected warning in _pack_test()."
 178     );
 179 }
 180
 181 {
 182     my $format = q{l!};
 183     my $type = q{intvalsize};
 184     my $size = 4;
 185     my $test = q{};
 186     my ($stdout, $stderr, $ret);
 187     capture(
 188         sub { $ret = auto::pack::_pack_test( $format, $type, $size, $test ) },
 189         \$stdout,
 190         \$stderr,
 191     );
 192     is( $ret, q{?}, "Got expected format" );
 193     ok(! $stderr, "Nothing on STDERR, as expected" );
 194 }
 195
 196 ##### _set_packtypes() #####
 197
 198 {
 199     my $current_numvalsize = $conf->data->get('numvalsize');
 200     $conf->data->set( numvalsize => 12 );
 201     auto::pack::_set_packtypes($conf);
 202     is($conf->data->get('packtype_b'), 'C',
 203         "Got expected value for packtype_b");
 204     is($conf->data->get('packtype_n'), 'D',
 205         "Got expected value for packtype_n");
 206
 207     # prepare for next test
 208     $conf->data->set( numvalsize => $current_numvalsize );
 209     $conf->data->set( packtype_b => undef );
 210     $conf->data->set( packtype_n => undef );
 211 }
 212
 213 {
 214     my $current_numvalsize = $conf->data->get('numvalsize');
 215     $conf->data->set( numvalsize => 72 );
 216     auto::pack::_set_packtypes($conf);
 217     is($conf->data->get('packtype_b'), 'C',
 218         "Got expected value for packtype_b");
 219     is($conf->data->get('packtype_n'), 'd',
 220         "Got expected value for packtype_n");
 221
 222     # prepare for next test
 223     $conf->data->set( numvalsize => $current_numvalsize );
 224     $conf->data->set( packtype_b => undef );
 225     $conf->data->set( packtype_n => undef );
 226 }
 227
 228 ##### _set_ptrconst() #####
 229
 230 {
 231     my ($ptrsize, $intsize, $longsize);
 232     $ptrsize = $intsize = 2;
 233     $longsize = 4;
 234     auto::pack::_set_ptrconst($conf, $ptrsize, $intsize, $longsize);
 235     is($conf->data->get( 'ptrconst' ), "u",
 236         "Got expected value for ptrconst" );
 237 }
 238
 239 {
 240     my ($ptrsize, $intsize, $longsize);
 241     $intsize = 2;
 242     $ptrsize = $longsize = 4;
 243     auto::pack::_set_ptrconst($conf, $ptrsize, $intsize, $longsize);
 244     is($conf->data->get( 'ptrconst' ), "ul",
 245         "Got expected value for ptrconst" );
 246     $conf->data->set( 'ptrconst' => undef ); # prepare for next test
 247 }
 248
 249 {
 250     my ($ptrsize, $intsize, $longsize);
 251     $intsize = 2;
 252     $ptrsize = 4;
 253     $longsize = 8;
 254     my ($stdout, $stderr);
 255     capture(
 256         sub { auto::pack::_set_ptrconst($conf, $ptrsize, $intsize, $longsize); },
 257         \$stdout,
 258         \$stderr,
 259     );
 260     ok(! defined $conf->data->get( 'ptrconst' ),
 261         "ptrconst not set, as expected");
 262     ok(! $stdout, "As expected, nothing on STDOUT");
 263     like($stderr, qr/Unable to find an integer type/,
 264         "Got expected warning");
 265     $conf->data->set( 'ptrconst' => undef ); # prepare for next test
 266 }
 267
 268 pass("Completed all tests in $0");
 269
 270 ################### DOCUMENTATION ###################
 271
 272 =head1 NAME
 273
 274 auto_pack-01.t - test config::auto::pack
 275
 276 =head1 SYNOPSIS
 277
 278     % prove t/steps/auto_pack-01.t
 279
 280 =head1 DESCRIPTION
 281
 282 The files in this directory test functionality used by F<Configure.pl>.
 283
 284 The tests in this file test auto::pack internal subroutines C<_set_packtypes()>
 285 and C<_set_ptrcons()>.
 286
 287 =head1 AUTHOR
 288
 289 James E Keenan
 290
 291 =head1 SEE ALSO
 292
 293 config::auto::pack, F<Configure.pl>.
 294
 295 =cut
 296
 297 # Local Variables:
 298 #   mode: cperl
 299 #   cperl-indent-level: 4
 300 #   fill-column: 100
 301 # End:
 302 # vim: expandtab shiftwidth=4: