Front page | perl.perl6.language.strict |
Postings from February 2001
[PATCH perl.c] Fixing PERL5OPT (was Re: Warnings, strict, and CPAN)
From:
schwern
Date:
February 17, 2001 22:11
Subject:
[PATCH perl.c] Fixing PERL5OPT (was Re: Warnings, strict, and CPAN)
Message ID:
20010218011135.A19957@magnonel.guild.net
On Sun, Feb 18, 2001 at 04:45:46AM +0000, Simon Cozens wrote:
> On Sat, Feb 17, 2001 at 05:00:51PM -0800, Peter Scott wrote:
> > Simon Cozens submitted a patch which failed the test
>
> ...and MJD and Jarkko and I worked on it and we put together something
> which was OK.
Both Simon's and Peter's patches...
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-11/msg01131.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-02/msg00913.html
Fail mjd's (revised) test suite.
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-11/msg01256.html
Fortunately, its the test suite that's wrong! :) Doncha love a happy
ending?
Here's the code patch against bleedperl along with a revised version
of mjd's suite. The revision of the test isn't quite complete. What
should really be done to prevent future mis-failures is compare
PERL5OPT switches vs those on the command line. Something like:
PERL5OPT='-Mstrict -w' ./perl -e 'print $::x'
./perl -Mstrict -w -e 'print $::x'
The proper way to write the test is to make sure both do the same thing.
But this is good enough for now.
--- t/run/runenv.t 2001/02/18 05:58:06 1.1
+++ t/run/runenv.t 2001/02/18 06:09:10
@@ -0,0 +1,137 @@
+#!./perl
+#
+# Tests for Perl run-time environment variable settings
+#
+# $PERL5OPT, $PERL5LIB, etc.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+my $STDOUT = './results-0';
+my $STDERR = './results-1';
+my $PERL = './perl';
+my $FAILURE_CODE = 119;
+
+print "1..9\n";
+
+# Run perl with specified environment and arguments returns a list.
+# First element is true iff Perl's stdout and stderr match the
+# supplied $stdout and $stderr argument strings exactly.
+# second element is an explanation of the failure
+sub runperl {
+ local *F;
+ my ($env, $args, $stdout, $stderr) = @_;
+
+ unshift @$args, '-I../lib';
+
+ $stdout = '' unless defined $stdout;
+ $stderr = '' unless defined $stderr;
+ my $pid = fork;
+ return (0, "Couldn't fork: $!") unless defined $pid; # failure
+ if ($pid) { # parent
+ my ($actual_stdout, $actual_stderr);
+ wait;
+ return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
+
+ open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
+ { local $/; $actual_stdout = <F> }
+ open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
+ { local $/; $actual_stderr = <F> }
+
+ if ($actual_stdout ne $stdout) {
+ return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
+ } elsif ($actual_stderr ne $stderr) {
+ return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
+ } else {
+ return 1; # success
+ }
+ } else { # child
+ for my $k (keys %$env) {
+ $ENV{$k} = $env->{$k};
+ }
+ open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
+ open STDERR, "> $STDERR" or it_didnt_work();
+ { exec $PERL, @$args }
+ it_didnt_work();
+ }
+}
+
+
+sub it_didnt_work {
+ print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
+ exit $FAILURE_CODE;
+}
+
+sub try {
+ my $testno = shift;
+ my ($success, $reason) = runperl(@_);
+ if ($success) {
+ print "ok $testno\n";
+ } else {
+ $reason =~ s/\n/\\n/g;
+ print "not ok $testno # $reason\n";
+ }
+}
+
+# PERL5OPT Command-line options (switches). Switches in
+# this variable are taken as if they were on
+# every Perl command line. Only the -[DIMUdmw]
+# switches are allowed. When running taint
+# checks (because the program was running setuid
+# or setgid, or the -T switch was used), this
+# variable is ignored. If PERL5OPT begins with
+# -T, tainting will be enabled, and any
+# subsequent options ignored.
+
+my $T = 1;
+try($T++, {PERL5OPT => '-w'}, ['-e', 'print $::x'],
+ "",
+ qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n});
+
+try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
+ "", "");
+
+try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
+ "",
+ qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
+ "",
+ qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
+ "",
+ <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value in print at -e line 1.
+ERROR
+ );
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
+ "",
+ <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value in print at -e line 1.
+ERROR
+ );
+
+try($T++, {PERL5OPT => '-MExporter'}, ['-e0'],
+ "",
+ "");
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
+ "",
+ "");
+
+try($T++, {PERL5OPT => '-Mstrict -Mwarnings'},
+ ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
+ "ok",
+ "");
+
+print "# ", $T-1, " tests total.\n";
--- MANIFEST 2001/02/18 03:28:09 1.2
+++ MANIFEST 2001/02/18 06:00:15
@@ -1715,6 +1715,7 @@
t/pragma/warn/utf8 Tests for utf8.c for warnings.t
t/pragma/warn/util Tests for util.c for warnings.t
t/pragma/warnings.t See if warning controls work
+t/run/runenv.t Test if perl honors its environment variables.
taint.c Tainting code
thrdvar.h Per-thread variables
thread.h Threading header
--- perl.c 2001/02/18 05:32:53 1.1
+++ perl.c 2001/02/18 05:43:51
@@ -1173,6 +1173,7 @@
PL_tainting = TRUE;
else {
while (s && *s) {
+ char *d;
while (isSPACE(*s))
s++;
if (*s == '-') {
@@ -1180,11 +1181,18 @@
if (isSPACE(*s))
continue;
}
+ d = s;
if (!*s)
break;
if (!strchr("DIMUdmw", *s))
Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
- s = moreswitches(s);
+ while (++s && *s) {
+ if (isSPACE(*s)) {
+ *s++ = '\0';
+ break;
+ }
+ }
+ moreswitches(d);
}
}
}