[inseparable changes from match from perl-5.003_97 to perl-5.003_97a]
[perl.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 $PERL = ($Is_MSWin32 ? '.\perl' : './perl');
24
25 print "1..28\n";
26
27 eval '$ENV{"foo"} = "hi there";';       # check that ENV is inited inside eval
28 if ($Is_MSWin32) { ok 1, `cmd /x /c set foo` eq "foo=hi there\n"; }
29 else             { ok 1, `echo \$foo` eq "hi there\n"; }
30
31 unlink 'ajslkdfpqjsjfk';
32 $! = 0;
33 open(FOO,'ajslkdfpqjsjfk');
34 ok 2, $!, $!;
35 close FOO; # just mention it, squelch used-only-once
36
37 if ($Is_MSWin32) {
38     ok 3,1;
39     ok 4,1;
40 }
41 else {
42   # the next tests are embedded inside system simply because sh spits out
43   # a newline onto stderr when a child process kills itself with SIGINT.
44   system './perl', '-e', <<'END';
45
46     $| = 1;             # command buffering
47
48     $SIG{"INT"} = "ok3"; kill "INT",$$;
49     $SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";
50     $SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";
51
52     sub ok3 {
53         if (($x = pop(@_)) eq "INT") {
54             print "ok 3\n";
55         }
56         else {
57             print "not ok 3 ($x @_)\n";
58         }
59     }
60
61 END
62 }
63
64 # can we slice ENV?
65 @val1 = @ENV{keys(%ENV)};
66 @val2 = values(%ENV);
67 ok 5, join(':',@val1) eq join(':',@val2);
68 ok 6, @val1 > 1;
69
70 # regex vars
71 'foobarbaz' =~ /b(a)r/;
72 ok 7, $` eq 'foo', $`;
73 ok 8, $& eq 'bar', $&;
74 ok 9, $' eq 'baz', $';
75 ok 10, $+ eq 'a', $+;
76
77 # $"
78 @a = qw(foo bar baz);
79 ok 11, "@a" eq "foo bar baz", "@a";
80 {
81     local $" = ',';
82     ok 12, "@a" eq "foo,bar,baz", "@a";
83 }
84
85 # $;
86 %h = ();
87 $h{'foo', 'bar'} = 1;
88 ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0];
89 {
90     local $; = 'x';
91     %h = ();
92     $h{'foo', 'bar'} = 1;
93     ok 14, (keys %h)[0] eq 'fooxbar', (keys %h)[0];
94 }
95
96 # $?, $@, $$
97 system qq[$PERL -e "exit(0)"];
98 ok 15, $? == 0, $?;
99 system qq[$PERL -e "exit(1)"];
100 ok 16, $? != 0, $?;
101
102 eval { die "foo\n" };
103 ok 17, $@ eq "foo\n", $@;
104
105 ok 18, $$ > 0, $$;
106
107 # $^X and $0
108 if ($Is_MSWin32) {
109     for (19 .. 25) { ok $_, 1 }
110 }
111 else {
112     if ($^O eq 'qnx' || $^O eq 'amigaos') {
113         chomp($wd = `pwd`);
114     }
115     else {
116         $wd = '.';
117     }
118     $script = "$wd/show-shebang";
119     $s1 = $s2 = "\$^X is $wd/perl, \$0 is $script\n";
120     if ($^O eq 'os2') {
121         # Started by ksh, which adds suffixes '.exe' and '.' to perl and script
122         $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n";
123     }
124     ok 19, open(SCRIPT, ">$script"), $!;
125     ok 20, print(SCRIPT <<EOB . <<'EOF'), $!;
126 #!$wd/perl
127 EOB
128 print "\$^X is $^X, \$0 is $0\n";
129 EOF
130     ok 21, close(SCRIPT), $!;
131     ok 22, chmod(0755, $script), $!;
132     $_ = `$script`;
133     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
134     s{is perl}{is $wd/perl}; # for systems where $^X is only a basename
135     ok 23, $_ eq $s2, ":$_:!=:$s2:";
136     $_ = `$wd/perl $script`;
137     ok 24, $_ eq $s1, ":$_:!=:$s1: after `$wd/perl $script`";
138     ok 25, unlink($script), $!;
139 }
140
141 # $], $^O, $^T
142 ok 26, $] >= 5.00319, $];
143 ok 27, $^O;
144 ok 28, $^T > 850000000, $^T;