This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fixing PERL5OPT (was Re: Warnings, strict, and CPAN)
[perl5.git] / t / run / runenv.t
1 #!./perl
2 #
3 # Tests for Perl run-time environment variable settings
4 #
5 # $PERL5OPT, $PERL5LIB, etc.
6
7 BEGIN {
8     chdir 't' if -d 't';
9     @INC = '../lib';
10 }
11
12 my $STDOUT = './results-0';
13 my $STDERR = './results-1';
14 my $PERL = './perl';
15 my $FAILURE_CODE = 119;
16
17 print "1..9\n";
18
19 # Run perl with specified environment and arguments returns a list.
20 # First element is true iff Perl's stdout and stderr match the
21 # supplied $stdout and $stderr argument strings exactly.
22 # second element is an explanation of the failure
23 sub runperl {
24   local *F;
25   my ($env, $args, $stdout, $stderr) = @_;
26
27   unshift @$args, '-I../lib';
28
29   $stdout = '' unless defined $stdout;
30   $stderr = '' unless defined $stderr;
31   my $pid = fork;
32   return (0, "Couldn't fork: $!") unless defined $pid;   # failure
33   if ($pid) {                   # parent
34     my ($actual_stdout, $actual_stderr);
35     wait;
36     return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
37
38     open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
39     { local $/; $actual_stdout = <F> }
40     open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
41     { local $/; $actual_stderr = <F> }
42
43     if ($actual_stdout ne $stdout) {
44       return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
45     } elsif ($actual_stderr ne $stderr) {
46       return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
47     } else {
48       return 1;                 # success
49     }
50   } else {                      # child
51     for my $k (keys %$env) {
52       $ENV{$k} = $env->{$k};
53     }
54     open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
55     open STDERR, "> $STDERR" or it_didnt_work();
56     { exec $PERL, @$args }
57     it_didnt_work();
58   }
59 }
60
61
62 sub it_didnt_work {
63     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
64     exit $FAILURE_CODE;
65 }
66
67 sub try {
68   my $testno = shift;
69   my ($success, $reason) = runperl(@_);
70   if ($success) {
71     print "ok $testno\n";
72   } else {
73     $reason =~ s/\n/\\n/g;
74     print "not ok $testno # $reason\n";    
75   }
76 }
77
78 #  PERL5OPT    Command-line options (switches).  Switches in
79 #                    this variable are taken as if they were on
80 #                    every Perl command line.  Only the -[DIMUdmw]
81 #                    switches are allowed.  When running taint
82 #                    checks (because the program was running setuid
83 #                    or setgid, or the -T switch was used), this
84 #                    variable is ignored.  If PERL5OPT begins with
85 #                    -T, tainting will be enabled, and any
86 #                    subsequent options ignored.
87
88 my  $T = 1;
89 try($T++, {PERL5OPT => '-w'}, ['-e', 'print $::x'],
90     "", 
91     qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n});
92
93 try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
94     "", "");
95
96 try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
97     "", 
98     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
99
100 # Fails in 5.6.0
101 try($T++, {PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
102     "", 
103     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
104
105 # Fails in 5.6.0
106 try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
107     "", 
108     <<ERROR
109 Name "main::x" used only once: possible typo at -e line 1.
110 Use of uninitialized value in print at -e line 1.
111 ERROR
112     );
113
114 # Fails in 5.6.0
115 try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
116     "", 
117     <<ERROR
118 Name "main::x" used only once: possible typo at -e line 1.
119 Use of uninitialized value in print at -e line 1.
120 ERROR
121     );
122
123 try($T++, {PERL5OPT => '-MExporter'}, ['-e0'],
124     "", 
125     "");
126
127 # Fails in 5.6.0
128 try($T++, {PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
129     "", 
130     "");
131
132 try($T++, {PERL5OPT => '-Mstrict -Mwarnings'}, 
133     ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
134     "ok",
135     "");
136
137 print "# ", $T-1, " tests total.\n";