This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
317784ae3189052dbe08aba761eb2e7d257180fc
[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     require Config; import Config;
11     unless ($Config{'d_fork'}) {
12         print "1..0 # Skip: no fork\n";
13             exit 0;
14     }
15 }
16
17 use Test;
18
19 plan tests => 15;
20
21 my $STDOUT = './results-0';
22 my $STDERR = './results-1';
23 my $PERL = './perl';
24 my $FAILURE_CODE = 119;
25
26 # Run perl with specified environment and arguments returns a list.
27 # First element is true if Perl's stdout and stderr match the
28 # supplied $stdout and $stderr argument strings exactly.
29 # second element is an explanation of the failure
30 sub runperl {
31   local *F;
32   my ($env, $args, $stdout, $stderr) = @_;
33
34   unshift @$args, '-I../lib';
35
36   $stdout = '' unless defined $stdout;
37   $stderr = '' unless defined $stderr;
38   my $pid = fork;
39   return (0, "Couldn't fork: $!") unless defined $pid;   # failure
40   if ($pid) {                   # parent
41     my ($actual_stdout, $actual_stderr);
42     wait;
43     return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
44
45     open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
46     { local $/; $actual_stdout = <F> }
47     open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
48     { local $/; $actual_stderr = <F> }
49
50     if ($actual_stdout ne $stdout) {
51       return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
52     } elsif ($actual_stderr ne $stderr) {
53       return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
54     } else {
55       return 1;                 # success
56     }
57   } else {                      # child
58     for my $k (keys %$env) {
59       $ENV{$k} = $env->{$k};
60     }
61     open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
62     open STDERR, "> $STDERR" or it_didnt_work();
63     { exec $PERL, @$args }
64     it_didnt_work();
65   }
66 }
67
68
69 sub it_didnt_work {
70     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
71     exit $FAILURE_CODE;
72 }
73
74 sub try {
75   my ($success, $reason) = runperl(@_);
76   $reason =~ s/\n/\\n/g if defined $reason;
77   ok( !!$success, 1, $reason );
78 }
79
80 #  PERL5OPT    Command-line options (switches).  Switches in
81 #                    this variable are taken as if they were on
82 #                    every Perl command line.  Only the -[DIMUdmtw]
83 #                    switches are allowed.  When running taint
84 #                    checks (because the program was running setuid
85 #                    or setgid, or the -T switch was used), this
86 #                    variable is ignored.  If PERL5OPT begins with
87 #                    -T, tainting will be enabled, and any
88 #                    subsequent options ignored.
89
90 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
91     "", 
92     qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n});
93
94 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
95     "", "");
96
97 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
98     "", 
99     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
100
101 # Fails in 5.6.0
102 try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
103     "", 
104     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
105
106 # Fails in 5.6.0
107 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
108     "", 
109     <<ERROR
110 Name "main::x" used only once: possible typo at -e line 1.
111 Use of uninitialized value in print at -e line 1.
112 ERROR
113     );
114
115 # Fails in 5.6.0
116 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
117     "", 
118     <<ERROR
119 Name "main::x" used only once: possible typo at -e line 1.
120 Use of uninitialized value in print at -e line 1.
121 ERROR
122     );
123
124 try({PERL5OPT => '-MExporter'}, ['-e0'],
125     "", 
126     "");
127
128 # Fails in 5.6.0
129 try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
130     "", 
131     "");
132
133 try({PERL5OPT => '-Mstrict -Mwarnings'}, 
134     ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
135     "ok",
136     "");
137
138 try({PERL5OPT => '-w -w'},
139     ['-e', 'print $ENV{PERL5OPT}'],
140     '-w -w',
141     '');
142
143 try({PERL5OPT => '-t'},
144     ['-e', 'print ${^TAINT}'],
145     '1',
146     '');
147
148 try({PERLLIB => "foobar:42"},
149     ['-e', 'print grep { $_ eq "foobar" } @INC'],
150     'foobar',
151     '');
152
153 try({PERLLIB => "foobar:42"},
154     ['-e', 'print grep { $_ eq "42" } @INC'],
155     '42',
156     '');
157
158 try({PERL5LIB => "foobar:42"},
159     ['-e', 'print grep { $_ eq "foobar" } @INC'],
160     'foobar',
161     '');
162
163 try({PERL5LIB => "foobar:42"},
164     ['-e', 'print grep { $_ eq "42" } @INC'],
165     '42',
166     '');
167
168 # PERL5LIB tests with included arch directories still missing
169
170 END {
171     1 while unlink $STDOUT;
172     1 while unlink $STDERR;
173 }