diff options
Diffstat (limited to 'contrib/perl5/t/op/magic.t')
-rwxr-xr-x | contrib/perl5/t/op/magic.t | 228 |
1 files changed, 0 insertions, 228 deletions
diff --git a/contrib/perl5/t/op/magic.t b/contrib/perl5/t/op/magic.t deleted file mode 100755 index c2a8211..0000000 --- a/contrib/perl5/t/op/magic.t +++ /dev/null @@ -1,228 +0,0 @@ -#!./perl - -BEGIN { - $| = 1; - chdir 't' if -d 't'; - @INC = '../lib'; - $SIG{__WARN__} = sub { die "Dying on warning: ", @_ }; -} - -use warnings; - -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 = <<EOH ; -\@rem =' -\@echo off -$perl -x \%0 -goto endofperl -\@rem '; -EOH - $tailmaybe = <<EOT ; - -__END__ -:endofperl -EOT - } - elsif ($Is_os2) { - $script = "./show-shebang"; - } - if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') { # no shebang - $headmaybe = <<EOH ; - eval 'exec ./perl -S \$0 \${1+"\$\@"}' - if 0; -EOH - } - $s1 = "\$^X is $perl, \$0 is $script\n"; - ok 19, open(SCRIPT, ">$script"), $!; - ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!; -#!$wd/perl -EOB -print "\$^X is $^X, \$0 is $0\n"; -EOF - ok 21, close(SCRIPT), $!; - ok 22, chmod(0755, $script), $!; - $_ = `$script`; - s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2; - s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl - s{is perl}{is $perl}; # for systems where $^X is only a basename - s{\\}{/}g; - ok 23, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:"; - $_ = `$perl $script`; - s/\.exe//i if $Is_Dos or $Is_os2; - s{\\}{/}g; - ok 24, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`"; - ok 25, unlink($script), $!; -} - -# $], $^O, $^T -ok 26, $] >= 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}; - $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0; - $ENV{foo} = "bar"; - %ENV = (); - $ENV{PATH} = $PATH; - $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0; - 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; -} |