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;
char *
Perl_instr(register const char *big, register const char *little)
{
- register I32 first;
+ I32 first;
PERL_ARGS_ASSERT_INSTR;
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; /**/ ) {
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;
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; /**/ ) {
Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
{
dVAR;
- register const U8 *s;
+ const U8 *s;
STRLEN i;
STRLEN len;
STRLEN rarest = 0;
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))
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);
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;
{
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 */
little += littlelen; /* last char */
oldlittle = little;
if (s < bigend) {
- register I32 tmp;
+ I32 tmp;
top2:
if ((tmp = table[*s])) {
goto check_end;
}
else { /* less expensive than calling strncmp() */
- register unsigned char * const olds = s;
+ unsigned char * const olds = s;
tmp = littlelen;
}
}
-/* 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;
}
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;
* 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;
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;
char *
Perl_savepvn(pTHX_ const char *pv, register I32 len)
{
- register char *newaddr;
+ char *newaddr;
PERL_UNUSED_CONTEXT;
Newx(newaddr,len+1,char);
char *
Perl_savesharedpv(pTHX_ const char *pv)
{
- register char *newaddr;
+ char *newaddr;
STRLEN pvlen;
if (!pv)
return NULL;
{
STRLEN len;
const char * const pv = SvPV_const(sv, len);
- register char *newaddr;
+ char *newaddr;
PERL_ARGS_ASSERT_SAVESVPV;
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
{
PERL_ARGS_ASSERT_DIE_SV;
croak_sv(baseex);
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
return NULL;
}
va_list args;
va_start(args, pat);
vcroak(pat, &args);
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
va_end(args);
return NULL;
}
va_list args;
va_start(args, pat);
vcroak(pat, &args);
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
va_end(args);
return NULL;
}
va_list args;
va_start(args, pat);
vcroak(pat, &args);
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
va_end(args);
}
#endif /* PERL_IMPLICIT_CONTEXT */
va_list args;
va_start(args, pat);
vcroak(pat, &args);
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
va_end(args);
}
#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? */
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
dVAR;
- register char *envstr;
+ char *envstr;
const int nlen = strlen(nam);
int vlen;
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;
#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;
#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;
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; \
} \
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) { \
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; \
} \
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) { \
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;
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];
}
/* 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;
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)
#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)
{
#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);
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);
}
#endif
-#if defined(atarist) || defined(OS2) || defined(EPOC)
+#if defined(OS2) || defined(EPOC)
int pclose();
#ifdef HAS_FORK
int /* Cannot prototype with I32
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++;
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
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
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),
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) ? "" : "()");
(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 ? " " : "",
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
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 *
} /* 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 == '.') {
}
while (isDIGIT(*d)) {
- d++;
+ d++; j++;
if (*d == '.' && isDIGIT(d[-1])) {
if (alpha) {
BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
if ( ! isDIGIT(d[1]) ) {
BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
}
+ width = j;
d++;
alpha = TRUE;
}
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
return dir->dd_fd;
#else
Perl_die(aTHX_ PL_no_func, "dirfd");
- /* NOT REACHED */
+ assert(0); /* NOT REACHED */
return 0;
#endif
}