integrate cfgperl changes into mainline

p4raw-id: //depot/perl@4573

8 files changed, 287 insertions, 29 deletions

diff --git a/t/io/fs.t b/t/io/fs.t
index 31929708a4..72e9552037 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -12,6 +12,10 @@ use Config;
 $Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or
 	      $^O eq 'os2' or $^O eq 'mint');
 
+if (defined &Win32::IsWinNT && Win32::IsWinNT()) {
+    $Is_Dosish = '' if Win32::FsType() eq 'NTFS';
+}
+
 print "1..28\n";
 
 $wd = (($^O eq 'MSWin32') ? `cd` : `pwd`);
@@ -54,28 +58,35 @@ elsif (($mode & 0777) == 0666)
     {print "ok 5\n";} 
 else {print "not ok 5\n";}
 
-if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
+$newmode = $^O eq 'MSWin32' ? 0444 : 0777;
+if ((chmod $newmode,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
 if ($Is_Dosish) {print "ok 7 # skipped: no link\n";} 
-elsif (($mode & 0777) == 0777) {print "ok 7\n";} 
+elsif (($mode & 0777) == $newmode) {print "ok 7\n";} 
 else {print "not ok 7\n";}
 
+$newmode = 0700;
+if ($^O eq 'MSWin32') {
+    chmod 0444, 'x';
+    $newmode = 0666;
+}
+
 if ($Is_Dosish) {print "ok 8 # skipped: no link\n";} 
-elsif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} 
+elsif ((chmod $newmode,'c','x') == 2) {print "ok 8\n";} 
 else {print "not ok 8\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
 if ($Is_Dosish) {print "ok 9 # skipped: no link\n";} 
-elsif (($mode & 0777) == 0700) {print "ok 9\n";} 
+elsif (($mode & 0777) == $newmode) {print "ok 9\n";} 
 else {print "not ok 9\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('x');
 if ($Is_Dosish) {print "ok 10 # skipped: no link\n";} 
-elsif (($mode & 0777) == 0700) {print "ok 10\n";} 
+elsif (($mode & 0777) == $newmode) {print "ok 10\n";} 
 else {print "not ok 10\n";}
 
 if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; } 
diff --git a/t/lib/dumper.t b/t/lib/dumper.t
index 9130d1c690..505051f216 100755
--- a/t/lib/dumper.t
+++ b/t/lib/dumper.t
@@ -9,6 +9,8 @@ BEGIN {
 }
 
 use Data::Dumper;
+use Config;
+my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
 
 $Data::Dumper::Pad = "#";
 my $TMAX;
@@ -238,11 +240,20 @@ EOT
 
 ############# 43
 ##
+if (!$Is_ebcdic) {
 $WANT = <<'EOT';
 #$VAR1 = {
 #  "abc\0'\efg" => "mno\0"
 #};
 EOT
+}
+else {
+$WANT = <<"EOT";
+#\$VAR1 = {
+#  "\\201\\202\\203\\340\\360'\e\\206\\207" => "\\224\\225\\226\\340\\360"
+#};
+EOT
+}
 
 $foo = { "abc\000\'\efg" => "mno\000" };
 {
@@ -277,6 +288,7 @@ EOT
 
 ############# 49
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #$foo = \*::foo;
 #*::foo = \5;
@@ -301,6 +313,33 @@ EOT
 #@bar = @{*::foo{ARRAY}};
 #%baz = %{*::foo{ARRAY}->[2]};
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#           #0
+#           10,
+#           #1
+#           '',
+#           #2
+#           {
+#             'd' => {},
+#             'a' => 1,
+#             'b' => '',
+#             'c' => []
+#           }
+#         ];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo = *::foo{ARRAY}->[2];
+#@bar = @{*::foo{ARRAY}};
+#%baz = %{*::foo{ARRAY}->[2]};
+EOT
+}
 
   $Data::Dumper::Purity = 1;
   $Data::Dumper::Indent = 3;
@@ -309,6 +348,7 @@ EOT
 
 ############# 55
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #$foo = \*::foo;
 #*::foo = \5;
@@ -330,6 +370,30 @@ EOT
 #$bar = *::foo{ARRAY};
 #$baz = *::foo{ARRAY}->[2];
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#  10,
+#  '',
+#  {
+#    'd' => {},
+#    'a' => 1,
+#    'b' => '',
+#    'c' => []
+#  }
+#];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo = *::foo{ARRAY}->[2];
+#$bar = *::foo{ARRAY};
+#$baz = *::foo{ARRAY}->[2];
+EOT
+}
 
   $Data::Dumper::Indent = 1;
   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
@@ -337,6 +401,7 @@ EOT
 
 ############# 61
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #@bar = (
 #  10,
@@ -358,12 +423,37 @@ EOT
 #%baz = %{*::foo{HASH}};
 #$foo = $bar[1];
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#@bar = (
+#  10,
+#  \*::foo,
+#  {}
+#);
+#*::foo = \5;
+#*::foo = \@bar;
+#*::foo = {
+#  'd' => {},
+#  'a' => 1,
+#  'b' => '',
+#  'c' => []
+#};
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'c'} = \@bar;
+#$bar[2] = *::foo{HASH};
+#%baz = %{*::foo{HASH}};
+#$foo = $bar[1];
+EOT
+}
 
   TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
   TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
 
 ############# 67
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #$bar = [
 #  10,
@@ -385,12 +475,37 @@ EOT
 #$baz = *::foo{HASH};
 #$foo = $bar->[1];
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#$bar = [
+#  10,
+#  \*::foo,
+#  {}
+#];
+#*::foo = \5;
+#*::foo = $bar;
+#*::foo = {
+#  'd' => {},
+#  'a' => 1,
+#  'b' => '',
+#  'c' => []
+#};
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'c'} = $bar;
+#$bar->[2] = *::foo{HASH};
+#$baz = *::foo{HASH};
+#$foo = $bar->[1];
+EOT
+}
 
   TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
   TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
 
 ############# 73
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #$foo = \*::foo;
 #@bar = (
@@ -405,6 +520,23 @@ EOT
 #);
 #%baz = %{$bar[2]};
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#@bar = (
+#  10,
+#  $foo,
+#  {
+#    d => $bar[2],
+#    a => 1,
+#    b => \5,
+#    c => \@bar
+#  }
+#);
+#%baz = %{$bar[2]};
+EOT
+}
 
   $Data::Dumper::Purity = 0;
   $Data::Dumper::Quotekeys = 0;
@@ -413,6 +545,7 @@ EOT
 
 ############# 79
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #$foo = \*::foo;
 #$bar = [
@@ -427,6 +560,23 @@ EOT
 #];
 #$baz = $bar->[2];
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#$bar = [
+#  10,
+#  $foo,
+#  {
+#    d => $bar->[2],
+#    a => 1,
+#    b => \5,
+#    c => $bar
+#  }
+#];
+#$baz = $bar->[2];
+EOT
+}
 
   TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
   TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
@@ -448,6 +598,7 @@ EOT
   
 ############# 85
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #%kennels = (
 #  First => \'Fido',
@@ -460,6 +611,21 @@ EOT
 #);
 #%mutts = %kennels;
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+}
 
   TEST q(
 	 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
@@ -487,6 +653,7 @@ EOT
   
 ############# 97
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #%kennels = (
 #  First => \'Fido',
@@ -499,6 +666,21 @@ EOT
 #);
 #%mutts = %kennels;
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+#@dogs = (
+#  ${$kennels{First}},
+#  ${$kennels{Second}},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+}
 
   
   TEST q($d->Reset; $d->Dump);
@@ -508,6 +690,7 @@ EOT
 
 ############# 103
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #@dogs = (
 #  'Fido',
@@ -520,6 +703,21 @@ EOT
 #%kennels = %{$dogs[2]};
 #%mutts = %{$dogs[2]};
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    Second => \$dogs[1],
+#    First => \$dogs[0]
+#  }
+#);
+#%kennels = %{$dogs[2]};
+#%mutts = %{$dogs[2]};
+EOT
+}
 
   TEST q(
 	 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
@@ -543,6 +741,7 @@ EOT
 
 ############# 115
 ##
+if (!$Is_ebcdic) {
   $WANT = <<'EOT';
 #@dogs = (
 #  'Fido',
@@ -557,6 +756,23 @@ EOT
 #  Second => \'Wags'
 #);
 EOT
+}
+else {
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    Second => \'Wags',
+#    First => \'Fido'
+#  }
+#);
+#%kennels = (
+#  Second => \'Wags',
+#  First => \'Fido'
+#);
+EOT
+}
 
   TEST q(
 	 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t
index ce91db6e3c..942bb4dad6 100644
--- a/t/lib/syslfs.t
+++ b/t/lib/syslfs.t
@@ -37,20 +37,22 @@ sub explain {
 EOM
 }
 
+print "# checking whether we have sparse files...\n";
+
 # Known have-nots.
 if ($^O eq 'win32' || $^O eq 'vms') {
-    print "1..0\n# no sparse files\n";
+    print "1..0\n# no sparse files (because this is $^O) \n";
     bye();
 }
 
 # Known haves that have problems running this test
 # (for example because they do not support sparse files, like UNICOS)
 if ($^O eq 'unicos') {
-    print "1..0\n# large files known to work but unable to test them here\n";
+    print "1..0\n# large files known to work but unable to test them here ($^O)\n";
     bye();
 }
 
-# Then try to deduce whether we have sparse files.
+# Then try heuristically to deduce whether we have sparse files.
 
 # We'll start off by creating a one megabyte file which has
 # only three "true" bytes.  If we have sparseness, we should
@@ -79,24 +81,31 @@ unless (@s == 13 &&
     bye();
 }
 
+print "# we seem to have sparse files...\n";
+
 # By now we better be sure that we do have sparse files:
 # if we are not, the following will hog 5 gigabytes of disk.  Ooops.
 
 $ENV{LC_ALL} = "C";
 
 sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
-	do { warn "sysopen failed: $!\n"; bye };
-sysseek(BIG, 5_000_000_000, SEEK_SET);
+	do { warn "sysopen 'big' failed: $!\n"; bye };
+my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
+unless (defined $sysseek && $sysseek == 5_000_000_000) {
+    print "1..0\n# seeking past 2GB failed: $! (sysseek returned ",
+          defined $sysseek ? $sysseek : 'undef', ")\n";
+    explain();
+    bye();
+}
 
 # The syswrite will fail if there are are filesize limitations (process or fs).
-my $syswrite = syswrite(BIG, "big") == 3;
-my $close   = close BIG if $syswrite;
+my $syswrite = syswrite(BIG, "big");
+print "# syswrite failed: $! (syswrite returned ",
+      defined $syswrite ? $syswrite : 'undef', ")\n"
+    unless defined $syswrite && $syswrite == 3;
+my $close     = close BIG;
+print "# close failed: $!\n" unless $close;
 unless($syswrite && $close) {
-    unless ($syswrite) {
-        print "# syswrite failed: $!\n"
-    } else {
-        print "# close failed: $!\n"
-    }
     if ($! =~/too large/i) {
 	print "1..0\n# writing past 2GB failed: process limits?\n";
     } elsif ($! =~ /quota/i) {
diff --git a/t/op/lfs.t b/t/op/lfs.t
index 140846f7a2..0d6d027743 100644
--- a/t/op/lfs.t
+++ b/t/op/lfs.t
@@ -36,20 +36,22 @@ sub explain {
 EOM
 }
 
+print "# checking whether we have sparse files...\n";
+
 # Known have-nots.
 if ($^O eq 'win32' || $^O eq 'vms') {
-    print "1..0\n# no sparse files\n";
+    print "1..0\n# no sparse files (because this is $^O) \n";
     bye();
 }
 
 # Known haves that have problems running this test
 # (for example because they do not support sparse files, like UNICOS)
 if ($^O eq 'unicos') {
-    print "1..0\n# large files known to work but unable to test them here\n";
+    print "1..0\n# large files known to work but unable to test them here ($^O)\n";
     bye();
 }
 
-# Then try to deduce whether we have sparse files.
+# Then try to heuristically deduce whether we have sparse files.
 
 # Let's not depend on Fcntl or any other extension.
 
@@ -82,6 +84,8 @@ unless (@s == 13 &&
     bye();
 }
 
+print "# we seem to have sparse files...\n";
+
 # By now we better be sure that we do have sparse files:
 # if we are not, the following will hog 5 gigabytes of disk.  Ooops.
 
@@ -89,18 +93,19 @@ $ENV{LC_ALL} = "C";
 
 open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
 binmode BIG;
-seek(BIG, 5_000_000_000, $SEEK_SET);
+unless (seek(BIG, 5_000_000_000, $SEEK_SET)) {
+    print "1..0\n# seeking past 2GB failed: $!\n";
+    explain();
+    bye();
+}
 
 # Either the print or (more likely, thanks to buffering) the close will
 # fail if there are are filesize limitations (process or fs).
 my $print = print BIG "big";
-my $close = close BIG if $print;
+print "# print failed: $!\n" unless $print;
+my $close = close BIG;
+print "# close failed: $!\n" unless $close;
 unless ($print && $close) {
-    unless ($print) {
-        print "# print failed: $!\n"
-    } else {
-        print "# close failed: $!\n"
-    }
     if ($! =~/too large/i) {
 	print "1..0\n# writing past 2GB failed: process limits?\n";
     } elsif ($! =~ /quota/i) {
diff --git a/t/op/pack.t b/t/op/pack.t
index 11ada3905d..2d34311f1f 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -381,7 +381,9 @@ print $@ eq '' && $x eq 'ab3456789012' ? "ok $test\n" : "not ok $test\n";
 $test++;
 
 eval { ($x) = unpack 'a/a*/b*', '212ab' };
-print $@ eq '' && $x eq '100001100100' ? "ok $test\n" : "#$x,$@\nnot ok $test\n";
+my $expected_x = '100001100100';
+if ($Config{ebcdic} eq 'define') { $expected_x = '100000010100'; }
+print $@ eq '' && $x eq $expected_x ? "ok $test\n" : "#$x,$@\nnot ok $test\n";
 $test++;
 
 # 153..156: / with #
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 4ffe1362c6..74ca639a8c 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -71,6 +71,8 @@ while (<TESTS>) {
     $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//));
     # Certain tests don't work with utf8 (the re_test should be in UTF8)
     $skip = 1 if ($^H &= ~0x00000008) && $pat =~ /\[:\^(alnum|print|word):\]/;
+    # ebcdic platforms do not do [:ascii:]
+    $skip = 1 if ("\t" ne "\011") && $pat =~ /\[:\^?ascii:\]/;
     $result =~ s/B//i unless $skip;
     for $study ('', 'study \$subject') {
  	$c = $iters;
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index c453c47bd1..76426787ca 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -286,6 +286,11 @@ Turkish:tr:tr:9 turkish8
 Yiddish:::1 15
 EOF
 
+if ($^O eq 'os390') {
+    $locales =~ s/Svenska Swedish:sv:fi se:1 15\n//;
+    $locales =~ s/Thai:th:th:11 tis620\n//;
+}
+
 sub in_utf8 () { $^H & 0x08 }
 
 if (in_utf8) {
@@ -323,6 +328,9 @@ sub decode_encodings {
 	    push @enc, $_;
 	}
     }
+    if ($^O eq 'os390') {
+	push @enc, qw(IBM-037 IBM-819 IBM-1047);
+    }
 
     return @enc;
 }
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index f673dce028..f9a9c59c87 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -759,7 +759,12 @@ else {
 		    }, 'deref';
   # Hash:
   my @cont = sort %$deref;
-  test "@cont", '23 5 fake foo';	# 178
+  if ("\t" eq "\011") { # ascii
+      test "@cont", '23 5 fake foo';	# 178
+  } 
+  else {                # ebcdic alpha-numeric sort order
+      test "@cont", 'fake foo 23 5';	# 178
+  }
   my @keys = sort keys %$deref;
   test "@keys", 'fake foo';	# 179
   my @val = sort values %$deref;