Hash Function Change - Murmur hash and true per process hash seed
[perl.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     require './test.pl';
12     skip_all_without_config('d_fork');
13 }
14
15 plan tests => 94;
16
17 my $STDOUT = tempfile();
18 my $STDERR = tempfile();
19 my $PERL = $ENV{PERL} || './perl';
20 my $FAILURE_CODE = 119;
21
22 delete $ENV{PERLLIB};
23 delete $ENV{PERL5LIB};
24 delete $ENV{PERL5OPT};
25
26
27 # Run perl with specified environment and arguments, return (STDOUT, STDERR)
28 sub runperl_and_capture {
29   local *F;
30   my ($env, $args) = @_;
31
32   local %ENV = %ENV;
33   delete $ENV{PERLLIB};
34   delete $ENV{PERL5LIB};
35   delete $ENV{PERL5OPT};
36   my $pid = fork;
37   return (0, "Couldn't fork: $!") unless defined $pid;   # failure
38   if ($pid) {                   # parent
39     wait;
40     return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
41
42     open my $stdout, '<', $STDOUT
43         or return (0, "Couldn't read $STDOUT file: $!");
44     open my $stderr, '<', $STDERR
45         or return (0, "Couldn't read $STDERR file: $!");
46     local $/;
47     # Empty file with <$stderr> returns nothing in list context
48     # (because there are no lines) Use scalar to force it to ''
49     return (scalar <$stdout>, scalar <$stderr>);
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 and do { exec $PERL, @$args };
56     # it didn't_work:
57     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
58     exit $FAILURE_CODE;
59   }
60 }
61
62 sub try {
63   my ($env, $args, $stdout, $stderr) = @_;
64   my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
65   local $::Level = $::Level + 1;
66   if (ref $stdout) {
67     ok ( $actual_stdout =~/$stdout/ );
68   } else {
69     is ($stdout, $actual_stdout);
70   }
71   if (ref $stderr) {
72     ok ( $actual_stderr =~/$stderr/);
73   } else {
74     is ($stderr, $actual_stderr);
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 -[DIMUdmtw]
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 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
89     "", 
90     qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value \$x in print at -e line 1.\n});
91
92 try({PERL5OPT => '-Mstrict'}, ['-I../lib', '-e', 'print $::x'],
93     "", "");
94
95 try({PERL5OPT => '-Mstrict'}, ['-I../lib', '-e', 'print $x'],
96     "", 
97     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
98
99 # Fails in 5.6.0
100 try({PERL5OPT => '-Mstrict -w'}, ['-I../lib', '-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({PERL5OPT => '-w -Mstrict'}, ['-I../lib', '-e', 'print $::x'],
106     "", 
107     <<ERROR
108 Name "main::x" used only once: possible typo at -e line 1.
109 Use of uninitialized value \$x in print at -e line 1.
110 ERROR
111     );
112
113 # Fails in 5.6.0
114 try({PERL5OPT => '-w -Mstrict'}, ['-I../lib', '-e', 'print $::x'],
115     "", 
116     <<ERROR
117 Name "main::x" used only once: possible typo at -e line 1.
118 Use of uninitialized value \$x in print at -e line 1.
119 ERROR
120     );
121
122 try({PERL5OPT => '-MExporter'}, ['-I../lib', '-e0'],
123     "", 
124     "");
125
126 # Fails in 5.6.0
127 try({PERL5OPT => '-MExporter -MExporter'}, ['-I../lib', '-e0'],
128     "", 
129     "");
130
131 try({PERL5OPT => '-Mstrict -Mwarnings'}, 
132     ['-I../lib', '-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
133     "ok",
134     "");
135
136 open my $fh, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
137 print $fh "package Oooof; 1;\n";
138 close $fh;
139 END { 1 while unlink "Oooof.pm" }
140
141 try({PERL5OPT => '-I. -MOooof'}, 
142     ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
143     "ok",
144     "");
145
146 try({PERL5OPT => '-I./ -MOooof'}, 
147     ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
148     "ok",
149     "");
150
151 try({PERL5OPT => '-w -w'},
152     ['-e', 'print $ENV{PERL5OPT}'],
153     '-w -w',
154     '');
155
156 try({PERL5OPT => '-t'},
157     ['-e', 'print ${^TAINT}'],
158     '-1',
159     '');
160
161 try({PERL5OPT => '-W'},
162     ['-I../lib','-e', 'local $^W = 0;  no warnings;  print $x'],
163     '',
164     <<ERROR
165 Name "main::x" used only once: possible typo at -e line 1.
166 Use of uninitialized value \$x in print at -e line 1.
167 ERROR
168 );
169
170 try({PERLLIB => "foobar$Config{path_sep}42"},
171     ['-e', 'print grep { $_ eq "foobar" } @INC'],
172     'foobar',
173     '');
174
175 try({PERLLIB => "foobar$Config{path_sep}42"},
176     ['-e', 'print grep { $_ eq "42" } @INC'],
177     '42',
178     '');
179
180 try({PERL5LIB => "foobar$Config{path_sep}42"},
181     ['-e', 'print grep { $_ eq "foobar" } @INC'],
182     'foobar',
183     '');
184
185 try({PERL5LIB => "foobar$Config{path_sep}42"},
186     ['-e', 'print grep { $_ eq "42" } @INC'],
187     '42',
188     '');
189
190 try({PERL5LIB => "foo",
191      PERLLIB => "bar"},
192     ['-e', 'print grep { $_ eq "foo" } @INC'],
193     'foo',
194     '');
195
196 try({PERL5LIB => "foo",
197      PERLLIB => "bar"},
198     ['-e', 'print grep { $_ eq "bar" } @INC'],
199     '',
200     '');
201
202 try({PERL_HASH_SEED_DEBUG => 1},
203     ['-e','1'],
204     '',
205     qr/HASH_FUNCTION =/);
206
207 try({PERL_HASH_SEED_DEBUG => 1},
208     ['-e','1'],
209     '',
210     qr/HASH_SEED =/);
211
212 try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"},
213     ['-e','1'],
214     '',
215     qr/HASH_SEED = 0x12345678/);
216
217 try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"},
218     ['-e','1'],
219     '',
220     qr/HASH_SEED = 0x12000000/);
221
222 try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"},
223     ['-e','1'],
224     '',
225     qr/HASH_SEED = 0x12345678/);
226 # Tests for S_incpush_use_sep():
227
228 my @dump_inc = ('-e', 'print "$_\n" foreach @INC');
229
230 my ($out, $err) = runperl_and_capture({}, [@dump_inc]);
231
232 is ($err, '', 'No errors when determining @INC');
233
234 my @default_inc = split /\n/, $out;
235
236 is ($default_inc[-1], '.', '. is last in @INC');
237
238 my $sep = $Config{path_sep};
239 foreach (['nothing', ''],
240          ['something', 'zwapp', 'zwapp'],
241          ['two things', "zwapp${sep}bam", 'zwapp', 'bam'],
242          ['two things, ::', "zwapp${sep}${sep}bam", 'zwapp', 'bam'],
243          [': at start', "${sep}zwapp", 'zwapp'],
244          [': at end', "zwapp${sep}", 'zwapp'],
245          [':: sandwich ::', "${sep}${sep}zwapp${sep}${sep}", 'zwapp'],
246          [':', "${sep}"],
247          ['::', "${sep}${sep}"],
248          [':::', "${sep}${sep}${sep}"],
249          ['two things and :', "zwapp${sep}bam${sep}", 'zwapp', 'bam'],
250          [': and two things', "${sep}zwapp${sep}bam", 'zwapp', 'bam'],
251          [': two things :', "${sep}zwapp${sep}bam${sep}", 'zwapp', 'bam'],
252          ['three things', "zwapp${sep}bam${sep}${sep}owww",
253           'zwapp', 'bam', 'owww'],
254         ) {
255   my ($name, $lib, @expect) = @$_;
256   push @expect, @default_inc;
257
258   ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]);
259
260   is ($err, '', "No errors when determining \@INC for $name");
261
262   my @inc = split /\n/, $out;
263
264   is (scalar @inc, scalar @expect,
265       "expected number of elements in \@INC for $name");
266
267   is ("@inc", "@expect", "expected elements in \@INC for $name");
268 }
269
270 # PERL5LIB tests with included arch directories still missing