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