X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/25bbd8263003a49c3f7afdc1cd082f6f66e76ce4..7e0d5ad7c9cdb21b681e611b888acd41d34c4d05:/util.c diff --git a/util.c b/util.c index 378ffe0..8bd2094 100644 --- a/util.c +++ b/util.c @@ -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; @@ -557,11 +557,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) PERL_ARGS_ASSERT_FBM_COMPILE; - /* Refuse to fbm_compile a studied scalar, as this gives more flexibility in - SV flag usage. No real-world code would ever end up using a studied - scalar as a compile-time second argument to index, so this isn't a real - pessimisation. */ - if (SvSCREAM(sv)) + if (isGV_with_GP(sv)) return; if (SvVALID(sv)) @@ -604,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); @@ -643,8 +639,8 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) /* =for apidoc fbm_instr -Returns the location of the SV in the string delimited by C and -C. It returns C if the string can't be found. The C +Returns the location of the SV in the string delimited by C and +C. It returns C if the string can't be found. The C does not have to be fbm_compiled, but the search will not be as fast then. @@ -654,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; @@ -795,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 */ @@ -803,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])) { @@ -812,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; @@ -838,174 +833,21 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit } } -/* start_shift, end_shift are positive quantities which give offsets - of ends of some substring of bigstr. - If "last" we want the last occurrence. - old_posp is the way of communication between consequent calls if - the next call needs to find the . - The initial *old_posp should be -1. - - Note that we take into account SvTAIL, so one can get extra - optimizations if _ALL flag is set. - */ - -/* If SvTAIL is actually due to \Z or \z, this gives false positives - if PL_multiline. In fact if !PL_multiline the authoritative answer - is not supported yet. */ - char * Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last) { dVAR; - register const unsigned char *big; - U32 pos = 0; /* hush a gcc warning */ - register I32 previous; - register I32 first; - register const unsigned char *little; - register I32 stop_pos; - register const unsigned char *littleend; - bool found = FALSE; - const MAGIC * mg; - const void *screamnext_raw = NULL; /* hush a gcc warning */ - bool cant_find = FALSE; /* hush a gcc warning */ - PERL_ARGS_ASSERT_SCREAMINSTR; - - assert(SvMAGICAL(bigstr)); - mg = mg_find(bigstr, PERL_MAGIC_study); - assert(mg); - assert(SvTYPE(littlestr) == SVt_PVMG); - assert(SvVALID(littlestr)); - - if (mg->mg_private == 1) { - const U8 *const screamfirst = (U8 *)mg->mg_ptr; - const U8 *const screamnext = screamfirst + 256; - - screamnext_raw = (const void *)screamnext; - - pos = *old_posp == -1 - ? screamfirst[BmRARE(littlestr)] : screamnext[*old_posp]; - cant_find = pos == (U8)~0; - } else if (mg->mg_private == 2) { - const U16 *const screamfirst = (U16 *)mg->mg_ptr; - const U16 *const screamnext = screamfirst + 256; - - screamnext_raw = (const void *)screamnext; - - pos = *old_posp == -1 - ? screamfirst[BmRARE(littlestr)] : screamnext[*old_posp]; - cant_find = pos == (U16)~0; - } else if (mg->mg_private == 4) { - const U32 *const screamfirst = (U32 *)mg->mg_ptr; - const U32 *const screamnext = screamfirst + 256; - - screamnext_raw = (const void *)screamnext; - - pos = *old_posp == -1 - ? screamfirst[BmRARE(littlestr)] : screamnext[*old_posp]; - cant_find = pos == (U32)~0; - } else - Perl_croak(aTHX_ "panic: unknown study size %u", mg->mg_private); - - if (cant_find) { - cant_find: - if ( BmRARE(littlestr) == '\n' - && BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) { - little = (const unsigned char *)(SvPVX_const(littlestr)); - littleend = little + SvCUR(littlestr); - first = *little++; - goto check_tail; - } - return NULL; - } - - little = (const unsigned char *)(SvPVX_const(littlestr)); - littleend = little + SvCUR(littlestr); - first = *little++; - /* The value of pos we can start at: */ - previous = BmPREVIOUS(littlestr); - big = (const unsigned char *)(SvPVX_const(bigstr)); - /* The value of pos we can stop at: */ - stop_pos = SvCUR(bigstr) - end_shift - (SvCUR(littlestr) - 1 - previous); - if (previous + start_shift > stop_pos) { -/* - stop_pos does not include SvTAIL in the count, so this check is incorrect - (I think) - see [ID 20010618.006] and t/op/study.t. HVDS 2001/06/19 -*/ -#if 0 - if (previous + start_shift == stop_pos + 1) /* A fake '\n'? */ - goto check_tail; -#endif - return NULL; - } - if (mg->mg_private == 1) { - const U8 *const screamnext = (const U8 *const) screamnext_raw; - while ((I32)pos < previous + start_shift) { - pos = screamnext[pos]; - if (pos == (U8)~0) - goto cant_find; - } - } else if (mg->mg_private == 2) { - const U16 *const screamnext = (const U16 *const) screamnext_raw; - while ((I32)pos < previous + start_shift) { - pos = screamnext[pos]; - if (pos == (U16)~0) - goto cant_find; - } - } else if (mg->mg_private == 4) { - const U32 *const screamnext = (const U32 *const) screamnext_raw; - while ((I32)pos < previous + start_shift) { - pos = screamnext[pos]; - if (pos == (U32)~0) - goto cant_find; - } - } - big -= previous; - while (1) { - if ((I32)pos >= stop_pos) break; - if (big[pos] == first) { - const unsigned char *s = little; - const unsigned char *x = big + pos + 1; - while (s < littleend) { - if (*s != *x++) - break; - ++s; - } - if (s == littleend) { - *old_posp = (I32)pos; - if (!last) return (char *)(big+pos); - found = TRUE; - } - } - if (mg->mg_private == 1) { - pos = ((const U8 *const)screamnext_raw)[pos]; - if (pos == (U8)~0) - break; - } else if (mg->mg_private == 2) { - pos = ((const U16 *const)screamnext_raw)[pos]; - if (pos == (U16)~0) - break; - } else if (mg->mg_private == 4) { - pos = ((const U32 *const)screamnext_raw)[pos]; - if (pos == (U32)~0) - break; - } - }; - if (last && found) - return (char *)(big+(*old_posp)); - check_tail: - if (!SvTAIL(littlestr) || (end_shift > 0)) - return NULL; - /* Ignore the trailing "\n". This code is not microoptimized */ - big = (const unsigned char *)(SvPVX_const(bigstr) + SvCUR(bigstr)); - stop_pos = littleend - little; /* Actual littlestr len */ - if (stop_pos == 0) - return (char*)big; - big -= stop_pos; - if (*big == first - && ((stop_pos == 1) || - memEQ((char *)(big + 1), (char *)little, stop_pos - 1))) - return (char*)big; + PERL_UNUSED_ARG(bigstr); + PERL_UNUSED_ARG(littlestr); + PERL_UNUSED_ARG(start_shift); + PERL_UNUSED_ARG(end_shift); + PERL_UNUSED_ARG(old_posp); + PERL_UNUSED_ARG(last); + + /* This function must only ever be called on a scalar with study magic, + but those do not happen any more. */ + Perl_croak(aTHX_ "panic: screaminstr"); return NULL; } @@ -1024,8 +866,8 @@ 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; @@ -1044,8 +886,8 @@ 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; @@ -1071,8 +913,8 @@ 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; @@ -1129,7 +971,7 @@ 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; Newx(newaddr,len+1,char); @@ -1155,7 +997,7 @@ which is shared between threads. char * Perl_savesharedpv(pTHX_ const char *pv) { - register char *newaddr; + char *newaddr; STRLEN pvlen; if (!pv) return NULL; @@ -1205,7 +1047,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; @@ -1463,8 +1305,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 @@ -1614,7 +1457,7 @@ Perl_die_sv(pTHX_ SV *baseex) { PERL_ARGS_ASSERT_DIE_SV; croak_sv(baseex); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ return NULL; } @@ -1636,7 +1479,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; } @@ -1648,7 +1491,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; } @@ -1748,7 +1591,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 */ @@ -1759,7 +1602,7 @@ Perl_croak(pTHX_ const char *pat, ...) va_list args; va_start(args, pat); vcroak(pat, &args); - /* NOTREACHED */ + assert(0); /* NOTREACHED */ va_end(args); } @@ -2043,8 +1886,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? */ @@ -2140,7 +1983,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; @@ -2230,9 +2073,9 @@ 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; @@ -2335,8 +2178,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; @@ -2364,8 +2207,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; @@ -2396,8 +2239,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; \ } \ @@ -2412,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; \ u.value = n; \ n = 0; \ for (i = 0; i < sizeof(u.c); i++, s += 8) { \ @@ -2434,8 +2277,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; \ } \ @@ -2450,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); \ u.value = n; \ n = 0; \ for (i = 0; i < sizeof(u.c); i++, s -= 8) { \ @@ -2615,9 +2458,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; @@ -2631,11 +2474,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]; @@ -2768,14 +2611,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; @@ -2915,7 +2758,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) @@ -3210,7 +3053,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) { @@ -3243,9 +3086,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); @@ -3368,7 +3208,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); @@ -3377,7 +3217,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 @@ -3419,12 +3259,12 @@ Perl_repeatcpy(register char *to, register const char *from, I32 len, register I 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++; @@ -3490,11 +3330,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 @@ -3617,28 +3457,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 @@ -3872,15 +3709,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), @@ -3907,7 +3744,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) ? "" : "()"); @@ -3920,7 +3757,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 ? " " : "", @@ -4066,15 +3903,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 @@ -4169,9 +3998,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 * @@ -4537,6 +4364,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 == '.') { @@ -4599,7 +4427,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)"); @@ -4621,6 +4449,7 @@ dotted_decimal_version: if ( ! isDIGIT(d[1]) ) { BADVERSION(s,errstr,"Invalid version format (misplaced underscore)"); } + width = j; d++; alpha = TRUE; } @@ -5851,40 +5680,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 @@ -6633,7 +6428,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 } @@ -6657,8 +6452,8 @@ Perl_get_re_arg(pTHX_ SV *sv) { * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */