Commit | Line | Data |
8d063cd8 |
1 | #!./perl |
2 | |
90ce63d5 |
3 | BEGIN { |
90ce63d5 |
4 | $| = 1; |
5 | chdir 't' if -d 't'; |
20822f61 |
6 | @INC = '../lib'; |
774d564b |
7 | $SIG{__WARN__} = sub { die "Dying on warning: ", @_ }; |
90ce63d5 |
8 | } |
8d063cd8 |
9 | |
9f1b1f2d |
10 | use warnings; |
11 | |
90ce63d5 |
12 | sub ok { |
13 | my ($n, $result, $info) = @_; |
14 | if ($result) { |
15 | print "ok $n\n"; |
16 | } |
17 | else { |
18 | print "not ok $n\n"; |
19 | print "# $info\n" if $info; |
20 | } |
21 | } |
22 | |
3e3baf6d |
23 | $Is_MSWin32 = $^O eq 'MSWin32'; |
2986a63f |
24 | $Is_NetWare = $^O eq 'NetWare'; |
3e3baf6d |
25 | $Is_VMS = $^O eq 'VMS'; |
39e571d4 |
26 | $Is_Dos = $^O eq 'dos'; |
ed344e4f |
27 | $Is_os2 = $^O eq 'os2'; |
4fabb596 |
28 | $Is_Cygwin = $^O eq 'cygwin'; |
dc22e1c4 |
29 | $Is_MPE = $^O eq 'mpeix'; |
2986a63f |
30 | $PERL = ($Is_MSWin32 ? '.\perl' : ($Is_NetWare ? 'perl' : './perl')); |
68dc0745 |
31 | |
65b8483b |
32 | print "1..41\n"; |
378cc40b |
33 | |
39e571d4 |
34 | eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval |
6d0cc0d7 |
35 | if ($Is_MSWin32) { ok 1, `set FOO` eq "FOO=hi there\n"; } |
39e571d4 |
36 | else { ok 1, `echo \$FOO` eq "hi there\n"; } |
8d063cd8 |
37 | |
bf38876a |
38 | unlink 'ajslkdfpqjsjfk'; |
8d063cd8 |
39 | $! = 0; |
90ce63d5 |
40 | open(FOO,'ajslkdfpqjsjfk'); |
41 | ok 2, $!, $!; |
42 | close FOO; # just mention it, squelch used-only-once |
8d063cd8 |
43 | |
dc22e1c4 |
44 | if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE) { |
902173a3 |
45 | ok "3 # skipped",1; |
46 | ok "4 # skipped",1; |
68dc0745 |
47 | } |
48 | else { |
49 | # the next tests are embedded inside system simply because sh spits out |
50 | # a newline onto stderr when a child process kills itself with SIGINT. |
51 | system './perl', '-e', <<'END'; |
378cc40b |
52 | |
79072805 |
53 | $| = 1; # command buffering |
378cc40b |
54 | |
b715f106 |
55 | $SIG{"INT"} = "ok3"; kill "INT",$$; sleep 1; |
56 | $SIG{"INT"} = "IGNORE"; kill "INT",$$; sleep 1; print "ok 4\n"; |
57 | $SIG{"INT"} = "DEFAULT"; kill "INT",$$; sleep 1; print "not ok\n"; |
79072805 |
58 | |
59 | sub ok3 { |
60 | if (($x = pop(@_)) eq "INT") { |
61 | print "ok 3\n"; |
62 | } |
63 | else { |
652ed9f8 |
64 | print "not ok 3 ($x @_)\n"; |
79072805 |
65 | } |
66 | } |
67 | |
68 | END |
68dc0745 |
69 | } |
a687059c |
70 | |
68dc0745 |
71 | # can we slice ENV? |
72 | @val1 = @ENV{keys(%ENV)}; |
a687059c |
73 | @val2 = values(%ENV); |
90ce63d5 |
74 | ok 5, join(':',@val1) eq join(':',@val2); |
75 | ok 6, @val1 > 1; |
76 | |
77 | # regex vars |
78 | 'foobarbaz' =~ /b(a)r/; |
79 | ok 7, $` eq 'foo', $`; |
80 | ok 8, $& eq 'bar', $&; |
81 | ok 9, $' eq 'baz', $'; |
82 | ok 10, $+ eq 'a', $+; |
83 | |
84 | # $" |
85 | @a = qw(foo bar baz); |
86 | ok 11, "@a" eq "foo bar baz", "@a"; |
87 | { |
88 | local $" = ','; |
89 | ok 12, "@a" eq "foo,bar,baz", "@a"; |
90 | } |
a687059c |
91 | |
90ce63d5 |
92 | # $; |
93 | %h = (); |
94 | $h{'foo', 'bar'} = 1; |
95 | ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0]; |
96 | { |
97 | local $; = 'x'; |
98 | %h = (); |
99 | $h{'foo', 'bar'} = 1; |
100 | ok 14, (keys %h)[0] eq 'fooxbar', (keys %h)[0]; |
101 | } |
ed6116ce |
102 | |
90ce63d5 |
103 | # $?, $@, $$ |
5aabfad6 |
104 | system qq[$PERL -e "exit(0)"]; |
90ce63d5 |
105 | ok 15, $? == 0, $?; |
5aabfad6 |
106 | system qq[$PERL -e "exit(1)"]; |
90ce63d5 |
107 | ok 16, $? != 0, $?; |
108 | |
109 | eval { die "foo\n" }; |
110 | ok 17, $@ eq "foo\n", $@; |
111 | |
112 | ok 18, $$ > 0, $$; |
113 | |
114 | # $^X and $0 |
ed37317b |
115 | { |
3e3baf6d |
116 | if ($^O eq 'qnx') { |
7fbf1995 |
117 | chomp($wd = `/usr/bin/fullpath -t`); |
68dc0745 |
118 | } |
1cab015a |
119 | elsif($Is_Cygwin) { |
120 | # Cygwin turns the symlink into the real file |
121 | chomp($wd = `pwd`); |
122 | $wd =~ s#/t$##; |
123 | } |
ed344e4f |
124 | elsif($Is_os2) { |
125 | $wd = Cwd::sys_cwd(); |
126 | } |
68dc0745 |
127 | else { |
128 | $wd = '.'; |
129 | } |
ed37317b |
130 | my $perl = "$wd/perl"; |
131 | my $headmaybe = ''; |
132 | my $tailmaybe = ''; |
68dc0745 |
133 | $script = "$wd/show-shebang"; |
ed37317b |
134 | if ($Is_MSWin32) { |
135 | chomp($wd = `cd`); |
8ac9c18d |
136 | $wd =~ s|\\|/|g; |
137 | $perl = "$wd/perl.exe"; |
138 | $script = "$wd/show-shebang.bat"; |
ed37317b |
139 | $headmaybe = <<EOH ; |
140 | \@rem =' |
141 | \@echo off |
142 | $perl -x \%0 |
143 | goto endofperl |
144 | \@rem '; |
145 | EOH |
146 | $tailmaybe = <<EOT ; |
147 | |
148 | __END__ |
149 | :endofperl |
150 | EOT |
151 | } |
ed344e4f |
152 | elsif ($Is_os2) { |
153 | $script = "./show-shebang"; |
154 | } |
a1a0e61e |
155 | if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') { # no shebang |
9d116dd7 |
156 | $headmaybe = <<EOH ; |
157 | eval 'exec ./perl -S \$0 \${1+"\$\@"}' |
158 | if 0; |
159 | EOH |
160 | } |
2eecd615 |
161 | $s1 = "\$^X is $perl, \$0 is $script\n"; |
68dc0745 |
162 | ok 19, open(SCRIPT, ">$script"), $!; |
ed37317b |
163 | ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!; |
774d564b |
164 | #!$wd/perl |
165 | EOB |
90ce63d5 |
166 | print "\$^X is $^X, \$0 is $0\n"; |
167 | EOF |
68dc0745 |
168 | ok 21, close(SCRIPT), $!; |
169 | ok 22, chmod(0755, $script), $!; |
170 | $_ = `$script`; |
ed344e4f |
171 | s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2; |
68dc0745 |
172 | s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl |
ed37317b |
173 | s{is perl}{is $perl}; # for systems where $^X is only a basename |
a6c40364 |
174 | s{\\}{/}g; |
ed344e4f |
175 | ok 23, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:"; |
ed37317b |
176 | $_ = `$perl $script`; |
ed344e4f |
177 | s/\.exe//i if $Is_Dos or $Is_os2; |
a6c40364 |
178 | s{\\}{/}g; |
ed344e4f |
179 | ok 24, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`"; |
68dc0745 |
180 | ok 25, unlink($script), $!; |
181 | } |
ed6116ce |
182 | |
90ce63d5 |
183 | # $], $^O, $^T |
184 | ok 26, $] >= 5.00319, $]; |
185 | ok 27, $^O; |
186 | ok 28, $^T > 850000000, $^T; |
66b1d557 |
187 | |
39e571d4 |
188 | if ($Is_VMS || $Is_Dos) { |
902173a3 |
189 | ok "29 # skipped", 1; |
190 | ok "30 # skipped", 1; |
66b1d557 |
191 | } |
192 | else { |
3e3baf6d |
193 | $PATH = $ENV{PATH}; |
7ddf2a0a |
194 | $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0; |
3e3baf6d |
195 | $ENV{foo} = "bar"; |
196 | %ENV = (); |
197 | $ENV{PATH} = $PATH; |
7ddf2a0a |
198 | $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0; |
6d0cc0d7 |
199 | ok 29, ($Is_MSWin32 ? (`set foo 2>NUL` eq "") |
3e3baf6d |
200 | : (`echo \$foo` eq "\n") ); |
201 | |
ec00bdd8 |
202 | $ENV{__NoNeSuCh} = "foo"; |
3e3baf6d |
203 | $0 = "bar"; |
6d0cc0d7 |
204 | ok 30, ($Is_MSWin32 ? (`set __NoNeSuCh` eq "__NoNeSuCh=foo\n") |
ec00bdd8 |
205 | : (`echo \$__NoNeSuCh` eq "foo\n") ); |
66b1d557 |
206 | } |
3e3baf6d |
207 | |
78987ded |
208 | { |
2eecd615 |
209 | local $SIG{'__WARN__'} = sub { print "# @_\nnot " }; |
78987ded |
210 | $! = undef; |
211 | print "ok 31\n"; |
212 | } |
213 | |
902173a3 |
214 | # test case-insignificance of %ENV (these tests must be enabled only |
215 | # when perl is compiled with -DENV_IS_CASELESS) |
2986a63f |
216 | if ($Is_MSWin32 || $Is_NetWare) { |
902173a3 |
217 | %ENV = (); |
218 | $ENV{'Foo'} = 'bar'; |
219 | $ENV{'fOo'} = 'baz'; |
78987ded |
220 | ok 32, (scalar(keys(%ENV)) == 1); |
221 | ok 33, exists($ENV{'FOo'}); |
222 | ok 34, (delete($ENV{'foO'}) eq 'baz'); |
223 | ok 35, (scalar(keys(%ENV)) == 0); |
902173a3 |
224 | } |
225 | else { |
ed344e4f |
226 | ok "32 # skipped: no caseless %ENV support",1; |
227 | ok "33 # skipped: no caseless %ENV support",1; |
228 | ok "34 # skipped: no caseless %ENV support",1; |
229 | ok "35 # skipped: no caseless %ENV support",1; |
902173a3 |
230 | } |
d2c93421 |
231 | |
232 | # Make sure Errno hasn't been prematurely autoloaded |
233 | |
234 | ok 36, !defined %Errno::; |
235 | |
236 | # Test auto-loading of Errno when %! is used |
237 | |
238 | ok 37, scalar eval q{ |
239 | my $errs = %!; |
240 | defined %Errno::; |
241 | }, $@; |
242 | |
243 | |
244 | # Make sure that Errno loading doesn't clobber $! |
245 | |
246 | undef %Errno::; |
247 | delete $INC{"Errno.pm"}; |
248 | |
249 | open(FOO, "nonesuch"); # Generate ENOENT |
250 | my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time |
251 | ok 38, ${"!"}{ENOENT}; |
a4268c0a |
252 | |
253 | ok 39, $^S == 0; |
65b8483b |
254 | eval { ok 40, $^S == 1 }; |
255 | ok 41, $^S == 0; |