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