[svn:parrot] r41794 - in branches/detect_llvm: config/auto t/steps/auto

[jkeenan at svn.parrot.org]

Author: jkeenan
Date: Sat Oct 10 14:14:53 2009
New Revision: 41794
URL: https://trac.parrot.org/parrot/changeset/41794

Log:
Refactor four instances of handling verbose output.

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 11:35:38 2009	(r41793)
+++ branches/detect_llvm/config/auto/llvm.pm	Sat Oct 10 14:14:53 2009	(r41794)
@@ -80,9 +80,7 @@
             system(qq{llvm-gcc -O3 -emit-llvm $fullcfile -c -o $bcfile});
         };
         if ($@) {
-            print "Unable to compile C file into LLVM bitcode file\n"
-                if $verbose;
-            $self->_handle_result( $conf, 0 );
+            $self->_handle_failure_to_compile_into_bitcode( $conf, $verbose );
         }
         else {
             my $output;
@@ -90,18 +88,15 @@
                 $output = capture_output( 'lli', $bcfile );
             };
             if ( $@ or $output !~ /hello world/ ) {
-                print "Unable to run  LLVM bitcode file with 'lli'\n"
-                    if $verbose;
-                $self->_handle_result( $conf, 0 );
+                $self->_handle_failure_to_execute_bitcode( $conf, $verbose );
             }
             else {
                 eval {
                     system(qq{llc $bcfile -o $sfile});
                 };
                 if ( $@ or (! -e $sfile) ) {
-                    print "Unable to compile program to native assembly using 'llc'\n"
-                        if $verbose;
-                    $self->_handle_result( $conf, 0 );
+                    $self->_handle_failure_to_compile_to_assembly(
+                        $conf, $verbose );
                 }
                 else {
                     eval {
@@ -109,9 +104,8 @@
                         system(qq{$cc $sfile -o $nativefile});
                     };
                     if ( $@ or (! -e $nativefile) ) {
-                        print "Unable to assemble native assembly into program\n"
-                            if $verbose;
-                        $self->_handle_result( $conf, 0 );
+                        $self->_handle_failure_to_assemble_assembly(
+                            $conf, $verbose );
                     }
                     else {
                         eval {
@@ -171,6 +165,34 @@
     return $llvm_lacking;
 }
 
+sub _handle_failure_to_compile_into_bitcode {
+    my ($self, $conf, $verbose ) = @_;
+    print "Unable to compile C file into LLVM bitcode file\n"
+        if $verbose;
+    $self->_handle_result( $conf, 0 );
+}
+
+sub _handle_failure_to_execute_bitcode {
+    my ($self, $conf, $verbose ) = @_;
+    print "Unable to run LLVM bitcode file with 'lli'\n"
+    if $verbose;
+    $self->_handle_result( $conf, 0 );
+}
+
+sub _handle_failure_to_compile_to_assembly {
+    my ($self, $conf, $verbose ) = @_;
+    print "Unable to compile program to native assembly using 'llc'\n"
+        if $verbose;
+    $self->_handle_result( $conf, 0 );
+}
+
+sub _handle_failure_to_assemble_assembly {
+    my ($self, $conf, $verbose ) = @_;
+    print "Unable to assemble native assembly into program\n"
+         if $verbose;
+    $self->_handle_result( $conf, 0 );
+}
+
 sub _handle_result {
     my ($self, $conf, $result) = @_;
     if ( $result ) {

Modified: branches/detect_llvm/t/steps/auto/llvm-01.t
==============================================================================
--- branches/detect_llvm/t/steps/auto/llvm-01.t	Sat Oct 10 11:35:38 2009	(r41793)
+++ branches/detect_llvm/t/steps/auto/llvm-01.t	Sat Oct 10 14:14:53 2009	(r41794)
@@ -6,7 +6,7 @@
 use strict;
 use warnings;
 use File::Temp qw( tempdir );
-use Test::More tests =>  61;
+use Test::More tests =>  65;
 use Carp;
 use lib qw( lib t/configure/testlib );
 use_ok('config::init::defaults');
@@ -235,6 +235,49 @@
     "Got expected verbose output from _examine_llvm_gcc_version()",
 );
 
+##### 4 methods #####
+
+$verbose = 1;
+capture(
+    sub { $step->_handle_failure_to_compile_into_bitcode( $conf, $verbose ); },
+    \$stdout,
+    \$stderr,
+);
+like( $stdout,
+    qr/Unable to compile C file into LLVM bitcode file/,
+    "Got expected verbose output from _handle_failure_to_compile_into_bitcode()",
+);
+
+capture(
+    sub { $step->_handle_failure_to_execute_bitcode( $conf, $verbose ); },
+    \$stdout,
+    \$stderr,
+);
+like( $stdout,
+    qr/Unable to run LLVM bitcode file with 'lli'/,
+    "Got expected verbose output from _handle_failure_to_execute_bitcode()",
+);
+
+capture(
+    sub { $step->_handle_failure_to_compile_to_assembly( $conf, $verbose ); },
+    \$stdout,
+    \$stderr,
+);
+like( $stdout,
+    qr/Unable to compile program to native assembly using 'llc'/,
+    "Got expected verbose output from _handle_failure_to_compile_to_assembly()",
+);
+
+capture(
+    sub { $step->_handle_failure_to_assemble_assembly( $conf, $verbose ); },
+    \$stdout,
+    \$stderr,
+);
+like( $stdout,
+    qr/Unable to assemble native assembly into program/,
+    "Got expected verbose output from _handle_failure_to_assemble_assembly()",
+);
+
 ##### _handle_native_assembly_output() #####
 
 {