From 2f3efc978ada94e3718bd6f3a25b06cd1d13b6f8 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Thu, 13 Jul 2006 22:47:29 +0300 Subject: z/OS: non-CPAN ext and lib + main() without the third arg + Stephen McCamant's comment Message-ID: <44B67921.6090901@iki.fi> p4raw-id: //depot/perl@28567 --- ext/B/B/Deparse.pm | 2 +- lib/AutoLoader.t | 2 +- lib/DBM_Filter/t/encode.t | 27 +++++++++++++++++++-------- lib/DBM_Filter/t/utf8.t | 24 +++++++++++++++++------- lib/ExtUtils/Constant/Utils.pm | 12 ++++++++++-- lib/ExtUtils/Embed.pm | 6 ++++-- lib/ExtUtils/t/Embed.t | 17 ++++++++++++++++- lib/PerlIO/via/t/QuotedPrint.t | 12 +++++++++++- lib/bytes.t | 17 ++++++++++++++--- lib/dumpvar.pl | 31 ++++++++++++++++++++++++------- lib/utf8.t | 18 +++++++++++++++--- miniperlmain.c | 12 +++++++++++- perl.h | 4 ++++ 13 files changed, 147 insertions(+), 37 deletions(-) diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index a9abfec268..6bb2f683f2 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -3588,7 +3588,7 @@ sub const { 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); diff --git a/lib/AutoLoader.t b/lib/AutoLoader.t index 9f0804b004..da7071b32b 100755 --- a/lib/AutoLoader.t +++ b/lib/AutoLoader.t @@ -121,7 +121,7 @@ is( $foo->bazmarkhianish($1), 'foo', '(again)' ); 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')) diff --git a/lib/DBM_Filter/t/encode.t b/lib/DBM_Filter/t/encode.t index 7b71a98b2e..2c3ee0bf43 100644 --- a/lib/DBM_Filter/t/encode.t +++ b/lib/DBM_Filter/t/encode.t @@ -87,14 +87,25 @@ my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; 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; { diff --git a/lib/DBM_Filter/t/utf8.t b/lib/DBM_Filter/t/utf8.t index e37afa2d4a..f884e04eea 100644 --- a/lib/DBM_Filter/t/utf8.t +++ b/lib/DBM_Filter/t/utf8.t @@ -69,13 +69,23 @@ my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; 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; { diff --git a/lib/ExtUtils/Constant/Utils.pm b/lib/ExtUtils/Constant/Utils.pm index 3ef2228c87..2a0625e451 100644 --- a/lib/ExtUtils/Constant/Utils.pm +++ b/lib/ExtUtils/Constant/Utils.pm @@ -54,7 +54,11 @@ sub C_stringify { 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 @@ sub perl_stringify { 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. diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index 79bca4dfe2..78451c7d8f 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -225,11 +225,13 @@ sub ldopts { 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'); diff --git a/lib/ExtUtils/t/Embed.t b/lib/ExtUtils/t/Embed.t index 3f4c28628c..a7ebaa2a9c 100644 --- a/lib/ExtUtils/t/Embed.t +++ b/lib/ExtUtils/t/Embed.t @@ -79,7 +79,9 @@ if ($^O eq 'VMS') { 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 @@ static struct perl_vars *my_plvarsp; 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 @@ int main(int argc, char **argv, char **env) (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 @@ int main(int argc, char **argv, char **env) 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"); diff --git a/lib/PerlIO/via/t/QuotedPrint.t b/lib/PerlIO/via/t/QuotedPrint.t index baf0d1f4e4..40bca4fe60 100644 --- a/lib/PerlIO/via/t/QuotedPrint.t +++ b/lib/PerlIO/via/t/QuotedPrint.t @@ -30,11 +30,21 @@ This is a t in it. EOD -my $encoded = <