[PATCH] first steps: allow make test to succeed when builddir path contains spaces
#16072
Labels
Comments
From @ptolemarchCreated by @ptolemarchAt the moment, perl will not pass its tests in a directory, in Unix, when that This is a series of patches that tweak tests--mostly to add quotes around paths Note that these patches do not fix modules under `cpan/`. I'll be contacting I welcome critique and advice about all these patches, and especially about the Perl Info |
From @ptolemarch0001-regularize-whitespace-in-t-test.pl.patchFrom cc7ab967041b761468bafaf1dff064552ddb2d04 Mon Sep 17 00:00:00 2001
From: David Hand <davidhand@davidhand.com>
Date: Fri, 30 Jun 2017 19:56:23 -0400
Subject: [PATCH 1/7] regularize whitespace in t/test.pl
In preparation for more changes.
This is a part of an ongoing patch to allow `make test` to succeed even
if the path to the build directory contains spaces.
---
t/test.pl | 802 +++++++++++++++++++++++++++++++-------------------------------
1 file changed, 401 insertions(+), 401 deletions(-)
diff --git a/t/test.pl b/t/test.pl
index 79e6e25e95..c753954dc8 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -47,15 +47,15 @@ sub _print_stderr {
sub plan {
my $n;
if (@_ == 1) {
- $n = shift;
- if ($n eq 'no_plan') {
- undef $n;
- $noplan = 1;
- }
+ $n = shift;
+ if ($n eq 'no_plan') {
+ undef $n;
+ $noplan = 1;
+ }
} else {
- my %plan = @_;
- $plan{skip_all} and skip_all($plan{skip_all});
- $n = $plan{tests};
+ my %plan = @_;
+ $plan{skip_all} and skip_all($plan{skip_all});
+ $n = $plan{tests};
}
_print "1..$n\n" unless $noplan;
$planned = $n;
@@ -75,12 +75,12 @@ sub done_testing {
END {
my $ran = $test - 1;
if (!$NO_ENDING) {
- if (defined $planned && $planned != $ran) {
- _print_stderr
- "# Looks like you planned $planned tests but ran $ran.\n";
- } elsif ($noplan) {
- _print "1..$ran\n";
- }
+ if (defined $planned && $planned != $ran) {
+ _print_stderr
+ "# Looks like you planned $planned tests but ran $ran.\n";
+ } elsif ($noplan) {
+ _print "1..$ran\n";
+ }
}
}
@@ -120,8 +120,8 @@ sub _comment {
sub _have_dynamic_extension {
my $extension = shift;
unless (eval {require Config; 1}) {
- warn "test.pl had problems loading Config: $@";
- return 1;
+ warn "test.pl had problems loading Config: $@";
+ return 1;
}
$extension =~ s!::!/!g;
return 1 if ($Config::Config{extensions} =~ /\b$extension\b/);
@@ -131,7 +131,7 @@ sub skip_all {
if (@_) {
_print "1..0 # Skip @_\n";
} else {
- _print "1..0\n";
+ _print "1..0\n";
}
exit(0);
}
@@ -153,15 +153,15 @@ sub skip_all_without_perlio {
sub skip_all_without_config {
unless (eval {require Config; 1}) {
- warn "test.pl had problems loading Config: $@";
- return;
+ warn "test.pl had problems loading Config: $@";
+ return;
}
foreach (@_) {
- next if $Config::Config{$_};
- my $key = $_; # Need to copy, before trying to modify.
- $key =~ s/^use//;
- $key =~ s/^d_//;
- skip_all("no $key");
+ next if $Config::Config{$_};
+ my $key = $_; # Need to copy, before trying to modify.
+ $key =~ s/^use//;
+ $key =~ s/^d_//;
+ skip_all("no $key");
}
}
@@ -175,42 +175,42 @@ sub skip_all_without_unicode_tables { # (but only under miniperl)
sub find_git_or_skip {
my ($source_dir, $reason);
if (-d '.git') {
- $source_dir = '.';
+ $source_dir = '.';
} elsif (-l 'MANIFEST' && -l 'AUTHORS') {
- my $where = readlink 'MANIFEST';
- die "Can't readling MANIFEST: $!" unless defined $where;
- die "Confusing symlink target for MANIFEST, '$where'"
- unless $where =~ s!/MANIFEST\z!!;
- if (-d "$where/.git") {
- # Looks like we are in a symlink tree
- if (exists $ENV{GIT_DIR}) {
- diag("Found source tree at $where, but \$ENV{GIT_DIR} is $ENV{GIT_DIR}. Not changing it");
- } else {
- note("Found source tree at $where, setting \$ENV{GIT_DIR}");
- $ENV{GIT_DIR} = "$where/.git";
- }
- $source_dir = $where;
- }
+ my $where = readlink 'MANIFEST';
+ die "Can't readling MANIFEST: $!" unless defined $where;
+ die "Confusing symlink target for MANIFEST, '$where'"
+ unless $where =~ s!/MANIFEST\z!!;
+ if (-d "$where/.git") {
+ # Looks like we are in a symlink tree
+ if (exists $ENV{GIT_DIR}) {
+ diag("Found source tree at $where, but \$ENV{GIT_DIR} is $ENV{GIT_DIR}. Not changing it");
+ } else {
+ note("Found source tree at $where, setting \$ENV{GIT_DIR}");
+ $ENV{GIT_DIR} = "$where/.git";
+ }
+ $source_dir = $where;
+ }
} elsif (exists $ENV{GIT_DIR}) {
- my $commit = '8d063cd8450e59ea1c611a2f4f5a21059a2804f1';
- my $out = `git rev-parse --verify --quiet '$commit^{commit}'`;
- chomp $out;
- if($out eq $commit) {
- $source_dir = '.'
- }
+ my $commit = '8d063cd8450e59ea1c611a2f4f5a21059a2804f1';
+ my $out = `git rev-parse --verify --quiet '$commit^{commit}'`;
+ chomp $out;
+ if($out eq $commit) {
+ $source_dir = '.'
+ }
}
if ($source_dir) {
- my $version_string = `git --version`;
- if (defined $version_string
- && $version_string =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
- return $source_dir if eval "v$1 ge v1.5.0";
- # If you have earlier than 1.5.0 and it works, change this test
- $reason = "in git checkout, but git version '$1$2' too old";
- } else {
- $reason = "in git checkout, but cannot run git";
- }
+ my $version_string = `git --version`;
+ if (defined $version_string
+ && $version_string =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
+ return $source_dir if eval "v$1 ge v1.5.0";
+ # If you have earlier than 1.5.0 and it works, change this test
+ $reason = "in git checkout, but git version '$1$2' too old";
+ } else {
+ $reason = "in git checkout, but cannot run git";
+ }
} else {
- $reason = 'not being run from a git checkout';
+ $reason = 'not being run from a git checkout';
}
skip_all($reason) if $_[0] && $_[0] eq 'all';
skip($reason, @_);
@@ -230,28 +230,28 @@ sub _ok {
if ($name) {
# escape out '#' or it will interfere with '# skip' and such
$name =~ s/#/\\#/g;
- $out = $pass ? "ok $test - $name" : "not ok $test - $name";
+ $out = $pass ? "ok $test - $name" : "not ok $test - $name";
} else {
- $out = $pass ? "ok $test" : "not ok $test";
+ $out = $pass ? "ok $test" : "not ok $test";
}
if ($TODO) {
- $out = $out . " # TODO $TODO";
+ $out = $out . " # TODO $TODO";
} else {
- $Tests_Are_Passing = 0 unless $pass;
+ $Tests_Are_Passing = 0 unless $pass;
}
_print "$out\n";
if ($pass) {
- note @mess; # Ensure that the message is properly escaped.
+ note @mess; # Ensure that the message is properly escaped.
}
else {
- my $msg = "# Failed test $test - ";
- $msg.= "$name " if $name;
- $msg .= "$where\n";
- _diag $msg;
- _diag @mess;
+ my $msg = "# Failed test $test - ";
+ $msg.= "$name " if $name;
+ $msg .= "$where\n";
+ _diag $msg;
+ _diag @mess;
}
$test = $test + 1; # don't use ++
@@ -351,8 +351,8 @@ sub is ($$@) {
}
unless ($pass) {
- unshift(@mess, "# got "._qq($got)."\n",
- "# expected "._qq($expected)."\n");
+ unshift(@mess, "# got "._qq($got)."\n",
+ "# expected "._qq($expected)."\n");
}
_ok($pass, _where(), $name, @mess);
}
@@ -434,8 +434,8 @@ sub within ($$$@) {
if ($got eq $expected) {
unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
}
- unshift@mess, "# got "._qq($got)."\n",
- "# expected "._qq($expected)." (within "._qq($range).")\n";
+ unshift@mess, "# got "._qq($got)."\n",
+ "# expected "._qq($expected)." (within "._qq($range).")\n";
}
_ok($pass, _where(), $name, @mess);
}
@@ -452,7 +452,7 @@ sub like_yn ($$$@) {
# definitely not like(..., '/.../') like
# Test::Builder::maybe_regex() does.
unless (re::is_regexp($expected)) {
- die "PANIC: The value '$expected' isn't a regexp. The like() function needs a qr// pattern, not a string";
+ die "PANIC: The value '$expected' isn't a regexp. The like() function needs a qr// pattern, not a string";
}
my $pass;
@@ -463,9 +463,9 @@ sub like_yn ($$$@) {
my $display_expected = $expected;
$display_expected = display($display_expected);
unless ($pass) {
- unshift(@mess, "# got '$display_got'\n",
- $flip
- ? "# expected !~ /$display_expected/\n"
+ unshift(@mess, "# got '$display_got'\n",
+ $flip
+ ? "# expected !~ /$display_expected/\n"
: "# expected /$display_expected/\n");
}
local $Level = $Level + 1;
@@ -525,7 +525,7 @@ sub skip_if_miniperl {
sub skip_without_dynamic_extension {
my $extension = shift;
skip("no dynamic loading on miniperl, no extension $extension", @_)
- if is_miniperl();
+ if is_miniperl();
return if &_have_dynamic_extension($extension);
skip("extension $extension was not built", @_);
}
@@ -546,10 +546,10 @@ sub eq_array {
my ($ra, $rb) = @_;
return 0 unless $#$ra == $#$rb;
for my $i (0..$#$ra) {
- next if !defined $ra->[$i] && !defined $rb->[$i];
- return 0 if !defined $ra->[$i];
- return 0 if !defined $rb->[$i];
- return 0 unless $ra->[$i] eq $rb->[$i];
+ next if !defined $ra->[$i] && !defined $rb->[$i];
+ return 0 if !defined $ra->[$i];
+ return 0 if !defined $rb->[$i];
+ return 0 unless $ra->[$i] eq $rb->[$i];
}
return 1;
}
@@ -589,24 +589,24 @@ sub eq_hash {
sub require_ok ($) {
my ($require) = @_;
if ($require =~ tr/[A-Za-z0-9:.]//c) {
- fail("Invalid character in \"$require\", passed to require_ok");
+ fail("Invalid character in \"$require\", passed to require_ok");
} else {
- eval <<REQUIRE_OK;
+ eval <<REQUIRE_OK;
require $require;
REQUIRE_OK
- is($@, '', _where(), "require $require");
+ is($@, '', _where(), "require $require");
}
}
sub use_ok ($) {
my ($use) = @_;
if ($use =~ tr/[A-Za-z0-9:.]//c) {
- fail("Invalid character in \"$use\", passed to use");
+ fail("Invalid character in \"$use\", passed to use");
} else {
- eval <<USE_OK;
+ eval <<USE_OK;
use $use;
USE_OK
- is($@, '', _where(), "use $use");
+ is($@, '', _where(), "use $use");
}
}
@@ -633,8 +633,8 @@ sub _quote_args {
my ($runperl, $args) = @_;
foreach (@$args) {
- # In VMS protect with doublequotes because otherwise
- # DCL will lowercase -- unless already doublequoted.
+ # In VMS protect with doublequotes because otherwise
+ # DCL will lowercase -- unless already doublequoted.
$_ = q(").$_.q(") if $is_vms && !/^\"/ && length($_) > 0;
$runperl = $runperl . ' ' . $_;
}
@@ -649,37 +649,37 @@ sub _create_runperl { # Create the string to qx in runperl().
}
#- this allows, for example, to set PERL_RUNPERL_DEBUG=/usr/bin/valgrind
if ($ENV{PERL_RUNPERL_DEBUG}) {
- $runperl = "$ENV{PERL_RUNPERL_DEBUG} $runperl";
+ $runperl = "$ENV{PERL_RUNPERL_DEBUG} $runperl";
}
unless ($args{nolib}) {
- $runperl = $runperl . ' "-I../lib" "-I." '; # doublequotes because of VMS
+ $runperl = $runperl . ' "-I../lib" "-I." '; # doublequotes because of VMS
}
if ($args{switches}) {
- local $Level = 2;
- die "test.pl:runperl(): 'switches' must be an ARRAYREF " . _where()
- unless ref $args{switches} eq "ARRAY";
- $runperl = _quote_args($runperl, $args{switches});
+ local $Level = 2;
+ die "test.pl:runperl(): 'switches' must be an ARRAYREF " . _where()
+ unless ref $args{switches} eq "ARRAY";
+ $runperl = _quote_args($runperl, $args{switches});
}
if (defined $args{prog}) {
- die "test.pl:runperl(): both 'prog' and 'progs' cannot be used " . _where()
- if defined $args{progs};
+ die "test.pl:runperl(): both 'prog' and 'progs' cannot be used " . _where()
+ if defined $args{progs};
$args{progs} = [split /\n/, $args{prog}, -1]
}
if (defined $args{progs}) {
- die "test.pl:runperl(): 'progs' must be an ARRAYREF " . _where()
- unless ref $args{progs} eq "ARRAY";
+ die "test.pl:runperl(): 'progs' must be an ARRAYREF " . _where()
+ unless ref $args{progs} eq "ARRAY";
foreach my $prog (@{$args{progs}}) {
- if (!$args{non_portable}) {
- if ($prog =~ tr/'"//) {
- warn "quotes in prog >>$prog<< are not portable";
- }
- if ($prog =~ /^([<>|]|2>)/) {
- warn "Initial $1 in prog >>$prog<< is not portable";
- }
- if ($prog =~ /&\z/) {
- warn "Trailing & in prog >>$prog<< is not portable";
- }
- }
+ if (!$args{non_portable}) {
+ if ($prog =~ tr/'"//) {
+ warn "quotes in prog >>$prog<< are not portable";
+ }
+ if ($prog =~ /^([<>|]|2>)/) {
+ warn "Initial $1 in prog >>$prog<< is not portable";
+ }
+ if ($prog =~ /&\z/) {
+ warn "Trailing & in prog >>$prog<< is not portable";
+ }
+ }
if ($is_mswin || $is_netware || $is_vms) {
$runperl = $runperl . qq ( -e "$prog" );
}
@@ -688,28 +688,28 @@ sub _create_runperl { # Create the string to qx in runperl().
}
}
} elsif (defined $args{progfile}) {
- $runperl = $runperl . qq( "$args{progfile}");
+ $runperl = $runperl . qq( "$args{progfile}");
} else {
- # You probably didn't want to be sucking in from the upstream stdin
- die "test.pl:runperl(): none of prog, progs, progfile, args, "
- . " switches or stdin specified"
- unless defined $args{args} or defined $args{switches}
- or defined $args{stdin};
+ # You probably didn't want to be sucking in from the upstream stdin
+ die "test.pl:runperl(): none of prog, progs, progfile, args, "
+ . " switches or stdin specified"
+ unless defined $args{args} or defined $args{switches}
+ or defined $args{stdin};
}
if (defined $args{stdin}) {
- # so we don't try to put literal newlines and crs onto the
- # command line.
- $args{stdin} =~ s/\n/\\n/g;
- $args{stdin} =~ s/\r/\\r/g;
-
- if ($is_mswin || $is_netware || $is_vms) {
- $runperl = qq{$Perl -e "print qq(} .
- $args{stdin} . q{)" | } . $runperl;
- }
- else {
- $runperl = qq{$Perl -e 'print qq(} .
- $args{stdin} . q{)' | } . $runperl;
- }
+ # so we don't try to put literal newlines and crs onto the
+ # command line.
+ $args{stdin} =~ s/\n/\\n/g;
+ $args{stdin} =~ s/\r/\\r/g;
+
+ if ($is_mswin || $is_netware || $is_vms) {
+ $runperl = qq{$Perl -e "print qq(} .
+ $args{stdin} . q{)" | } . $runperl;
+ }
+ else {
+ $runperl = qq{$Perl -e 'print qq(} .
+ $args{stdin} . q{)' | } . $runperl;
+ }
} elsif (exists $args{stdin}) {
# Using the pipe construction above can cause fun on systems which use
# ksh as /bin/sh, as ksh does pipes differently (with one less process)
@@ -734,7 +734,7 @@ sub _create_runperl { # Create the string to qx in runperl().
$runperl = $runperl . ($is_mswin ? ' <nul' : ' </dev/null');
}
if (defined $args{args}) {
- $runperl = _quote_args($runperl, $args{args});
+ $runperl = _quote_args($runperl, $args{args});
}
if (exists $args{stderr} && $args{stderr} eq 'devnull') {
$runperl = $runperl . ($is_mswin ? ' 2>nul' : ' 2>/dev/null');
@@ -743,9 +743,9 @@ sub _create_runperl { # Create the string to qx in runperl().
$runperl = $runperl . ' 2>&1';
}
if ($args{verbose}) {
- my $runperldisplay = $runperl;
- $runperldisplay =~ s/\n/\n\#/g;
- _print_stderr "# $runperldisplay\n";
+ my $runperldisplay = $runperl;
+ $runperldisplay =~ s/\n/\n\#/g;
+ _print_stderr "# $runperldisplay\n";
}
return $runperl;
}
@@ -753,7 +753,7 @@ sub _create_runperl { # Create the string to qx in runperl().
# sub run_perl {} is alias to below
sub runperl {
die "test.pl:runperl() does not take a hashref"
- if ref $_[0] and ref $_[0] eq 'HASH';
+ if ref $_[0] and ref $_[0] eq 'HASH';
my $runperl = &_create_runperl;
my $result;
@@ -762,38 +762,38 @@ sub runperl {
exists $args{switches} && grep m/^-T$/, @{$args{switches}} and $tainted = $tainted + 1;
if ($tainted) {
- # We will assume that if you're running under -T, you really mean to
- # run a fresh perl, so we'll brute force launder everything for you
- my $sep;
-
- if (! eval {require Config; 1}) {
- warn "test.pl had problems loading Config: $@";
- $sep = ':';
- } else {
- $sep = $Config::Config{path_sep};
- }
-
- my @keys = grep {exists $ENV{$_}} qw(CDPATH IFS ENV BASH_ENV);
- local @ENV{@keys} = ();
- # Untaint, plus take out . and empty string:
- local $ENV{'DCL$PATH'} = $1 if $is_vms && exists($ENV{'DCL$PATH'}) && ($ENV{'DCL$PATH'} =~ /(.*)/s);
- $ENV{PATH} =~ /(.*)/s;
- local $ENV{PATH} =
- join $sep, grep { $_ ne "" and $_ ne "." and -d $_ and
- ($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
- split quotemeta ($sep), $1;
- if ($is_cygwin) { # Must have /bin under Cygwin
- if (length $ENV{PATH}) {
- $ENV{PATH} = $ENV{PATH} . $sep;
- }
- $ENV{PATH} = $ENV{PATH} . '/bin';
- }
- $runperl =~ /(.*)/s;
- $runperl = $1;
-
- $result = `$runperl`;
+ # We will assume that if you're running under -T, you really mean to
+ # run a fresh perl, so we'll brute force launder everything for you
+ my $sep;
+
+ if (! eval {require Config; 1}) {
+ warn "test.pl had problems loading Config: $@";
+ $sep = ':';
+ } else {
+ $sep = $Config::Config{path_sep};
+ }
+
+ my @keys = grep {exists $ENV{$_}} qw(CDPATH IFS ENV BASH_ENV);
+ local @ENV{@keys} = ();
+ # Untaint, plus take out . and empty string:
+ local $ENV{'DCL$PATH'} = $1 if $is_vms && exists($ENV{'DCL$PATH'}) && ($ENV{'DCL$PATH'} =~ /(.*)/s);
+ $ENV{PATH} =~ /(.*)/s;
+ local $ENV{PATH} =
+ join $sep, grep { $_ ne "" and $_ ne "." and -d $_ and
+ ($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
+ split quotemeta ($sep), $1;
+ if ($is_cygwin) { # Must have /bin under Cygwin
+ if (length $ENV{PATH}) {
+ $ENV{PATH} = $ENV{PATH} . $sep;
+ }
+ $ENV{PATH} = $ENV{PATH} . '/bin';
+ }
+ $runperl =~ /(.*)/s;
+ $runperl = $1;
+
+ $result = `$runperl`;
} else {
- $result = `$runperl`;
+ $result = `$runperl`;
}
$result =~ s/\n\n/\n/g if $is_vms; # XXX pipes sometimes double these
return $result;
@@ -810,45 +810,45 @@ sub DIE {
# A somewhat safer version of the sometimes wrong $^X.
sub which_perl {
unless (defined $Perl) {
- $Perl = $^X;
-
- # VMS should have 'perl' aliased properly
- return $Perl if $is_vms;
-
- my $exe;
- if (! eval {require Config; 1}) {
- warn "test.pl had problems loading Config: $@";
- $exe = '';
- } else {
- $exe = $Config::Config{_exe};
- }
- $exe = '' unless defined $exe;
+ $Perl = $^X;
- # This doesn't absolutize the path: beware of future chdirs().
- # We could do File::Spec->abs2rel() but that does getcwd()s,
- # which is a bit heavyweight to do here.
+ # VMS should have 'perl' aliased properly
+ return $Perl if $is_vms;
+
+ my $exe;
+ if (! eval {require Config; 1}) {
+ warn "test.pl had problems loading Config: $@";
+ $exe = '';
+ } else {
+ $exe = $Config::Config{_exe};
+ }
+ $exe = '' unless defined $exe;
- if ($Perl =~ /^perl\Q$exe\E$/i) {
- my $perl = "perl$exe";
- if (! eval {require File::Spec; 1}) {
- warn "test.pl had problems loading File::Spec: $@";
- $Perl = "./$perl";
- } else {
- $Perl = File::Spec->catfile(File::Spec->curdir(), $perl);
- }
- }
+ # This doesn't absolutize the path: beware of future chdirs().
+ # We could do File::Spec->abs2rel() but that does getcwd()s,
+ # which is a bit heavyweight to do here.
+
+ if ($Perl =~ /^perl\Q$exe\E$/i) {
+ my $perl = "perl$exe";
+ if (! eval {require File::Spec; 1}) {
+ warn "test.pl had problems loading File::Spec: $@";
+ $Perl = "./$perl";
+ } else {
+ $Perl = File::Spec->catfile(File::Spec->curdir(), $perl);
+ }
+ }
- # Build up the name of the executable file from the name of
- # the command.
+ # Build up the name of the executable file from the name of
+ # the command.
- if ($Perl !~ /\Q$exe\E$/i) {
- $Perl = $Perl . $exe;
- }
+ if ($Perl !~ /\Q$exe\E$/i) {
+ $Perl = $Perl . $exe;
+ }
- warn "which_perl: cannot find $Perl from $^X" unless -f $Perl;
+ warn "which_perl: cannot find $Perl from $^X" unless -f $Perl;
- # For subcommands to use.
- $ENV{PERLEXE} = $Perl;
+ # For subcommands to use.
+ $ENV{PERLEXE} = $Perl;
}
return $Perl;
}
@@ -857,11 +857,11 @@ sub unlink_all {
my $count = 0;
foreach my $file (@_) {
1 while unlink $file;
- if( -f $file ){
- _print_stderr "# Couldn't unlink '$file': $!\n";
- }else{
- $count = $count + 1; # don't use ++
- }
+ if( -f $file ){
+ _print_stderr "# Couldn't unlink '$file': $!\n";
+ }else{
+ $count = $count + 1; # don't use ++
+ }
}
$count;
}
@@ -914,19 +914,19 @@ $::tempfile_regexp = 'tmp\d+[A-Z][A-Z]?';
my $tempfile_count = 0;
sub tempfile {
while(1){
- my $try = "tmp$$";
+ my $try = "tmp$$";
my $alpha = _num_to_alpha($tempfile_count,2);
last unless defined $alpha;
$try = $try . $alpha;
$tempfile_count = $tempfile_count + 1;
- # Need to note all the file names we allocated, as a second request may
- # come before the first is created.
- if (!$tmpfiles{$try} && !-e $try) {
- # We have a winner
- $tmpfiles{$try} = 1;
- return $try;
- }
+ # Need to note all the file names we allocated, as a second request may
+ # come before the first is created.
+ if (!$tmpfiles{$try} && !-e $try) {
+ # We have a winner
+ $tmpfiles{$try} = 1;
+ return $try;
+ }
}
die "Can't find temporary file name starting \"tmp$$\"";
}
@@ -943,12 +943,12 @@ sub tempfile {
sub register_tempfile {
my $count = 0;
for( @_ ){
- if( $tmpfiles{$_} ){
- _print_stderr "# Temporary file '$_' already added\n";
- }else{
- $tmpfiles{$_} = 1;
- $count = $count + 1;
- }
+ if( $tmpfiles{$_} ){
+ _print_stderr "# Temporary file '$_' already added\n";
+ }else{
+ $tmpfiles{$_} = 1;
+ $count = $count + 1;
+ }
}
return $count;
}
@@ -1027,13 +1027,13 @@ sub _fresh_perl {
# feels like a better trade off.
my $pass;
if ($action eq 'eq') {
- $pass = is($results, $expect, $name);
+ $pass = is($results, $expect, $name);
} elsif ($action eq '=~') {
- $pass = like($results, $expect, $name);
+ $pass = like($results, $expect, $name);
} else {
- die "_fresh_perl can't process action '$action'";
+ die "_fresh_perl can't process action '$action'";
}
-
+
unless ($pass) {
_diag "# PROG: \n$prog\n";
_diag "# STATUS: $status\n";
@@ -1171,9 +1171,9 @@ sub run_multiple_progs {
my $up = shift;
my @prgs;
if ($up) {
- # The tests in lib run in a temporary subdirectory of t, and always
- # pass in a list of "programs" to run
- @prgs = @_;
+ # The tests in lib run in a temporary subdirectory of t, and always
+ # pass in a list of "programs" to run
+ @prgs = @_;
} else {
# The tests below t run in t and pass in a file handle. In theory we
# can pass (caller)[1] as the second argument to report errors with
@@ -1200,166 +1200,166 @@ sub run_multiple_progs {
if (defined $file) {
print "# From $file\n";
}
- next;
- }
- my $switch = "";
- my @temps ;
- my @temp_path;
- if (s/^(\s*-\w+)//) {
- $switch = $1;
- }
- my ($prog, $expected) = split(/\nEXPECT(?:\n|$)/, $_, 2);
-
- my %reason;
- foreach my $what (qw(skip todo)) {
- $prog =~ s/^#\s*\U$what\E\s*(.*)\n//m and $reason{$what} = $1;
- # If the SKIP reason starts ? then it's taken as a code snippet to
- # evaluate. This provides the flexibility to have conditional SKIPs
- if ($reason{$what} && $reason{$what} =~ s/^\?//) {
- my $temp = eval $reason{$what};
- if ($@) {
- die "# In \U$what\E code reason:\n# $reason{$what}\n$@";
- }
- $reason{$what} = $temp;
- }
- }
-
- my $name = '';
- if ($prog =~ s/^#\s*NAME\s+(.+)\n//m) {
- $name = $1;
- }
-
- if ($reason{skip}) {
- SKIP:
- {
- skip($name ? "$name - $reason{skip}" : $reason{skip}, 1);
- }
- next PROGRAM;
- }
-
- if ($prog =~ /--FILE--/) {
- my @files = split(/\n?--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
- shift @files ;
- die "Internal error: test $_ didn't split into pairs, got " .
- scalar(@files) . "[" . join("%%%%", @files) ."]\n"
- if @files % 2;
- while (@files > 2) {
- my $filename = shift @files;
- my $code = shift @files;
- push @temps, $filename;
- if ($filename =~ m#(.*)/# && $filename !~ m#^\.\./#) {
- require File::Path;
- File::Path::mkpath($1);
- push(@temp_path, $1);
- }
- open my $fh, '>', $filename or die "Cannot open $filename: $!\n";
- print $fh $code;
- close $fh or die "Cannot close $filename: $!\n";
- }
- shift @files;
- $prog = shift @files;
- }
-
- open my $fh, '>', $tmpfile or die "Cannot open >$tmpfile: $!";
- print $fh q{
+ next;
+ }
+ my $switch = "";
+ my @temps ;
+ my @temp_path;
+ if (s/^(\s*-\w+)//) {
+ $switch = $1;
+ }
+ my ($prog, $expected) = split(/\nEXPECT(?:\n|$)/, $_, 2);
+
+ my %reason;
+ foreach my $what (qw(skip todo)) {
+ $prog =~ s/^#\s*\U$what\E\s*(.*)\n//m and $reason{$what} = $1;
+ # If the SKIP reason starts ? then it's taken as a code snippet to
+ # evaluate. This provides the flexibility to have conditional SKIPs
+ if ($reason{$what} && $reason{$what} =~ s/^\?//) {
+ my $temp = eval $reason{$what};
+ if ($@) {
+ die "# In \U$what\E code reason:\n# $reason{$what}\n$@";
+ }
+ $reason{$what} = $temp;
+ }
+ }
+
+ my $name = '';
+ if ($prog =~ s/^#\s*NAME\s+(.+)\n//m) {
+ $name = $1;
+ }
+
+ if ($reason{skip}) {
+ SKIP:
+ {
+ skip($name ? "$name - $reason{skip}" : $reason{skip}, 1);
+ }
+ next PROGRAM;
+ }
+
+ if ($prog =~ /--FILE--/) {
+ my @files = split(/\n?--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+ shift @files ;
+ die "Internal error: test $_ didn't split into pairs, got " .
+ scalar(@files) . "[" . join("%%%%", @files) ."]\n"
+ if @files % 2;
+ while (@files > 2) {
+ my $filename = shift @files;
+ my $code = shift @files;
+ push @temps, $filename;
+ if ($filename =~ m#(.*)/# && $filename !~ m#^\.\./#) {
+ require File::Path;
+ File::Path::mkpath($1);
+ push(@temp_path, $1);
+ }
+ open my $fh, '>', $filename or die "Cannot open $filename: $!\n";
+ print $fh $code;
+ close $fh or die "Cannot close $filename: $!\n";
+ }
+ shift @files;
+ $prog = shift @files;
+ }
+
+ open my $fh, '>', $tmpfile or die "Cannot open >$tmpfile: $!";
+ print $fh q{
BEGIN {
push @INC, '.';
open STDERR, '>&', STDOUT
or die "Can't dup STDOUT->STDERR: $!;";
}
- };
- print $fh "\n#line 1\n"; # So the line numbers don't get messed up.
- print $fh $prog,"\n";
- close $fh or die "Cannot close $tmpfile: $!";
- my $results = runperl( stderr => 1, progfile => $tmpfile,
- stdin => undef, $up
- ? (switches => ["-I$up/lib", $switch], nolib => 1)
- : (switches => [$switch])
- );
- my $status = $?;
- $results =~ s/\n+$//;
- # allow expected output to be written as if $prog is on STDIN
- $results =~ s/$::tempfile_regexp/-/g;
- if ($^O eq 'VMS') {
- # some tests will trigger VMS messages that won't be expected
- $results =~ s/\n?%[A-Z]+-[SIWEF]-[A-Z]+,.*//;
-
- # pipes double these sometimes
- $results =~ s/\n\n/\n/g;
- }
- # bison says 'parse error' instead of 'syntax error',
- # various yaccs may or may not capitalize 'syntax'.
- $results =~ s/^(syntax|parse) error/syntax error/mig;
- # allow all tests to run when there are leaks
- $results =~ s/Scalars leaked: \d+\n//g;
-
- $expected =~ s/\n+$//;
- my $prefix = ($results =~ s#^PREFIX(\n|$)##) ;
- # any special options? (OPTIONS foo bar zap)
- my $option_regex = 0;
- my $option_random = 0;
- my $fatal = $FATAL;
- if ($expected =~ s/^OPTIONS? (.+)\n//) {
- foreach my $option (split(' ', $1)) {
- if ($option eq 'regex') { # allow regular expressions
- $option_regex = 1;
- }
- elsif ($option eq 'random') { # all lines match, but in any order
- $option_random = 1;
- }
- elsif ($option eq 'fatal') { # perl should fail
- $fatal = 1;
- }
- else {
- die "$0: Unknown OPTION '$option'\n";
- }
- }
- }
- die "$0: can't have OPTION regex and random\n"
- if $option_regex + $option_random > 1;
- my $ok = 0;
- if ($results =~ s/^SKIPPED\n//) {
- print "$results\n" ;
- $ok = 1;
- }
- else {
- if ($option_random) {
- my @got = sort split "\n", $results;
- my @expected = sort split "\n", $expected;
-
- $ok = "@got" eq "@expected";
- }
- elsif ($option_regex) {
- $ok = $results =~ /^$expected/;
- }
- elsif ($prefix) {
- $ok = $results =~ /^\Q$expected/;
- }
- else {
- $ok = $results eq $expected;
- }
-
- if ($ok && $fatal && !($status >> 8)) {
- $ok = 0;
- }
- }
-
- local $::TODO = $reason{todo};
-
- unless ($ok) {
- my $err_line = "PROG: $switch\n$prog\n" .
- "EXPECTED:\n$expected\n";
- $err_line .= "EXIT STATUS: != 0\n" if $fatal;
- $err_line .= "GOT:\n$results\n";
- $err_line .= "EXIT STATUS: " . ($status >> 8) . "\n" if $fatal;
- if ($::TODO) {
- $err_line =~ s/^/# /mg;
- print $err_line; # Harness can't filter it out from STDERR.
- }
- else {
- print STDERR $err_line;
- }
- }
+ };
+ print $fh "\n#line 1\n"; # So the line numbers don't get messed up.
+ print $fh $prog,"\n";
+ close $fh or die "Cannot close $tmpfile: $!";
+ my $results = runperl( stderr => 1, progfile => $tmpfile,
+ stdin => undef, $up
+ ? (switches => ["-I$up/lib", $switch], nolib => 1)
+ : (switches => [$switch])
+ );
+ my $status = $?;
+ $results =~ s/\n+$//;
+ # allow expected output to be written as if $prog is on STDIN
+ $results =~ s/$::tempfile_regexp/-/g;
+ if ($^O eq 'VMS') {
+ # some tests will trigger VMS messages that won't be expected
+ $results =~ s/\n?%[A-Z]+-[SIWEF]-[A-Z]+,.*//;
+
+ # pipes double these sometimes
+ $results =~ s/\n\n/\n/g;
+ }
+ # bison says 'parse error' instead of 'syntax error',
+ # various yaccs may or may not capitalize 'syntax'.
+ $results =~ s/^(syntax|parse) error/syntax error/mig;
+ # allow all tests to run when there are leaks
+ $results =~ s/Scalars leaked: \d+\n//g;
+
+ $expected =~ s/\n+$//;
+ my $prefix = ($results =~ s#^PREFIX(\n|$)##) ;
+ # any special options? (OPTIONS foo bar zap)
+ my $option_regex = 0;
+ my $option_random = 0;
+ my $fatal = $FATAL;
+ if ($expected =~ s/^OPTIONS? (.+)\n//) {
+ foreach my $option (split(' ', $1)) {
+ if ($option eq 'regex') { # allow regular expressions
+ $option_regex = 1;
+ }
+ elsif ($option eq 'random') { # all lines match, but in any order
+ $option_random = 1;
+ }
+ elsif ($option eq 'fatal') { # perl should fail
+ $fatal = 1;
+ }
+ else {
+ die "$0: Unknown OPTION '$option'\n";
+ }
+ }
+ }
+ die "$0: can't have OPTION regex and random\n"
+ if $option_regex + $option_random > 1;
+ my $ok = 0;
+ if ($results =~ s/^SKIPPED\n//) {
+ print "$results\n" ;
+ $ok = 1;
+ }
+ else {
+ if ($option_random) {
+ my @got = sort split "\n", $results;
+ my @expected = sort split "\n", $expected;
+
+ $ok = "@got" eq "@expected";
+ }
+ elsif ($option_regex) {
+ $ok = $results =~ /^$expected/;
+ }
+ elsif ($prefix) {
+ $ok = $results =~ /^\Q$expected/;
+ }
+ else {
+ $ok = $results eq $expected;
+ }
+
+ if ($ok && $fatal && !($status >> 8)) {
+ $ok = 0;
+ }
+ }
+
+ local $::TODO = $reason{todo};
+
+ unless ($ok) {
+ my $err_line = "PROG: $switch\n$prog\n" .
+ "EXPECTED:\n$expected\n";
+ $err_line .= "EXIT STATUS: != 0\n" if $fatal;
+ $err_line .= "GOT:\n$results\n";
+ $err_line .= "EXIT STATUS: " . ($status >> 8) . "\n" if $fatal;
+ if ($::TODO) {
+ $err_line =~ s/^/# /mg;
+ print $err_line; # Harness can't filter it out from STDERR.
+ }
+ else {
+ print STDERR $err_line;
+ }
+ }
if (defined $file) {
_ok($ok, "at $file line $line", $name);
@@ -1370,12 +1370,12 @@ sub run_multiple_progs {
ok($ok, $name);
}
- foreach (@temps) {
- unlink $_ if $_;
- }
- foreach (@temp_path) {
- File::Path::rmtree $_ if -d $_;
- }
+ foreach (@temps) {
+ unlink $_ if $_;
+ }
+ foreach (@temp_path) {
+ File::Path::rmtree $_ if -d $_;
+ }
}
}
@@ -1510,7 +1510,7 @@ sub object_ok {
sub __capture {
push @::__capture, join "", @_;
}
-
+
sub capture_warnings {
my $code = shift;
@@ -1530,15 +1530,15 @@ sub warnings_like {
cmp_ok(scalar @w, '==', scalar @$expect, $name);
foreach my $e (@$expect) {
- if (ref $e) {
- like(shift @w, $e, $name);
- } else {
- is(shift @w, $e, $name);
- }
+ if (ref $e) {
+ like(shift @w, $e, $name);
+ } else {
+ is(shift @w, $e, $name);
+ }
}
if (@w) {
- diag("Saw these additional warnings:");
- diag($_) foreach @w;
+ diag("Saw these additional warnings:");
+ diag($_) foreach @w;
}
}
@@ -1554,26 +1554,26 @@ sub _fail_excess_warnings {
sub warning_is {
my ($code, $expect, $name) = @_;
die sprintf "Expect must be a string or undef, not a %s reference", ref $expect
- if ref $expect;
+ if ref $expect;
local $Level = $Level + 1;
my @w = capture_warnings($code);
if (@w > 1) {
- _fail_excess_warnings(0 + defined $expect, \@w, $name);
+ _fail_excess_warnings(0 + defined $expect, \@w, $name);
} else {
- is($w[0], $expect, $name);
+ is($w[0], $expect, $name);
}
}
sub warning_like {
my ($code, $expect, $name) = @_;
die sprintf "Expect must be a regexp object"
- unless ref $expect eq 'Regexp';
+ unless ref $expect eq 'Regexp';
local $Level = $Level + 1;
my @w = capture_warnings($code);
if (@w > 1) {
- _fail_excess_warnings(0 + defined $expect, \@w, $name);
+ _fail_excess_warnings(0 + defined $expect, \@w, $name);
} else {
- like($w[0], $expect, $name);
+ like($w[0], $expect, $name);
}
}
@@ -1684,11 +1684,11 @@ sub watchdog ($;$)
if (kill(0, $pid_to_kill)) {
_diag($timeout_msg);
kill('KILL', $pid_to_kill);
- if ($is_cygwin) {
- # sometimes the above isn't enough on cygwin
- sleep 1; # wait a little, it might have worked after all
- system("/bin/kill -f $pid_to_kill");
- }
+ if ($is_cygwin) {
+ # sometimes the above isn't enough on cygwin
+ sleep 1; # wait a little, it might have worked after all
+ system("/bin/kill -f $pid_to_kill");
+ }
}
# Don't execute END block (added at beginning of this file)
--
2.11.0
|
From @ptolemarch0002-regularize-whitespace-in-t-op-magic.t.patchFrom dcd17f6f56ebc0e02f2f8161f68123a20e1d1a21 Mon Sep 17 00:00:00 2001
From: David Hand <davidhand@davidhand.com>
Date: Fri, 30 Jun 2017 19:57:38 -0400
Subject: [PATCH 2/7] regularize whitespace in t/op/magic.t
In preparation for more changes.
This is a part of an ongoing patch to allow `make test` to succeed even
if the path to the build directory contains spaces.
---
t/op/magic.t | 370 +++++++++++++++++++++++++++++------------------------------
1 file changed, 185 insertions(+), 185 deletions(-)
diff --git a/t/op/magic.t b/t/op/magic.t
index 3f71f8ec64..ea93a9a6ee 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -17,24 +17,24 @@ BEGIN {
# not available in miniperl
my %non_mini = map { $_ => 1 } qw(+ - [);
for (qw(
- SIG ^OPEN ^TAINT ^UNICODE ^UTF8LOCALE ^WARNING_BITS 1 2 3 4 5 6 7 8
- 9 42 & ` ' : ? ! _ - [ ^ ~ = % . ( ) < > \ / $ | + ; ] ^A ^C ^D
- ^E ^F ^H ^I ^L ^N ^O ^P ^S ^T ^V ^W ^UTF8CACHE ::12345 main::98732
- ^LAST_FH
+ SIG ^OPEN ^TAINT ^UNICODE ^UTF8LOCALE ^WARNING_BITS 1 2 3 4 5 6 7 8
+ 9 42 & ` ' : ? ! _ - [ ^ ~ = % . ( ) < > \ / $ | + ; ] ^A ^C ^D
+ ^E ^F ^H ^I ^L ^N ^O ^P ^S ^T ^V ^W ^UTF8CACHE ::12345 main::98732
+ ^LAST_FH
)) {
- my $v = $_;
- # avoid using any global vars here:
- if ($v =~ s/^\^(?=.)//) {
- for(substr $v, 0, 1) {
- $_ = chr(utf8::native_to_unicode(ord($_)) - 64);
- }
- }
- SKIP:
- {
- skip_if_miniperl("the module for *$_ may not be available in "
- . "miniperl", 1) if $non_mini{$_};
- ok defined *$v, "*$_ appears to be defined at the outset";
- }
+ my $v = $_;
+ # avoid using any global vars here:
+ if ($v =~ s/^\^(?=.)//) {
+ for(substr $v, 0, 1) {
+ $_ = chr(utf8::native_to_unicode(ord($_)) - 64);
+ }
+ }
+ SKIP:
+ {
+ skip_if_miniperl("the module for *$_ may not be available in "
+ . "miniperl", 1) if $non_mini{$_};
+ ok defined *$v, "*$_ appears to be defined at the outset";
+ }
}
}
@@ -70,11 +70,11 @@ sub env_is {
if ($Is_MSWin32) {
# cmd.exe will echo 'variable=value' but 4nt will echo just the value
# -- Nikola Knezevic
- require Win32;
- my $cp = Win32::GetConsoleOutputCP();
- Win32::SetConsoleOutputCP(Win32::GetACP());
+ require Win32;
+ my $cp = Win32::GetConsoleOutputCP();
+ Win32::SetConsoleOutputCP(Win32::GetACP());
(my $set = `set $key 2>nul`) =~ s/\r\n$/\n/;
- Win32::SetConsoleOutputCP($cp);
+ Win32::SetConsoleOutputCP($cp);
like $set, qr/^(?:\Q$key\E=)?\Q$val\E$/, $desc;
} elsif ($Is_VMS) {
my $eqv = `write sys\$output f\$trnlnm("\Q$key\E")`;
@@ -101,7 +101,7 @@ END {
}
}
-eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval
+eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval
# cmd.exe will echo 'variable=value' but 4nt will echo just the value
# -- Nikola Knezevic
if ($Is_MSWin32) { like `set FOO`, qr/^(?:FOO=)?hi there$/; }
@@ -116,7 +116,7 @@ close FOO; # just mention it, squelch used-only-once
SKIP: {
skip('SIGINT not safe on this platform', 5)
- if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
+ if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
# the next tests are done in a subprocess because sh spits out a
# newline onto stderr when a child process kills itself with SIGINT.
# We use a pipe rather than system() because the VMS command buffer
@@ -132,19 +132,19 @@ SKIP: {
print CMDPIPE "\$t1 = $tn[1]; \$t2 = $tn[2];\n", <<'END';
- $| = 1; # command buffering
+ $| = 1; # command buffering
$SIG{"INT"} = "ok1"; kill "INT",$$; sleep 1;
$SIG{"INT"} = "IGNORE"; kill "INT",$$; sleep 1; print "ok $t2\n";
$SIG{"INT"} = "DEFAULT"; kill "INT",$$; sleep 1; print" not ok $t2\n";
sub ok1 {
- if (($x = pop(@_)) eq "INT") {
- print "ok $t1\n";
- }
- else {
- print "not ok $t1 ($x @_)\n";
- }
+ if (($x = pop(@_)) eq "INT") {
+ print "ok $t1\n";
+ }
+ else {
+ print "not ok $t1 ($x @_)\n";
+ }
}
END
@@ -155,25 +155,25 @@ END
print CMDPIPE "\$t3 = $tn[3];\n", <<'END';
{ package X;
- sub DESTROY {
- kill "INT",$$;
- }
+ sub DESTROY {
+ kill "INT",$$;
+ }
}
sub x {
- my $x=bless [], 'X';
- return sub { $x };
+ my $x=bless [], 'X';
+ return sub { $x };
}
- $| = 1; # command buffering
+ $| = 1; # command buffering
$SIG{"INT"} = "ok3";
{
- local $SIG{"INT"}=x();
- print ""; # Needed to expose failure in 5.8.0 (why?)
+ local $SIG{"INT"}=x();
+ print ""; # Needed to expose failure in 5.8.0 (why?)
}
sleep 1;
delete $SIG{"INT"};
kill "INT",$$; sleep 1;
sub ok3 {
- print "ok $t3\n";
+ print "ok $t3\n";
}
END
close CMDPIPE;
@@ -264,14 +264,14 @@ SKIP: {
skip "no fork", 1 unless $Config{d_fork};
(my $kidpid = open my $fh, "-|") // skip "cannot fork: $!", 1;
if($kidpid) { # parent
- my $kiddollars = <$fh>;
- close $fh or die "cannot close pipe from kid proc: $!";
- is $kiddollars, $kidpid, '$$ is reset on fork';
+ my $kiddollars = <$fh>;
+ close $fh or die "cannot close pipe from kid proc: $!";
+ is $kiddollars, $kidpid, '$$ is reset on fork';
}
else { # child
- print $$;
- $::NO_ENDING = 1; # silence "Looks like you only ran..."
- exit;
+ print $$;
+ $::NO_ENDING = 1; # silence "Looks like you only ran..."
+ exit;
}
}
$$ = $pid; # Tests below use $$
@@ -281,7 +281,7 @@ $$ = $pid; # Tests below use $$
my $is_abs = $Config{d_procselfexe} || $Config{usekernprocpathname}
|| $Config{usensgetexecutablepath};
if ($^O eq 'qnx') {
- chomp($wd = `/usr/bin/fullpath -t`);
+ chomp($wd = `/usr/bin/fullpath -t`);
}
elsif($^O =~ /android/) {
chomp($wd = `sh -c 'pwd'`);
@@ -292,14 +292,14 @@ $$ = $pid; # Tests below use $$
$wd =~ s#/t$##;
$wd =~ /(.*)/; $wd = $1; # untaint
if ($Is_Cygwin) {
- $wd = Cygwin::win_to_posix_path(Cygwin::posix_to_win_path($wd, 1));
+ $wd = Cygwin::win_to_posix_path(Cygwin::posix_to_win_path($wd, 1));
}
}
elsif($Is_os2) {
$wd = Cwd::sys_cwd();
}
else {
- $wd = '.';
+ $wd = '.';
}
my $perl = $Is_VMS || $is_abs ? $^X : "$wd/perl";
my $headmaybe = '';
@@ -307,18 +307,18 @@ $$ = $pid; # Tests below use $$
my $tailmaybe = '';
$script = "$wd/show-shebang";
if ($Is_MSWin32) {
- chomp($wd = `cd`);
- $wd =~ s|\\|/|g;
- $perl = "$wd/perl.exe";
- $script = "$wd/show-shebang.bat";
- $headmaybe = <<EOH ;
+ chomp($wd = `cd`);
+ $wd =~ s|\\|/|g;
+ $perl = "$wd/perl.exe";
+ $script = "$wd/show-shebang.bat";
+ $headmaybe = <<EOH ;
\@rem ='
\@echo off
$perl -x \%0
goto endofperl
\@rem ';
EOH
- $tailmaybe = <<EOT ;
+ $tailmaybe = <<EOT ;
__END__
:endofperl
@@ -337,7 +337,7 @@ $0 = Cygwin::win_to_posix_path(Cygwin::posix_to_win_path($0, 1));
EOX
}
if ($^O eq 'os390' or $^O eq 'posix-bc') { # no shebang
- $headmaybe = <<EOH ;
+ $headmaybe = <<EOH ;
eval 'exec ./perl -S \$0 \${1+"\$\@"}'
if 0;
EOH
@@ -356,21 +356,21 @@ EOF
s{is perl}{is $perl}; # for systems where $^X is only a basename
s{\\}{/}g;
if ($Is_MSWin32 || $Is_os2) {
- is uc $_, uc $s1;
+ is uc $_, uc $s1;
} else {
SKIP:
{
- skip "# TODO: Hit bug posix-2058; exec does not setup argv[0] correctly." if ($^O eq "vos");
- is $_, $s1;
+ skip "# TODO: Hit bug posix-2058; exec does not setup argv[0] correctly." if ($^O eq "vos");
+ is $_, $s1;
}
}
$_ = `$perl $script`;
s/\.exe//i if $Is_Dos or $Is_os2 or $Is_Cygwin;
s{\\}{/}g;
if ($Is_MSWin32 || $Is_os2) {
- is uc $_, uc $s1;
+ is uc $_, uc $s1;
} else {
- is $_, $s1;
+ is $_, $s1;
}
ok unlink($script) or diag $!;
# CHECK
@@ -394,7 +394,7 @@ $^O = $orig_osname;
{
#RT #72422
foreach my $p (0, 1) {
- fresh_perl_is(<<"EOP", '2 4 8', undef, "test \$^P = $p");
+ fresh_perl_is(<<"EOP", '2 4 8', undef, "test \$^P = $p");
\$DB::single = 2;
\$DB::trace = 4;
\$DB::signal = 8;
@@ -476,7 +476,7 @@ SKIP: {
# Make sure defined(*{"!"}) before %! does not stop %! from working
is
runperl(
- prog => 'BEGIN { defined *{q-!-} } print qq-ok\n- if tied %!',
+ prog => 'BEGIN { defined *{q-!-} } print qq-ok\n- if tied %!',
),
"ok\n",
'defined *{"!"} does not stop %! from working';
@@ -484,25 +484,25 @@ SKIP: {
# Check that we don't auto-load packages
foreach (['powie::!', 'Errno'],
- ['powie::+', 'Tie::Hash::NamedCapture']) {
+ ['powie::+', 'Tie::Hash::NamedCapture']) {
my ($symbol, $package) = @$_;
SKIP: {
- (my $extension = $package) =~ s|::|/|g;
- skip "$package is statically linked", 2
- if $Config{static_ext} =~ m|\b\Q$extension\E\b|;
- foreach my $scalar_first ('', '$$symbol;') {
- my $desc = qq{Referencing %{"$symbol"}};
- $desc .= qq{ after mentioning \${"$symbol"}} if $scalar_first;
- $desc .= " doesn't load $package";
-
- fresh_perl_is(<<"EOP", 0, {}, $desc);
+ (my $extension = $package) =~ s|::|/|g;
+ skip "$package is statically linked", 2
+ if $Config{static_ext} =~ m|\b\Q$extension\E\b|;
+ foreach my $scalar_first ('', '$$symbol;') {
+ my $desc = qq{Referencing %{"$symbol"}};
+ $desc .= qq{ after mentioning \${"$symbol"}} if $scalar_first;
+ $desc .= " doesn't load $package";
+
+ fresh_perl_is(<<"EOP", 0, {}, $desc);
use strict qw(vars subs);
my \$symbol = '$symbol';
$scalar_first;
1 if %{\$symbol};
print scalar %${package}::;
EOP
- }
+ }
}
}
@@ -528,15 +528,15 @@ is "@+", "10 1 6 10";
my $ok = 0;
# [perl #19330]
{
- local $\ = undef;
- $\++; $\++;
- $ok = $\ eq 2;
+ local $\ = undef;
+ $\++; $\++;
+ $ok = $\ eq 2;
}
ok $ok;
$ok = 0;
{
- local $\ = "a\0b";
- $ok = "a$\b" eq "aa\0bb";
+ local $\ = "a\0b";
+ $ok = "a$\b" eq "aa\0bb";
}
ok $ok;
}
@@ -600,13 +600,13 @@ SKIP: {
# Make sure defined(*{"+"}) before %+ does not stop %+ from working
is
runperl(
- prog => 'BEGIN { defined *{q-+-} } print qq-ok\n- if tied %+',
+ prog => 'BEGIN { defined *{q-+-} } print qq-ok\n- if tied %+',
),
"ok\n",
'defined *{"+"} does not stop %+ from working';
is
runperl(
- prog => 'BEGIN { defined *{q=-=} } print qq-ok\n- if tied %-',
+ prog => 'BEGIN { defined *{q=-=} } print qq-ok\n- if tied %-',
),
"ok\n",
'defined *{"-"} does not stop %- from working';
@@ -617,16 +617,16 @@ SKIP: {
for ( [qw( %- Tie::Hash::NamedCapture )], [qw( $[ arybase )],
[qw( %! Errno )] ) {
- my ($var, $mod) = @$_;
- my $modfile = $mod =~ s|::|/|gr . ".pm";
- fresh_perl_is
- qq 'sub UNIVERSAL::AUTOLOAD{}
- $mod\::foo() if 0;
- $var;
- print "ok\\n" if \$INC{"$modfile"}',
- "ok\n",
- { switches => [ '-X' ] },
- "$var still loads $mod when stash and UNIVERSAL::AUTOLOAD exist";
+ my ($var, $mod) = @$_;
+ my $modfile = $mod =~ s|::|/|gr . ".pm";
+ fresh_perl_is
+ qq 'sub UNIVERSAL::AUTOLOAD{}
+ $mod\::foo() if 0;
+ $var;
+ print "ok\\n" if \$INC{"$modfile"}',
+ "ok\n",
+ { switches => [ '-X' ] },
+ "$var still loads $mod when stash and UNIVERSAL::AUTOLOAD exist";
}
}
@@ -712,100 +712,100 @@ is ++${^MPEN}, 1, '${^MPEN} can be incremented';
SKIP: {
skip("%ENV manipulations fail or aren't safe on $^O", 20)
- if $Is_Dos;
+ if $Is_Dos;
skip "Win32 needs XS for env/shell tests", 20
if $Is_MSWin32 && is_miniperl;
SKIP: {
- skip("clearing \%ENV is not safe when running under valgrind or on VMS")
- if $ENV{PERL_VALGRIND} || $Is_VMS;
-
- $PATH = $ENV{PATH};
- $SYSTEMROOT = $ENV{SYSTEMROOT} if exists $ENV{SYSTEMROOT}; # win32
- $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
- $ENV{foo} = "bar";
- %ENV = ();
- $ENV{PATH} = $PATH;
- $ENV{SYSTEMROOT} = $SYSTEMROOT if defined $SYSTEMROOT;
- $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
- if ($Is_MSWin32) {
- is `set foo 2>NUL`, "";
- } else {
- is `echo \$foo`, "\n";
- }
- }
-
- $ENV{__NoNeSuCh} = 'foo';
- $0 = 'bar';
- env_is(__NoNeSuCh => 'foo', 'setting $0 does not break %ENV');
-
- $ENV{__NoNeSuCh2} = 'foo';
- $ENV{__NoNeSuCh2} = undef;
- env_is(__NoNeSuCh2 => '', 'setting a key as undef does not delete it');
-
- # stringify a glob
- $ENV{foo} = *TODO;
- env_is(foo => '*main::TODO', 'ENV store of stringified glob');
-
- # stringify a ref
- my $ref = [];
- $ENV{foo} = $ref;
- env_is(foo => "$ref", 'ENV store of stringified ref');
-
- # downgrade utf8 when possible
- $bytes = "eh zero \x{A0}";
- utf8::upgrade($chars = $bytes);
- $forced = $ENV{foo} = $chars;
- ok(!utf8::is_utf8($forced) && $forced eq $bytes, 'ENV store downgrades utf8 in SV');
- env_is(foo => $bytes, 'ENV store downgrades utf8 in setenv');
-
- # warn when downgrading utf8 is not possible
- $chars = "X-Day \x{1998}";
- utf8::encode($bytes = $chars);
- {
- my $warned = 0;
- local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /^Wide character in setenv/; print "# @_" };
- $forced = $ENV{foo} = $chars;
- ok($warned == 1, 'ENV store warns about wide characters');
- }
- ok(!utf8::is_utf8($forced) && $forced eq $bytes, 'ENV store encodes high utf8 in SV');
- env_is(foo => $bytes, 'ENV store encodes high utf8 in SV');
-
- # test local $ENV{foo} on existing foo
- {
- local $ENV{__NoNeSuCh};
- { local $TODO = 'exists on %ENV should reflect real env';
- ok(!exists $ENV{__NoNeSuCh}, 'not exists $ENV{existing} during local $ENV{existing}'); }
- env_is(__NoNeLoCaL => '');
- }
- ok(exists $ENV{__NoNeSuCh}, 'exists $ENV{existing} after local $ENV{existing}');
- env_is(__NoNeSuCh => 'foo');
-
- # test local $ENV{foo} on new foo
- {
- local $ENV{__NoNeLoCaL} = 'foo';
- ok(exists $ENV{__NoNeLoCaL}, 'exists $ENV{new} during local $ENV{new}');
- env_is(__NoNeLoCaL => 'foo');
- }
- ok(!exists $ENV{__NoNeLoCaL}, 'not exists $ENV{new} after local $ENV{new}');
- env_is(__NoNeLoCaL => '');
+ skip("clearing \%ENV is not safe when running under valgrind or on VMS")
+ if $ENV{PERL_VALGRIND} || $Is_VMS;
+
+ $PATH = $ENV{PATH};
+ $SYSTEMROOT = $ENV{SYSTEMROOT} if exists $ENV{SYSTEMROOT}; # win32
+ $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
+ $ENV{foo} = "bar";
+ %ENV = ();
+ $ENV{PATH} = $PATH;
+ $ENV{SYSTEMROOT} = $SYSTEMROOT if defined $SYSTEMROOT;
+ $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
+ if ($Is_MSWin32) {
+ is `set foo 2>NUL`, "";
+ } else {
+ is `echo \$foo`, "\n";
+ }
+ }
+
+ $ENV{__NoNeSuCh} = 'foo';
+ $0 = 'bar';
+ env_is(__NoNeSuCh => 'foo', 'setting $0 does not break %ENV');
+
+ $ENV{__NoNeSuCh2} = 'foo';
+ $ENV{__NoNeSuCh2} = undef;
+ env_is(__NoNeSuCh2 => '', 'setting a key as undef does not delete it');
+
+ # stringify a glob
+ $ENV{foo} = *TODO;
+ env_is(foo => '*main::TODO', 'ENV store of stringified glob');
+
+ # stringify a ref
+ my $ref = [];
+ $ENV{foo} = $ref;
+ env_is(foo => "$ref", 'ENV store of stringified ref');
+
+ # downgrade utf8 when possible
+ $bytes = "eh zero \x{A0}";
+ utf8::upgrade($chars = $bytes);
+ $forced = $ENV{foo} = $chars;
+ ok(!utf8::is_utf8($forced) && $forced eq $bytes, 'ENV store downgrades utf8 in SV');
+ env_is(foo => $bytes, 'ENV store downgrades utf8 in setenv');
+
+ # warn when downgrading utf8 is not possible
+ $chars = "X-Day \x{1998}";
+ utf8::encode($bytes = $chars);
+ {
+ my $warned = 0;
+ local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /^Wide character in setenv/; print "# @_" };
+ $forced = $ENV{foo} = $chars;
+ ok($warned == 1, 'ENV store warns about wide characters');
+ }
+ ok(!utf8::is_utf8($forced) && $forced eq $bytes, 'ENV store encodes high utf8 in SV');
+ env_is(foo => $bytes, 'ENV store encodes high utf8 in SV');
+
+ # test local $ENV{foo} on existing foo
+ {
+ local $ENV{__NoNeSuCh};
+ { local $TODO = 'exists on %ENV should reflect real env';
+ ok(!exists $ENV{__NoNeSuCh}, 'not exists $ENV{existing} during local $ENV{existing}'); }
+ env_is(__NoNeLoCaL => '');
+ }
+ ok(exists $ENV{__NoNeSuCh}, 'exists $ENV{existing} after local $ENV{existing}');
+ env_is(__NoNeSuCh => 'foo');
+
+ # test local $ENV{foo} on new foo
+ {
+ local $ENV{__NoNeLoCaL} = 'foo';
+ ok(exists $ENV{__NoNeLoCaL}, 'exists $ENV{new} during local $ENV{new}');
+ env_is(__NoNeLoCaL => 'foo');
+ }
+ ok(!exists $ENV{__NoNeLoCaL}, 'not exists $ENV{new} after local $ENV{new}');
+ env_is(__NoNeLoCaL => '');
SKIP: {
- skip("\$0 check only on Linux and FreeBSD", 2)
- unless $^O =~ /^(linux|android|freebsd)$/
- && open CMDLINE, "/proc/$$/cmdline";
-
- chomp(my $line = scalar <CMDLINE>);
- my $me = (split /\0/, $line)[0];
- is $me, $0, 'altering $0 is effective (testing with /proc/)';
- close CMDLINE;
+ skip("\$0 check only on Linux and FreeBSD", 2)
+ unless $^O =~ /^(linux|android|freebsd)$/
+ && open CMDLINE, "/proc/$$/cmdline";
+
+ chomp(my $line = scalar <CMDLINE>);
+ my $me = (split /\0/, $line)[0];
+ is $me, $0, 'altering $0 is effective (testing with /proc/)';
+ close CMDLINE;
skip("\$0 check with 'ps' only on Linux (but not Android) and FreeBSD", 1) if $^O eq 'android';
# perlbug #22811
my $mydollarzero = sub {
my($arg) = shift;
$0 = $arg if defined $arg;
- # In FreeBSD the ps -o command= will cause
- # an empty header line, grab only the last line.
+ # In FreeBSD the ps -o command= will cause
+ # an empty header line, grab only the last line.
my $ps = (`ps -o command= -p $$`)[-1];
return if $?;
chomp $ps;
@@ -814,19 +814,19 @@ SKIP: {
};
my $ps = $mydollarzero->("x");
ok(!$ps # we allow that something goes wrong with the ps command
- # In Linux 2.4 we would get an exact match ($ps eq 'x') but
- # in Linux 2.2 there seems to be something funny going on:
- # it seems as if the original length of the argv[] would
- # be stored in the proc struct and then used by ps(1),
- # no matter what characters we use to pad the argv[].
- # (And if we use \0:s, they are shown as spaces.) Sigh.
+ # In Linux 2.4 we would get an exact match ($ps eq 'x') but
+ # in Linux 2.2 there seems to be something funny going on:
+ # it seems as if the original length of the argv[] would
+ # be stored in the proc struct and then used by ps(1),
+ # no matter what characters we use to pad the argv[].
+ # (And if we use \0:s, they are shown as spaces.) Sigh.
|| $ps =~ /^x\s*$/
- # FreeBSD cannot get rid of both the leading "perl :"
- # and the trailing " (perl)": some FreeBSD versions
- # can get rid of the first one.
- || ($^O eq 'freebsd' && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/),
- 'altering $0 is effective (testing with `ps`)');
- }
+ # FreeBSD cannot get rid of both the leading "perl :"
+ # and the trailing " (perl)": some FreeBSD versions
+ # can get rid of the first one.
+ || ($^O eq 'freebsd' && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/),
+ 'altering $0 is effective (testing with `ps`)');
+ }
}
# test case-insignificance of %ENV (these tests must be enabled only
--
2.11.0
|
From @ptolemarch0003-runperl-quote-path-to-perl-even-if-stdin-given.patchFrom 3ca4145f975a6ebc2c156a56babd3840a673ff13 Mon Sep 17 00:00:00 2001
From: David Hand <davidhand@davidhand.com>
Date: Sun, 2 Jul 2017 18:56:46 -0400
Subject: [PATCH 3/7] `runperl`: quote path to perl even if stdin given
This is a part of an ongoing patch to allow `make test` to succeed even
if the path to the build directory contains spaces.
---
t/test.pl | 5 ++---
1 file changed, 2 insertions(+), 3 deletions(-)
diff --git a/t/test.pl b/t/test.pl
index c753954dc8..5bf1dc112d 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -631,7 +631,6 @@ my $is_cygwin = $^O eq 'cygwin';
sub _quote_args {
my ($runperl, $args) = @_;
-
foreach (@$args) {
# In VMS protect with doublequotes because otherwise
# DCL will lowercase -- unless already doublequoted.
@@ -703,11 +702,11 @@ sub _create_runperl { # Create the string to qx in runperl().
$args{stdin} =~ s/\r/\\r/g;
if ($is_mswin || $is_netware || $is_vms) {
- $runperl = qq{$Perl -e "print qq(} .
+ $runperl = qq{"$Perl" -e "print qq(} .
$args{stdin} . q{)" | } . $runperl;
}
else {
- $runperl = qq{$Perl -e 'print qq(} .
+ $runperl = qq{'$Perl' -e 'print qq(} .
$args{stdin} . q{)' | } . $runperl;
}
} elsif (exists $args{stdin}) {
--
2.11.0
|
From @ptolemarch0004-In-core-tests-quote-calls-to-perl-binary.patchFrom 37f597f67c0b13bee0eebf2f09dd6b6c13ba17c6 Mon Sep 17 00:00:00 2001
From: David Hand <davidhand@davidhand.com>
Date: Sun, 2 Jul 2017 18:59:30 -0400
Subject: [PATCH 4/7] In core tests, quote calls to perl binary
This is a part of an ongoing patch to allow `make test` to succeed even
if the path to the build directory contains spaces.
---
t/base/term.t | 2 +-
t/io/dup.t | 5 ++++-
t/io/open.t | 1 +
t/io/openpid.t | 13 +++++++------
t/io/pipe.t | 12 +++++++-----
t/io/through.t | 1 +
t/op/alarm.t | 1 +
t/op/die_exit.t | 4 ++--
t/op/exec.t | 6 ++++--
t/op/filetest.t | 1 +
t/op/fork.t | 10 +++++-----
t/op/lex_assign.t | 2 +-
t/op/srand.t | 4 ++--
t/porting/authors.t | 2 +-
t/porting/bench_selftest.t | 2 +-
t/porting/checkcfgvar.t | 2 +-
t/porting/cmp_version.t | 2 +-
t/porting/pending-author.t | 2 +-
t/porting/perlfunc.t | 2 +-
t/porting/regen.t | 2 +-
t/run/cloexec.t | 1 +
t/run/script.t | 1 +
t/run/switchC.t | 2 +-
t/run/switcht.t | 1 +
24 files changed, 48 insertions(+), 33 deletions(-)
diff --git a/t/base/term.t b/t/base/term.t
index 7a16ffdfd0..c51202cf60 100644
--- a/t/base/term.t
+++ b/t/base/term.t
@@ -17,7 +17,7 @@ else {print "not ok 1\n";}
# check `` processing
-$x = `$^X -le "print 'hi there'"`;
+$x = `"$^X" -le "print 'hi there'"`;
if ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";}
# check $#array
diff --git a/t/io/dup.t b/t/io/dup.t
index 8a8b27eabd..dfaf658982 100644
--- a/t/io/dup.t
+++ b/t/io/dup.t
@@ -9,6 +9,9 @@ BEGIN {
use Config;
no warnings 'once';
+my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
+
my $test = 1;
my $tests_needing_perlio = 17;
plan(12 + $tests_needing_perlio);
@@ -29,7 +32,7 @@ print STDOUT "ok 2\n";
print STDERR "ok 3\n";
# Since some systems don't have echo, we use Perl.
-$echo = qq{$^X -le "print q(ok %d)"};
+$echo = qq{$Perl -le "print q(ok %d)"};
$cmd = sprintf $echo, 4;
print `$cmd`;
diff --git a/t/io/open.t b/t/io/open.t
index 6be9f0e842..92d4bfa78e 100644
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -13,6 +13,7 @@ use Config;
plan tests => 156;
my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
my $afile = tempfile();
{
diff --git a/t/io/openpid.t b/t/io/openpid.t
index d3fcf7869a..7a1f32cdec 100644
--- a/t/io/openpid.t
+++ b/t/io/openpid.t
@@ -25,8 +25,9 @@ $| = 1;
$SIG{PIPE} = 'IGNORE';
$SIG{HUP} = 'IGNORE' if $^O eq 'interix';
-my $perl = which_perl();
-$perl .= qq[ "-I../lib"];
+my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
+$Perl .= qq[ "-I../lib"];
#
# commands run 4 perl programs. Two of these programs write a
@@ -35,10 +36,10 @@ $perl .= qq[ "-I../lib"];
# the other reader reads one line, waits a few seconds and then
# exits to test the waitpid function.
#
-$cmd1 = qq/$perl -e "\$|=1; print qq[first process\\n]; sleep 30;"/;
-$cmd2 = qq/$perl -e "\$|=1; print qq[second process\\n]; sleep 30;"/;
-$cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN
-$cmd4 = qq/$perl -e "print scalar <>;"/;
+$cmd1 = qq/$Perl -e "\$|=1; print qq[first process\\n]; sleep 30;"/;
+$cmd2 = qq/$Perl -e "\$|=1; print qq[second process\\n]; sleep 30;"/;
+$cmd3 = qq/$Perl -e "print <>;"/; # hangs waiting for end of STDIN
+$cmd4 = qq/$Perl -e "print scalar <>;"/;
#warn "#$cmd1\n#$cmd2\n#$cmd3\n#$cmd4\n";
diff --git a/t/io/pipe.t b/t/io/pipe.t
index bec1a662b9..6ab1e69b8e 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -14,11 +14,13 @@ else {
}
my $Perl = which_perl();
+my $barePerl = $Perl;
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
$| = 1;
-open(PIPE, "|-") || exec $Perl, '-pe', 'tr/YX/ko/';
+open(PIPE, "|-") || exec $barePerl, '-pe', 'tr/YX/ko/';
printf PIPE "Xk %d - open |- || exec\n", curr_test();
next_test();
@@ -39,7 +41,7 @@ close PIPE;
next_test();
my $tnum = curr_test;
next_test();
- exec $Perl, '-le', "print q{not ok $tnum - again}";
+ exec $barePerl, '-le', "print q{not ok $tnum - again}";
}
# This has to be *outside* the fork
@@ -61,7 +63,7 @@ close PIPE;
}
else {
printf STDOUT "not ok %d - $raw", curr_test();
- exec $Perl, '-e0'; # Do not run END()...
+ exec $barePerl, '-e0'; # Do not run END()...
}
# This has to be *outside* the fork
@@ -82,7 +84,7 @@ close PIPE;
s/^(not ok \d+ -) .*/$1 expect '@r', got '@r1'\n/s;
}
print;
- exec $Perl, '-e0'; # Do not run END()...
+ exec $barePerl, '-e0'; # Do not run END()...
}
# This has to be *outside* the fork
@@ -113,7 +115,7 @@ close PIPE;
my $tnum = curr_test;
next_test;
- exec $Perl, '-le', "print q{not ok $tnum - with fh dup }";
+ exec $barePerl, '-le', "print q{not ok $tnum - with fh dup }";
}
# This has to be done *outside* the fork.
diff --git a/t/io/through.t b/t/io/through.t
index 65a64bbcaf..2ed531c03b 100644
--- a/t/io/through.t
+++ b/t/io/through.t
@@ -11,6 +11,7 @@ BEGIN {
use strict;
my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
my $data = <<'EOD';
x
diff --git a/t/op/alarm.t b/t/op/alarm.t
index 749482c26d..43031f3c4d 100644
--- a/t/op/alarm.t
+++ b/t/op/alarm.t
@@ -14,6 +14,7 @@ if ( !$Config{d_alarm} ) {
plan tests => 5;
my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
my ($start_time, $end_time);
diff --git a/t/op/die_exit.t b/t/op/die_exit.t
index e074913e86..98c852bc12 100644
--- a/t/op/die_exit.t
+++ b/t/op/die_exit.t
@@ -64,10 +64,10 @@ foreach my $test (@tests) {
my($bang, $query, $code) = @$test;
$code ||= 'die;';
if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
- system(qq{$^X -e "\$! = $bang; \$? = $query; $code"});
+ system(qq{"$^X" -e "\$! = $bang; \$? = $query; $code"});
}
else {
- system(qq{$^X -e '\$! = $bang; \$? = $query; $code'});
+ system(qq{'$^X' -e '\$! = $bang; \$? = $query; $code'});
}
my $exit = $?;
diff --git a/t/op/exec.t b/t/op/exec.t
index 11554395b9..bcba4e9c87 100644
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -39,6 +39,8 @@ my $Is_Win32 = $^O eq 'MSWin32';
plan(tests => 25);
my $Perl = which_perl();
+my $barePerl = $Perl;
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
my $exit;
SKIP: {
@@ -59,7 +61,7 @@ is( $exit, 0, ' exited 0' );
# On Unix its the opposite.
my $quote = $Is_VMS || $Is_Win32 ? '"' : '';
$tnum = curr_test();
-$exit = system $Perl, '-le',
+$exit = system $barePerl, '-le',
"${quote}print q{ok $tnum - system(PROG, LIST)}${quote}";
next_test();
is( $exit, 0, ' exited 0' );
@@ -157,5 +159,5 @@ TODO: {
}
my $test = curr_test();
-exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};
+exec $barePerl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};
fail("This should never be reached if the exec() worked");
diff --git a/t/op/filetest.t b/t/op/filetest.t
index 8883381f94..45b5d56c9e 100644
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -296,6 +296,7 @@ isnt(stat _, 1,
# -T and -B
my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
SKIP: {
skip "no -T on filehandles", 8 unless eval { -T STDERR; 1 };
diff --git a/t/op/fork.t b/t/op/fork.t
index be3125d673..a9bf3d5f4a 100644
--- a/t/op/fork.t
+++ b/t/op/fork.t
@@ -29,7 +29,7 @@ SKIP: {
unless $probe eq 'good';
my $out = qx{
- $shell -c 'ulimit -u 1; exec $^X -e "
+ $shell -c 'ulimit -u 1; exec "$^X" -e "
print((() = fork) == 1 ? q[ok] : q[not ok])
"'
};
@@ -253,10 +253,10 @@ $| = 1;
$\ = "\n";
my $getenv;
if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
- $getenv = qq[$^X -e "print \$ENV{TST}"];
+ $getenv = qq["$^X" -e "print \$ENV{TST}"];
}
else {
- $getenv = qq[$^X -e 'print \$ENV{TST}'];
+ $getenv = qq["$^X" -e 'print \$ENV{TST}'];
}
$ENV{TST} = 'foo';
if (fork) {
@@ -477,13 +477,13 @@ child: called as [main::f(foo,bar)]
waitpid() returned ok
########
# Windows 2000: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
-system $^X, "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}";
+system "$^X", "-e", "if (\$pid=fork){sleep 1;kill(9, \$pid)} else {sleep 5}";
print $?>>8, "\n";
EXPECT
0
########
# Windows 7: https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976
-system $^X, "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}";
+system "$^X", "-e", "if (\$pid=fork){kill(9, \$pid)} else {sleep 5}";
print $?>>8, "\n";
EXPECT
0
diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
index e1abde35c9..4003688354 100644
--- a/t/op/lex_assign.t
+++ b/t/op/lex_assign.t
@@ -12,7 +12,7 @@ BEGIN {
$| = 1;
umask 0;
$xref = \ "";
-$runme = $^X;
+$runme = qq{"$^X"};
@a = (1..5);
%h = (1..6);
$aref = \@a;
diff --git a/t/op/srand.t b/t/op/srand.t
index 09de60aa22..57082b6c5c 100644
--- a/t/op/srand.t
+++ b/t/op/srand.t
@@ -52,9 +52,9 @@ ok( !eq_array(\@first_run, \@second_run),
}
# This test checks whether Perl called srand for you.
-@first_run = `$^X -le "print int rand 100 for 1..100"`;
+@first_run = `"$^X" -le "print int rand 100 for 1..100"`;
sleep(1); # in case our srand() is too time-dependent
-@second_run = `$^X -le "print int rand 100 for 1..100"`;
+@second_run = `"$^X" -le "print int rand 100 for 1..100"`;
ok( !eq_array(\@first_run, \@second_run), 'srand() called automatically');
diff --git a/t/porting/authors.t b/t/porting/authors.t
index 563b92a525..b18275204a 100644
--- a/t/porting/authors.t
+++ b/t/porting/authors.t
@@ -12,6 +12,6 @@ find_git_or_skip('all');
# This is the subset of "pretty=fuller" that checkAUTHORS.pl actually needs:
my $quote = $^O =~ /^mswin/i ? q(") : q(');
-system("git log --pretty=format:${quote}Author: %an <%ae>%n${quote} | $^X Porting/checkAUTHORS.pl --tap -");
+system("git log --pretty=format:${quote}Author: %an <%ae>%n${quote} | ${quote}$^X${quote} Porting/checkAUTHORS.pl --tap -");
# EOF
diff --git a/t/porting/bench_selftest.t b/t/porting/bench_selftest.t
index d15474c1c8..933ea4754d 100644
--- a/t/porting/bench_selftest.t
+++ b/t/porting/bench_selftest.t
@@ -7,4 +7,4 @@ use strict;
chdir '..' if -f 'test.pl' && -f 'thread_it.pl';
require './t/test.pl';
-system "$^X -I. -MTestInit Porting/bench.pl --action=selftest";
+system qq{"$^X" -I. -MTestInit Porting/bench.pl --action=selftest};
diff --git a/t/porting/checkcfgvar.t b/t/porting/checkcfgvar.t
index c52f9e2934..bfd1266134 100644
--- a/t/porting/checkcfgvar.t
+++ b/t/porting/checkcfgvar.t
@@ -33,4 +33,4 @@ if ( $Config{usecrosscompile} ) {
skip_all( "Not all files are available during cross-compilation" );
}
-system "$^X -Ilib Porting/checkcfgvar.pl --tap";
+system qq{"$^X" -Ilib Porting/checkcfgvar.pl --tap};
diff --git a/t/porting/cmp_version.t b/t/porting/cmp_version.t
index 18b3e57510..15fc66a9bd 100644
--- a/t/porting/cmp_version.t
+++ b/t/porting/cmp_version.t
@@ -27,4 +27,4 @@ require './t/test.pl';
my $source = find_git_or_skip('all');
chdir $source or die "Can't chdir to $source: $!";
-system "$^X Porting/cmpVERSION.pl --tap";
+system qq{"$^X" Porting/cmpVERSION.pl --tap};
diff --git a/t/porting/pending-author.t b/t/porting/pending-author.t
index 0aaa546ad6..97badd2d71 100644
--- a/t/porting/pending-author.t
+++ b/t/porting/pending-author.t
@@ -54,7 +54,7 @@ sub get {
my $email = get('email');
my $name = get('name');
-open my $fh, '|-', "$^X Porting/checkAUTHORS.pl --tap -"
+open my $fh, '|-', qq{"$^X" Porting/checkAUTHORS.pl --tap -}
or die $!;
print $fh "Author: $name <$email>\n";
close $fh or die $!;
diff --git a/t/porting/perlfunc.t b/t/porting/perlfunc.t
index 61e072816c..aea5a3b7c0 100644
--- a/t/porting/perlfunc.t
+++ b/t/porting/perlfunc.t
@@ -38,4 +38,4 @@ if ( ord("A") == 193) {
exit 0;
}
-system "$^X ext/Pod-Functions/Functions_pm.PL --tap pod/perlfunc.pod";
+system qq{"$^X" ext/Pod-Functions/Functions_pm.PL --tap pod/perlfunc.pod};
diff --git a/t/porting/regen.t b/t/porting/regen.t
index f296626d15..5f9e6bae71 100644
--- a/t/porting/regen.t
+++ b/t/porting/regen.t
@@ -104,7 +104,7 @@ OUTER: foreach my $file (@files) {
}
foreach (@progs) {
- my $command = "$^X -I. $_ --tap";
+ my $command = qq{"$^X" -I. $_ --tap};
system $command
and die "Failed to run $command: $?";
}
diff --git a/t/run/cloexec.t b/t/run/cloexec.t
index f767267f94..ff65d70535 100644
--- a/t/run/cloexec.t
+++ b/t/run/cloexec.t
@@ -56,6 +56,7 @@ sub make_tmp_file {
}
my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
my $quote = "'";
my $tmperr = tempfile();
diff --git a/t/run/script.t b/t/run/script.t
index fa61a2ce33..c3ed2b4389 100644
--- a/t/run/script.t
+++ b/t/run/script.t
@@ -8,6 +8,7 @@ BEGIN {
}
my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
my $filename = tempfile();
diff --git a/t/run/switchC.t b/t/run/switchC.t
index 6583010551..f9cccb4533 100644
--- a/t/run/switchC.t
+++ b/t/run/switchC.t
@@ -35,7 +35,7 @@ SKIP: {
($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) {
skip(qq[cannot test with PERL_UNICODE "" or /[SO]/], 1);
}
- $r = runperl( switches => [ '-CI', '-w' ],
+ $r = runperl( debug => 0, switches => [ '-CI', '-w' ],
prog => 'print ord(<STDIN>)',
stderr => 1,
stdin => $b );
diff --git a/t/run/switcht.t b/t/run/switcht.t
index 01b9f2f623..82c186eef3 100644
--- a/t/run/switcht.t
+++ b/t/run/switcht.t
@@ -9,6 +9,7 @@ BEGIN {
plan tests => 13;
my $Perl = which_perl();
+$Perl = qq{"$Perl"} if $Perl =~ m/\s/;
my $warning;
local $SIG{__WARN__} = sub { $warning = join "\n", @_; };
--
2.11.0
|
From @ptolemarch0005-Skip-test-of-script-if-builddir-path-has-space.patchFrom f2a5337db18983d803fcbf7aaca0f30a6a41a8b9 Mon Sep 17 00:00:00 2001
From: David Hand <davidhand@davidhand.com>
Date: Mon, 3 Jul 2017 00:02:52 -0400
Subject: [PATCH 5/7] Skip test of #! script if builddir path has space
Scripts using #! lines to identify the interpreter cannot have a space
in the path to the interpreter. The kernel parses the #! line, and it
offers no way to quote paths nor to escape spaces in the path. The
overall test should not fail in such a case. Instead, the subtest
should be skipped.
This is a part of an ongoing patch to allow `make test` to succeed even
if the path to the build directory contains spaces.
---
t/op/magic.t | 33 ++++++++++++++++++++-------------
1 file changed, 20 insertions(+), 13 deletions(-)
diff --git a/t/op/magic.t b/t/op/magic.t
index ea93a9a6ee..f113858b06 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -351,20 +351,27 @@ print "\$^X is $^X, \$0 is $0\n";
EOF
ok close(SCRIPT) or diag $!;
ok chmod(0755, $script) or diag $!;
- $_ = $Is_VMS ? `$perl $script` : `$script`;
- s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
- s{is perl}{is $perl}; # for systems where $^X is only a basename
- s{\\}{/}g;
- if ($Is_MSWin32 || $Is_os2) {
- is uc $_, uc $s1;
- } else {
- SKIP:
- {
- skip "# TODO: Hit bug posix-2058; exec does not setup argv[0] correctly." if ($^O eq "vos");
- is $_, $s1;
- }
+ SKIP: {
+ # If there's a space in the path to the build directory, there'll be a
+ # space in the #! line, and that's basically just guaranteed never to work.
+ skip "#! line: build directory path contains spaces"
+ if $perl =~ m/\s/;
+ $_ = $Is_VMS ? `$perl $script` : `$script`;
+ s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
+ s{is perl}{is $perl}; # for systems where $^X is only a basename
+ s{\\}{/}g;
+ if ($Is_MSWin32 || $Is_os2) {
+ is uc $_, uc $s1;
+ } else {
+ SKIP: {
+ skip "# TODO: Hit bug posix-2058; exec does not setup argv[0] correctly."
+ if ($^O eq "vos");
+ is $_, $s1;
+ }
+ }
}
- $_ = `$perl $script`;
+
+ $_ = `"$perl" "$script"`;
s/\.exe//i if $Is_Dos or $Is_os2 or $Is_Cygwin;
s{\\}{/}g;
if ($Is_MSWin32 || $Is_os2) {
--
2.11.0
|
From @ptolemarch0006-In-core-module-tests-quote-calls-to-perl-binary.patchFrom 1fb21c386c2ca17d6c0ad75ba9be3f0d8ca9fe38 Mon Sep 17 00:00:00 2001
From: David Hand <davidhand@davidhand.com>
Date: Sun, 9 Jul 2017 01:20:28 -0400
Subject: [PATCH 6/7] In core module tests, quote calls to perl binary
This is a part of an ongoing patch to allow `make test` to succeed even
if the path to the build directory contains spaces.
---
dist/Devel-SelfStubber/t/Devel-SelfStubber.t | 1 +
dist/IO/t/io_dup.t | 2 +-
ext/B/t/showlex.t | 2 +-
ext/B/t/terse.t | 2 +-
ext/IPC-Open3/t/IPC-Open3.t | 2 +-
ext/Pod-Functions/t/Functions.t | 2 +-
lib/B/Deparse.t | 32 ++++++++++++++--------------
lib/h2xs.t | 4 ++--
t/lib/warnings/doio | 4 ++--
t/lib/warnings/op | 4 ++--
10 files changed, 28 insertions(+), 27 deletions(-)
diff --git a/dist/Devel-SelfStubber/t/Devel-SelfStubber.t b/dist/Devel-SelfStubber/t/Devel-SelfStubber.t
index 48e27cd073..841d7b8eeb 100644
--- a/dist/Devel-SelfStubber/t/Devel-SelfStubber.t
+++ b/dist/Devel-SelfStubber/t/Devel-SelfStubber.t
@@ -5,6 +5,7 @@ use Devel::SelfStubber;
use File::Spec::Functions;
my $runperl = $^X;
+$runperl = qq{"$runperl"} if $runperl =~ m/\s/;
# ensure correct output ordering for system() calls
diff --git a/dist/IO/t/io_dup.t b/dist/IO/t/io_dup.t
index 6afc96a272..1c8bd13a8b 100644
--- a/dist/IO/t/io_dup.t
+++ b/dist/IO/t/io_dup.t
@@ -34,7 +34,7 @@ print $stdout "ok 2\n";
print $stderr "ok 3\n";
# Since some systems don't have echo, we use Perl.
-$echo = qq{$^X -le "print q(ok %d)"};
+$echo = qq{"$^X" -le "print q(ok %d)"};
$cmd = sprintf $echo, 4;
print `$cmd`;
diff --git a/ext/B/t/showlex.t b/ext/B/t/showlex.t
index f92ac9ea7e..504567a09a 100644
--- a/ext/B/t/showlex.t
+++ b/ext/B/t/showlex.t
@@ -28,7 +28,7 @@ my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
if ($is_thread) {
ok "# use5005threads: test skipped\n";
} else {
- $a = `$^X $path "-MO=Showlex" -e "my \@one" 2>&1`;
+ $a = `"$^X" $path "-MO=Showlex" -e "my \@one" 2>&1`;
like ($a, qr/undef.*: \([^)]*\) \@one.*Nullsv.*AV/s,
"canonical usage works");
}
diff --git a/ext/B/t/terse.t b/ext/B/t/terse.t
index 26e2e76054..b27c6699f5 100644
--- a/ext/B/t/terse.t
+++ b/ext/B/t/terse.t
@@ -91,7 +91,7 @@ sub bar {
# Schwern's example of finding an RV
my $path = join " ", map { qq["-I$_"] } @INC;
-my $items = qx{$^X $path "-MO=Terse" -le "print \\42" 2>&1};
+my $items = qx{"$^X" $path "-MO=Terse" -le "print \\42" 2>&1};
if( $] >= 5.011 ) {
like( $items, qr/IV $hex \\42/, 'RV (but now stored in an IV)' );
} else {
diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t
index aa196e5cf2..e9ecede1bc 100644
--- a/ext/IPC-Open3/t/IPC-Open3.t
+++ b/ext/IPC-Open3/t/IPC-Open3.t
@@ -134,7 +134,7 @@ EOF
# for understanding of Config{'sh'} test see exec description in camel book
my $cmd = 'print(scalar(<STDIN>))';
$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd);
-$pid = eval { open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
+$pid = eval { open3 'WRITE', '>&STDOUT', 'ERROR', qq{"$perl" -e } . $cmd; };
if ($@) {
print "error $@\n";
++$test;
diff --git a/ext/Pod-Functions/t/Functions.t b/ext/Pod-Functions/t/Functions.t
index 2beccc1ac6..38f214ba0a 100644
--- a/ext/Pod-Functions/t/Functions.t
+++ b/ext/Pod-Functions/t/Functions.t
@@ -47,7 +47,7 @@ SKIP: {
my $test_out = do { local $/; <DATA> };
skip( "Can't fork '$^X': $!", 1)
- unless open my $fh, qq[$^X "-I../../lib" Functions.pm |];
+ unless open my $fh, qq["$^X" "-I../../lib" Functions.pm |];
my $fake_out = do { local $/; <$fh> };
skip( "Pipe error: $!", 1)
unless close $fh;
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 57c523c6cb..5a8b5e0def 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -129,7 +129,7 @@ is($val->[0], 'hello', 'and return the correct value');
my $path = join " ", map { qq["-I$_"] } @INC;
-$a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 2>&1`;
+$a = `"$^X" $path "-MO=Deparse" -anlwi.bak -e 1 2>&1`;
$a =~ s/-e syntax OK\n//g;
$a =~ s/.*possible typo.*\n//; # Remove warning line
$a =~ s/.*-i used with no filenames.*\n//; # Remove warning line
@@ -147,7 +147,7 @@ $b =~ s/our\\\(\\\@F\\\)/our[( ]\@F\\)?/; # accept both our @F and our(@F)
like($a, qr/$b/,
'command line flags deparse as BEGIN blocks setting control variables');
-$a = `$^X $path "-MO=Deparse" -e "use constant PI => 4" 2>&1`;
+$a = `"$^X" $path "-MO=Deparse" -e "use constant PI => 4" 2>&1`;
$a =~ s/-e syntax OK\n//g;
is($a, "use constant ('PI', 4);\n",
"Proxy Constant Subroutines must not show up as (incorrect) prototypes");
@@ -194,7 +194,7 @@ eval <<EOFCODE and test($x);
EOFCODE
# Exotic sub declarations
-$a = `$^X $path "-MO=Deparse" -e "sub ::::{}sub ::::::{}" 2>&1`;
+$a = `"$^X" $path "-MO=Deparse" -e "sub ::::{}sub ::::::{}" 2>&1`;
$a =~ s/-e syntax OK\n//g;
is($a, <<'EOCODG', "sub :::: and sub ::::::");
sub :::: {
@@ -206,7 +206,7 @@ sub :::::: {
EOCODG
# [perl #117311]
-$a = `$^X $path "-MO=Deparse,-l" -e "map{ eval(0) }()" 2>&1`;
+$a = `"$^X" $path "-MO=Deparse,-l" -e "map{ eval(0) }()" 2>&1`;
$a =~ s/-e syntax OK\n//g;
is($a, <<'EOCODH', "[perl #117311] [PATCH] -l option ('#line ...') does not emit ^Ls in the output");
#line 1 "-e"
@@ -230,7 +230,7 @@ EOCODE
# [perl #62500]
$a =
- `$^X $path "-MO=Deparse" -e "BEGIN{*CORE::GLOBAL::require=sub{1}}" 2>&1`;
+ `"$^X" $path "-MO=Deparse" -e "BEGIN{*CORE::GLOBAL::require=sub{1}}" 2>&1`;
$a =~ s/-e syntax OK\n//g;
is($a, <<'EOCODF', "CORE::GLOBAL::require override causing panick");
sub BEGIN {
@@ -243,7 +243,7 @@ EOCODF
# [perl #91384]
$a =
- `$^X $path "-MO=Deparse" -e "BEGIN{*Acme::Acme:: = *Acme::}" 2>&1`;
+ `"$^X" $path "-MO=Deparse" -e "BEGIN{*Acme::Acme:: = *Acme::}" 2>&1`;
like($a, qr/-e syntax OK/,
"Deparse does not hang when traversing stash circularities");
@@ -260,7 +260,7 @@ q<{
# Strict hints in %^H are mercilessly suppressed
$a =
- `$^X $path "-MO=Deparse" -e "use strict; print;" 2>&1`;
+ `"$^X" $path "-MO=Deparse" -e "use strict; print;" 2>&1`;
unlike($a, qr/BEGIN/,
"Deparse does not emit strict hh hints");
@@ -281,7 +281,7 @@ SKIP: {
}
# multiple statements on format lines
-$a = `$^X $path "-MO=Deparse" -e "format =" -e "\@" -e "x();z()" -e. 2>&1`;
+$a = `"$^X" $path "-MO=Deparse" -e "format =" -e "\@" -e "x();z()" -e. 2>&1`;
$a =~ s/-e syntax OK\n//g;
is($a, <<'EOCODH', 'multiple statements on format lines');
format STDOUT =
@@ -321,7 +321,7 @@ $x
EOCODN
# CORE::format
-$a = readpipe qq`$^X $path "-MO=Deparse" -e "use feature q|:all|;`
+$a = readpipe qq`"$^X" $path "-MO=Deparse" -e "use feature q|:all|;`
.qq` my sub format; CORE::format =" -e. 2>&1`;
like($a, qr/CORE::format/, 'CORE::format when lex format sub is in scope');
@@ -334,7 +334,7 @@ is($deparse->coderef2text(sub{ use utf8; /€/; }),
# STDERR when deparsing sub calls
# For a short while the output included 'While deparsing'
-$a = `$^X $path "-MO=Deparse" -e "foo()" 2>&1`;
+$a = `"$^X" $path "-MO=Deparse" -e "foo()" 2>&1`;
$a =~ s/-e syntax OK\n//g;
is($a, <<'EOCODI', 'no extra output when deparsing foo()');
foo();
@@ -370,26 +370,26 @@ sub _121050empty ( ) {
EOCODP
# CORE::no
-$a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
+$a = readpipe qq`"$^X" $path "-MO=Deparse" -Xe `
.qq`"use feature q|:all|; my sub no; CORE::no less" 2>&1`;
like($a, qr/my sub no;\n.*CORE::no less;/s,
'CORE::no after my sub no');
# CORE::use
-$a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
+$a = readpipe qq`"$^X" $path "-MO=Deparse" -Xe `
.qq`"use feature q|:all|; my sub use; CORE::use less" 2>&1`;
like($a, qr/my sub use;\n.*CORE::use less;/s,
'CORE::use after my sub use');
# CORE::__DATA__
-$a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
+$a = readpipe qq`"$^X" $path "-MO=Deparse" -Xe `
.qq`"use feature q|:all|; my sub __DATA__; `
.qq`CORE::__DATA__" 2>&1`;
like($a, qr/my sub __DATA__;\n.*CORE::__DATA__/s,
'CORE::__DATA__ after my sub __DATA__');
# sub declarations
-$a = readpipe qq`$^X $path "-MO=Deparse" -e "sub foo{}" 2>&1`;
+$a = readpipe qq`"$^X" $path "-MO=Deparse" -e "sub foo{}" 2>&1`;
like($a, qr/sub foo\s*\{\s+\}/, 'sub declarations');
like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ],
prog => 'sub f($); sub f($){}'),
@@ -422,7 +422,7 @@ SKIP : {
}
}';
$prog =~ s/\n//g;
- $a = readpipe qq`$^X $path "-MO=Deparse" -e "$prog" 2>&1`;
+ $a = readpipe qq`"$^X" $path "-MO=Deparse" -e "$prog" 2>&1`;
$a =~ s/-e syntax OK\n//g;
is($a, <<'EOCODJ', 'BEGIN blocks');
sub BEGIN {
@@ -477,7 +477,7 @@ like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ],
# [perl #115066]
my $prog = 'use constant FOO => do { 1 }; no overloading; die';
-$a = readpipe qq`$^X $path "-MO=-qq,Deparse" -e "$prog" 2>&1`;
+$a = readpipe qq`"$^X" $path "-MO=-qq,Deparse" -e "$prog" 2>&1`;
is($a, <<'EOCODK', '[perl #115066] use statements accidentally nested');
use constant ('FOO', do {
1
diff --git a/lib/h2xs.t b/lib/h2xs.t
index 69746a52b3..096361ba74 100644
--- a/lib/h2xs.t
+++ b/lib/h2xs.t
@@ -58,7 +58,7 @@ if (!(-e $extracted_program)) {
exit 0;
}
# You might also wish to bail out if your perl platform does not
-# do `$^X -e 'warn "Writing h2xst"' 2>&1`; duplicity.
+# do `"$^X" -e 'warn "Writing h2xst"' 2>&1`; duplicity.
# ok on unix, nt, VMS, ...
my $dupe = '2>&1';
@@ -180,7 +180,7 @@ while (my ($args, $version, $expectation) = splice @tests, 0, 3) {
# h2xs warns about what it is writing hence the (possibly unportable)
# 2>&1 dupe:
# does it run?
- my $prog = "$^X $lib $extracted_program $args $dupe";
+ my $prog = qq{"$^X" $lib $extracted_program $args $dupe};
@result = `$prog`;
cmp_ok ($?, "==", 0, "running $prog ");
$result = join("",@result);
diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index baa6b97006..927b7e9706 100644
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@@ -60,10 +60,10 @@
__END__
# doio.c [Perl_do_open9]
use warnings 'io' ;
-open(F, '|'."$^X -e 1|");
+open(F, '|'.qq{"$^X" -e 1|});
close(F);
no warnings 'io' ;
-open(G, '|'."$^X -e 1|");
+open(G, '|'.qq{"$^X" -e 1|});
close(G);
EXPECT
Can't open bidirectional pipe at - line 3.
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index b128eec29b..65a7b95946 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -1058,7 +1058,7 @@ Format FRED redefined at - line 5.
########
# op.c
use warnings 'exec' ;
-exec "$^X -e 1" ;
+exec qq{"$^X" -e 1} ;
my $a
EXPECT
Statement unlikely to be reached at - line 4.
@@ -1066,7 +1066,7 @@ Statement unlikely to be reached at - line 4.
########
# op.c, no warning if exec isn't a statement.
use warnings 'exec' ;
-$a || exec "$^X -e 1" ;
+$a || exec qq{"$^X" -e 1} ;
my $a
EXPECT
########
--
2.11.0
|
From @ptolemarch0007-Path-in-warning-can-contain-spaces.patchFrom e5b3feb623c1b41ed3c2fa81555bcdc0b064d420 Mon Sep 17 00:00:00 2001
From: David Hand <davidhand@davidhand.com>
Date: Sun, 9 Jul 2017 01:21:37 -0400
Subject: [PATCH 7/7] Path in warning can contain spaces
That said, with this change, the path listed in this warning still
cannot contain newlines. This may itself be too restrictive...
This is a part of an ongoing patch to allow `make test` to succeed even
if the path to the build directory contains spaces.
---
ext/Pod-Html/t/feature2.t | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/ext/Pod-Html/t/feature2.t b/ext/Pod-Html/t/feature2.t
index dfafbe9e40..a6b99e5323 100644
--- a/ext/Pod-Html/t/feature2.t
+++ b/ext/Pod-Html/t/feature2.t
@@ -27,7 +27,7 @@ convert_n_test("feature2", "misc pod-html features 2",
like($warn,
qr(
\Acaching\ directories\ for\ later\ use\n
- Converting\ input\ file\ \S+[/\\\]]feature2\.pod\n\z
+ Converting\ input\ file\ \N+[/\\\]]feature2\.pod\n\z
)x,
"misc pod-html --verbose warnings");
--
2.11.0
|
From @jkeenanOn Sun, 09 Jul 2017 07:23:28 GMT, davidhand@davidhand.com wrote:
You might want to hold off on doing this until the feature change you are requesting in 131723 is accepted.
-- |
|
The RT System itself - Status changed from 'new' to 'open' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#131724 (status was 'open')
Searchable as RT131724$
The text was updated successfully, but these errors were encountered: