Integrate mainline

p4raw-id: //depot/perlio@8567

5 files changed, 123 insertions, 32 deletions

diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t
index e853dee2b7..21e0c7c8d0 100644
--- a/t/lib/1_compile.t
+++ b/t/lib/1_compile.t
@@ -8,48 +8,73 @@ BEGIN {
 use strict;
 use warnings;
 use Config;
-use File::Find;
 
 my %Core_Modules;
 
-find(sub {
-        if ($File::Find::name =~ m!^lib\W+(.+)\.pm$!i) {
-	    my $module = $1;
-	    $module =~ s/[^\w-]/::/g;
-	    $Core_Modules{$module}++;
-	}
-    }, "lib");
+unless (open(MANIFEST, "MANIFEST")) {
+    die "$0: failed to open 'MANIFEST': $!\n";
+}
+
+sub add_by_name {
+    $Core_Modules{$_[0]}++;
+}
+
+while (<MANIFEST>) {
+    next unless m!^lib/(\S+?)\.pm!;
+    my $module = $1;
+    $module =~ s!/!::!g;
+    add_by_name($module);
+}
+
+close(MANIFEST);
 
 # Delete stuff that can't be tested here.
 
-sub delete_unless_in_extensions {
-    delete $Core_Modules{$_[0]} unless $Config{extensions} =~ /\b$_[0]\b/;
+sub delete_by_name {
+    delete $Core_Modules{$_[0]};
+}
+
+sub has_extension {
+    $Config{extensions} =~ /\b$_[0]\b/i;
+}
+
+sub delete_unless_has_extension {
+    delete $Core_Modules{$_[0]} unless has_extension($_[0]);
 }
 
 foreach my $known_extension (split(' ', $Config{known_extensions})) {
-    delete_unless_in_extensions($known_extension);
+    delete_unless_has_extension($known_extension);
 }
 
 sub delete_by_prefix {
-    delete @Core_Modules{grep { /^$_[0]/ } keys %Core_Modules};
+    for my $match (grep { /^$_[0]/ } keys %Core_Modules) {
+	delete_by_name($match);
+    }
 }
 
-delete $Core_Modules{'CGI::Fast'}; # won't load without FCGI
+delete_by_name('CGI::Fast');		# won't load without FCGI
 
-delete $Core_Modules{'Devel::DProf'}; # needs to be run as -d:DProf
+delete_by_name('Devel::DProf');		# needs to be run as -d:DProf
 
 delete_by_prefix('ExtUtils::MM_');	# ExtUtils::MakeMaker's domain
 
 delete_by_prefix('File::Spec::');	# File::Spec's domain
-$Core_Modules{'File::Spec::Functions'}++;	# put this back
+add_by_name('File::Spec::Functions');	# put this back
 
-unless ($Config{extensions} =~ /\bThread\b/) {
-    delete $Core_Modules{Thread};
+sub using_feature {
+    my $use = "use$_[0]";
+    exists $Config{$use} &&
+	defined $Config{$use} &&
+	$Config{$use} eq 'define';
+}
+
+unless (using_feature('threads') && has_extension('Thread')) {
+    delete_by_name('Thread');
     delete_by_prefix('Thread::');
 }
 
 delete_by_prefix('unicode::');
-$Core_Modules{'unicode::distinct'}++;	# put this back
+add_by_name('unicode::distinct');	# put this back
 
 # Okay, this is the list.
 
@@ -65,11 +90,10 @@ foreach my $module (@Core_Modules) {
     $test_num++;
 }
 
-
-# We do this as a separate process else we'll blow the hell out of our
-# namespace.
+# We do this as a separate process else we'll blow the hell
+# out of our namespace.
 sub compile_module {
-    my($module) = @_;
+    my ($module) = $_[0];
     
     return scalar `./perl -Ilib t/lib/compmod.pl $module` =~ /^ok/;
 }
diff --git a/t/lib/b.t b/t/lib/b.t
index 42760c8f15..7186841c78 100755
--- a/t/lib/b.t
+++ b/t/lib/b.t
@@ -71,6 +71,8 @@ my $a;
 my $Is_VMS = $^O eq 'VMS';
 $a = `$^X "-I../lib" "-MO=Deparse" -anle 1 2>&1`;
 $a =~ s/-e syntax OK\n//g;
+$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
+$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
 $b = <<'EOF';
 
 LINE: while (defined($_ = <ARGV>)) {
@@ -140,7 +142,12 @@ if ($is_thread) {
     print "# use5005threads: test $test skipped\n";
 } else {
     $a = `$^X "-I../lib" "-MO=Showlex" -e "my %one" 2>&1`;
-    print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+    if (ord('A') != 193) { # ASCIIish
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+    } 
+    else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
+    }
 }
 ok;
 
diff --git a/t/lib/st-06compat.t b/t/lib/st-06compat.t
index e1a0780e5e..236d1134dc 100644
--- a/t/lib/st-06compat.t
+++ b/t/lib/st-06compat.t
@@ -86,15 +86,27 @@ sub obj { $_[0]->{obj} }
 
 package main;
 
+my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
+
 my $r = ROOT->make;
 
 my $data = '';
 while (<DATA>) {
-	next if /^#/;
-	$data .= unpack("u", $_);
+	if (!$Is_EBCDIC) {
+	    next if /^#/;
+	    $data .= unpack("u", $_);
+	}
+	else {
+	    next if /^#$/;
+	    next if /^#\s+/;
+	    next if /^[^#]/;
+	    s/^#//;
+	    $data .= unpack("u", $_);
+	}
 }
 
-ok 1, length $data == 278;
+my $expected_length = $Is_EBCDIC ? 217 : 278;
+ok 1, length $data == $expected_length;
 
 my $y = thaw($data);
 ok 2, 1;
@@ -130,3 +142,12 @@ M6%A8`````6$$`@````4$`@````$(@%AB!E-)35!,15A8!`(````!"(%88@93
 M24U03$586`0"`````0B"6&(&4TE-4$Q%6%@$`@````$(@UAB!E-)35!,15A8
 M!`(````!"(188@9324U03$586%A8`````V]B:@0,!``````*6%A8`````W)E
 (9F($4D]/5%@`
+#
+# using Storable-1.007, output of: print '#' . pack("u", nfreeze(ROOT->make));
+# on OS/390 (cp 1047) original size: 217 bytes
+#
+#M!0,1!-G6UN,#````!00,!!$)X\G%Q&W(P>+(`P````(*!*6!D_$````$DH6H
+#M\0H$I8&3\@````22A:CR`````YF%A@0"````!@B!"(`(?0H(8/-+\?3Q]?D)
+#M```!R`H#]$OU`````Y6DE`0"````!001!N+)U-?3Q0(````!"(`$$@("````
+#M`0B!!!("`@````$(@@02`@(````!"(,$$@("`````0B$`````Y:"D00`````
+#E!`````&(!`(````#"@:BHYF)E8<$``````0$```````````!@0``
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index bf24c07ec9..2cf937b6b7 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -970,6 +970,38 @@ unless ($aaa) {
     test($a =~ /^`1' is not a code reference at/); # 215
 }
 
+{
+  my $c = 0;
+  package ov_int1;
+  use overload '""'    => sub { 3+shift->[0] },
+               '0+'    => sub { 10+shift->[0] },
+               'int'   => sub { 100+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package ov_int2;
+  use overload '""'    => sub { 5+shift->[0] },
+               '0+'    => sub { 30+shift->[0] },
+               'int'   => sub { 'ov_int1'->new(1000+shift->[0]) };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package noov_int;
+  use overload '""'    => sub { 2+shift->[0] },
+               '0+'    => sub { 9+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package main;
+
+  my $x = new noov_int 11;
+  my $int_x = int $x;
+  main::test("$int_x" eq 20);			# 216
+  $x = new ov_int1 31;
+  $int_x = int $x;
+  main::test("$int_x" eq 131);			# 217
+  $x = new ov_int2 51;
+  $int_x = int $x;
+  main::test("$int_x" eq 1054);			# 218
+}
+
 # make sure that we don't inifinitely recurse
 {
   my $c = 0;
@@ -979,10 +1011,12 @@ unless ($aaa) {
                'bool'  => sub { shift },
                fallback => 1;
   my $x = bless([]);
-  main::test("$x" =~ /Recurse=ARRAY/);		# 216
-  main::test($x);                               # 217
-  main::test($x+0 =~ /Recurse=ARRAY/);		# 218
-};
+  main::test("$x" =~ /Recurse=ARRAY/);		# 219
+  main::test($x);                               # 220
+  main::test($x+0 =~ /Recurse=ARRAY/);		# 221
+}
+
+
 
 # Last test is:
-sub last {218}
+sub last {221}
diff --git a/t/pragma/sub_lval.t b/t/pragma/sub_lval.t
index 03a2fa0a9a..f19268b384 100755
--- a/t/pragma/sub_lval.t
+++ b/t/pragma/sub_lval.t
@@ -514,7 +514,12 @@ print "ok 61\n";
 
 $str = "Made w/ JavaScript";
 sub veclv : lvalue { vec($str, 2, 32) }
-veclv() = 0x5065726C;
+if (ord('A') != 193) {
+    veclv() = 0x5065726C;
+}
+else { # EBCDIC?
+    veclv() = 0xD7859993;
+}
 print "# $str\nnot " unless $str eq "Made w/ PerlScript";
 print "ok 62\n";