X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FMakeMaker%2FTest%2FUtils.pm;h=fb8162d2cd1afba3d43a28104d915b591f644ee3;hb=277189c8ad3fc0d1dcd4c757f62b0a7bf5bacaa0;hp=be3ec73d749d8be2d1e6384c9ccf9eac68c54220;hpb=303615418b9a57c2ec471053f1ec710915096066;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/lib/MakeMaker/Test/Utils.pm b/t/lib/MakeMaker/Test/Utils.pm
index be3ec73..fb8162d 100644
--- a/t/lib/MakeMaker/Test/Utils.pm
+++ b/t/lib/MakeMaker/Test/Utils.pm
@@ -9,10 +9,12 @@ 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 run make_macro calibrate_mtime
+             setup_mm_test_root
+	     have_compiler
             );
 
 my $Is_VMS   = $^O eq 'VMS';
@@ -41,6 +43,9 @@ MakeMaker::Test::Utils - Utility routines for testing MakeMaker
 
   my $out           = run($cmd);
 
+  my $have_compiler = have_compiler();
+
+
 =head1 DESCRIPTION
 
 A consolidation of little utility functions used through out the
@@ -144,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>
@@ -246,7 +251,7 @@ would expect to see on a screen.
 sub run {
     my $cmd = shift;
 
-    require ExtUtils::MM;
+    use ExtUtils::MM;
 
     # Unix can handle 2>&1 and OS/2 from 5.005_54 up.
     # This makes our failure diagnostics nicer to read.
@@ -258,7 +263,64 @@ sub run {
     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