}
void
-Perl_write_to_stderr(pTHX_ const char* message, int msglen)
+Perl_write_to_stderr(pTHX_ SV* msv)
{
dVAR;
IO *io;
PUSHMARK(SP);
EXTEND(SP,2);
PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
- mPUSHp(message, msglen);
+ PUSHs(msv);
PUTBACK;
call_method("PRINT", G_SCALAR);
dSAVED_ERRNO;
#endif
PerlIO * const serr = Perl_error_log;
+ STRLEN msglen;
+ const char* message = SvPVx_const(msv, msglen);
PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
(void)PerlIO_flush(serr);
/* Common code used by vcroak, vdie, vwarn and vwarner */
STATIC bool
-S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bool warn)
+S_vdie_common(pTHX_ SV *message, bool warn)
{
dVAR;
HV *stash;
*hook = NULL;
}
if (warn || message) {
- msg = newSVpvn_flags(message, msglen, utf8);
+ msg = newSVsv(message);
SvREADONLY_on(msg);
SAVEFREESV(msg);
}
return FALSE;
}
-STATIC const char *
-S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
- I32* utf8)
+STATIC SV *
+S_vdie_croak_common(pTHX_ const char* pat, va_list* args)
{
dVAR;
- const char *message;
+ SV *message;
if (pat) {
SV * const msv = vmess(pat, args);
if (PL_errors && SvCUR(PL_errors)) {
sv_catsv(PL_errors, msv);
- message = SvPV_const(PL_errors, *msglen);
+ message = sv_mortalcopy(PL_errors);
SvCUR_set(PL_errors, 0);
}
else
- message = SvPV_const(msv,*msglen);
- *utf8 = SvUTF8(msv);
+ message = msv;
}
else {
message = NULL;
}
if (PL_diehook) {
- S_vdie_common(aTHX_ message, *msglen, *utf8, FALSE);
+ S_vdie_common(aTHX_ message, FALSE);
}
return message;
}
S_vdie(pTHX_ const char* pat, va_list *args)
{
dVAR;
- const char *message;
- const int was_in_eval = PL_in_eval;
- STRLEN msglen;
- I32 utf8 = 0;
+ SV *message;
- message = vdie_croak_common(pat, args, &msglen, &utf8);
+ message = vdie_croak_common(pat, args);
- PL_restartop = die_where(message, msglen);
- SvFLAGS(ERRSV) |= utf8;
- if ((!PL_restartop && was_in_eval) || PL_top_env->je_prev)
- JMPENV_JUMP(3);
- return PL_restartop;
+ die_where(message);
+ /* NOTREACHED */
+ return NULL;
}
#if defined(PERL_IMPLICIT_CONTEXT)
Perl_vcroak(pTHX_ const char* pat, va_list *args)
{
dVAR;
- const char *message;
- STRLEN msglen;
- I32 utf8 = 0;
+ SV *msv;
- message = S_vdie_croak_common(aTHX_ pat, args, &msglen, &utf8);
+ msv = S_vdie_croak_common(aTHX_ pat, args);
- if (PL_in_eval) {
- PL_restartop = die_where(message, msglen);
- SvFLAGS(ERRSV) |= utf8;
- JMPENV_JUMP(3);
- }
- else if (!message)
- message = SvPVx_const(ERRSV, msglen);
-
- write_to_stderr(message, msglen);
- my_failure_exit();
+ die_where(msv);
}
#if defined(PERL_IMPLICIT_CONTEXT)
Perl_vwarn(pTHX_ const char* pat, va_list *args)
{
dVAR;
- STRLEN msglen;
SV * const msv = vmess(pat, args);
- const I32 utf8 = SvUTF8(msv);
- const char * const message = SvPV_const(msv, msglen);
PERL_ARGS_ASSERT_VWARN;
if (PL_warnhook) {
- if (vdie_common(message, msglen, utf8, TRUE))
+ if (vdie_common(msv, TRUE))
return;
}
- write_to_stderr(message, msglen);
+ write_to_stderr(msv);
}
#if defined(PERL_IMPLICIT_CONTEXT)
#endif /* PERL_IMPLICIT_CONTEXT */
void
+Perl_ck_warner_d(pTHX_ U32 err, const char* pat, ...)
+{
+ PERL_ARGS_ASSERT_CK_WARNER_D;
+
+ if (Perl_ckwarn_d(aTHX_ err)) {
+ va_list args;
+ va_start(args, pat);
+ vwarner(err, pat, &args);
+ va_end(args);
+ }
+}
+
+void
+Perl_ck_warner(pTHX_ U32 err, const char* pat, ...)
+{
+ PERL_ARGS_ASSERT_CK_WARNER;
+
+ if (Perl_ckwarn(aTHX_ err)) {
+ va_list args;
+ va_start(args, pat);
+ vwarner(err, pat, &args);
+ va_end(args);
+ }
+}
+
+void
Perl_warner(pTHX_ U32 err, const char* pat,...)
{
va_list args;
PERL_ARGS_ASSERT_VWARNER;
if (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) {
SV * const msv = vmess(pat, args);
- STRLEN msglen;
- const char * const message = SvPV_const(msv, msglen);
- const I32 utf8 = SvUTF8(msv);
if (PL_diehook) {
- assert(message);
- S_vdie_common(aTHX_ message, msglen, utf8, FALSE);
- }
- if (PL_in_eval) {
- PL_restartop = die_where(message, msglen);
- SvFLAGS(ERRSV) |= utf8;
- JMPENV_JUMP(3);
+ assert(msv);
+ S_vdie_common(aTHX_ msv, FALSE);
}
- write_to_stderr(message, msglen);
- my_failure_exit();
+ die_where(msv);
}
else {
Perl_vwarn(aTHX_ pat, args);
Perl_ckwarn(pTHX_ U32 w)
{
dVAR;
- return isLEXWARN_on
- ? (PL_curcop->cop_warnings != pWARN_NONE
- && (
- PL_curcop->cop_warnings == pWARN_ALL
- || isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))
- || (unpackWARN2(w) &&
- isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w)))
- || (unpackWARN3(w) &&
- isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w)))
- || (unpackWARN4(w) &&
- isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w)))
- )
- )
- : (PL_dowarn & G_WARN_ON);
+ /* If lexical warnings have not been set, use $^W. */
+ if (isLEXWARN_off)
+ return PL_dowarn & G_WARN_ON;
+
+ return ckwarn_common(w);
}
/* implements the ckWARN?_d macro */
Perl_ckwarn_d(pTHX_ U32 w)
{
dVAR;
- return
- isLEXWARN_off
- || PL_curcop->cop_warnings == pWARN_ALL
- || (
- PL_curcop->cop_warnings != pWARN_NONE
- && (
- isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))
- || (unpackWARN2(w) &&
- isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w)))
- || (unpackWARN3(w) &&
- isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w)))
- || (unpackWARN4(w) &&
- isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w)))
- )
- )
- ;
+ /* If lexical warnings have not been set then default classes warn. */
+ if (isLEXWARN_off)
+ return TRUE;
+
+ return ckwarn_common(w);
+}
+
+static bool
+S_ckwarn_common(pTHX_ U32 w)
+{
+ if (PL_curcop->cop_warnings == pWARN_ALL)
+ return TRUE;
+
+ if (PL_curcop->cop_warnings == pWARN_NONE)
+ return FALSE;
+
+ /* Check the assumption that at least the first slot is non-zero. */
+ assert(unpackWARN1(w));
+
+ /* Check the assumption that it is valid to stop as soon as a zero slot is
+ seen. */
+ if (!unpackWARN2(w)) {
+ assert(!unpackWARN3(w));
+ assert(!unpackWARN4(w));
+ } else if (!unpackWARN3(w)) {
+ assert(!unpackWARN4(w));
+ }
+
+ /* Right, dealt with all the special cases, which are implemented as non-
+ pointers, so there is a pointer to a real warnings mask. */
+ do {
+ if (isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w)))
+ return TRUE;
+ } while (w >>= WARNshift);
+
+ return FALSE;
}
/* Set buffer=NULL to get a new one. */
}
return NULL;
}
- if (ckWARN(WARN_PIPE))
- Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
+ Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
sleep(5);
}
if (pid == 0) {
Perl_croak(aTHX_ "Can't fork: %s", Strerror(errno));
return NULL;
}
- if (ckWARN(WARN_PIPE))
- Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
+ Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds");
sleep(5);
}
if (pid == 0) {
}
#define VERSION_MAX 0x7FFFFFFF
+
+const char *
+Perl_prescan_version(pTHX_ const char *s, bool strict,
+ const char **errstr,
+ bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) {
+ bool qv = (sqv ? *sqv : FALSE);
+ int width = 3;
+ int saw_decimal = 0;
+ bool alpha = FALSE;
+ const char *d = s;
+
+ PERL_ARGS_ASSERT_PRESCAN_VERSION;
+
+ if (qv && isDIGIT(*d))
+ goto dotted_decimal_version;
+
+ if (*d == 'v') { /* explicit v-string */
+ d++;
+ if (isDIGIT(*d)) {
+ qv = TRUE;
+ }
+ else { /* degenerate v-string */
+ /* requires v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+
+dotted_decimal_version:
+ if (strict && d[0] == '0' && isDIGIT(d[1])) {
+ /* no leading zeros allowed */
+ BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
+ }
+
+ while (isDIGIT(*d)) /* integer part */
+ d++;
+
+ if (*d == '.')
+ {
+ saw_decimal++;
+ d++; /* decimal point */
+ }
+ else
+ {
+ if (strict) {
+ /* require v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+ else {
+ goto version_prescan_finish;
+ }
+ }
+
+ {
+ int i = 0;
+ int j = 0;
+ while (isDIGIT(*d)) { /* just keep reading */
+ i++;
+ while (isDIGIT(*d)) {
+ d++; j++;
+ /* maximum 3 digits between decimal */
+ if (strict && j > 3) {
+ BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)");
+ }
+ }
+ if (*d == '_') {
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ if ( alpha ) {
+ BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
+ }
+ d++;
+ alpha = TRUE;
+ }
+ else if (*d == '.') {
+ if (alpha) {
+ BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
+ }
+ saw_decimal++;
+ d++;
+ }
+ else if (!isDIGIT(*d)) {
+ break;
+ }
+ j = 0;
+ }
+
+ if (strict && i < 2) {
+ /* requires v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+ }
+ } /* end if dotted-decimal */
+ else
+ { /* decimal versions */
+ /* special strict case for leading '.' or '0' */
+ if (strict) {
+ if (*d == '.') {
+ BADVERSION(s,errstr,"Invalid version format (0 before decimal required)");
+ }
+ if (*d == '0' && isDIGIT(d[1])) {
+ BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
+ }
+ }
+
+ /* consume all of the integer part */
+ while (isDIGIT(*d))
+ d++;
+
+ /* look for a fractional part */
+ if (*d == '.') {
+ /* we found it, so consume it */
+ saw_decimal++;
+ d++;
+ }
+ else if (!*d || *d == ';' || isSPACE(*d) || *d == '}') {
+ if ( d == s ) {
+ /* found nothing */
+ BADVERSION(s,errstr,"Invalid version format (version required)");
+ }
+ /* found just an integer */
+ goto version_prescan_finish;
+ }
+ else if ( d == s ) {
+ /* didn't find either integer or period */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+ else if (*d == '_') {
+ /* underscore can't come after integer part */
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ else if (isDIGIT(d[1])) {
+ BADVERSION(s,errstr,"Invalid version format (alpha without decimal)");
+ }
+ else {
+ BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
+ }
+ }
+ else {
+ /* anything else after integer part is just invalid data */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+
+ /* scan the fractional part after the decimal point*/
+
+ if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '}') )) {
+ /* strict or lax-but-not-the-end */
+ BADVERSION(s,errstr,"Invalid version format (fractional part required)");
+ }
+
+ while (isDIGIT(*d)) {
+ d++;
+ if (*d == '.' && isDIGIT(d[-1])) {
+ if (alpha) {
+ BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
+ }
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
+ }
+ d = (char *)s; /* start all over again */
+ qv = TRUE;
+ goto dotted_decimal_version;
+ }
+ if (*d == '_') {
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ if ( alpha ) {
+ BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
+ }
+ if ( ! isDIGIT(d[1]) ) {
+ BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
+ }
+ d++;
+ alpha = TRUE;
+ }
+ }
+ }
+
+version_prescan_finish:
+ while (isSPACE(*d))
+ d++;
+
+ if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '}') )) {
+ /* trailing non-numeric data */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+
+ if (sqv)
+ *sqv = qv;
+ if (swidth)
+ *swidth = width;
+ if (ssaw_decimal)
+ *ssaw_decimal = saw_decimal;
+ if (salpha)
+ *salpha = alpha;
+ return d;
+}
+
/*
=for apidoc scan_version
const char *start;
const char *pos;
const char *last;
- int saw_period = 0;
- int alpha = 0;
+ const char *errstr = NULL;
+ int saw_decimal = 0;
int width = 3;
+ bool alpha = FALSE;
bool vinf = FALSE;
AV * const av = newAV();
SV * const hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+#ifndef NODEFAULT_SHAREKEYS
+ HvSHAREKEYS_on(hv); /* key-sharing on by default */
+#endif
+
while (isSPACE(*s)) /* leading whitespace is OK */
s++;
- start = last = s;
-
- if (*s == 'v') {
- s++; /* get past 'v' */
- qv = 1; /* force quoted version processing */
- }
-
- pos = s;
-
- /* pre-scan the input string to check for decimals/underbars */
- while ( *pos == '.' || *pos == '_' || *pos == ',' || isDIGIT(*pos) )
- {
- if ( *pos == '.' )
- {
- if ( alpha )
- Perl_croak(aTHX_ "Invalid version format (underscores before decimal)");
- saw_period++ ;
- last = pos;
+ last = prescan_version(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
+ if (errstr) {
+ /* "undef" is a special case and not an error */
+ if ( ! ( *s == 'u' && strEQ(s,"undef")) ) {
+ Perl_croak(aTHX_ "%s", errstr);
}
- else if ( *pos == '_' )
- {
- if ( alpha )
- Perl_croak(aTHX_ "Invalid version format (multiple underscores)");
- alpha = 1;
- width = pos - last - 1; /* natural width of sub-version */
- }
- else if ( *pos == ',' && isDIGIT(pos[1]) )
- {
- saw_period++ ;
- last = pos;
- }
-
- pos++;
}
- if ( alpha && !saw_period )
- Perl_croak(aTHX_ "Invalid version format (alpha without decimal)");
-
- if ( alpha && saw_period && width == 0 )
- Perl_croak(aTHX_ "Invalid version format (misplaced _ in number)");
-
- if ( saw_period > 1 )
- qv = 1; /* force quoted version processing */
-
- last = pos;
+ start = s;
+ if (*s == 'v')
+ s++;
pos = s;
if ( qv )
* point of a version originally created with a bare
* floating point number, i.e. not quoted in any way
*/
- if ( !qv && s > start && saw_period == 1 ) {
+ if ( !qv && s > start && saw_decimal == 1 ) {
mult *= 100;
while ( s < end ) {
orev = rev;
mult /= 10;
if ( (PERL_ABS(orev) > PERL_ABS(rev))
|| (PERL_ABS(rev) > VERSION_MAX )) {
- if(ckWARN(WARN_OVERFLOW))
- Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "Integer overflow in version %d",VERSION_MAX);
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "Integer overflow in version %d",VERSION_MAX);
s = end - 1;
rev = VERSION_MAX;
vinf = 1;
mult *= 10;
if ( (PERL_ABS(orev) > PERL_ABS(rev))
|| (PERL_ABS(rev) > VERSION_MAX )) {
- if(ckWARN(WARN_OVERFLOW))
- Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "Integer overflow in version");
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "Integer overflow in version");
end = s - 1;
rev = VERSION_MAX;
vinf = 1;
}
else if ( s > start ) {
SV * orig = newSVpvn(start,s-start);
- if ( qv && saw_period == 1 && *start != 'v' ) {
+ if ( qv && saw_decimal == 1 && *start != 'v' ) {
/* need to insert a v to be consistent */
sv_insert(orig, 0, 0, "v", 1);
}
/* This will get reblessed later if a derived class*/
SV * const hv = newSVrv(rv, "version");
(void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+#ifndef NODEFAULT_SHAREKEYS
+ HvSHAREKEYS_on(hv); /* key-sharing on by default */
+#endif
if ( SvROK(ver) )
ver = SvRV(ver);
char * const version = savepvn( (const char*)mg->mg_ptr, len);
sv_setpvn(rv,version,len);
/* this is for consistency with the pure Perl class */
- if ( *version != 'v' )
+ if ( isDIGIT(*version) )
sv_insert(rv, 0, 0, "v", 1);
Safefree(version);
}
#ifdef SvVOK
else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
- qv = 1;
+ qv = TRUE;
}
#endif
else /* must be a string or something like a string */
#ifndef SvVOK
# if PERL_VERSION > 5
/* This will only be executed for 5.6.0 - 5.8.0 inclusive */
- if ( len == 3 && !instr(version,".") && !instr(version,"_") ) {
+ if ( len >= 3 && !instr(version,".") && !instr(version,"_")
+ && !(*version == 'u' && strEQ(version, "undef"))
+ && (*version < '0' || *version > '9') ) {
/* may be a v-string */
SV * const nsv = sv_newmortal();
const char *nver;
const char *pos;
- int saw_period = 0;
+ int saw_decimal = 0;
sv_setpvf(nsv,"v%vd",ver);
pos = nver = savepv(SvPV_nolen(nsv));
pos++; /* skip the leading 'v' */
while ( *pos == '.' || isDIGIT(*pos) ) {
if ( *pos == '.' )
- saw_period++ ;
+ saw_decimal++ ;
pos++;
}
/* is definitely a v-string */
- if ( saw_period == 2 ) {
+ if ( saw_decimal >= 2 ) {
Safefree(version);
version = nver;
}
s = scan_version(version, ver, qv);
if ( *s != '\0' )
- if(ckWARN(WARN_MISC))
- Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Version string '%s' contains invalid data; "
- "ignoring: '%s'", version, s);
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+ "Version string '%s' contains invalid data; "
+ "ignoring: '%s'", version, s);
Safefree(version);
return ver;
}
I32 i, len, digit;
int width;
bool alpha = FALSE;
- SV * const sv = newSV(0);
+ SV *sv;
AV *av;
PERL_ARGS_ASSERT_VNUMIFY;
/* attempt to retrieve the version array */
if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
- sv_catpvs(sv,"0");
- return sv;
+ return newSVpvs("0");
}
len = av_len(av);
if ( len == -1 )
{
- sv_catpvs(sv,"0");
- return sv;
+ return newSVpvs("0");
}
digit = SvIV(*av_fetch(av, 0, 0));
- Perl_sv_setpvf(aTHX_ sv, "%d.", (int)PERL_ABS(digit));
+ sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
for ( i = 1 ; i < len ; i++ )
{
digit = SvIV(*av_fetch(av, i, 0));
{
I32 i, len, digit;
bool alpha = FALSE;
- SV * const sv = newSV(0);
+ SV *sv;
AV *av;
PERL_ARGS_ASSERT_VNORMAL;
len = av_len(av);
if ( len == -1 )
{
- sv_catpvs(sv,"");
- return sv;
+ return newSVpvs("");
}
digit = SvIV(*av_fetch(av, 0, 0));
- Perl_sv_setpvf(aTHX_ sv, "v%"IVdf, (IV)digit);
+ sv = Perl_newSVpvf(aTHX_ "v%"IVdf, (IV)digit);
for ( i = 1 ; i < len ; i++ ) {
digit = SvIV(*av_fetch(av, i, 0));
Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
* help. Sum in another random number that will
* fill in the low bits. */
myseed +=
- (UV)(Drand01() * (NV)((1 << ((UVSIZE * 8 - RANDBITS))) - 1));
+ (UV)(Drand01() * (NV)((((UV)1) << ((UVSIZE * 8 - RANDBITS))) - 1));
#endif /* RANDBITS < (UVSIZE * 8) */
if (myseed == 0) { /* Superparanoia. */
myseed = (UV)(Drand01() * (NV)UV_MAX); /* One more chance. */
PERL_ARGS_ASSERT_MY_CXT_INIT;
if (*index == -1) {
/* this module hasn't been allocated an index yet */
+#if defined(USE_ITHREADS)
MUTEX_LOCK(&PL_my_ctx_mutex);
+#endif
*index = PL_my_cxt_index++;
+#if defined(USE_ITHREADS)
MUTEX_UNLOCK(&PL_my_ctx_mutex);
+#endif
}
/* make sure the array is big enough */
index = Perl_my_cxt_index(aTHX_ my_cxt_key);
if (index == -1) {
/* this module hasn't been allocated an index yet */
+#if defined(USE_ITHREADS)
MUTEX_LOCK(&PL_my_ctx_mutex);
+#endif
index = PL_my_cxt_index++;
+#if defined(USE_ITHREADS)
MUTEX_UNLOCK(&PL_my_ctx_mutex);
+#endif
}
/* make sure the array is big enough */
REGEXP *
Perl_get_re_arg(pTHX_ SV *sv) {
- SV *tmpsv;
if (sv) {
if (SvMAGICAL(sv))
mg_get(sv);
- if (SvROK(sv) &&
- (tmpsv = MUTABLE_SV(SvRV(sv))) && /* assign deliberate */
- SvTYPE(tmpsv) == SVt_REGEXP)
- {
- return (REGEXP*) tmpsv;
- }
+ if (SvROK(sv))
+ sv = MUTABLE_SV(SvRV(sv));
+ if (SvTYPE(sv) == SVt_REGEXP)
+ return (REGEXP*) sv;
}
return NULL;
projects / p5sagit/p5-mst-13.2.git / blobdiff