z/OS: t/ - mostly EBCDIC fixes

Message-Id: <200607112101.k6BL1TGr321715@kosh.hut.fi>

p4raw-id: //depot/perl@28550

2 files changed, 40 insertions, 6 deletions

diff --git a/t/uni/case.pl b/t/uni/case.pl
index aad638dc67..e27771b192 100644
--- a/t/uni/case.pl
+++ b/t/uni/case.pl
@@ -78,6 +78,9 @@ sub casetest {
 
     for my $i (sort keys %$spec) {
 	my $w = unidump($spec->{$i});
+	if (ord('A') == 193 && $i eq "\x8A\x73") {
+	    $w = '0178'; # It's a latin small Y with diaresis and not a latin small letter sharp 's'.
+	}
 	my $u = unpack "C0U", $i;
 	my $h = sprintf "%04X", $u;
 	my $c = chr($u); $c .= chr(0x100); chop $c;
@@ -118,7 +121,7 @@ sub casetest {
 		#
 		# 0130 -> 0069 0307 (00D1 0307)
 		#
-		if ($i =~ /^(0130|0149|01F0|1E96|1E97|1E98|1E99|1E9A)$/) {
+		if ($h =~ /^(0130|0149|01F0|1E96|1E97|1E98|1E99|1E9A)$/) {
 		    $e =~ s/004E/002B/; # N
 		    $e =~ s/004A/00A2/; # J
 		    $e =~ s/0048/00E7/; # H
diff --git a/t/uni/class.t b/t/uni/class.t
index fa4cbf58ae..225b77030d 100644
--- a/t/uni/class.t
+++ b/t/uni/class.t
@@ -50,7 +50,13 @@ sub test_regexp ($$) {
 
 use strict;
 
-my $str = join "", map chr($_), 0x20 .. 0x6F;
+my $str;
+
+if (ord('A') == 193) {
+    $str = join "", map chr($_), 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, 0xF0 .. 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, 0x7C, 0xC1 .. 0xC9, 0xD1 .. 0xD9, 0xE2 .. 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, 0x79, 0x81 .. 0x89, 0x91 .. 0x96; # IBM-1047
+} else {
+    $str = join "", map chr($_), 0x20 .. 0x6F;
+}
 
 # make sure it finds built-in class
 is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
@@ -91,6 +97,27 @@ my $updir = File::Spec->updir;
 
 no warnings 'utf8'; # we do not want warnings about surrogates etc
 
+sub char_range {
+    my ($h1, $h2) = @_;
+
+    my $str;
+
+    if (ord('A') == 193 && $h1 < 256) {
+	my $h3 = ($h2 || $h1) + 1;
+	if ($h3 - $h1 == 1) {
+	    $str = join "", pack 'U*', $h1 .. $h3; # Using pack since chr doesn't generate Unicode chars for value < 256.
+	} elsif ($h3 - $h1 > 1) {
+	    for (my $i = $h1; $i <= $h3; $i++) {
+		$str = join "", $str, pack 'U*', $i;
+	    }
+	}
+    } else {
+	$str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+    }
+
+    return $str;
+}
+
 # non-General Category and non-Script
 while (my ($abbrev, $files) = each %utf8::PVA_abbr_map) {
   my $prop_name = $utf8::PropertyAlias{$abbrev};
@@ -104,7 +131,8 @@ while (my ($abbrev, $files) = each %utf8::PVA_abbr_map) {
 
     next unless -e $filename;
     my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
-    my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+    my $str = char_range($h1, $h2);
 
     for my $p ($prop_name, $abbrev) {
       for my $c ($files->{$_}, $_) {
@@ -124,7 +152,8 @@ for my $p ('gc', 'sc') {
 
     next unless -e $filename;
     my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
-    my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+    my $str = char_range($h1, $h2);
 
     for my $x ($p, { gc => 'General Category', sc => 'Script' }->{$p}) {
       for my $y ($abbr, $utf8::PropValueAlias{$p}{$abbr}, $utf8::PVA_abbr_map{gc_sc}{$abbr}) {
@@ -162,7 +191,8 @@ SKIP:
     my $filename = File::Spec->catfile($dirname, $leafname);
 
     my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
-    my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+    my $str = char_range($h1, $h2);
 
     for my $x ('gc', 'General Category') {
       print "# $filename $x $_, $utf8::PA_reverse{$_}\n";
@@ -186,7 +216,8 @@ for (grep $utf8::Canonical{$_} =~ /^In/, keys %utf8::Canonical) {
   print "# In$_ $filename\n";
 
   my ($h1, $h2) = map hex, (split(/\t/, (do $filename), 3))[0,1];
-  my $str = join "", map chr, $h1 .. (($h2 || $h1) + 1);
+
+  my $str = char_range($h1, $h2);
 
   my $blk = $_;