Vendor import Perl 5.6.1

6 files changed, 64 insertions, 9 deletions

diff --git a/contrib/perl5/t/comp/bproto.t b/contrib/perl5/t/comp/bproto.t
index 01efb84..70748be 100755
--- a/contrib/perl5/t/comp/bproto.t
+++ b/contrib/perl5/t/comp/bproto.t
@@ -5,7 +5,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 print "1..10\n";
diff --git a/contrib/perl5/t/comp/colon.t b/contrib/perl5/t/comp/colon.t
index dee5330..d2c64fe 100755
--- a/contrib/perl5/t/comp/colon.t
+++ b/contrib/perl5/t/comp/colon.t
@@ -9,7 +9,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 use strict;
diff --git a/contrib/perl5/t/comp/cpp.t b/contrib/perl5/t/comp/cpp.t
index bbff38c..5b061ee 100755
--- a/contrib/perl5/t/comp/cpp.t
+++ b/contrib/perl5/t/comp/cpp.t
@@ -4,7 +4,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 use Config;
diff --git a/contrib/perl5/t/comp/proto.t b/contrib/perl5/t/comp/proto.t
index ee17088..99dd3ea 100755
--- a/contrib/perl5/t/comp/proto.t
+++ b/contrib/perl5/t/comp/proto.t
@@ -11,12 +11,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 use strict;
 
-print "1..107\n";
+print "1..122\n";
 
 my $i = 1;
 
@@ -293,6 +293,25 @@ printf "ok %d\n",$i++;
 ##
 ##
 
+testing \&a_subx, '\&';
+
+sub a_subx (\&) {
+    print "# \@_ = (",join(",",@_),")\n";
+    &{$_[0]};
+}
+
+sub tmp_sub_2 { printf "ok %d\n",$i++ }
+a_subx &tmp_sub_2;
+
+@array = ( \&tmp_sub_2 );
+eval 'a_subx @array';
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
 testing \&sub_aref, '&\@';
 
 sub sub_aref (&\@) {
@@ -466,3 +485,14 @@ sub sreftest (\$$) {
     sreftest($helem{$i}, $i++);
     sreftest $aelem[0], $i++;
 }
+
+# test prototypes when they are evaled and there is a syntax error
+#
+for my $p ( "", qw{ () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@) } ) {
+  no warnings 'redefine';
+  my $eval = "sub evaled_subroutine $p { &void *; }";
+  eval $eval;
+  # The /Syntax error/ is seen on OS/390.  It's /syntax error/ elsewhere
+  print "# eval[$eval]\nnot " unless $@ && $@ =~ /[Ss]yntax error/;
+  print "ok ", $i++, "\n";
+}
diff --git a/contrib/perl5/t/comp/require.t b/contrib/perl5/t/comp/require.t
index 1d92687..1b0af9f 100755
--- a/contrib/perl5/t/comp/require.t
+++ b/contrib/perl5/t/comp/require.t
@@ -2,12 +2,21 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, ('.', '../lib');
+    @INC = '.';
+    push @INC, '../lib';
 }
 
 # don't make this lexical
 $i = 1;
-print "1..20\n";
+# Tests 21 .. 23 work only with non broken UTF16-as-code implementations,
+# i.e. not EBCDIC Perls.
+my $Is_EBCDIC = ord('A') == 193 ? 1 : 0;
+if ($Is_EBCDIC) {
+   print "1..20\n";
+}
+else {
+   print "1..23\n";
+}
 
 sub do_require {
     %INC = ();
@@ -19,6 +28,8 @@ sub do_require {
 sub write_file {
     my $f = shift;
     open(REQ,">$f") or die "Can't write '$f': $!";
+    binmode REQ;
+    use bytes;
     print REQ @_;
     close REQ;
 }
@@ -122,7 +133,21 @@ do "bleah.do";
 dofile();
 sub dofile { do "bleah.do"; };
 print $x;
-$i++;
+
+exit if $Is_EBCDIC;
+
+# UTF-encoded things
+my $utf8 = chr(0xFEFF);
+
+$i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n));
+
+sub bytes_to_utf16 {
+    my $utf16 = pack("$_[0]*", unpack("C*", $_[1]));
+    return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16;
+}
+
+$i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE
+$i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE
 
 END { 1 while unlink 'bleah.pm'; 1 while unlink 'bleah.do'; }
 
diff --git a/contrib/perl5/t/comp/use.t b/contrib/perl5/t/comp/use.t
index 1f5fae3..fb59777 100755
--- a/contrib/perl5/t/comp/use.t
+++ b/contrib/perl5/t/comp/use.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 print "1..27\n";