X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/42bb8ff7b3697c670cb960482274cd0127bbda86..ff41e38dc752c5886c923bd36d815d2a8d3508d6:/util.c?ds=sidebyside diff --git a/util.c b/util.c index 6512160..b7403e8 100644 --- a/util.c +++ b/util.c @@ -307,12 +307,12 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) #endif } else - Perl_croak_nocontext("%s", PL_memory_wrap); + croak_memory_wrap(); #ifdef PERL_TRACK_MEMPOOL if (sTHX <= MEM_SIZE_MAX - (MEM_SIZE)total_size) total_size += sTHX; else - Perl_croak_nocontext("%s", PL_memory_wrap); + croak_memory_wrap(); #endif #ifdef HAS_64K_LIMIT if (total_size > 0xffff) { @@ -408,7 +408,7 @@ Free_t Perl_mfree (Malloc_t where) char * Perl_delimcpy(register char *to, register const char *toend, register const char *from, register const char *fromend, register int delim, I32 *retlen) { - register I32 tolen; + I32 tolen; PERL_ARGS_ASSERT_DELIMCPY; @@ -438,7 +438,7 @@ Perl_delimcpy(register char *to, register const char *toend, register const char char * Perl_instr(register const char *big, register const char *little) { - register I32 first; + I32 first; PERL_ARGS_ASSERT_INSTR; @@ -448,7 +448,7 @@ Perl_instr(register const char *big, register const char *little) if (!first) return (char*)big; while (*big) { - register const char *s, *x; + const char *s, *x; if (*big++ != first) continue; for (x=big,s=little; *s; /**/ ) { @@ -499,9 +499,9 @@ Perl_ninstr(const char *big, const char *bigend, const char *little, const char char * Perl_rninstr(register const char *big, const char *bigend, const char *little, const char *lend) { - register const char *bigbeg; - register const I32 first = *little; - register const char * const littleend = lend; + const char *bigbeg; + const I32 first = *little; + const char * const littleend = lend; PERL_ARGS_ASSERT_RNINSTR; @@ -510,7 +510,7 @@ Perl_rninstr(register const char *big, const char *bigend, const char *little, c bigbeg = big; big = bigend - (littleend - little++); while (big >= bigbeg) { - register const char *s, *x; + const char *s, *x; if (*big-- != first) continue; for (x=big+2,s=little; s < littleend; /**/ ) { @@ -548,7 +548,7 @@ void Perl_fbm_compile(pTHX_ SV *sv, U32 flags) { dVAR; - register const U8 *s; + const U8 *s; STRLEN i; STRLEN len; STRLEN rarest = 0; @@ -600,7 +600,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) the BM table. */ const U8 mlen = (len>255) ? 255 : (U8)len; const unsigned char *const sb = s + len - mlen; /* first char (maybe) */ - register U8 *table; + U8 *table; Newx(table, 256, U8); memset((void*)table, mlen, 256); @@ -650,12 +650,11 @@ then. char * Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *littlestr, U32 flags) { - register unsigned char *s; + unsigned char *s; STRLEN l; - register const unsigned char *little - = (const unsigned char *)SvPV_const(littlestr,l); - register STRLEN littlelen = l; - register const I32 multiline = flags & FBMrf_MULTILINE; + const unsigned char *little = (const unsigned char *)SvPV_const(littlestr,l); + STRLEN littlelen = l; + const I32 multiline = flags & FBMrf_MULTILINE; PERL_ARGS_ASSERT_FBM_INSTR; @@ -791,7 +790,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit { const MAGIC *const mg = mg_find(littlestr, PERL_MAGIC_bm); const unsigned char * const table = (const unsigned char *) mg->mg_ptr; - register const unsigned char *oldlittle; + const unsigned char *oldlittle; --littlelen; /* Last char found by table lookup */ @@ -799,7 +798,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit little += littlelen; /* last char */ oldlittle = little; if (s < bigend) { - register I32 tmp; + I32 tmp; top2: if ((tmp = table[*s])) { @@ -808,7 +807,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit goto check_end; } else { /* less expensive than calling strncmp() */ - register unsigned char * const olds = s; + unsigned char * const olds = s; tmp = littlelen; @@ -867,11 +866,13 @@ range bytes match only themselves. I32 Perl_foldEQ(const char *s1, const char *s2, register I32 len) { - register const U8 *a = (const U8 *)s1; - register const U8 *b = (const U8 *)s2; + const U8 *a = (const U8 *)s1; + const U8 *b = (const U8 *)s2; PERL_ARGS_ASSERT_FOLDEQ; + assert(len >= 0); + while (len--) { if (*a != *b && *a != PL_fold[*b]) return 0; @@ -887,11 +888,13 @@ Perl_foldEQ_latin1(const char *s1, const char *s2, register I32 len) * LATIN_SMALL_LETTER_Y_WITH_DIAERESIS, and does not check for these. Nor * does it check that the strings each have at least 'len' characters */ - register const U8 *a = (const U8 *)s1; - register const U8 *b = (const U8 *)s2; + const U8 *a = (const U8 *)s1; + const U8 *b = (const U8 *)s2; PERL_ARGS_ASSERT_FOLDEQ_LATIN1; + assert(len >= 0); + while (len--) { if (*a != *b && *a != PL_fold_latin1[*b]) { return 0; @@ -914,11 +917,13 @@ I32 Perl_foldEQ_locale(const char *s1, const char *s2, register I32 len) { dVAR; - register const U8 *a = (const U8 *)s1; - register const U8 *b = (const U8 *)s2; + const U8 *a = (const U8 *)s1; + const U8 *b = (const U8 *)s2; PERL_ARGS_ASSERT_FOLDEQ_LOCALE; + assert(len >= 0); + while (len--) { if (*a != *b && *a != PL_fold_locale[*b]) return 0; @@ -972,9 +977,11 @@ the new string can be freed with the C function. char * Perl_savepvn(pTHX_ const char *pv, register I32 len) { - register char *newaddr; + char *newaddr; PERL_UNUSED_CONTEXT; + assert(len >= 0); + Newx(newaddr,len+1,char); /* Give a meaning to NULL pointer mainly for the use in sv_magic() */ if (pv) { @@ -998,7 +1005,7 @@ which is shared between threads. char * Perl_savesharedpv(pTHX_ const char *pv) { - register char *newaddr; + char *newaddr; STRLEN pvlen; if (!pv) return NULL; @@ -1048,7 +1055,7 @@ Perl_savesvpv(pTHX_ SV *sv) { STRLEN len; const char * const pv = SvPV_const(sv, len); - register char *newaddr; + char *newaddr; PERL_ARGS_ASSERT_SAVESVPV; @@ -1306,8 +1313,9 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume) if (GvIO(PL_last_in_gv) && (SvTYPE(GvIOp(PL_last_in_gv)) == SVt_PVIO) && IoLINES(GvIOp(PL_last_in_gv))) { + STRLEN l; const bool line_mode = (RsSIMPLE(PL_rs) && - SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n'); + *SvPV_const(PL_rs,l) == '\n' && l == 1); Perl_sv_catpvf(aTHX_ sv, ", <%"SVf"> %s %"IVdf, SVfARG(PL_last_in_gv == PL_argvgv ? &PL_sv_no @@ -1457,7 +1465,7 @@ Perl_die_sv(pTHX_ SV *baseex) { PERL_ARGS_ASSERT_DIE_SV; croak_sv(baseex); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ return NULL; } @@ -1479,7 +1487,7 @@ Perl_die_nocontext(const char* pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ va_end(args); return NULL; } @@ -1491,7 +1499,7 @@ Perl_die(pTHX_ const char* pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ va_end(args); return NULL; } @@ -1591,7 +1599,7 @@ Perl_croak_nocontext(const char *pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ va_end(args); } #endif /* PERL_IMPLICIT_CONTEXT */ @@ -1602,7 +1610,7 @@ Perl_croak(pTHX_ const char *pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ va_end(args); } @@ -1617,9 +1625,9 @@ paths reduces CPU cache pressure. */ void -Perl_croak_no_modify(pTHX) +Perl_croak_no_modify() { - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_nocontext( "%s", PL_no_modify); } /* @@ -1886,8 +1894,8 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) #ifndef PERL_USE_SAFE_PUTENV if (!PL_use_safe_putenv) { /* most putenv()s leak, so we manipulate environ directly */ - register I32 i; - register const I32 len = strlen(nam); + I32 i; + const I32 len = strlen(nam); int nlen, vlen; /* where does it go? */ @@ -1983,7 +1991,7 @@ void Perl_my_setenv(pTHX_ const char *nam, const char *val) { dVAR; - register char *envstr; + char *envstr; const int nlen = strlen(nam); int vlen; @@ -2024,6 +2032,8 @@ Perl_my_bcopy(register const char *from,register char *to,register I32 len) PERL_ARGS_ASSERT_MY_BCOPY; + assert(len >= 0); + if (from - to >= 0) { while (len--) *to++ = *from++; @@ -2047,6 +2057,8 @@ Perl_my_memset(register char *loc, register I32 ch, register I32 len) PERL_ARGS_ASSERT_MY_MEMSET; + assert(len >= 0); + while (len--) *loc++ = ch; return retval; @@ -2062,6 +2074,8 @@ Perl_my_bzero(register char *loc, register I32 len) PERL_ARGS_ASSERT_MY_BZERO; + assert(len >= 0); + while (len--) *loc++ = 0; return retval; @@ -2073,12 +2087,14 @@ Perl_my_bzero(register char *loc, register I32 len) I32 Perl_my_memcmp(const char *s1, const char *s2, register I32 len) { - register const U8 *a = (const U8 *)s1; - register const U8 *b = (const U8 *)s2; - register I32 tmp; + const U8 *a = (const U8 *)s1; + const U8 *b = (const U8 *)s2; + I32 tmp; PERL_ARGS_ASSERT_MY_MEMCMP; + assert(len >= 0); + while (len--) { if ((tmp = *a++ - *b++)) return tmp; @@ -2178,8 +2194,8 @@ Perl_my_htonl(pTHX_ long l) #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf) Perl_croak(aTHX_ "Unknown BYTEORDER\n"); #else - register I32 o; - register I32 s; + I32 o; + I32 s; for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) { u.c[o & 0xf] = (l >> s) & 255; @@ -2207,8 +2223,8 @@ Perl_my_ntohl(pTHX_ long l) #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf) Perl_croak(aTHX_ "Unknown BYTEORDER\n"); #else - register I32 o; - register I32 s; + I32 o; + I32 s; u.l = l; l = 0; @@ -2239,8 +2255,8 @@ Perl_my_ntohl(pTHX_ long l) type value; \ char c[sizeof(type)]; \ } u; \ - register U32 i; \ - register U32 s = 0; \ + U32 i; \ + U32 s = 0; \ for (i = 0; i < sizeof(u.c); i++, s += 8) { \ u.c[i] = (n >> s) & 0xFF; \ } \ @@ -2255,8 +2271,8 @@ Perl_my_ntohl(pTHX_ long l) type value; \ char c[sizeof(type)]; \ } u; \ - register U32 i; \ - register U32 s = 0; \ + U32 i; \ + U32 s = 0; \ u.value = n; \ n = 0; \ for (i = 0; i < sizeof(u.c); i++, s += 8) { \ @@ -2277,8 +2293,8 @@ Perl_my_ntohl(pTHX_ long l) type value; \ char c[sizeof(type)]; \ } u; \ - register U32 i; \ - register U32 s = 8*(sizeof(u.c)-1); \ + U32 i; \ + U32 s = 8*(sizeof(u.c)-1); \ for (i = 0; i < sizeof(u.c); i++, s -= 8) { \ u.c[i] = (n >> s) & 0xFF; \ } \ @@ -2293,8 +2309,8 @@ Perl_my_ntohl(pTHX_ long l) type value; \ char c[sizeof(type)]; \ } u; \ - register U32 i; \ - register U32 s = 8*(sizeof(u.c)-1); \ + U32 i; \ + U32 s = 8*(sizeof(u.c)-1); \ u.value = n; \ n = 0; \ for (i = 0; i < sizeof(u.c); i++, s -= 8) { \ @@ -2458,9 +2474,9 @@ BETOH(Perl_my_betohl,long) void Perl_my_swabn(void *ptr, int n) { - register char *s = (char *)ptr; - register char *e = s + (n-1); - register char tc; + char *s = (char *)ptr; + char *e = s + (n-1); + char tc; PERL_ARGS_ASSERT_MY_SWABN; @@ -2474,11 +2490,11 @@ Perl_my_swabn(void *ptr, int n) PerlIO * Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) { -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(EPOC) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__) dVAR; int p[2]; - register I32 This, that; - register Pid_t pid; + I32 This, that; + Pid_t pid; SV *sv; I32 did_pipes = 0; int pp[2]; @@ -2488,7 +2504,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PERL_FLUSHALL_FOR_CHILD; This = (*mode == 'w'); that = !This; - if (PL_tainting) { + if (TAINTING_get) { taint_env(); taint_proper("Insecure %s%s", "EXEC"); } @@ -2611,14 +2627,14 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) } /* VMS' my_popen() is in VMS.c, same with OS/2. */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) PerlIO * Perl_my_popen(pTHX_ const char *cmd, const char *mode) { dVAR; int p[2]; - register I32 This, that; - register Pid_t pid; + I32 This, that; + Pid_t pid; SV *sv; const I32 doexec = !(*cmd == '-' && cmd[1] == '\0'); I32 did_pipes = 0; @@ -2634,7 +2650,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) #endif This = (*mode == 'w'); that = !This; - if (doexec && PL_tainting) { + if (doexec && TAINTING_get) { taint_env(); taint_proper("Insecure %s%s", "EXEC"); } @@ -2758,7 +2774,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) return PerlIO_fdopen(p[This], mode); } #else -#if defined(atarist) || defined(EPOC) +#if defined(EPOC) FILE *popen(); PerlIO * Perl_my_popen(pTHX_ const char *cmd, const char *mode) @@ -3053,7 +3069,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) #endif /* !PERL_MICRO */ /* VMS' my_pclose() is in VMS.c; same with OS/2 */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(EPOC) && !defined(__LIBCATAMOUNT__) I32 Perl_my_pclose(pTHX_ PerlIO *ptr) { @@ -3086,9 +3102,6 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) #endif close_failed = (PerlIO_close(ptr) == EOF); SAVE_ERRNO; -#ifdef UTS - if(PerlProc_kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ -#endif #ifndef PERL_MICRO rsignal_save(SIGHUP, (Sighandler_t) SIG_IGN, &hstat); rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &istat); @@ -3211,7 +3224,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) void S_pidgone(pTHX_ Pid_t pid, int status) { - register SV *sv; + SV *sv; sv = *hv_fetch(PL_pidstatus,(const char*)&pid,sizeof(Pid_t),TRUE); SvUPGRADE(sv,SVt_IV); @@ -3220,7 +3233,7 @@ S_pidgone(pTHX_ Pid_t pid, int status) } #endif -#if defined(atarist) || defined(OS2) || defined(EPOC) +#if defined(OS2) || defined(EPOC) int pclose(); #ifdef HAS_FORK int /* Cannot prototype with I32 @@ -3259,15 +3272,20 @@ Perl_repeatcpy(register char *to, register const char *from, I32 len, register I { PERL_ARGS_ASSERT_REPEATCPY; + assert(len >= 0); + + if (count < 0) + croak_memory_wrap(); + if (len == 1) memset(to, *from, count); else if (count) { - register char *p = to; + char *p = to; IV items, linear, half; linear = count < PERL_REPEATCPY_LINEAR ? count : PERL_REPEATCPY_LINEAR; for (items = 0; items < linear; ++items) { - register const char *q = from; + const char *q = from; IV todo; for (todo = len; todo > 0; todo--) *p++ = *q++; @@ -3333,11 +3351,11 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char *xfound = NULL; char *xfailed = NULL; char tmpbuf[MAXPATHLEN]; - register char *s; + char *s; I32 len = 0; int retval; char *bufend; -#if defined(DOSISH) && !defined(OS2) && !defined(atarist) +#if defined(DOSISH) && !defined(OS2) # define SEARCH_EXTS ".bat", ".cmd", NULL # define MAX_EXT_LEN 4 #endif @@ -3460,28 +3478,25 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, bufend = s + strlen(s); while (s < bufend) { -#if defined(atarist) || defined(DOSISH) +# ifdef DOSISH for (len = 0; *s -# ifdef atarist - && *s != ',' -# endif && *s != ';'; len++, s++) { if (len < sizeof tmpbuf) tmpbuf[len] = *s; } if (len < sizeof tmpbuf) tmpbuf[len] = '\0'; -#else /* ! (atarist || DOSISH) */ +# else s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend, ':', &len); -#endif /* ! (atarist || DOSISH) */ +# endif if (s < bufend) s++; if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf) continue; /* don't search dir with too-long name */ if (len -# if defined(atarist) || defined(DOSISH) +# ifdef DOSISH && tmpbuf[len - 1] != '/' && tmpbuf[len - 1] != '\\' # endif @@ -3715,15 +3730,15 @@ void Perl_report_wrongway_fh(pTHX_ const GV *gv, const char have) { if (ckWARN(WARN_IO)) { - SV * const name - = gv && (isGV(gv) || isGV_with_GP(gv)) - ? sv_2mortal(newSVhek(GvENAME_HEK((gv)))) + HEK * const name + = gv && (isGV_with_GP(gv)) + ? GvENAME_HEK((gv)) : NULL; const char * const direction = have == '>' ? "out" : "in"; - if (name && SvPOK(name) && *SvPV_nolen(name)) + if (name && HEK_LEN(name)) Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle %"SVf" opened only for %sput", + "Filehandle %"HEKf" opened only for %sput", name, direction); else Perl_warner(aTHX_ packWARN(WARN_IO), @@ -3750,7 +3765,7 @@ Perl_report_evil_fh(pTHX_ const GV *gv) if (ckWARN(warn_type)) { SV * const name - = gv && (isGV(gv) || isGV_with_GP(gv)) && GvENAMELEN(gv) ? + = gv && isGV_with_GP(gv) && GvENAMELEN(gv) ? sv_2mortal(newSVhek(GvENAME_HEK(gv))) : NULL; const char * const pars = (const char *)(OP_IS_FILETEST(op) ? "" : "()"); @@ -3763,7 +3778,7 @@ Perl_report_evil_fh(pTHX_ const GV *gv) (const char *) (OP_IS_SOCKET(op) || (io && IoTYPE(io) == IoTYPE_SOCKET) ? "socket" : "filehandle"); - const bool have_name = name && SvPOK(name) && *SvPV_nolen(name); + const bool have_name = name && SvCUR(name); Perl_warner(aTHX_ packWARN(warn_type), "%s%s on %s %s%s%"SVf, func, pars, vile, type, have_name ? " " : "", @@ -3909,15 +3924,7 @@ Perl_mini_mktime(pTHX_ struct tm *ptm) year = 1900 + ptm->tm_year; month = ptm->tm_mon; mday = ptm->tm_mday; - /* allow given yday with no month & mday to dominate the result */ - if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) { - month = 0; - mday = 0; - jday = 1 + ptm->tm_yday; - } - else { - jday = 0; - } + jday = 0; if (month >= 2) month+=2; else @@ -4012,9 +4019,7 @@ Perl_mini_mktime(pTHX_ struct tm *ptm) yearday = year*DAYS_PER_YEAR + year/4 - year/100 + year/400; yearday += 14*MONTH_TO_DAYS + 1; ptm->tm_yday = jday - yearday; - /* fix tm_wday if not overridden by caller */ - if ((unsigned)ptm->tm_wday > 6) - ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7; + ptm->tm_wday = (jday + WEEKDAY_BIAS) % 7; } char * @@ -4380,6 +4385,7 @@ dotted_decimal_version: } /* end if dotted-decimal */ else { /* decimal versions */ + int j = 0; /* may need this later */ /* special strict case for leading '.' or '0' */ if (strict) { if (*d == '.') { @@ -4442,7 +4448,7 @@ dotted_decimal_version: } while (isDIGIT(*d)) { - d++; + d++; j++; if (*d == '.' && isDIGIT(d[-1])) { if (alpha) { BADVERSION(s,errstr,"Invalid version format (underscores before decimal)"); @@ -4464,6 +4470,7 @@ dotted_decimal_version: if ( ! isDIGIT(d[1]) ) { BADVERSION(s,errstr,"Invalid version format (misplaced underscore)"); } + width = j; d++; alpha = TRUE; } @@ -5694,40 +5701,6 @@ Perl_get_hash_seed(pTHX) return myseed; } -#ifdef USE_ITHREADS -bool -Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv) -{ - const char * stashpv = CopSTASHPV(c); - const char * name = HvNAME_get(hv); - const bool utf8 = CopSTASH_len(c) < 0; - const I32 len = utf8 ? -CopSTASH_len(c) : CopSTASH_len(c); - PERL_UNUSED_CONTEXT; - PERL_ARGS_ASSERT_STASHPV_HVNAME_MATCH; - - if (!stashpv || !name) - return stashpv == name; - if ( !HvNAMEUTF8(hv) != !utf8 ) { - if (utf8) { - return (bytes_cmp_utf8( - (const U8*)stashpv, len, - (const U8*)name, HEK_LEN(HvNAME_HEK(hv))) == 0); - } else { - return (bytes_cmp_utf8( - (const U8*)name, HEK_LEN(HvNAME_HEK(hv)), - (const U8*)stashpv, len) == 0); - } - } - else - return (stashpv == name - || (HEK_LEN(HvNAME_HEK(hv)) == len - && memEQ(stashpv, name, len))); - /*NOTREACHED*/ - return FALSE; -} -#endif - - #ifdef PERL_GLOBAL_STRUCT #define PERL_GLOBAL_STRUCT_INIT @@ -6034,7 +6007,6 @@ getting C. int Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...) { - dTHX; int retval; va_list ap; PERL_ARGS_ASSERT_MY_SNPRINTF; @@ -6053,7 +6025,7 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...) (len > 0 && (Size_t)retval >= len) #endif ) - Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); + Perl_croak_nocontext("panic: my_snprintf buffer overflow"); return retval; } @@ -6071,7 +6043,6 @@ C instead, or getting C. int Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap) { - dTHX; int retval; #ifdef NEED_VA_COPY va_list apc; @@ -6099,7 +6070,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap (len > 0 && (Size_t)retval >= len) #endif ) - Perl_croak(aTHX_ "panic: my_vsnprintf buffer overflow"); + Perl_croak_nocontext("panic: my_vsnprintf buffer overflow"); return retval; } @@ -6411,7 +6382,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv) { dVAR; SV * const dbsv = GvSVn(PL_DBsub); - const bool save_taint = PL_tainted; + const bool save_taint = TAINT_get; /* Accepted unused var warning under NO_TAINT_SUPPORT */ /* When we are called from pp_goto (svp is null), * we do not care about using dbsv to call CV; @@ -6420,7 +6391,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv) PERL_ARGS_ASSERT_GET_DB_SUB; - PL_tainted = FALSE; + TAINT_set(FALSE); save_item(dbsv); if (!PERLDB_SUB_NN) { GV *gv = CvGV(cv); @@ -6476,7 +6447,7 @@ Perl_my_dirfd(pTHX_ DIR * dir) { return dir->dd_fd; #else Perl_die(aTHX_ PL_no_func, "dirfd"); - /* NOT REACHED */ + assert(0); /* NOT REACHED */ return 0; #endif }