was Re: [ID 19991102.003] perl on os390

To: gsar@activestate.com, perl-mvs@perl.org, perlbug@perl.com
Message-Id: <199911102234.OAA01018@brio.forte.com>

p4raw-id: //depot/cfgperl@4562

diff --git a/t/lib/dumper.t b/t/lib/dumper.t
index 9130d1c..505051f 100755 (executable)
--- 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/op/pack.t b/t/op/pack.t
index 11ada39..2d34311 100755 (executable)
--- 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 4ffe136..74ca639 100755 (executable)
--- 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 c453c47..7642678 100755 (executable)
--- 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 f673dce..f9a9c59 100755 (executable)
--- 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;