t/steps/auto/llvm-01.t

   1 #!perl
   2 # Copyright (C) 2001-2007, Parrot Foundation.
   3 # $Id$
   4 # auto/llvm-01.t
   5
   6 use strict;
   7 use warnings;
   8 use File::Temp qw( tempdir );
   9 use Test::More tests =>  69;
  10 use Carp;
  11 use lib qw( lib t/configure/testlib );
  12 use_ok('config::init::defaults');
  13 use_ok('config::inter::progs');
  14 use_ok('config::auto::llvm');
  15 use Parrot::Configure;
  16 use Parrot::Configure::Options qw( process_options );
  17 use Parrot::Configure::Test qw(
  18     test_step_thru_runstep
  19     rerun_defaults_for_testing
  20     test_step_constructor_and_description
  21 );
  22 use IO::CaptureOutput qw( capture );
  23
  24 ########## regular ##########
  25
  26 my ($args, $step_list_ref) = process_options( {
  27     argv => [ ],
  28     mode => q{configure},
  29 } );
  30
  31 my $conf = Parrot::Configure->new;
  32
  33 my $serialized = $conf->pcfreeze();
  34
  35 test_step_thru_runstep($conf, q{init::defaults}, $args);
  36 test_step_thru_runstep($conf, q{inter::progs},   $args);
  37
  38 my $pkg = q{auto::llvm};
  39
  40 $conf->add_steps($pkg);
  41 $conf->options->set( %{$args} );
  42 my $step = test_step_constructor_and_description($conf);
  43 my $ret = $step->runstep($conf);
  44 ok( $ret, "runstep() returned true value" );
  45 like( $step->result(), qr/yes|no/,
  46   "Result was either 'yes' or 'no'" );
  47
  48 $conf->replenish($serialized);
  49
  50 ########## --verbose ##########
  51
  52 ($args, $step_list_ref) = process_options( {
  53     argv => [ q{--verbose} ],
  54     mode => q{configure},
  55 } );
  56 rerun_defaults_for_testing($conf, $args );
  57 $conf->add_steps($pkg);
  58 $conf->options->set( %{$args} );
  59 $step = test_step_constructor_and_description($conf);
  60 {
  61     my $stdout;
  62     my $ret = capture(
  63         sub { $step->runstep($conf) },
  64         \$stdout
  65     );
  66     ok( $ret, "runstep() returned true value" );
  67     like( $step->result(), qr/yes|no/,
  68         "Result was either 'yes' or 'no'" );
  69     SKIP: {
  70         skip 'No sense testing for verbose output if LLVM not present',
  71         2 unless ( $step->result() =~ /yes/ );
  72         like( $stdout, qr/llvm-gcc/s,
  73             "Got expected verbose output" );
  74         like( $stdout, qr/Low Level Virtual Machine/s,
  75             "Got expected verbose output" );
  76     }
  77 }
  78
  79 $step->set_result( undef );
  80 $conf->data->set( 'has_llvm' => undef );
  81 auto::llvm::_handle_result($step, $conf, 1);
  82 is( $step->result(), 'yes', "Got expected 'yes' result" );
  83 ok( $conf->data->get( 'has_llvm' ),
  84     "'has_llvm' set to true value, as expected" );
  85
  86 $step->set_result( undef );
  87 $conf->data->set( 'has_llvm' => undef );
  88 auto::llvm::_handle_result($step, $conf, 0);
  89 is( $step->result(), 'no', "Got expected 'no' result" );
  90 ok( ! $conf->data->get( 'has_llvm' ),
  91     "'has_llvm' set to false  value, as expected" );
  92
  93 ##### _handle_component_version_output() #####
  94
  95 my ($prog, $output, $llvm_lacking, $verbose);
  96 $prog = [ 'llvm-gcc'    => 'llvm-gcc' ];
  97
  98 $verbose = 0;
  99
 100 $output = 'llvm-gcc';
 101 $llvm_lacking = 0;
 102 $llvm_lacking = auto::llvm::_handle_component_version_output(
 103     $prog, $output, $llvm_lacking, $verbose
 104 );
 105 ok( ! $llvm_lacking, "llvm reported as not lacking" );
 106
 107 $output = 'foobar';
 108 $llvm_lacking = 0;
 109 $llvm_lacking = auto::llvm::_handle_component_version_output(
 110     $prog, $output, $llvm_lacking, $verbose
 111 );
 112 ok( $llvm_lacking, "llvm reported as lacking: wrong output" );
 113
 114 $output = undef;
 115 $llvm_lacking = 0;
 116 $llvm_lacking = auto::llvm::_handle_component_version_output(
 117     $prog, $output, $llvm_lacking, $verbose
 118 );
 119 ok( $llvm_lacking, "llvm reported as lacking: output undefined" );
 120
 121 $verbose = 1;
 122
 123 my ($stdout, $stderr);
 124 my $exp = $prog->[0];
 125
 126 $output = 'llvm-gcc';
 127 $llvm_lacking = 0;
 128 capture(
 129     sub {
 130         $llvm_lacking = auto::llvm::_handle_component_version_output(
 131             $prog, $output, $llvm_lacking, $verbose
 132         );
 133     },
 134     \$stdout,
 135     \$stderr,
 136 );
 137 ok( ! $llvm_lacking, "llvm reported as not lacking" );
 138 like( $stdout, qr/$output/, "Got expected verbose output: llvm not lacking" );
 139
 140 $output = 'foobar';
 141 $llvm_lacking = 0;
 142 capture(
 143     sub {
 144         $llvm_lacking = auto::llvm::_handle_component_version_output(
 145             $prog, $output, $llvm_lacking, $verbose
 146         );
 147     },
 148     \$stdout,
 149     \$stderr,
 150 );
 151 ok( $llvm_lacking, "llvm reported as lacking: wrong output" );
 152 like(
 153     $stdout,
 154     qr/Could not get expected '--version' output for $exp/,
 155     "Got expected verbose output: llvm lacking",
 156 );
 157
 158 $output = undef;
 159 $llvm_lacking = 0;
 160 capture(
 161     sub {
 162         $llvm_lacking = auto::llvm::_handle_component_version_output(
 163             $prog, $output, $llvm_lacking, $verbose
 164         );
 165     },
 166     \$stdout,
 167     \$stderr,
 168 );
 169 ok( $llvm_lacking, "llvm reported as lacking: output undefined" );
 170 like(
 171     $stdout,
 172     qr/Could not get expected '--version' output for $exp/,
 173     "Got expected verbose output: llvm lacking",
 174 );
 175
 176 ##### _examine_llvm_gcc_version() #####
 177
 178 $output = '';
 179 $llvm_lacking = 0;
 180 $verbose = 0;
 181 $llvm_lacking =
 182     auto::llvm::_examine_llvm_gcc_version( $output, $llvm_lacking, $verbose );
 183 ok( $llvm_lacking, "_examine_llvm_gcc_version() reported LLVM lacking" );
 184
 185 $output = 'foobar';
 186 $llvm_lacking = 0;
 187 $verbose = 0;
 188 $llvm_lacking =
 189     auto::llvm::_examine_llvm_gcc_version( $output, $llvm_lacking, $verbose );
 190 ok( $llvm_lacking, "_examine_llvm_gcc_version() reported LLVM lacking" );
 191
 192 $output = '3.2.1';
 193 $llvm_lacking = 0;
 194 $verbose = 0;
 195 $llvm_lacking =
 196     auto::llvm::_examine_llvm_gcc_version( $output, $llvm_lacking, $verbose );
 197 ok( $llvm_lacking, "_examine_llvm_gcc_version() reported LLVM lacking" );
 198
 199 $output = '4.2.1';
 200 $llvm_lacking = 0;
 201 $verbose = 0;
 202 $llvm_lacking =
 203     auto::llvm::_examine_llvm_gcc_version( $output, $llvm_lacking, $verbose );
 204 ok( ! $llvm_lacking, "_examine_llvm_gcc_version() reported LLVM not lacking" );
 205
 206 $output = 'foobar';
 207 $llvm_lacking = 0;
 208 $verbose = 1;
 209 capture(
 210     sub { $llvm_lacking = auto::llvm::_examine_llvm_gcc_version(
 211             $output, $llvm_lacking, $verbose ); },
 212     \$stdout,
 213     \$stderr,
 214 );
 215 ok( $llvm_lacking, "_examine_llvm_gcc_version() reported LLVM lacking" );
 216 like(
 217     $stdout,
 218     qr/Unable to extract llvm-gcc major, minor and patch versions/,
 219     "Got expected verbose output from _examine_llvm_gcc_version()",
 220 );
 221
 222 $output = '3.2.1';
 223 $llvm_lacking = 0;
 224 $verbose = 1;
 225 capture(
 226     sub { $llvm_lacking = auto::llvm::_examine_llvm_gcc_version(
 227             $output, $llvm_lacking, $verbose ); },
 228     \$stdout,
 229     \$stderr,
 230 );
 231 ok( $llvm_lacking, "_examine_llvm_gcc_version() reported LLVM lacking" );
 232 like(
 233     $stdout,
 234     qr/llvm-gcc must be at least major version 4/,
 235     "Got expected verbose output from _examine_llvm_gcc_version()",
 236 );
 237
 238 ##### 4 methods #####
 239 $verbose = 0;
 240
 241 $step->set_result( undef );
 242 $step->_handle_failure_to_compile_into_bitcode( $conf, $verbose );
 243 is( $step->result(), 'no', "Got expected result" );
 244
 245 $step->set_result( undef );
 246 $step->_handle_failure_to_execute_bitcode( $conf, $verbose );
 247 is( $step->result(), 'no', "Got expected result" );
 248
 249 $step->set_result( undef );
 250 $step->_handle_failure_to_compile_to_assembly( $conf, $verbose );
 251 is( $step->result(), 'no', "Got expected result" );
 252
 253 $step->set_result( undef );
 254 $step->_handle_failure_to_assemble_assembly( $conf, $verbose );
 255 is( $step->result(), 'no', "Got expected result" );
 256
 257 $verbose = 1;
 258 capture(
 259     sub { $step->_handle_failure_to_compile_into_bitcode( $conf, $verbose ); },
 260     \$stdout,
 261     \$stderr,
 262 );
 263 like( $stdout,
 264     qr/Unable to compile C file into LLVM bitcode file/,
 265     "Got expected verbose output from _handle_failure_to_compile_into_bitcode()",
 266 );
 267
 268 capture(
 269     sub { $step->_handle_failure_to_execute_bitcode( $conf, $verbose ); },
 270     \$stdout,
 271     \$stderr,
 272 );
 273 like( $stdout,
 274     qr/Unable to run LLVM bitcode file with 'lli'/,
 275     "Got expected verbose output from _handle_failure_to_execute_bitcode()",
 276 );
 277
 278 capture(
 279     sub { $step->_handle_failure_to_compile_to_assembly( $conf, $verbose ); },
 280     \$stdout,
 281     \$stderr,
 282 );
 283 like( $stdout,
 284     qr/Unable to compile program to native assembly using 'llc'/,
 285     "Got expected verbose output from _handle_failure_to_compile_to_assembly()",
 286 );
 287
 288 capture(
 289     sub { $step->_handle_failure_to_assemble_assembly( $conf, $verbose ); },
 290     \$stdout,
 291     \$stderr,
 292 );
 293 like( $stdout,
 294     qr/Unable to assemble native assembly into program/,
 295     "Got expected verbose output from _handle_failure_to_assemble_assembly()",
 296 );
 297
 298 ##### _handle_native_assembly_output() #####
 299
 300 {
 301     local $@ = '';
 302     $output = 'hello world';
 303     $verbose = 0;
 304     ok( $step->_handle_native_assembly_output( $conf, $output, $verbose ),
 305         "_handle_native_assembly_output() returned true value" );
 306     is( $step->result(), 'yes', "Got expected 'yes' result" );
 307 }
 308
 309 {
 310     local $@ = 'error';
 311     $output = 'hello world';
 312     $verbose = 0;
 313     ok( $step->_handle_native_assembly_output( $conf, $output, $verbose ),
 314         "_handle_native_assembly_output() returned true value" );
 315     is( $step->result(), 'no', "Got expected 'no' result" );
 316 }
 317
 318 {
 319     local $@ = '';
 320     $output = 'goodbye, cruel world';
 321     $verbose = 0;
 322     ok( $step->_handle_native_assembly_output( $conf, $output, $verbose ),
 323         "_handle_native_assembly_output() returned true value" );
 324     is( $step->result(), 'no', "Got expected 'no' result" );
 325 }
 326
 327 {
 328     local $@ = 'error';
 329     $output = 'hello world';
 330     $verbose = 1;
 331     capture(
 332         sub { $step->_handle_native_assembly_output(
 333                 $conf, $output, $verbose); },
 334         \$stdout,
 335         \$stderr,
 336     );
 337     is( $step->result(), 'no', "Got expected 'no' result" );
 338     like(
 339         $stdout,
 340         qr/Unable to execute native assembly program successfully/,
 341         "Got expected verbose output: native assembly program",
 342     );
 343 }
 344
 345 {
 346     local $@ = '';
 347     $output = 'goodbye, cruel world';
 348     $verbose = 1;
 349     capture(
 350         sub { $step->_handle_native_assembly_output(
 351                 $conf, $output, $verbose); },
 352         \$stdout,
 353         \$stderr,
 354     );
 355     is( $step->result(), 'no', "Got expected 'no' result" );
 356     like(
 357         $stdout,
 358         qr/Unable to execute native assembly program successfully/,
 359         "Got expected verbose output: native assembly program",
 360     );
 361 }
 362
 363 ##### _cleanup_llvm_files() #####
 364
 365 my ( $bcfile, $sfile, $nativefile );
 366 my $count_unlinked;
 367
 368 $count_unlinked =
 369     auto::llvm::_cleanup_llvm_files( $bcfile, $sfile, $nativefile );
 370 is( $count_unlinked, 0, "no files existed, hence none unlinked" );
 371
 372 ( $bcfile, $sfile, $nativefile ) = ( '', '', '' );
 373 $count_unlinked =
 374     auto::llvm::_cleanup_llvm_files( $bcfile, $sfile, $nativefile );
 375 is( $count_unlinked, 0, "no files existed, hence none unlinked" );
 376
 377 {
 378     my $tdir = tempdir( CLEANUP => 1 );
 379     $bcfile = qq|$tdir/bcfile|;
 380     open my $FH, '>', $bcfile
 381         or die "Unable to open handle for writing: $!";
 382     print $FH qq|bcfile hello world\n|;
 383     close $FH or die "Unable to close handle after writing: $!";
 384     $count_unlinked =
 385         auto::llvm::_cleanup_llvm_files( $bcfile, $sfile, $nativefile );
 386     is( $count_unlinked, 1, "one file existed, hence one unlinked" );
 387 }
 388
 389 $conf->cc_clean();
 390
 391 pass("Completed all tests in $0");
 392
 393 ################### DOCUMENTATION ###################
 394
 395 =head1 NAME
 396
 397 t/steps/auto/llvm-01.t - tests Parrot::Configure step auto::llvm
 398
 399 =head1 SYNOPSIS
 400
 401     prove t/steps/auto/llvm-01.t
 402
 403 =head1 DESCRIPTION
 404
 405 This file holds tests for auto::llvm.
 406
 407 =head1 AUTHOR
 408
 409 James E Keenan
 410
 411 =cut
 412
 413 # Local Variables:
 414 #   mode: cperl
 415 #   cperl-indent-level: 4
 416 #   fill-column: 100
 417 # End:
 418 # vim: expandtab shiftwidth=4: