xref: /openbsd/gnu/usr.bin/perl/t/op/magic.t (revision 78b63d65) 
1#!./perl
2
3BEGIN {
4    $| = 1;
5    chdir 't' if -d 't';
6    @INC = '../lib';
7    $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
8}
9
10use warnings;
11
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
23$Is_MSWin32 = $^O eq 'MSWin32';
24$Is_VMS     = $^O eq 'VMS';
25$Is_Dos   = $^O eq 'dos';
26$Is_os2   = $^O eq 'os2';
27$Is_Cygwin   = $^O eq 'cygwin';
28$PERL = ($Is_MSWin32 ? '.\perl' : './perl');
29
30print "1..35\n";
31
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"; }
35
36unlink 'ajslkdfpqjsjfk';
37$! = 0;
38open(FOO,'ajslkdfpqjsjfk');
39ok 2, $!, $!;
40close FOO; # just mention it, squelch used-only-once
41
42if ($Is_MSWin32 || $Is_Dos) {
43    ok "3 # skipped",1;
44    ok "4 # skipped",1;
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';
50
51    $| = 1;		# command buffering
52
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";
56
57    sub ok3 {
58	if (($x = pop(@_)) eq "INT") {
59	    print "ok 3\n";
60	}
61	else {
62	    print "not ok 3 ($x @_)\n";
63	}
64    }
65
66END
67}
68
69# can we slice ENV?
70@val1 = @ENV{keys(%ENV)};
71@val2 = values(%ENV);
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}
89
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}
100
101# $?, $@, $$
102system qq[$PERL -e "exit(0)"];
103ok 15, $? == 0, $?;
104system qq[$PERL -e "exit(1)"];
105ok 16, $? != 0, $?;
106
107eval { die "foo\n" };
108ok 17, $@ eq "foo\n", $@;
109
110ok 18, $$ > 0, $$;
111
112# $^X and $0
113{
114    if ($^O eq 'qnx') {
115	chomp($wd = `/usr/bin/fullpath -t`);
116    }
117    elsif($Is_Cygwin) {
118       # Cygwin turns the symlink into the real file
119       chomp($wd = `pwd`);
120       $wd =~ s#/t$##;
121    }
122    elsif($Is_os2) {
123       $wd = Cwd::sys_cwd();
124    }
125    else {
126	$wd = '.';
127    }
128    my $perl = "$wd/perl";
129    my $headmaybe = '';
130    my $tailmaybe = '';
131    $script = "$wd/show-shebang";
132    if ($Is_MSWin32) {
133	chomp($wd = `cd`);
134	$wd =~ s|\\|/|g;
135	$perl = "$wd/perl.exe";
136	$script = "$wd/show-shebang.bat";
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    }
150    elsif ($Is_os2) {
151      $script = "./show-shebang";
152    }
153    if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') {  # no shebang
154	$headmaybe = <<EOH ;
155    eval 'exec ./perl -S \$0 \${1+"\$\@"}'
156        if 0;
157EOH
158    }
159    $s1 = "\$^X is $perl, \$0 is $script\n";
160    ok 19, open(SCRIPT, ">$script"), $!;
161    ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
162#!$wd/perl
163EOB
164print "\$^X is $^X, \$0 is $0\n";
165EOF
166    ok 21, close(SCRIPT), $!;
167    ok 22, chmod(0755, $script), $!;
168    $_ = `$script`;
169    s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
170    s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
171    s{is perl}{is $perl}; # for systems where $^X is only a basename
172    s{\\}{/}g;
173    ok 23, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:";
174    $_ = `$perl $script`;
175    s/\.exe//i if $Is_Dos or $Is_os2;
176    s{\\}{/}g;
177    ok 24, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`";
178    ok 25, unlink($script), $!;
179}
180
181# $], $^O, $^T
182ok 26, $] >= 5.00319, $];
183ok 27, $^O;
184ok 28, $^T > 850000000, $^T;
185
186if ($Is_VMS || $Is_Dos) {
187	ok "29 # skipped", 1;
188	ok "30 # skipped", 1;
189}
190else {
191	$PATH = $ENV{PATH};
192	$PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
193	$ENV{foo} = "bar";
194	%ENV = ();
195	$ENV{PATH} = $PATH;
196	$ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
197	ok 29, ($Is_MSWin32 ? (`cmd /x /c set foo 2>NUL` eq "")
198				: (`echo \$foo` eq "\n") );
199
200	$ENV{__NoNeSuCh} = "foo";
201	$0 = "bar";
202	ok 30, ($Is_MSWin32 ? (`cmd /x /c set __NoNeSuCh` eq "__NoNeSuCh=foo\n")
203			    : (`echo \$__NoNeSuCh` eq "foo\n") );
204}
205
206{
207    local $SIG{'__WARN__'} = sub { print "# @_\nnot " };
208    $! = undef;
209    print "ok 31\n";
210}
211
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';
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);
222}
223else {
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;
228}
229