Change 30023 by [EMAIL PROTECTED] on 2007/01/26 21:52:35
Integrate:
[ 28603]
In pp_entersub, accept to handle a CV with a NULL padlist.
This fixes a crash with mod_perl 1.29.
[ 28606]
Add another volatile modifier to protect against longjmp clobbering
[ 28607]
Subject: [PATCH] z/OS: pp_sys.c, reg*.c, toke.c, utf8.c
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sat, 22 Jul 2006 18:51:48 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28608]
Revert part of last change, that was causing utf8 test failures
[ 28613]
Revert change 28603: this was a wrong fix, that didn't prevent
a later crash. Reindent a bit of the same function.
[ 28634]
Subject: [PATCH] solution(?) to the "warning: comparison is always
false dueto limited range of data type" with New*()
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Fri, 28 Jul 2006 09:00:28 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28639]
Subject: [PATCH] g++ dNOOP (luckily one can mix code and decls in C++)
Somewhat modifies as per Steve Hay's comment
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Tue, 1 Aug 2006 08:46:15 +0300 (EEST)
Message-Id: <[EMAIL PROTECTED]>
[ 28669]
We shouldn't try to decrement the refcount of PL_warnhook
if it has been set to PERL_WARNHOOK_FATAL.
[ 28675]
Simplification in Perl_magic_clearsig, plus a fix similar and
symmetrical to the one implemented in change #28669.
[ 28686]
A couple const's and a cast to get Sun CC to compile these files.
Perl, however, still will not build with the Sun CC.
[ 28688]
Subject: [PATCH] doio.c: vararg NULLs must be cast right
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Thu, 10 Aug 2006 08:35:53 +0300 (EEST)
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/doio.c#99 integrate
... //depot/maint-5.8/perl/handy.h#46 integrate
... //depot/maint-5.8/perl/mg.c#139 integrate
... //depot/maint-5.8/perl/op.c#186 integrate
... //depot/maint-5.8/perl/perl.h#143 integrate
... //depot/maint-5.8/perl/pp_hot.c#123 integrate
... //depot/maint-5.8/perl/pp_sort.c#47 integrate
... //depot/maint-5.8/perl/pp_sys.c#135 integrate
... //depot/maint-5.8/perl/regcomp.c#94 integrate
... //depot/maint-5.8/perl/regexec.c#82 integrate
... //depot/maint-5.8/perl/toke.c#156 integrate
... //depot/maint-5.8/perl/utf8.c#73 integrate
Differences ...
==== //depot/maint-5.8/perl/doio.c#99 (text) ====
Index: perl/doio.c
--- perl/doio.c#98~30007~ 2007-01-26 05:50:55.000000000 -0800
+++ perl/doio.c 2007-01-26 13:52:35.000000000 -0800
@@ -1458,7 +1458,7 @@
if (s[-1] == '\'') {
*--s = '\0';
PERL_FPU_PRE_EXEC
- PerlProc_execl(PL_cshname, "csh", flags, ncmd, NULL);
+ PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
PERL_FPU_POST_EXEC
*s = '\'';
S_exec_failed(aTHX_ PL_cshname, fd, do_report);
@@ -1507,7 +1507,7 @@
}
doshell:
PERL_FPU_PRE_EXEC
- PerlProc_execl(PL_sh_path, "sh", "-c", cmd, NULL);
+ PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
Safefree(cmd);
==== //depot/maint-5.8/perl/handy.h#46 (text) ====
Index: perl/handy.h
--- perl/handy.h#45~29962~ 2007-01-24 14:51:14.000000000 -0800
+++ perl/handy.h 2007-01-26 13:52:35.000000000 -0800
@@ -641,10 +641,13 @@
#define NEWSV(x,len) newSV(len)
#endif
+/* The +0.0 in MEM_WRAP_CHECK_ is an attempt to foil
+ * overly eager compilers that will bleat about e.g.
+ * (U16)n > (size_t)~0/sizeof(U16) always being false. */
#ifdef PERL_MALLOC_WRAP
#define MEM_WRAP_CHECK(n,t) MEM_WRAP_CHECK_1(n,t,PL_memory_wrap)
#define MEM_WRAP_CHECK_1(n,t,a) \
- (void)(sizeof(t) > 1 && (MEM_SIZE)(n) > ((MEM_SIZE)~0)/sizeof(t) &&
(Perl_croak_nocontext(a),0))
+ (void)(sizeof(t) > 1 && ((MEM_SIZE)(n)+0.0) > ((MEM_SIZE)~0)/sizeof(t)
&& (Perl_croak_nocontext(a),0))
#define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t),
#define PERL_STRLEN_ROUNDUP(n) ((void)(((n) > (MEM_SIZE)~0 - 2 *
PERL_STRLEN_ROUNDUP_QUANTUM) ?
(Perl_croak_nocontext(PL_memory_wrap),0):0),((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
==== //depot/maint-5.8/perl/mg.c#139 (text) ====
Index: perl/mg.c
--- perl/mg.c#138~30007~ 2007-01-26 05:50:55.000000000 -0800
+++ perl/mg.c 2007-01-26 13:52:35.000000000 -0800
@@ -1233,14 +1233,12 @@
SV** svp = NULL;
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
- else if (strEQ(s,"__WARN__"))
+ else if (strEQ(s,"__WARN__") && PL_warnhook != PERL_WARNHOOK_FATAL)
svp = &PL_warnhook;
- else
- Perl_croak(aTHX_ "No such hook: %s", s);
if (svp && *svp) {
- SV * const to_dec = *svp;
+ SV *const to_dec = *svp;
*svp = NULL;
- SvREFCNT_dec(to_dec);
+ SvREFCNT_dec(to_dec);
}
}
else {
@@ -1396,7 +1394,8 @@
Perl_croak(aTHX_ "No such hook: %s", s);
i = 0;
if (*svp) {
- to_dec = *svp;
+ if (*svp != PERL_WARNHOOK_FATAL)
+ to_dec = *svp;
*svp = NULL;
}
}
==== //depot/maint-5.8/perl/op.c#186 (text) ====
Index: perl/op.c
--- perl/op.c#185~30006~ 2007-01-26 04:19:35.000000000 -0800
+++ perl/op.c 2007-01-26 13:52:35.000000000 -0800
@@ -2080,7 +2080,7 @@
{
register OP *curop;
volatile I32 type = o->op_type;
- SV *sv = NULL;
+ volatile SV *sv = NULL;
int ret = 0;
I32 oldscope;
OP *old_next;
@@ -6373,7 +6373,7 @@
int optional = 0;
I32 arg = 0;
I32 contextclass = 0;
- char *e = NULL;
+ const char *e = NULL;
o->op_private |= OPpENTERSUB_HASTARG;
for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
==== //depot/maint-5.8/perl/perl.h#143 (text) ====
Index: perl/perl.h
--- perl/perl.h#142~30021~ 2007-01-26 11:23:54.000000000 -0800
+++ perl/perl.h 2007-01-26 13:52:35.000000000 -0800
@@ -207,7 +207,11 @@
#endif
#define NOOP /*EMPTY*/(void)0
+#if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus)
+#define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */
+#else
#define dNOOP extern int /[EMAIL PROTECTED]@*/ Perl___notused PERL_UNUSED_DECL
+#endif
#ifndef pTHX
/* Don't bother defining tTHX and sTHX; using them outside
==== //depot/maint-5.8/perl/pp_sort.c#47 (text) ====
Index: perl/pp_sort.c
--- perl/pp_sort.c#46~30006~ 2007-01-26 04:19:35.000000000 -0800
+++ perl/pp_sort.c 2007-01-26 13:52:35.000000000 -0800
@@ -1699,9 +1699,9 @@
: ( overloading ? S_amagic_ncmp : S_sv_ncmp ) )
: ( IN_LOCALE_RUNTIME
? ( overloading
- ? S_amagic_cmp_locale
- : sv_cmp_locale_static)
- : ( overloading ? S_amagic_cmp : sv_cmp_static)));
+ ? (SVCOMPARE_t)S_amagic_cmp_locale
+ : (SVCOMPARE_t)sv_cmp_locale_static)
+ : ( overloading ? (SVCOMPARE_t)S_amagic_cmp :
(SVCOMPARE_t)sv_cmp_static)));
}
if (priv & OPpSORT_REVERSE) {
SV **q = start+max-1;
==== //depot/maint-5.8/perl/pp_sys.c#135 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#134~30007~ 2007-01-26 05:50:55.000000000 -0800
+++ perl/pp_sys.c 2007-01-26 13:52:35.000000000 -0800
@@ -2547,6 +2547,17 @@
nstio = GvIOn(ngv);
fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)
namebuf, &len);
+#if defined(OEMVS)
+ if (len == 0) {
+ /* Some platforms indicate zero length when an AF_UNIX client is
+ * not bound. Simulate a non-zero-length sockaddr structure in
+ * this case. */
+ namebuf[0] = 0; /* sun_len */
+ namebuf[1] = AF_UNIX; /* sun_family */
+ len = 2;
+ }
+#endif
+
if (fd < 0)
goto badexit;
if (IoIFP(nstio))
==== //depot/maint-5.8/perl/regcomp.c#94 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#93~30005~ 2007-01-26 04:01:34.000000000 -0800
+++ perl/regcomp.c 2007-01-26 13:52:35.000000000 -0800
@@ -4216,11 +4216,27 @@
STRLEN foldlen;
const UV f = to_uni_fold(natvalue, foldbuf, &foldlen);
+#ifdef EBCDIC /* RD t/uni/fold ff and 6b */
+ if (RExC_precomp[0] == ':' &&
+ RExC_precomp[1] == '[' &&
+ (f == 0xDF || f == 0x92)) {
+ f = NATIVE_TO_UNI(f);
+ }
+#endif
/* If folding and foldable and a single
* character, insert also the folded version
* to the charclass. */
if (f != value) {
+#ifdef EBCDIC /* RD tunifold ligatures s,t fb05, fb06 */
+ if ((RExC_precomp[0] == ':' &&
+ RExC_precomp[1] == '[' &&
+ (f == 0xA2 &&
+ (value == 0xFB05 || value == 0xFB06))) ?
+ foldlen == ((STRLEN)UNISKIP(f) - 1) :
+ foldlen == (STRLEN)UNISKIP(f) )
+#else
if (foldlen == (STRLEN)UNISKIP(f))
+#endif
Perl_sv_catpvf(aTHX_ listsv,
"%04"UVxf"\n", f);
else {
==== //depot/maint-5.8/perl/regexec.c#82 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#81~30018~ 2007-01-26 09:39:35.000000000 -0800
+++ perl/regexec.c 2007-01-26 13:52:35.000000000 -0800
@@ -3407,11 +3407,19 @@
to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
-
+#ifdef EBCDIC
+ ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
+ ckWARN(WARN_UTF8) ?
+ 0 : UTF8_ALLOW_ANY);
+ ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
+ ckWARN(WARN_UTF8) ?
+ 0 : UTF8_ALLOW_ANY);
+#else
c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
- uniflags);
+ uniflags);
c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
- uniflags);
+ uniflags);
+#endif
}
else {
c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
==== //depot/maint-5.8/perl/toke.c#156 (text) ====
Index: perl/toke.c
--- perl/toke.c#155~30011~ 2007-01-26 06:31:27.000000000 -0800
+++ perl/toke.c 2007-01-26 13:52:35.000000000 -0800
@@ -1437,6 +1437,7 @@
UV uv;
#ifdef EBCDIC
UV literal_endpoint = 0;
+ bool native_range = TRUE; /* turned to FALSE if the first endpoint is
Unicode. */
#endif
const char * const leaveit = /* set of acceptably-backslashed characters */
@@ -1460,7 +1461,15 @@
I32 min; /* first character in range */
I32 max; /* last character in range */
- if (has_utf8) {
+#ifdef EBCDIC
+ UV uvmax = 0;
+#endif
+
+ if (has_utf8
+#ifdef EBCDIC
+ && !native_range
+#endif
+ ) {
char * const c = (char*)utf8_hop((U8*)d, -1);
char *e = d++;
while (e-- > c)
@@ -1473,12 +1482,43 @@
}
i = d - SvPVX_const(sv); /* remember current
offset */
+#ifdef EBCDIC
+ SvGROW(sv,
+ SvLEN(sv) + (has_utf8 ?
+ (512 - UTF_CONTINUATION_MARK +
+ UNISKIP(0x100))
+ : 256));
+ /* How many two-byte within 0..255: 128 in UTF-8,
+ * 96 in UTF-8-mod. */
+#else
SvGROW(sv, SvLEN(sv) + 256); /* never more than 256 chars in
a range */
+#endif
d = SvPVX(sv) + i; /* refresh d after realloc */
- d -= 2; /* eat the first char and the -
*/
-
- min = (U8)*d; /* first char in range */
- max = (U8)d[1]; /* last char in range */
+#ifdef EBCDIC
+ if (has_utf8) {
+ int j;
+ for (j = 0; j <= 1; j++) {
+ char * const c = (char*)utf8_hop((U8*)d, -1);
+ const UV uv = utf8n_to_uvchr((U8*)c, d - c, NULL,
0);
+ if (j)
+ min = (U8)uv;
+ else if (uv < 256)
+ max = (U8)uv;
+ else {
+ max = (U8)0xff; /* only to \xff */
+ uvmax = uv; /* \x{100} to uvmax */
+ }
+ d = c; /* eat endpoint chars */
+ }
+ }
+ else {
+#endif
+ d -= 2; /* eat the first char and the - */
+ min = (U8)*d; /* first char in range */
+ max = (U8)d[1]; /* last char in range */
+#ifdef EBCDIC
+ }
+#endif
if (min > max) {
Perl_croak(aTHX_
@@ -1503,7 +1543,29 @@
else
#endif
for (i = min; i <= max; i++)
- *d++ = (char)i;
+#ifdef EBCDIC
+ if (has_utf8) {
+ const U8 ch = (U8)NATIVE_TO_UTF(i);
+ if (UNI_IS_INVARIANT(ch))
+ *d++ = (U8)i;
+ else {
+ *d++ = (U8)UTF8_EIGHT_BIT_HI(ch);
+ *d++ = (U8)UTF8_EIGHT_BIT_LO(ch);
+ }
+ }
+ else
+#endif
+ *d++ = (char)i;
+
+#ifdef EBCDIC
+ if (uvmax) {
+ d = (char*)uvchr_to_utf8((U8*)d, 0x100);
+ if (uvmax > 0x101)
+ *d++ = (char)UTF_TO_NATIVE(0xff);
+ if (uvmax > 0x100)
+ d = (char*)uvchr_to_utf8((U8*)d, uvmax);
+ }
+#endif
/* mark the range as done, and continue */
dorange = FALSE;
@@ -1519,7 +1581,11 @@
if (didrange) {
Perl_croak(aTHX_ "Ambiguous range in transliteration
operator");
}
- if (has_utf8) {
+ if (has_utf8
+#ifdef EBCDIC
+ && !native_range
+#endif
+ ) {
*d++ = (char)UTF_TO_NATIVE(0xff); /* use illegal utf8
byte--see pmtrans */
s++;
continue;
@@ -1531,6 +1597,7 @@
didrange = FALSE;
#ifdef EBCDIC
literal_endpoint = 0;
+ native_range = TRUE;
#endif
}
}
@@ -1640,8 +1707,8 @@
if ((isALPHA(*s) || isDIGIT(*s)) &&
ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Unrecognized escape \\%c passed through",
- *s);
+ "Unrecognized escape \\%c passed through",
+ *s);
/* default action is to copy the quoted character */
goto default_action;
}
@@ -1739,6 +1806,10 @@
(PL_lex_repl ? OPpTRANS_FROM_UTF
: OPpTRANS_TO_UTF);
}
+#ifdef EBCDIC
+ if (uv > 255 && !dorange)
+ native_range = FALSE;
+#endif
}
else {
*d++ = (char)uv;
@@ -1816,6 +1887,10 @@
SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
d = SvPVX(sv) + (d - odest);
}
+#ifdef EBCDIC
+ if (!dorange)
+ native_range = FALSE; /* \N{} is guessed to be Unicode
*/
+#endif
Copy(str, d, len, char);
d += len;
SvREFCNT_dec(res);
@@ -1889,6 +1964,10 @@
}
d = (char*)uvchr_to_utf8((U8*)d, nextuv);
has_utf8 = TRUE;
+#ifdef EBCDIC
+ if (uv > 255 && !dorange)
+ native_range = FALSE;
+#endif
}
else {
*d++ = NATIVE_TO_NEED(has_utf8,*s++);
@@ -9993,7 +10072,7 @@
S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
{
SV *sv; /* scalar value: string */
- char *tmps; /* temp string, used for
delimiter matching */
+ const char *tmps; /* temp string, used for delimiter
matching */
register char *s = start; /* current position in the buffer */
register char term; /* terminating character */
register char *to; /* current position in the sv's data */
@@ -11006,6 +11085,15 @@
goto utf16be;
}
}
+#ifdef EBCDIC
+ case 0xDD:
+ if (slen > 3 && s[1] == 0x73 && s[2] == 0x66 && s[3] == 0x73) {
+ if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log,
"UTF-8 script encoding (BOM)\n");
+ s += 4; /* UTF-8 */
+ }
+ break;
+#endif
+
default:
if (slen > 3 && s[1] == 0 && s[2] != 0 && s[3] == 0) {
/* Leading bytes
==== //depot/maint-5.8/perl/utf8.c#73 (text) ====
Index: perl/utf8.c
--- perl/utf8.c#72~29993~ 2007-01-26 01:15:17.000000000 -0800
+++ perl/utf8.c 2007-01-26 13:52:35.000000000 -0800
@@ -893,7 +893,11 @@
UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */
p += 2;
if (uv < 0x80) {
+#ifdef EBCDIC
+ *d++ = UNI_TO_NATIVE(uv);
+#else
*d++ = (U8)uv;
+#endif
continue;
}
if (uv < 0x800) {
End of Patch.
