Change 28567 by [EMAIL PROTECTED] on 2006/07/13 17:12:00
Subject: [PATCH] z/OS: non-CPAN ext and lib + main() without the third
arg + Stephen McCamant's comment
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Thu, 13 Jul 2006 19:47:29 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/B/B/Deparse.pm#166 edit
... //depot/perl/lib/AutoLoader.t#6 edit
... //depot/perl/lib/DBM_Filter/t/encode.t#2 edit
... //depot/perl/lib/DBM_Filter/t/utf8.t#2 edit
... //depot/perl/lib/ExtUtils/Constant/Utils.pm#2 edit
... //depot/perl/lib/ExtUtils/Embed.pm#29 edit
... //depot/perl/lib/ExtUtils/t/Embed.t#19 edit
... //depot/perl/lib/PerlIO/via/t/QuotedPrint.t#8 edit
... //depot/perl/lib/bytes.t#6 edit
... //depot/perl/lib/dumpvar.pl#25 edit
... //depot/perl/lib/utf8.t#21 edit
... //depot/perl/miniperlmain.c#52 edit
... //depot/perl/perl.h#708 edit
Differences ...
==== //depot/perl/ext/B/B/Deparse.pm#166 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#165~28257~ 2006-05-20 08:27:28.000000000 -0700
+++ perl/ext/B/B/Deparse.pm 2006-07-13 10:12:00.000000000 -0700
@@ -3588,7 +3588,7 @@
return $self->maybe_parens("\\" . $self->const($ref, 20), $cx, 20);
} elsif ($sv->FLAGS & SVf_POK) {
my $str = $sv->PV;
- if ($str =~ /[^ -~]/) { # ASCII for non-printing
+ if ($str =~ /[[:^print:]]/) {
return single_delim("qq", '"', uninterp escape_str unback $str);
} else {
return single_delim("q", "'", unback $str);
==== //depot/perl/lib/AutoLoader.t#6 (xtext) ====
Index: perl/lib/AutoLoader.t
--- perl/lib/AutoLoader.t#5~28295~ 2006-05-24 00:27:47.000000000 -0700
+++ perl/lib/AutoLoader.t 2006-07-13 10:12:00.000000000 -0700
@@ -121,7 +121,7 @@
eval {
$foo->blechanawilla;
};
-like( $@, qr/syntax error/, 'require error propagates' );
+like( $@, qr/syntax error/i, 'require error propagates' );
# test recursive autoloads
open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
==== //depot/perl/lib/DBM_Filter/t/encode.t#2 (text) ====
Index: perl/lib/DBM_Filter/t/encode.t
--- perl/lib/DBM_Filter/t/encode.t#1~22168~ 2004-01-17 09:38:21.000000000
-0800
+++ perl/lib/DBM_Filter/t/encode.t 2006-07-13 10:12:00.000000000 -0700
@@ -87,14 +87,25 @@
ok $db2, "tied to SDBM_File";
-VerifyData(\%h2,
- {
- 'alpha' => "\xCE\xB1",
- 'beta' => "\xCE\xB2",
- "\xCE\xB3"=> "gamma",
- 'euro' => "\xA4",
- "" => "",
- });
+if (ord('A') == 193) { # EBCDIC.
+ VerifyData(\%h2,
+ {
+ 'alpha' => "\xB4\x58",
+ 'beta' => "\xB4\x59",
+ "\xB4\x62"=> "gamma",
+ "\x65\x75\x72\x6F" => "\xA4",
+ "" => "",
+ });
+} else {
+ VerifyData(\%h2,
+ {
+ 'alpha' => "\xCE\xB1",
+ 'beta' => "\xCE\xB2",
+ "\xCE\xB3"=> "gamma",
+ 'euro' => "\xA4",
+ "" => "",
+ });
+}
undef $db2;
{
==== //depot/perl/lib/DBM_Filter/t/utf8.t#2 (text) ====
Index: perl/lib/DBM_Filter/t/utf8.t
--- perl/lib/DBM_Filter/t/utf8.t#1~22168~ 2004-01-17 09:38:21.000000000
-0800
+++ perl/lib/DBM_Filter/t/utf8.t 2006-07-13 10:12:00.000000000 -0700
@@ -69,13 +69,23 @@
ok $db2, "tied to SDBM_File";
-VerifyData(\%h2,
- {
- 'alpha' => "\xCE\xB1",
- 'beta' => "\xCE\xB2",
- "\xCE\xB3"=> "gamma",
- "" => "",
- });
+if (ord('A') == 193) { # EBCDIC.
+ VerifyData(\%h2,
+ {
+ 'alpha' => "\xB4\x58",
+ 'beta' => "\xB4\x59",
+ "\xB4\x62"=> "gamma",
+ "" => "",
+ });
+} else {
+ VerifyData(\%h2,
+ {
+ 'alpha' => "\xCE\xB1",
+ 'beta' => "\xCE\xB2",
+ "\xCE\xB3"=> "gamma",
+ "" => "",
+ });
+}
undef $db2;
{
==== //depot/perl/lib/ExtUtils/Constant/Utils.pm#2 (text) ====
Index: perl/lib/ExtUtils/Constant/Utils.pm
--- perl/lib/ExtUtils/Constant/Utils.pm#1~23867~ 2005-01-23
14:05:12.000000000 -0800
+++ perl/lib/ExtUtils/Constant/Utils.pm 2006-07-13 10:12:00.000000000 -0700
@@ -54,7 +54,11 @@
s/\t/\\t/g;
s/\f/\\f/g;
s/\a/\\a/g;
- s/([^\0-\177])/sprintf "\\%03o", ord $1/ge;
+ if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike.
+ s/([[:^print:]])/sprintf "\\x{%X}", ord $1/ge;
+ } else {
+ s/([^\0-\177])/sprintf "\\%03o", ord $1/ge;
+ }
unless ($] < 5.006) {
# This will elicit a warning on 5.005_03 about [: :] being reserved unless
# I cheat
@@ -87,7 +91,11 @@
s/\a/\\a/g;
unless ($] < 5.006) {
if ($] > 5.007) {
- s/([^\0-\177])/sprintf "\\x{%X}", ord $1/ge;
+ if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike.
+ s/([[:^print:]])/sprintf "\\x{%X}", ord $1/ge;
+ } else {
+ s/([^\0-\177])/sprintf "\\x{%X}", ord $1/ge;
+ }
} else {
# Grr 5.6.1. And I don't think I can use utf8; to force the regexp
# because 5.005_03 will fail.
==== //depot/perl/lib/ExtUtils/Embed.pm#29 (text) ====
Index: perl/lib/ExtUtils/Embed.pm
--- perl/lib/ExtUtils/Embed.pm#28~27566~ 2006-03-22 05:37:19.000000000
-0800
+++ perl/lib/ExtUtils/Embed.pm 2006-07-13 10:12:00.000000000 -0700
@@ -225,11 +225,13 @@
if ($^O eq 'MSWin32') {
$libperl = $Config{libperl};
}
- else {
+ elsif ($^O eq 'os390' && $Config{usedl}) {
+ # Nothing for OS/390 (z/OS) dynamic.
+ } else {
$libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0]
|| ($Config{libperl} =~
/^lib(\w+)(\Q$lib_ext\E|\.\Q$Config{dlext}\E)$/
? "-l$1" : '')
- || "-lperl";
+ || "-lperl";
}
my $lpath = File::Spec->catdir($Config{archlibexp}, 'CORE');
==== //depot/perl/lib/ExtUtils/t/Embed.t#19 (text) ====
Index: perl/lib/ExtUtils/t/Embed.t
--- perl/lib/ExtUtils/t/Embed.t#18~26930~ 2006-01-23 10:40:08.000000000
-0800
+++ perl/lib/ExtUtils/t/Embed.t 2006-07-13 10:12:00.000000000 -0700
@@ -79,7 +79,9 @@
push(@cmd,"-L$lib",File::Spec->catfile($lib,$Config{'libperl'}),$Config{'libc'});
}
}
- else { # Not MSWin32.
+ elsif ($^O eq 'os390' && $Config{usedl}) {
+ # Nothing for OS/390 (z/OS) dynamic.
+ } else { # Not MSWin32 or OS/390 (z/OS) dynamic.
push(@cmd,"-L$lib",'-lperl');
local $SIG{__WARN__} = sub {
warn $_[0] unless $_[0] =~ /No library found for .*perl/
@@ -164,7 +166,12 @@
struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
#endif
+#ifdef NO_ENV_ARRAY_IN_MAIN
+extern char **environ;
+int main(int argc, char **argv)
+#else
int main(int argc, char **argv, char **env)
+#endif
{
PerlInterpreter *my_perl;
#ifdef PERL_GLOBAL_STRUCT
@@ -177,7 +184,11 @@
(void)argc; /* PERL_SYS_INIT3 may #define away their use */
(void)argv;
+#ifdef NO_ENV_ARRAY_IN_MAIN
+ PERL_SYS_INIT3(&argc,&argv,&environ);
+#else
PERL_SYS_INIT3(&argc,&argv,&env);
+#endif
my_perl = perl_alloc();
@@ -187,7 +198,11 @@
my_puts("ok 3");
+#ifdef NO_ENV_ARRAY_IN_MAIN
+ perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, cmds, environ);
+#else
perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, cmds, env);
+#endif
my_puts("ok 4");
==== //depot/perl/lib/PerlIO/via/t/QuotedPrint.t#8 (text) ====
Index: perl/lib/PerlIO/via/t/QuotedPrint.t
--- perl/lib/PerlIO/via/t/QuotedPrint.t#7~22998~ 2004-06-25
15:19:51.000000000 -0700
+++ perl/lib/PerlIO/via/t/QuotedPrint.t 2006-07-13 10:12:00.000000000 -0700
@@ -30,11 +30,21 @@
in it.
EOD
-my $encoded = <<EOD;
+my $encoded;
+
+if (ord('A') == 193) { # EBCDIC.
+ $encoded = <<EOD;
+This is a t=51st for quoted-printable text that has h=44rdly any spe=48ial =
+characters
+in it.
+EOD
+} else {
+ $encoded = <<EOD;
This is a t=E9st for quoted-printable text that has h=E0rdly any spe=E7ial =
characters
in it.
EOD
+}
# Create the encoded test-file
==== //depot/perl/lib/bytes.t#6 (text) ====
Index: perl/lib/bytes.t
--- perl/lib/bytes.t#5~24585~ 2005-05-26 08:13:53.000000000 -0700
+++ perl/lib/bytes.t 2006-07-13 10:12:00.000000000 -0700
@@ -1,3 +1,4 @@
+
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
@@ -42,9 +43,19 @@
} else {
is(bytes::ord($c), 0xc4, "bytes::ord under use bytes looks at the 1st
byte");
}
- is(bytes::substr($c, 0, 1), "\xc4", "bytes::substr under use bytes looks
at bytes");
- is(bytes::index($c, "\x80"), 1, "bytes::index under use bytes looks at
bytes");
- is(bytes::rindex($c, "\xc4"), 0, "bytes::rindex under use bytes looks at
bytes");
+ # In z/OS \x41,\x8c are the codepoints corresponding to \x80,\xc4
respectively under ASCII platform
+ if (ord('A') == 193) { # EBCDIC?
+ is(bytes::substr($c, 0, 1), "\x8c", "bytes::substr under use bytes
looks at bytes");
+ is(bytes::index($c, "\x41"), 1, "bytes::index under use bytes looks at
bytes");
+ is(bytes::rindex($c, "\x8c"), 0, "bytes::rindex under use bytes looks
at bytes");
+
+ }
+ else{
+ is(bytes::substr($c, 0, 1), "\xc4", "bytes::substr under use bytes
looks at bytes");
+ is(bytes::index($c, "\x80"), 1, "bytes::index under use bytes looks at
bytes");
+ is(bytes::rindex($c, "\xc4"), 0, "bytes::rindex under use bytes looks
at bytes");
+ }
+
}
{
==== //depot/perl/lib/dumpvar.pl#25 (text) ====
Index: perl/lib/dumpvar.pl
--- perl/lib/dumpvar.pl#24~27342~ 2006-02-27 06:45:00.000000000 -0800
+++ perl/lib/dumpvar.pl 2006-07-13 10:12:00.000000000 -0700
@@ -41,7 +41,12 @@
local($v) ;
return \$_ if ref \$_ eq "GLOB";
- s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+ if (ord('A') == 193) { # EBCDIC.
+ # EBCDIC has no concept of "\cA" or "A" being related
+ # to each other by a linear/boolean mapping.
+ } else {
+ s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+ }
$_;
}
@@ -63,11 +68,19 @@
and %overload:: and defined &{'overload::StrVal'};
if ($tick eq 'auto') {
- if (/[\000-\011\013-\037\177]/) {
- $tick = '"';
- }else {
- $tick = "'";
- }
+ if (ord('A') == 193) {
+ if (/[\000-\011]/ or /[\013-\024\31-\037\177]/) {
+ $tick = '"';
+ } else {
+ $tick = "'";
+ }
+ } else {
+ if (/[\000-\011\013-\037\177]/) {
+ $tick = '"';
+ } else {
+ $tick = "'";
+ }
+ }
}
if ($tick eq "'") {
s/([\'\\])/\\$1/g;
@@ -80,7 +93,11 @@
} elsif ($unctrl eq 'quote') {
s/([\"[EMAIL PROTECTED])/\\$1/g if $tick eq '"';
s/\033/\\e/g;
- s/([\000-\037\177])/'\\c'._escaped_ord($1)/eg;
+ if (ord('A') == 193) { # EBCDIC.
+ s/([\000-\037\177])/'\\c'.chr(193)/eg; # Unfinished.
+ } else {
+ s/([\000-\037\177])/'\\c'._escaped_ord($1)/eg;
+ }
}
$_ = uniescape($_);
s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $quoteHighBit;
==== //depot/perl/lib/utf8.t#21 (text) ====
Index: perl/lib/utf8.t
--- perl/lib/utf8.t#20~25716~ 2005-10-09 07:31:47.000000000 -0700
+++ perl/lib/utf8.t 2006-07-13 10:12:00.000000000 -0700
@@ -349,7 +349,11 @@
ok( utf8::is_utf8($c), "utf8::is_utf8 unicode");
is(utf8::upgrade($a), 1, "utf8::upgrade basic");
- is(utf8::upgrade($b), 2, "utf8::upgrade beyond");
+ if (ord('A') == 193) { # EBCDIC.
+ is(utf8::upgrade($b), 1, "utf8::upgrade beyond");
+ } else {
+ is(utf8::upgrade($b), 2, "utf8::upgrade beyond");
+ }
is(utf8::upgrade($c), 2, "utf8::upgrade unicode");
is($a, "A", "basic");
@@ -381,7 +385,11 @@
utf8::encode($c);
is($a, "A", "basic");
- is(length($b), 2, "beyond length");
+ if (ord('A') == 193) { # EBCDIC.
+ is(length($b), 1, "beyond length");
+ } else {
+ is(length($b), 2, "beyond length");
+ }
is(length($c), 2, "unicode length");
ok(utf8::valid($a), "utf8::valid basic");
@@ -406,7 +414,11 @@
ok(utf8::valid($c), " utf8::valid unicode");
ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
- ok( utf8::is_utf8($b), " utf8::is_utf8 beyond"); # $b stays in UTF-8.
+ if (ord('A') == 193) { # EBCDIC.
+ ok( utf8::is_utf8(pack('U',0x0ff)), " utf8::is_utf8 beyond");
+ } else {
+ ok( utf8::is_utf8($b), " utf8::is_utf8 beyond"); # $b stays in UTF-8.
+ }
ok( utf8::is_utf8($c), " utf8::is_utf8 unicode");
}
==== //depot/perl/miniperlmain.c#52 (text) ====
Index: perl/miniperlmain.c
--- perl/miniperlmain.c#51~27343~ 2006-02-27 07:36:46.000000000 -0800
+++ perl/miniperlmain.c 2006-07-13 10:12:00.000000000 -0700
@@ -53,8 +53,14 @@
struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; }
#endif
+#ifdef NO_ENV_ARRAY_IN_MAIN
+extern char **environ;
+int
+main(int argc, char **argv)
+#else
int
main(int argc, char **argv, char **env)
+#endif
{
dVAR;
int exitstatus;
@@ -73,7 +79,11 @@
/* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
PERL_GPROF_MONCONTROL(0);
+#ifdef NO_ENV_ARRAY_IN_MAIN
+ PERL_SYS_INIT3(&argc,&argv,&environ);
+#else
PERL_SYS_INIT3(&argc,&argv,&env);
+#endif
#if defined(USE_ITHREADS)
/* XXX Ideally, this should really be happening in perl_alloc() or
@@ -106,7 +116,7 @@
perl_free(my_perl);
-#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL)
+#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) &&
!defined(NO_ENV_ARRAY_IN_MAIN)
/*
* The old environment may have been freed by perl_free()
* when PERL_TRACK_MEMPOOL is defined, but without having
==== //depot/perl/perl.h#708 (text) ====
Index: perl/perl.h
--- perl/perl.h#707~28541~ 2006-07-11 00:55:21.000000000 -0700
+++ perl/perl.h 2006-07-13 10:12:00.000000000 -0700
@@ -5595,6 +5595,10 @@
# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0)
#endif
+#if defined(OEMVS)
+#define NO_ENV_ARRAY_IN_MAIN
+#endif
+
/* and finally... */
#define PERL_PATCHLEVEL_H_IMPLICIT
#include "patchlevel.h"
End of Patch.
