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