From: Rafael Garcia-Suarez Date: Wed, 14 Nov 2001 12:23:01 +0000 (+0100) Subject: new version of runperl() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=137352a2af7440ba507c46800e6906b0f4e09e61;p=p5sagit%2Fp5-mst-13.2.git new version of runperl() Message-ID: <20011114122301.A29384@rafael> p4raw-id: //depot/perl@12993 --- diff --git a/t/io/argv.t b/t/io/argv.t index 7081c47..56b5714 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -5,34 +5,8 @@ BEGIN { @INC = '../lib'; } -sub runthis { - my($prog, $stdin, @files) = @_; - - my $cmd = ''; - if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' ) { - $cmd = qq{$^X -e "$prog"}; - $cmd .= " ". join ' ', map qq{"$_"}, @files if @files; - $cmd = qq{$^X -le "print '$stdin'" | } . $cmd if defined $stdin; - } - else { - $cmd = qq{$^X -e '$prog' @files}; - $cmd = qq{$^X -le 'print q{$stdin}' | } . $cmd if defined $stdin; - } - - # The combination of $^X, pipes and STDIN is broken on VMS and - # will hang. - if( defined $stdin && $^O eq 'VMS' && $TODO ) { - return 0; - } - - my $result = `$cmd`; - $result =~ s/\n\n/\n/ if $^O eq 'VMS'; # pipes sometimes double these - - return $result; -} - - require "./test.pl"; + plan(tests => 21); use File::Spec; @@ -43,16 +17,24 @@ open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!"); print TRY "a line\n"; close TRY; -$x = runthis( 'while (<>) { print $., $_; }', undef, ('Io_argv1.tmp') x 2); +$x = runperl( + prog => 'while (<>) { print $., $_; }', + args => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ], +); is($x, "1a line\n2a line\n", '<> from two files'); { - local $TODO = 'The combo of STDIN, pipes and $^X is broken on VMS' - if $^O eq 'VMS'; - $x = runthis( 'while (<>) { print $_; }', 'foo', 'Io_argv1.tmp', '-' ); + $x = runperl( + prog => 'while (<>) { print $_; }', + stdin => "foo\n", + args => [ 'Io_argv1.tmp', '-' ], + ); is($x, "a line\nfoo\n", ' from a file and STDIN'); - $x = runthis( 'while (<>) {print $_;}', 'foo' ); + $x = runperl( + prog => 'while (<>) { print $_; }', + stdin => "foo\n", + ); is($x, "foo\n", ' from just STDIN'); } diff --git a/t/test.pl b/t/test.pl index eaf9d86..b53f020 100644 --- a/t/test.pl +++ b/t/test.pl @@ -169,4 +169,63 @@ USE_OK _ok(!$@, _where(), "use $use"); } +# runperl - Runs a separate perl interpreter. +# Arguments : +# switches => [ command-line switches ] +# nolib => 1 # don't use -I../lib (included by default) +# prog => one-liner (avoid quotes) +# progfile => perl script +# stdin => string to feed the stdin +# stderr => redirect stderr to stdout +# args => [ command-line arguments to the perl program ] + +my $is_mswin = $^O eq 'MSWin32'; +my $is_netware = $^O eq 'NetWare'; +my $is_macos = $^O eq 'MacOS'; +my $is_vms = $^O eq 'VMS'; + +sub runperl { + my %args = @_; + my $runperl = $^X; + if (defined $args{switches}) { + $runperl .= ' ' . join ' ', map qq("$_"), @{ $args{switches} }; + } + unless (defined $args{nolib}) { + if ($is_macos && $args{stderr}) { + $runperl .= ' -I::lib -MMac::err=unix'; + } + else { + $runperl .= ' "-I../lib"'; + } + } + if (defined $args{prog}) { + if ($is_mswin || $is_netware || $is_vms) { + $runperl .= qq( -e ") . $args{prog} . qq("); + } + else { + $runperl .= qq( -e ') . $args{prog} . qq('); + } + } elsif (defined $args{progfile}) { + $runperl .= qq( "$args{progfile}"); + } + if (defined $args{stdin}) { + if ($is_mswin || $is_netware || $is_vms) { + $runperl = qq{$^X -e "print q(} . + $args{stdin} . q{)" | } . $runperl; + } + else { + $runperl = qq{$^X -e 'print q(} . + $args{stdin} . q{)' | } . $runperl; + } + } + if (defined $args{args}) { + $runperl .= ' ' . join ' ', map qq("$_"), @{ $args{args} }; + } + $runperl .= ' 2>&1' if $args{stderr} && !$is_macos; + $runperl .= " \xB3 Dev:Null" if !defined $args{stderr} && $is_macos; + my $result = `$runperl`; + $result =~ s/\n\n/\n/ if $is_vms; # XXX pipes sometimes double these + return $result; +} + 1;