Upgrade to ExtUtils-MakeMaker-6.35

[p5sagit/p5-mst-13.2.git] / t / lib / MakeMaker / Test / Utils.pm

diff --git a/t/lib/MakeMaker/Test/Utils.pm b/t/lib/MakeMaker/Test/Utils.pm
index fff8055..fb8162d 100644 (file)
--- a/t/lib/MakeMaker/Test/Utils.pm
+++ b/t/lib/MakeMaker/Test/Utils.pm
@@ -9,13 +9,15 @@ use vars qw($VERSION @ISA @EXPORT);
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = 0.02;
+$VERSION = 0.03;
 
 @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup
-             make make_run make_macro calibrate_mtime
+             make make_run run make_macro calibrate_mtime
+             setup_mm_test_root
+            have_compiler
             );
 
-my $Is_VMS = $^O eq 'VMS';
+my $Is_VMS   = $^O eq 'VMS';
 my $Is_MacOS = $^O eq 'MacOS';
 
 
@@ -39,6 +41,11 @@ MakeMaker::Test::Utils - Utility routines for testing MakeMaker
 
   my $mtime         = calibrate_mtime;
 
+  my $out           = run($cmd);
+
+  my $have_compiler = have_compiler();
+
+
 =head1 DESCRIPTION
 
 A consolidation of little utility functions used through out the
@@ -142,7 +149,7 @@ Makefile.
 
 sub makefile_backup {
     my $makefile = makefile_name;
-    return $Is_VMS ? $makefile : "$makefile.old";
+    return $Is_VMS ? "$makefile".'_old' : "$makefile.old";
 }
 
 =item B<make>
@@ -230,6 +237,91 @@ sub calibrate_mtime {
     return $mtime;
 }
 
+=item B<run>
+
+  my $out = run($command);
+  my @out = run($command);
+
+Runs the given $command as an external program returning at least STDOUT
+as $out.  If possible it will return STDOUT and STDERR combined as you
+would expect to see on a screen.
+
+=cut
+
+sub run {
+    my $cmd = shift;
+
+    use ExtUtils::MM;
+
+    # Unix can handle 2>&1 and OS/2 from 5.005_54 up.
+    # This makes our failure diagnostics nicer to read.
+    if( MM->os_flavor_is('Unix') or
+        ($] > 5.00554 and MM->os_flavor_is('OS/2'))
+      ) {
+        return `$cmd 2>&1`;
+    }
+    else {
+        return `$cmd`;
+    }
+}
+
+=item B<setup_mm_test_root>
+
+Creates a rooted logical to avoid the 8-level limit on older VMS systems.  
+No action taken on non-VMS systems.
+
+=cut
+
+sub setup_mm_test_root {
+    if( $Is_VMS ) {
+        # On older systems we might exceed the 8-level directory depth limit
+        # imposed by RMS.  We get around this with a rooted logical, but we
+        # can't create logical names with attributes in Perl, so we do it
+        # in a DCL subprocess and put it in the job table so the parent sees it.
+        open( MMTMP, '>mmtesttmp.com' ) || 
+          die "Error creating command file; $!";
+        print MMTMP <<'COMMAND';
+$ MM_TEST_ROOT = F$PARSE("SYS$DISK:[-]",,,,"NO_CONCEAL")-".][000000"-"]["-"].;"+".]"
+$ DEFINE/JOB/NOLOG/TRANSLATION=CONCEALED MM_TEST_ROOT 'MM_TEST_ROOT'
+COMMAND
+        close MMTMP;
+
+        system '@mmtesttmp.com';
+        1 while unlink 'mmtesttmp.com';
+    }
+}
+
+=item have_compiler
+
+  $have_compiler = have_compiler;
+
+Returns true if there is a compiler available for XS builds.
+
+=cut
+
+sub have_compiler {
+    my $have_compiler = 0;
+
+    # ExtUtils::CBuilder prints its compilation lines to the screen.
+    # Shut it up.
+    use TieOut;
+    local *STDOUT = *STDOUT;
+    local *STDERR = *STDERR;
+
+    tie *STDOUT, 'TieOut';
+    tie *STDERR, 'TieOut';
+
+    eval {
+       require ExtUtils::CBuilder;
+       my $cb = ExtUtils::CBuilder->new;
+
+       $have_compiler = $cb->have_compiler;
+    };
+
+    return $have_compiler;
+}
+
+
 =back
 
 =head1 AUTHOR