[svn:parrot] r41784 - in branches/detect_llvm: config/auto t/steps/auto
jkeenan at svn.parrot.org
jkeenan at svn.parrot.org
Sat Oct 10 01:14:34 UTC 2009
Author: jkeenan
Date: Sat Oct 10 01:14:33 2009
New Revision: 41784
URL: https://trac.parrot.org/parrot/changeset/41784
Log:
Refactor more code into _handle_component_version_output() and _cleanup_llvm_files(). Add tests to improve coverage.
Modified:
branches/detect_llvm/config/auto/llvm.pm
branches/detect_llvm/t/steps/auto/llvm-01.t
Modified: branches/detect_llvm/config/auto/llvm.pm
==============================================================================
--- branches/detect_llvm/config/auto/llvm.pm Sat Oct 10 00:59:54 2009 (r41783)
+++ branches/detect_llvm/config/auto/llvm.pm Sat Oct 10 01:14:33 2009 (r41784)
@@ -40,24 +40,24 @@
my $verbose = $conf->options->get( 'verbose' );
+ # We start by seeing whether we can run three LLVM component executables,
+ # each with the '--version' option, and get the expected output.
+
my $llvm_lacking = 0;
foreach my $prog ( @{ $self->{llvm_components} } ) {
my $output = capture_output( $prog->[0], '--version' );
- my $exp = $prog->[1];
- unless ( defined($output) and $output =~ m/$exp/s ) {
- $llvm_lacking++;
- print "Could not get expected '--version' output for $prog->[0]\n"
- if $verbose;
- }
- else {
- print $output, "\n" if $verbose;
- }
+ $llvm_lacking = _handle_component_version_output(
+ $prog, $output, $llvm_lacking, $verbose
+ );
}
my $output = q{};
$output = capture_output( 'llvm-gcc', '--version' );
if (! $output) {
$llvm_lacking++;
}
+
+ # Next, we make sure we have at least major version 4 of 'llvm-gcc'
+
else {
my @line = split /\n+/, $output;
if ( $line[0] =~ m/\b(\d+)\.(\d+)\.(\d+)\b/ ) {
@@ -78,6 +78,9 @@
if ( $llvm_lacking ) {
$self->_handle_result( $conf, 0 );
}
+
+ # Finally, we see whether our LLVM actually works.
+
else {
# Here we will take a simple C file, compile it into an LLVM bitcode
@@ -145,15 +148,29 @@
}
}
}
- foreach my $f ( $bcfile, $sfile, $nativefile ) {
- unlink $f if ( -e $f );
- }
+ my $count_unlinked = _cleanup_llvm_files(
+ $bcfile, $sfile, $nativefile
+ );
$conf->cc_clean();
}
return 1;
}
+sub _handle_component_version_output {
+ my ($prog, $output, $llvm_lacking, $verbose) = @_;
+ my $exp = $prog->[1];
+ unless ( defined($output) and $output =~ m/$exp/s ) {
+ $llvm_lacking++;
+ print "Could not get expected '--version' output for $prog->[0]\n"
+ if $verbose;
+ }
+ else {
+ print $output, "\n" if $verbose;
+ }
+ return $llvm_lacking;
+}
+
sub _handle_result {
my ($self, $conf, $result) = @_;
if ( $result ) {
@@ -166,6 +183,19 @@
}
return 1;
}
+
+sub _cleanup_llvm_files {
+ my @llvm_files = @_;
+ my $count_unlinked = 0;
+ foreach my $f ( @llvm_files ) {
+ if ( defined($f) and ( -e $f ) ) {
+ unlink $f;
+ $count_unlinked++;
+ }
+ }
+ return $count_unlinked;
+};
+
1;
=head1 AUTHOR
Modified: branches/detect_llvm/t/steps/auto/llvm-01.t
==============================================================================
--- branches/detect_llvm/t/steps/auto/llvm-01.t Sat Oct 10 00:59:54 2009 (r41783)
+++ branches/detect_llvm/t/steps/auto/llvm-01.t Sat Oct 10 01:14:33 2009 (r41784)
@@ -5,7 +5,8 @@
use strict;
use warnings;
-use Test::More qw(no_plan); # tests => 27;
+use File::Temp qw( tempdir );
+use Test::More tests => 43;
use Carp;
use lib qw( lib t/configure/testlib );
use_ok('config::init::defaults');
@@ -89,6 +90,115 @@
ok( ! $conf->data->get( 'has_llvm' ),
"'has_llvm' set to false value, as expected" );
+##### _handle_component_version_output() #####
+
+my ($prog, $output, $llvm_lacking, $verbose);
+$prog = [ 'llvm-gcc' => 'llvm-gcc' ];
+
+$verbose = 0;
+
+$output = 'llvm-gcc';
+$llvm_lacking = 0;
+$llvm_lacking = auto::llvm::_handle_component_version_output(
+ $prog, $output, $llvm_lacking, $verbose
+);
+ok( ! $llvm_lacking, "llvm reported as not lacking" );
+
+$output = 'foobar';
+$llvm_lacking = 0;
+$llvm_lacking = auto::llvm::_handle_component_version_output(
+ $prog, $output, $llvm_lacking, $verbose
+);
+ok( $llvm_lacking, "llvm reported as lacking: wrong output" );
+
+$output = undef;
+$llvm_lacking = 0;
+$llvm_lacking = auto::llvm::_handle_component_version_output(
+ $prog, $output, $llvm_lacking, $verbose
+);
+ok( $llvm_lacking, "llvm reported as lacking: output undefined" );
+
+$verbose = 1;
+
+my ($stdout, $stderr);
+my $exp = $prog->[0];
+
+$output = 'llvm-gcc';
+$llvm_lacking = 0;
+capture(
+ sub {
+ $llvm_lacking = auto::llvm::_handle_component_version_output(
+ $prog, $output, $llvm_lacking, $verbose
+ );
+ },
+ \$stdout,
+ \$stderr,
+);
+ok( ! $llvm_lacking, "llvm reported as not lacking" );
+like( $stdout, qr/$output/, "Got expected verbose output: llvm not lacking" );
+
+$output = 'foobar';
+$llvm_lacking = 0;
+capture(
+ sub {
+ $llvm_lacking = auto::llvm::_handle_component_version_output(
+ $prog, $output, $llvm_lacking, $verbose
+ );
+ },
+ \$stdout,
+ \$stderr,
+);
+ok( $llvm_lacking, "llvm reported as lacking: wrong output" );
+like(
+ $stdout,
+ qr/Could not get expected '--version' output for $exp/,
+ "Got expected verbose output: llvm lacking",
+);
+
+$output = undef;
+$llvm_lacking = 0;
+capture(
+ sub {
+ $llvm_lacking = auto::llvm::_handle_component_version_output(
+ $prog, $output, $llvm_lacking, $verbose
+ );
+ },
+ \$stdout,
+ \$stderr,
+);
+ok( $llvm_lacking, "llvm reported as lacking: output undefined" );
+like(
+ $stdout,
+ qr/Could not get expected '--version' output for $exp/,
+ "Got expected verbose output: llvm lacking",
+);
+
+##### _cleanup_llvm_files() #####
+
+my ( $bcfile, $sfile, $nativefile );
+my $count_unlinked;
+
+$count_unlinked =
+ auto::llvm::_cleanup_llvm_files( $bcfile, $sfile, $nativefile );
+is( $count_unlinked, 0, "no files existed, hence none unlinked" );
+
+my ( $bcfile, $sfile, $nativefile ) = ( '', '', '' );
+$count_unlinked =
+ auto::llvm::_cleanup_llvm_files( $bcfile, $sfile, $nativefile );
+is( $count_unlinked, 0, "no files existed, hence none unlinked" );
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ my $bcfile = qq|$tdir/bcfile|;
+ open my $FH, '>', $bcfile
+ or die "Unable to open handle for writing: $!";
+ print $FH qq|bcfile hello world\n|;
+ close $FH or die "Unable to close handle after writing: $!";
+ $count_unlinked =
+ auto::llvm::_cleanup_llvm_files( $bcfile, $sfile, $nativefile );
+ is( $count_unlinked, 1, "one file existed, hence one unlinked" );
+}
+
$conf->cc_clean();
pass("Completed all tests in $0");
More information about the parrot-commits
mailing list