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