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