#!./perl BEGIN { $^W = 1; $| = 1; chdir 't' if -d 't'; unshift @INC, '../lib'; $SIG{__WARN__} = sub { die "Dying on warning: ", @_ }; } sub ok { my ($n, $result, $info) = @_; if ($result) { print "ok $n\n"; } else { print "not ok $n\n"; print "# $info\n" if $info; } } $Is_MSWin32 = $^O eq 'MSWin32'; $Is_VMS = $^O eq 'VMS'; $Is_Dos = $^O eq 'dos'; $Is_os2 = $^O eq 'os2'; $Is_Cygwin = $^O eq 'cygwin'; $PERL = ($Is_MSWin32 ? '.\perl' : './perl'); print "1..35\n"; eval '$ENV{"FOO"} = "hi there";'; # check that ENV is inited inside eval if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; } else { ok 1, `echo \$FOO` eq "hi there\n"; } unlink 'ajslkdfpqjsjfk'; $! = 0; open(FOO,'ajslkdfpqjsjfk'); ok 2, $!, $!; close FOO; # just mention it, squelch used-only-once if ($Is_MSWin32 || $Is_Dos) { ok "3 # skipped",1; ok "4 # skipped",1; } else { # the next tests are embedded inside system simply because sh spits out # a newline onto stderr when a child process kills itself with SIGINT. system './perl', '-e', <<'END'; $| = 1; # command buffering $SIG{"INT"} = "ok3"; kill "INT",$$; sleep 1; $SIG{"INT"} = "IGNORE"; kill "INT",$$; sleep 1; print "ok 4\n"; $SIG{"INT"} = "DEFAULT"; kill "INT",$$; sleep 1; print "not ok\n"; sub ok3 { if (($x = pop(@_)) eq "INT") { print "ok 3\n"; } else { print "not ok 3 ($x @_)\n"; } } END } # can we slice ENV? @val1 = @ENV{keys(%ENV)}; @val2 = values(%ENV); ok 5, join(':',@val1) eq join(':',@val2); ok 6, @val1 > 1; # regex vars 'foobarbaz' =~ /b(a)r/; ok 7, $` eq 'foo', $`; ok 8, $& eq 'bar', $&; ok 9, $' eq 'baz', $'; ok 10, $+ eq 'a', $+; # $" @a = qw(foo bar baz); ok 11, "@a" eq "foo bar baz", "@a"; { local $" = ','; ok 12, "@a" eq "foo,bar,baz", "@a"; } # $; %h = (); $h{'foo', 'bar'} = 1; ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0]; { local $; = 'x'; %h = (); $h{'foo', 'bar'} = 1; ok 14, (keys %h)[0] eq 'fooxbar', (keys %h)[0]; } # $?, $@, $$ system qq[$PERL -e "exit(0)"]; ok 15, $? == 0, $?; system qq[$PERL -e "exit(1)"]; ok 16, $? != 0, $?; eval { die "foo\n" }; ok 17, $@ eq "foo\n", $@; ok 18, $$ > 0, $$; # $^X and $0 { if ($^O eq 'qnx') { chomp($wd = `/usr/bin/fullpath -t`); } elsif($Is_Cygwin) { # Cygwin turns the symlink into the real file chomp($wd = `pwd`); $wd =~ s#/t$##; } elsif($Is_os2) { $wd = Cwd::sys_cwd(); } else { $wd = '.'; } my $perl = "$wd/perl"; my $headmaybe = ''; my $tailmaybe = ''; $script = "$wd/show-shebang"; if ($Is_MSWin32) { chomp($wd = `cd`); $wd =~ s|\\|/|g; $perl = "$wd/perl.exe"; $script = "$wd/show-shebang.bat"; $headmaybe = <$script"), $!; ok 20, print(SCRIPT $headmaybe . <= 5.00319, $]; ok 27, $^O; ok 28, $^T > 850000000, $^T; if ($Is_VMS || $Is_Dos) { ok "29 # skipped", 1; ok "30 # skipped", 1; } else { $PATH = $ENV{PATH}; $ENV{foo} = "bar"; %ENV = (); $ENV{PATH} = $PATH; ok 29, ($Is_MSWin32 ? (`cmd /x /c set foo 2>NUL` eq "") : (`echo \$foo` eq "\n") ); $ENV{NoNeSuCh} = "foo"; $0 = "bar"; ok 30, ($Is_MSWin32 ? (`cmd /x /c set NoNeSuCh` eq "NoNeSuCh=foo\n") : (`echo \$NoNeSuCh` eq "foo\n") ); } { local $SIG{'__WARN__'} = sub { print "# @_\nnot " }; $! = undef; print "ok 31\n"; } # test case-insignificance of %ENV (these tests must be enabled only # when perl is compiled with -DENV_IS_CASELESS) if ($Is_MSWin32) { %ENV = (); $ENV{'Foo'} = 'bar'; $ENV{'fOo'} = 'baz'; ok 32, (scalar(keys(%ENV)) == 1); ok 33, exists($ENV{'FOo'}); ok 34, (delete($ENV{'foO'}) eq 'baz'); ok 35, (scalar(keys(%ENV)) == 0); } else { ok "32 # skipped: no caseless %ENV support",1; ok "33 # skipped: no caseless %ENV support",1; ok "34 # skipped: no caseless %ENV support",1; ok "35 # skipped: no caseless %ENV support",1; }