Change 28568 by [EMAIL PROTECTED] on 2006/07/13 20:18:59
Subject: [PATCH] z/OS: CPAN-ized ext/ and lib/
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Thu, 13 Jul 2006 23:10:27 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/Data/Dumper/Dumper.xs#61 edit
... //depot/perl/ext/Data/Dumper/t/dumper.t#15 edit
... //depot/perl/ext/Encode/Encode.xs#122 edit
... //depot/perl/ext/Encode/t/utf8strict.t#3 edit
... //depot/perl/ext/MIME/Base64/Base64.xs#19 edit
... //depot/perl/ext/Storable/t/downgrade.t#11 edit
... //depot/perl/ext/Storable/t/overload.t#8 edit
... //depot/perl/ext/threads/shared/shared.xs#57 edit
... //depot/perl/lib/CGI/t/util-58.t#2 edit
... //depot/perl/lib/Digest/t/base.t#2 edit
... //depot/perl/lib/Digest/t/file.t#2 edit
... //depot/perl/lib/Pod/t/pod2html-lib.pl#9 edit
... //depot/perl/lib/Tie/File/t/09_gen_rs.t#14 edit
Differences ...
==== //depot/perl/ext/Data/Dumper/Dumper.xs#61 (text) ====
Index: perl/ext/Data/Dumper/Dumper.xs
--- perl/ext/Data/Dumper/Dumper.xs#60~28035~ 2006-05-01 04:16:13.000000000
-0700
+++ perl/ext/Data/Dumper/Dumper.xs 2006-07-13 13:18:59.000000000 -0700
@@ -138,7 +138,11 @@
for (s = src; s < send; s += UTF8SKIP(s)) {
const UV k = utf8_to_uvchr((U8*)s, NULL);
- if (k > 127) {
+#ifdef EBCDIC
+ if (!isprint(k) || k > 256) {
+#else
+ if (k > 127) {
+#endif
/* 4: \x{} then count the number of hex digits. */
grow += 4 + (k <= 0xFF ? 2 : k <= 0xFFF ? 3 : k <= 0xFFFF ? 4 :
#if UVSIZE == 4
@@ -172,7 +176,12 @@
*r++ = '\\';
*r++ = (char)k;
}
- else if (k < 0x80)
+ else
+#ifdef EBCDIC
+ if (isprint(k) && k < 256)
+#else
+ if (k < 0x80)
+#endif
*r++ = (char)k;
else {
/* The return value of sprintf() is unportable.
==== //depot/perl/ext/Data/Dumper/t/dumper.t#15 (xtext) ====
Index: perl/ext/Data/Dumper/t/dumper.t
--- perl/ext/Data/Dumper/t/dumper.t#14~24917~ 2005-06-21 02:40:46.000000000
-0700
+++ perl/ext/Data/Dumper/t/dumper.t 2006-07-13 13:18:59.000000000 -0700
@@ -48,7 +48,15 @@
: "not ok [EMAIL PROTECTED]");
++$TNUM;
- eval "$t";
+ if ($Is_ebcdic) { # EBCDIC.
+ if ($TNUM == 311 || $TNUM == 314) {
+ eval $string;
+ } else {
+ eval $t;
+ }
+ } else {
+ eval "$t";
+ }
print $@ ? "not ok $TNUM\n# \$@ says: [EMAIL PROTECTED]" : "ok $TNUM\n";
$t = eval $string;
@@ -1285,20 +1293,37 @@
#XXX}
{
- $b = "Bad. XS didn't escape dollar sign";
+ if ($Is_ebcdic) {
+ $b = "Bad. XS didn't escape dollar sign";
+############# 322
+ $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
+#\$VAR1 = '\$b\"[EMAIL PROTECTED]';
+EOT
+ $a = "\$b\"[EMAIL PROTECTED]";
+ chop $a;
+ TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
+ if ($XS) {
+ $WANT = <<'EOT'; # While this is "" string written inside "" here
doc
+#$VAR1 = "\$b\"[EMAIL PROTECTED]";
+EOT
+ TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
+ }
+ } else {
+ $b = "Bad. XS didn't escape dollar sign";
############# 322
- $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
+ $WANT = <<"EOT"; # Careful. This is '' string written inside '' here doc
#\$VAR1 = '\$b\"[EMAIL PROTECTED]';
EOT
- $a = "\$b\"[EMAIL PROTECTED]";
- chop $a;
- TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
- if ($XS) {
- $WANT = <<'EOT'; # While this is "" string written inside "" here doc
+ $a = "\$b\"[EMAIL PROTECTED]";
+ chop $a;
+ TEST q(Data::Dumper->Dump([$a])), "utf8 flag with \" and \$";
+ if ($XS) {
+ $WANT = <<'EOT'; # While this is "" string written inside "" here
doc
#$VAR1 = "\$b\"[EMAIL PROTECTED]";
EOT
- TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
+ TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with \" and \$";
+ }
}
# XS used to produce "$b\"' which is 4 chars, not 3. [ie wrongly qq(\$b\\\")]
############# 328
==== //depot/perl/ext/Encode/Encode.xs#122 (text) ====
Index: perl/ext/Encode/Encode.xs
--- perl/ext/Encode/Encode.xs#121~28359~ 2006-06-06 05:37:34.000000000
-0700
+++ perl/ext/Encode/Encode.xs 2006-07-13 13:18:59.000000000 -0700
@@ -481,7 +481,8 @@
/* Native bytes - can always encode */
U8 *d = (U8 *) SvGROW(dst, 2*slen+1); /* +1 or assertion will botch */
while (s < e) {
- UV uv = NATIVE_TO_UNI((UV) *s++);
+ UV uv = NATIVE_TO_UNI((UV) *s);
+ s++; /* Above expansion of NATIVE_TO_UNI() is safer this way. */
if (UNI_IS_INVARIANT(uv))
*d++ = (U8)UTF_TO_NATIVE(uv);
else {
==== //depot/perl/ext/Encode/t/utf8strict.t#3 (text) ====
Index: perl/ext/Encode/t/utf8strict.t
--- perl/ext/Encode/t/utf8strict.t#2~28098~ 2006-05-04 05:06:33.000000000
-0700
+++ perl/ext/Encode/t/utf8strict.t 2006-07-13 13:18:59.000000000 -0700
@@ -40,14 +40,25 @@
0x0000FFFF => 1, # 5.3.1
);
$NTESTS += scalar keys %ORD;
- %SEQ = (
- qq/ed 9f bf/ => 0, # 2.3.1
- qq/ee 80 80/ => 0, # 2.3.2
- qq/f4 8f bf bf/ => 0, # 2.3.3
- qq/f4 90 80 80/ => 1, # 2.3.4 -- out of range so NG
- # "3 Malformed sequences" are checked by perl.
- # "4 Overlong sequences" are checked by perl.
- );
+ if (ord('A') == 193) {
+ %SEQ = (
+ qq/dd 64 73 73/ => 0, # 2.3.1
+ qq/dd 67 41 41/ => 0, # 2.3.2
+ qq/ee 42 73 73 73/ => 0, # 2.3.3
+ qq/f4 90 80 80/ => 1, # 2.3.4 -- out of range so NG
+ # "3 Malformed sequences" are checked by perl.
+ # "4 Overlong sequences" are checked by perl.
+ );
+ } else {
+ %SEQ = (
+ qq/ed 9f bf/ => 0, # 2.3.1
+ qq/ee 80 80/ => 0, # 2.3.2
+ qq/f4 8f bf bf/ => 0, # 2.3.3
+ qq/f4 90 80 80/ => 1, # 2.3.4 -- out of range so NG
+ # "3 Malformed sequences" are checked by perl.
+ # "4 Overlong sequences" are checked by perl.
+ );
+ }
$NTESTS += scalar keys %SEQ;
}
use strict;
==== //depot/perl/ext/MIME/Base64/Base64.xs#19 (text) ====
Index: perl/ext/MIME/Base64/Base64.xs
--- perl/ext/MIME/Base64/Base64.xs#18~26214~ 2005-11-26 18:35:25.000000000
-0800
+++ perl/ext/MIME/Base64/Base64.xs 2006-07-13 13:18:59.000000000 -0700
@@ -258,7 +258,11 @@
MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint
+#ifdef EBCDIC
+#define qp_isplain(c) ((c) == '\t' || ((!isprint(c) && (c) != '=')))
+#else
#define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) !=
'='))
+#endif
SV*
encode_qp(sv,...)
==== //depot/perl/ext/Storable/t/downgrade.t#11 (text) ====
Index: perl/ext/Storable/t/downgrade.t
--- perl/ext/Storable/t/downgrade.t#10~18008~ 2002-10-12 07:38:19.000000000
-0700
+++ perl/ext/Storable/t/downgrade.t 2006-07-13 13:18:59.000000000 -0700
@@ -217,11 +217,12 @@
if ($] > 5.007002) {
print "# We have utf8 hashes, so test that the utf8 hashes in <DATA> are
valid\n";
my $hash = thaw_hash ('Hash with utf8 keys', \%U_HASH);
+ my $a_circumflex = (ord ('A') == 193 ? "\x47" : "\xe5");
for (keys %$hash) {
my $l = 0 + /^\w+$/;
my $r = 0 + $hash->{$_} =~ /^\w+$/;
cmp_ok ($l, '==', $r, sprintf "key length %d", length $_);
- cmp_ok ($l, '==', $_ eq "ch\xe5teau" ? 0 : 1);
+ cmp_ok ($l, '==', $_ eq "ch${a_circumflex}teau" ? 0 : 1);
}
if (eval "use Hash::Util; 1") {
print "# We have Hash::Util, so test that the restricted utf8 hash is
valid\n";
@@ -230,7 +231,7 @@
my $l = 0 + /^\w+$/;
my $r = 0 + $hash->{$_} =~ /^\w+$/;
cmp_ok ($l, '==', $r, sprintf "key length %d", length $_);
- cmp_ok ($l, '==', $_ eq "ch\xe5teau" ? 0 : 1);
+ cmp_ok ($l, '==', $_ eq "ch${a_circumflex}teau" ? 0 : 1);
}
test_locked_hash ($hash);
} else {
@@ -391,7 +392,7 @@
end
begin 301 Locked hash placeholder
-C!049`0````(.%`````69I)[EMAIL PROTECTED]:23A:(`````!)>%F9,`
+C!049`0````(.%`````69I)[EMAIL PROTECTED]:23A:($````!)>%F9,`
end
==== //depot/perl/ext/Storable/t/overload.t#8 (text) ====
Index: perl/ext/Storable/t/overload.t
--- perl/ext/Storable/t/overload.t#7~22516~ 2004-03-17 08:10:57.000000000
-0800
+++ perl/ext/Storable/t/overload.t 2006-07-13 13:18:59.000000000 -0700
@@ -88,7 +88,12 @@
ok 12, $b + $b == 314;
# nfreeze data generated by make_overload.pl
-my $f = unpack 'u', q{7!084$0Q(05-?3U9%4DQ/040*!'-N;W<`};
+my $f = '';
+if (ord ('A') == 193) { # EBCDIC.
+ $f = unpack 'u', q{7!084$0S(P>)MUN7%V=/6P<0*!**5EJ8`};
+}else {
+ $f = unpack 'u', q{7!084$0Q(05-?3U9%4DQ/040*!'-N;W<`};
+}
# see note at the end of do_retrieve in Storable.xs about why this test has to
# use a reference to an overloaded reference, rather than just a reference.
==== //depot/perl/ext/threads/shared/shared.xs#57 (text) ====
Index: perl/ext/threads/shared/shared.xs
--- perl/ext/threads/shared/shared.xs#56~26695~ 2006-01-06 19:13:08.000000000
-0800
+++ perl/ext/threads/shared/shared.xs 2006-07-13 13:18:59.000000000 -0700
@@ -587,6 +587,11 @@
switch (pthread_cond_timedwait(cond, mut, &ts)) {
case 0: got_it = 1; break;
case ETIMEDOUT: break;
+#ifdef OEMVS
+ case -1:
+ if (errno == ETIMEDOUT || errno == EAGAIN)
+ break;
+#endif
default:
Perl_croak_nocontext("panic: cond_timedwait");
break;
==== //depot/perl/lib/CGI/t/util-58.t#2 (text) ====
Index: perl/lib/CGI/t/util-58.t
--- perl/lib/CGI/t/util-58.t#1~19664~ 2003-06-02 09:41:37.000000000 -0700
+++ perl/lib/CGI/t/util-58.t 2006-07-13 13:18:59.000000000 -0700
@@ -11,6 +11,11 @@
use Test::More tests => 2;
use_ok("CGI::Util");
my $uri = "\x{5c0f}\x{98fc} \x{5f3e}.txt"; # KOGAI, Dan, in Kanji
-is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
- "# Escape string with UTF-8 flag");
+if (ord('A') == 193) { # EBCDIC.
+ is(CGI::Util::escape($uri), "%FC%C3%A0%EE%F9%E5%E7%F8%20%FC%C3%C7%CA.txt",
+ "# Escape string with UTF-8 (UTF-EBCDIC) flag");
+} else {
+ is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
+ "# Escape string with UTF-8 flag");
+}
__END__
==== //depot/perl/lib/Digest/t/base.t#2 (text) ====
Index: perl/lib/Digest/t/base.t
--- perl/lib/Digest/t/base.t#1~21807~ 2003-11-29 08:45:19.000000000 -0800
+++ perl/lib/Digest/t/base.t 2006-07-13 13:18:59.000000000 -0700
@@ -32,17 +32,25 @@
my $ctx = LenDigest->new;
ok($ctx->digest, "X0000");
-ok($ctx->hexdigest, "5830303030");
-ok($ctx->b64digest, "WDAwMDA");
+
+my $EBCDIC = ord('A') == 193;
+
+if ($EBCDIC) {
+ ok($ctx->hexdigest, "e7f0f0f0f0");
+ ok($ctx->b64digest, "5/Dw8PA");
+} else {
+ ok($ctx->hexdigest, "5830303030");
+ ok($ctx->b64digest, "WDAwMDA");
+}
$ctx->add("foo");
ok($ctx->digest, "f0003");
$ctx->add("foo");
-ok($ctx->hexdigest, "6630303033");
+ok($ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033");
$ctx->add("foo");
-ok($ctx->b64digest, "ZjAwMDM");
+ok($ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM");
open(F, ">xxtest$$") || die;
binmode(F);
@@ -61,7 +69,7 @@
};
ok($@ =~ /^Number of bits must be multiple of 8/);
-$ctx->add_bits("01010101");
+$ctx->add_bits($EBCDIC ? "11100100" : "01010101");
ok($ctx->digest, "U0001");
eval {
==== //depot/perl/lib/Digest/t/file.t#2 (text) ====
Index: perl/lib/Digest/t/file.t
--- perl/lib/Digest/t/file.t#1~23928~ 2005-02-04 02:41:43.000000000 -0800
+++ perl/lib/Digest/t/file.t 2006-07-13 13:18:59.000000000 -0700
@@ -37,8 +37,14 @@
close(F) || die "Can't write '$file': $!";
ok(digest_file($file, "Foo"), "0005");
-ok(digest_file_hex($file, "Foo"), "30303035");
-ok(digest_file_base64($file, "Foo"), "MDAwNQ");
+
+if (ord('A') == 193) { # EBCDIC.
+ ok(digest_file_hex($file, "Foo"), "f0f0f0f5");
+ ok(digest_file_base64($file, "Foo"), "8PDw9Q");
+} else {
+ ok(digest_file_hex($file, "Foo"), "30303035");
+ ok(digest_file_base64($file, "Foo"), "MDAwNQ");
+}
unlink($file) || warn "Can't unlink '$file': $!";
==== //depot/perl/lib/Pod/t/pod2html-lib.pl#9 (text) ====
Index: perl/lib/Pod/t/pod2html-lib.pl
--- perl/lib/Pod/t/pod2html-lib.pl#8~20753~ 2003-08-18 01:21:36.000000000
-0700
+++ perl/lib/Pod/t/pod2html-lib.pl 2006-07-13 13:18:59.000000000 -0700
@@ -28,7 +28,7 @@
$expect = <DATA>;
$expect =~ s/\[PERLADMIN\]/$Config::Config{perladmin}/;
if (ord("A") == 193) { # EBCDIC.
- $expect =~ s/item_mat%3c%21%3e/item_mat%4c%5a%6e/;
+ $expect =~ s/item_mat_3c_21_3e/item_mat_4c_5a_6e/;
}
# result
==== //depot/perl/lib/Tie/File/t/09_gen_rs.t#14 (text) ====
Index: perl/lib/Tie/File/t/09_gen_rs.t
--- perl/lib/Tie/File/t/09_gen_rs.t#13~19813~ 2003-06-18 10:31:50.000000000
-0700
+++ perl/lib/Tie/File/t/09_gen_rs.t 2006-07-13 13:18:59.000000000 -0700
@@ -4,6 +4,8 @@
print "1..59\n";
+use Fcntl 'O_RDONLY';
+
my $N = 1;
use Tie::File;
print "ok $N\n"; $N++;
@@ -148,7 +150,7 @@
# termination.
$badrec = "world${RECSEP}hello";
if (setup_badly_terminated_file(1)) {
- tie(@a, "Tie::File", $file, mode => 0, recsep => $RECSEP)
+ tie(@a, "Tie::File", $file, mode => O_RDONLY, recsep => $RECSEP)
or die "Couldn't tie file: $!";
my $z = $#a;
$z = $a[1];
End of Patch.
