Author: bernhard
Date: Tue Apr 19 15:29:06 2005
New Revision: 7884
Modified:
trunk/.cvsignore
trunk/config/auto/antlr.pl
trunk/config/auto/python.pl
trunk/config/gen/icu.pl
trunk/lib/Parrot/Configure/Step.pm
Log:
Capture STDERR in Parrot::Configure::Step::capture_output().
Thanks to Adrian Lambeck for reporting, RT#35042, and to
Ron Blaschke for foixing, RT#35043.
Modified: trunk/.cvsignore
==============================================================================
--- trunk/.cvsignore (original)
+++ trunk/.cvsignore Tue Apr 19 15:29:06 2005
@@ -10,6 +10,7 @@
parrot.pdb
test
test.c
+test.err
test.o
test.cco
test.ilk
Modified: trunk/config/auto/antlr.pl
==============================================================================
--- trunk/config/auto/antlr.pl (original)
+++ trunk/config/auto/antlr.pl Tue Apr 19 15:29:06 2005
@@ -29,21 +29,24 @@
@args = qw(verbose);
sub runstep {
- my $a = capture_output( 'antlr -h' ) || '';
- my $has_antlr = ($a =~ m/ANTLR Parser Generator/) ? 1 : 0;
+ my ( $out, $err ) = capture_output( 'antlr', '-h' );
+ my $output = join( '', $out || '', $err || '' );
+ my ($python, $major, $minor, $revision) =
+ $output =~ m/(Python)\s+(\d+).(\d+)(?:.(\d+))?/;
+ my $has_antlr = ($output =~ m/ANTLR Parser Generator/) ? 1 : 0;
Configure::Data->set(has_antlr => $has_antlr);
my $has_antlr_with_python = 0;
if ( $has_antlr ) {
unlink <config/auto/antlr/*.py>;
- my $a = capture_output( 'antlr -o config/auto/antlr
config/auto/antlr/test_python.g' ) || '';
+ capture_output( 'antlr', '-o', 'config/auto/antlr',
'config/auto/antlr/test_python.g' );
$has_antlr_with_python = 1 if -e 'config/auto/antlr/test_python_l.py';
$Configure::Step::result = $has_antlr_with_python ?
'yes, with python' :
'yes, no python';
} else {
- $Configure::Step::result = ($a =~ m/NoClassDefFoundError/) ?
+ $Configure::Step::result = ($output =~ m/NoClassDefFoundError/) ?
'no, NoClassDefFoundError' :
'no';
}
Modified: trunk/config/auto/python.pl
==============================================================================
--- trunk/config/auto/python.pl (original)
+++ trunk/config/auto/python.pl Tue Apr 19 15:29:06 2005
@@ -27,9 +27,10 @@
@args = qw(verbose);
sub runstep {
- my $a = capture_output( 'python -V' ) || '';
+ my ( $out, $err ) = capture_output( 'python', '-V' );
+ my $output = join( '', $out || '', $err || '' );
my ($python, $major, $minor, $revision) =
- $a =~ m/(Python)\s+(\d+).(\d+)(?:.(\d+))?/;
+ $output =~ m/(Python)\s+(\d+).(\d+)(?:.(\d+))?/;
$revision = 0 unless defined $revision;
my $has_python = $python ? 1 : 0;
Modified: trunk/config/gen/icu.pl
==============================================================================
--- trunk/config/gen/icu.pl (original)
+++ trunk/config/gen/icu.pl Tue Apr 19 15:29:06 2005
@@ -35,7 +35,7 @@
if (!$autodetect) {
print "specified a icu config parameter,\nICU autodetection disabled.\n"
if $verbose;
} elsif (!defined $icuconfig || !$icuconfig) {
- my (undef, $ret) = capture_output("icu-config", "--exists");
+ my (undef, undef, $ret) = capture_output("icu-config", "--exists");
if (($ret == -1) || (($ret >> 8) != 0)) {
undef $icuconfig;
Modified: trunk/lib/Parrot/Configure/Step.pm
==============================================================================
--- trunk/lib/Parrot/Configure/Step.pm (original)
+++ trunk/lib/Parrot/Configure/Step.pm Tue Apr 19 15:29:06 2005
@@ -421,8 +421,8 @@
=item C<capture_output($command)>
-Executes the given command. The command's output and its return status is
returned.
-B<STDERR> is redirected to F<test.out> during the execution.
+Executes the given command. The command's output (both stdout and stderr), and
its return status is returned as a 3-tuple.
+B<STDERR> is redirected to F<test.err> during the execution, and deleted after
the command's run.
=cut
@@ -431,7 +431,7 @@
# disable STDERR
open OLDERR, ">&STDERR";
- open STDERR, ">test.out";
+ open STDERR, ">test.err";
my $output = `$command`;
my $retval = ($? == -1) ? -1 : ($? >> 8);
@@ -440,7 +440,19 @@
close STDERR;
open STDERR, ">&OLDERR";
- return ($output, $retval) if wantarray;
+ # slurp stderr
+ my $out_err;
+ {
+ local $/ = undef;
+ open IN, "<test.err";
+ $out_err = <IN>;
+ close IN;
+ }
+
+ # cleanup
+ unlink "test.err";
+
+ return ($output, $out_err, $retval) if wantarray;
return $output;
}
