This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add delay to signal handling in t/op/magic.t. (Solaris with pthreads
[perl5.git] / t / op / magic.t
1 #!./perl
2
3 BEGIN {
4     $^W = 1;
5     $| = 1;
6     chdir 't' if -d 't';
7     @INC = '../lib';
8     $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
9 }
10
11 sub ok {
12     my ($n, $result, $info) = @_;
13     if ($result) {
14         print "ok $n\n";
15     }
16     else {
17         print "not ok $n\n";
18         print "# $info\n" if $info;
19     }
20 }
21
22 $Is_MSWin32 = $^O eq 'MSWin32';
23 $Is_VMS     = $^O eq 'VMS';
24 $PERL = ($Is_MSWin32 ? '.\perl' : './perl');
25
26 print "1..30\n";
27
28 eval '$ENV{"foo"} = "hi there";';       # check that ENV is inited inside eval
29 if ($Is_MSWin32) { ok 1, `cmd /x /c set foo` eq "foo=hi there\n"; }
30 else             { ok 1, `echo \$foo` eq "hi there\n"; }
31
32 unlink 'ajslkdfpqjsjfk';
33 $! = 0;
34 open(FOO,'ajslkdfpqjsjfk');
35 ok 2, $!, $!;
36 close FOO; # just mention it, squelch used-only-once
37
38 if ($Is_MSWin32) {
39     ok 3,1;
40     ok 4,1;
41 }
42 else {
43   # the next tests are embedded inside system simply because sh spits out
44   # a newline onto stderr when a child process kills itself with SIGINT.
45   system './perl', '-e', <<'END';
46
47     $| = 1;             # command buffering
48
49     $SIG{"INT"} = "ok3";     kill "INT",$$; sleep 1;
50     $SIG{"INT"} = "IGNORE";  kill "INT",$$; sleep 1; print "ok 4\n";
51     $SIG{"INT"} = "DEFAULT"; kill "INT",$$; sleep 1; print "not ok\n";
52
53     sub ok3 {
54         if (($x = pop(@_)) eq "INT") {
55             print "ok 3\n";
56         }
57         else {
58             print "not ok 3 ($x @_)\n";
59         }
60     }
61
62 END
63 }
64
65 # can we slice ENV?
66 @val1 = @ENV{keys(%ENV)};
67 @val2 = values(%ENV);
68 ok 5, join(':',@val1) eq join(':',@val2);
69 ok 6, @val1 > 1;
70
71 # regex vars
72 'foobarbaz' =~ /b(a)r/;
73 ok 7, $` eq 'foo', $`;
74 ok 8, $& eq 'bar', $&;
75 ok 9, $' eq 'baz', $';
76 ok 10, $+ eq 'a', $+;
77
78 # $"
79 @a = qw(foo bar baz);
80 ok 11, "@a" eq "foo bar baz", "@a";
81 {
82     local $" = ',';
83     ok 12, "@a" eq "foo,bar,baz", "@a";
84 }
85
86 # $;
87 %h = ();
88 $h{'foo', 'bar'} = 1;
89 ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0];
90 {
91     local $; = 'x';
92     %h = ();
93     $h{'foo', 'bar'} = 1;
94     ok 14, (keys %h)[0] eq 'fooxbar', (keys %h)[0];
95 }
96
97 # $?, $@, $$
98 system qq[$PERL -e "exit(0)"];
99 ok 15, $? == 0, $?;
100 system qq[$PERL -e "exit(1)"];
101 ok 16, $? != 0, $?;
102
103 eval { die "foo\n" };
104 ok 17, $@ eq "foo\n", $@;
105
106 ok 18, $$ > 0, $$;
107
108 # $^X and $0
109 {
110     if ($^O eq 'qnx') {
111         chomp($wd = `pwd`);
112     }
113     else {
114         $wd = '.';
115     }
116     my $perl = "$wd/perl";
117     my $headmaybe = '';
118     my $tailmaybe = '';
119     $script = "$wd/show-shebang";
120     if ($Is_MSWin32) {
121         chomp($wd = `cd`);
122         $perl = "$wd\\perl.exe";
123         $script = "$wd\\show-shebang.bat";
124         $headmaybe = <<EOH ;
125 \@rem ='
126 \@echo off
127 $perl -x \%0
128 goto endofperl
129 \@rem ';
130 EOH
131         $tailmaybe = <<EOT ;
132
133 __END__
134 :endofperl
135 EOT
136     }
137     $s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
138     if ($^O eq 'os2') {
139         # Started by ksh, which adds suffixes '.exe' and '.' to perl and script
140         $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n";
141     }
142     ok 19, open(SCRIPT, ">$script"), $!;
143     ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
144 #!$wd/perl
145 EOB
146 print "\$^X is $^X, \$0 is $0\n";
147 EOF
148     ok 21, close(SCRIPT), $!;
149     ok 22, chmod(0755, $script), $!;
150     $_ = `$script`;
151     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
152     s{is perl}{is $perl}; # for systems where $^X is only a basename
153     ok 23, ($Is_MSWin32 ? uc($_) eq uc($s2) : $_ eq $s2), ":$_:!=:$s2:";
154     $_ = `$perl $script`;
155     ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
156     ok 25, unlink($script), $!;
157 }
158
159 # $], $^O, $^T
160 ok 26, $] >= 5.00319, $];
161 ok 27, $^O;
162 ok 28, $^T > 850000000, $^T;
163
164 if ($Is_VMS) {
165         ok 29, 1;
166         ok 30, 1;
167 }
168 else {
169         $PATH = $ENV{PATH};
170         $ENV{foo} = "bar";
171         %ENV = ();
172         $ENV{PATH} = $PATH;
173         ok 29, ($Is_MSWin32 ? (`cmd /x /c set foo 2>NUL` eq "")
174                                 : (`echo \$foo` eq "\n") );
175
176         $ENV{NoNeSuCh} = "foo";
177         $0 = "bar";
178         ok 30, ($Is_MSWin32 ? (`cmd /x /c set NoNeSuCh` eq "NoNeSuCh=foo\n")
179                                                 : (`echo \$NoNeSuCh` eq "foo\n") );
180 }
181