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