vendor/perl5/5.006

4 files changed, 0 insertions, 380 deletions

diff --git a/contrib/perl5/t/lib/thread.t b/contrib/perl5/t/lib/thread.t
deleted file mode 100755
index c127d0f28f2a..000000000000
--- a/contrib/perl5/t/lib/thread.t
+++ /dev/null
@@ -1,73 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if (! $Config{'usethreads'}) {
-	print "1..0\n";
-	exit 0;
-    }
-
-    # XXX known trouble with global destruction
-    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
-}
-$| = 1;
-print "1..14\n";
-use Thread;
-print "ok 1\n";
-
-sub content
-{
- print shift;
- return shift;
-}
-
-# create a thread passing args and immedaietly wait for it.
-my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000);
-print $t->join;
-
-# check that lock works ...
-{lock $foo;
- $t = new Thread sub { lock $foo; print "ok 5\n" };
- print "ok 4\n";
-}
-$t->join;
-
-sub dorecurse
-{
- my $val = shift;
- my $ret;
- print $val;
- if (@_)
-  {
-   $ret = Thread->new(\&dorecurse, @_);
-   $ret->join;
-  }
-}
-
-$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
-$t->join;
-
-# test that sleep lets other thread run
-$t = new Thread \&dorecurse,"ok 11\n";
-sleep 6;
-print "ok 12\n";
-$t->join;
-
-sub islocked
-{
- use attrs 'locked';
- my $val = shift;
- my $ret;
- print $val;
- if (@_)
-  {
-   $ret = Thread->new(\&islocked, shift);
-  }
- $ret;
-}
-
-$t = Thread->new(\&islocked, "ok 13\n", "ok 14\n");
-$t->join->join;
-
diff --git a/contrib/perl5/t/op/nothread.t b/contrib/perl5/t/op/nothread.t
deleted file mode 100755
index a0d444d90b31..000000000000
--- a/contrib/perl5/t/op/nothread.t
+++ /dev/null
@@ -1,35 +0,0 @@
-#!./perl
-
-# NOTE: Please don't add tests to this file unless they *need* to be run in
-# separate executable and can't simply use eval.
-
-BEGIN
- {
-  chdir 't' if -d 't';
-  @INC = "../lib";
-  require Config;
-  import Config;
-  if ($Config{'usethreads'})
-   {
-    print "1..0\n";
-    exit 0;
-   }
- }
-
-
-$|=1;
-
-print "1..9\n";
-$t = 1;
-sub foo { local(@_) = ('p', 'q', 'r'); }
-sub bar { unshift @_, 'D'; @_ }
-sub baz { push @_, 'E'; return @_ }
-for (1..3) 
- { 
-   print "not " unless join('',foo('a', 'b', 'c')) eq 'pqr';
-   print "ok ",$t++,"\n";
-   print "not" unless join('',bar('d')) eq 'Dd';
-   print "ok ",$t++,"\n";
-   print "not" unless join('',baz('e')) eq 'eE';
-   print "ok ",$t++,"\n";
- } 
diff --git a/contrib/perl5/t/pragma/warn-1global b/contrib/perl5/t/pragma/warn-1global
deleted file mode 100644
index a7ca6070778c..000000000000
--- a/contrib/perl5/t/pragma/warn-1global
+++ /dev/null
@@ -1,159 +0,0 @@
-Check existing $^W functionality
-
-__END__
-
-# warnable code, warnings disabled
-$a =+ 3 ;
-EXPECT
-
-########
--w
-# warnable code, warnings enabled via command line switch
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 3.
-Name "main::a" used only once: possible typo at - line 3.
-########
-#! perl -w
-# warnable code, warnings enabled via #! line
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 3.
-Name "main::a" used only once: possible typo at - line 3.
-########
-
-# warnable code, warnings enabled via compile time $^W
-BEGIN { $^W = 1 }
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 4.
-Name "main::a" used only once: possible typo at - line 4.
-########
-
-# compile-time warnable code, warnings enabled via runtime $^W
-# so no warning printed.
-$^W = 1 ;
-$a =+ 3 ;
-EXPECT
-
-########
-
-# warnable code, warnings enabled via runtime $^W
-$^W = 1 ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 4.
-########
-
-# warnings enabled at compile time, disabled at run time
-BEGIN { $^W = 1 }
-$^W = 0 ;
-my $b ; chop $b ;
-EXPECT
-
-########
-
-# warnings disabled at compile time, enabled at run time
-BEGIN { $^W = 0 }
-$^W = 1 ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 5.
-########
--w
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-require "./abcd";
-EXPECT
-Use of uninitialized value at ./abcd line 1.
-########
-
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-#! perl -w
-require "./abcd";
-EXPECT
-Use of uninitialized value at ./abcd line 1.
-########
-
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-$^W =1 ;
-require "./abcd";
-EXPECT
-Use of uninitialized value at ./abcd line 1.
-########
-
---FILE-- abcd
-$^W = 0;
-my $b ; chop $b ;
-1 ;
---FILE-- 
-$^W =1 ;
-require "./abcd";
-EXPECT
-
-########
-
---FILE-- abcd
-$^W = 1;
-1 ;
---FILE-- 
-$^W =0 ;
-require "./abcd";
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 3.
-########
-
-$^W = 1;
-eval "my $b ; chop $b ;" ;
-EXPECT
-Use of uninitialized value at - line 3.
-Use of uninitialized value at - line 3.
-########
-
-eval "$^W = 1;" ;
-my $b ; chop $b ;
-EXPECT
-
-########
-
-eval {$^W = 1;} ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 3.
-########
-
-{
-    local ($^W) = 1;
-}
-my $b ; chop $b ;
-EXPECT
-
-########
-
-my $a ; chop $a ;
-{
-    local ($^W) = 1;
-    my $b ; chop $b ;
-}
-my $c ; chop $c ;
-EXPECT
-Use of uninitialized value at - line 5.
-########
--w
--e undef
-EXPECT
-Use of uninitialized value at - line 2.
-########
-BEGIN { $^W = 1 }
-for (@{[0]}) { "$_" }		# check warning isn't duplicated
-EXPECT
-Useless use of string in void context at - line 2.
diff --git a/contrib/perl5/t/pragma/warning.t b/contrib/perl5/t/pragma/warning.t
deleted file mode 100755
index 35d9d485e760..000000000000
--- a/contrib/perl5/t/pragma/warning.t
+++ /dev/null
@@ -1,113 +0,0 @@
-#!./perl 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    $ENV{PERL5LIB} = '../lib';
-    require Config; import Config;
-}
-
-$| = 1;
-
-my $Is_VMS     = $^O eq 'VMS';
-my $Is_MSWin32 = $^O eq 'MSWin32';
-my $tmpfile = "tmp0000";
-my $i = 0 ;
-1 while -f ++$tmpfile;
-END {  if ($tmpfile) { 1 while unlink $tmpfile} }
-
-my @prgs = () ;
-
-foreach (sort glob("pragma/warn-*")) {
-
-    next if /\.orig$/ ;
-
-    next if /(~|\.orig)$/;
-
-    open F, "<$_" or die "Cannot open $_: $!\n" ;
-    while (<F>) {
-	last if /^__END__/ ;
-    }
-
-    {
-        local $/ = undef;
-        @prgs = (@prgs, split "\n########\n", <F>) ;
-    }
-    close F ;
-}
-
-undef $/;
-
-print "1..", scalar @prgs, "\n";
- 
- 
-for (@prgs){
-    my $switch = "";
-    my @temps = () ;
-    if (s/^\s*-\w+//){
-        $switch = $&;
-        $switch =~ s/(-\S*[A-Z]\S*)/"-$1"/ if $Is_VMS; # protect uc switches
-    }
-    my($prog,$expected) = split(/\nEXPECT\n/, $_);
-    if ( $prog =~ /--FILE--/) {
-        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
-	shift @files ;
-	die "Internal error test $i didn't split into pairs, got " . 
-		scalar(@files) . "[" . join("%%%%", @files) ."]\n"
-	    if @files % 2 ;
-	while (@files > 2) {
-	    my $filename = shift @files ;
-	    my $code = shift @files ;
-    	    push @temps, $filename ;
-	    open F, ">$filename" or die "Cannot open $filename: $!\n" ;
-	    print F $code ;
-	    close F ;
-	}
-	shift @files ;
-	$prog = shift @files ;
-    }
-    open TEST, ">$tmpfile";
-    print TEST $prog,"\n";
-    close TEST;
-    my $results = $Is_VMS ?
-                  `MCR $^X $switch $tmpfile` :
-		  $Is_MSWin32 ?
-                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
-                  `sh -c './perl $switch $tmpfile' 2>&1`;
-    my $status = $?;
-    $results =~ s/\n+$//;
-    # allow expected output to be written as if $prog is on STDIN
-    $results =~ s/tmp\d+/-/g;
-    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
-# bison says 'parse error' instead of 'syntax error',
-# various yaccs may or may not capitalize 'syntax'.
-    $results =~ s/^(syntax|parse) error/syntax error/mig;
-    $expected =~ s/\n+$//;
-    my $prefix = ($results =~ s/^PREFIX\n//) ;
-    # any special options? (OPTIONS foo bar zap)
-    my $option_regex = 0;
-    if ($expected =~ s/^OPTIONS? (.+)\n//) {
-	foreach my $option (split(' ', $1)) {
-	    if ($option eq 'regex') { # allow regular expressions
-		$option_regex = 1;
-	    } else {
-		die "$0: Unknown OPTION '$option'\n";
-	    }
-	}
-    }
-    if ( $results =~ s/^SKIPPED\n//) {
-	print "$results\n" ;
-    }
-    elsif (($prefix  && (( $option_regex && $results !~ /^$expected/) ||
-			 (!$option_regex && $results !~ /^\Q$expected/))) or
-	   (!$prefix && (( $option_regex && $results !~ /^$expected/) ||
-			 (!$option_regex && $results ne $expected)))) {
-        print STDERR "PROG: $switch\n$prog\n";
-        print STDERR "EXPECTED:\n$expected\n";
-        print STDERR "GOT:\n$results\n";
-        print "not ";
-    }
-    print "ok ", ++$i, "\n";
-    foreach (@temps) 
-	{ unlink $_ if $_ } 
-}