#define IS_NUMBER_TO_INT_BY_ATOF 0x02 /* atol() may be != atof() */
#define IS_NUMBER_NOT_IV 0x04 /* (IV)atof() may be != atof() */
#define IS_NUMBER_NEG 0x08 /* not good to cache UV */
+#define IS_NUMBER_INFINITY 0x10 /* this is big */
/* Actually, ISO C leaves conversion of UV to IV undefined, but
until proven guilty, assume that things are not that bad... */
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
- SvIVX(sv) = 0;
(void)SvIOK_on(sv);
+ SvIVX(sv) = 0;
if (ckWARN(WARN_NUMERIC))
not_a_number(sv);
}
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
- SvUVX(sv) = 0; /* We assume that 0s have the
- same bitmap in IV and UV. */
(void)SvIOK_on(sv);
(void)SvIsUV_on(sv);
+ SvUVX(sv) = 0; /* We assume that 0s have the
+ same bitmap in IV and UV. */
if (ckWARN(WARN_NUMERIC))
not_a_number(sv);
}
* IS_NUMBER_TO_INT_BY_ATOL 123
* IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_NOT_IV 123.1
* IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV 123e0
+ * IS_NUMBER_INFINITY
* with a possible addition of IS_NUMBER_NEG.
*/
register char *sbegin;
register char *nbegin;
I32 numtype = 0;
+ I32 sawinf = 0;
STRLEN len;
if (SvPOK(sv)) {
* (int)atof().
*/
- /* next must be digit or the radix separator */
+ /* next must be digit or the radix separator or beginning of infinity */
if (isDIGIT(*s)) {
do {
s++;
else
return 0;
}
+ else if (*s == 'I' || *s == 'i') {
+ s++; if (*s != 'N' && *s != 'n') return 0;
+ s++; if (*s != 'F' && *s != 'f') return 0;
+ s++; if (*s == 'I' || *s == 'i') {
+ s++; if (*s != 'N' && *s != 'n') return 0;
+ s++; if (*s != 'I' && *s != 'i') return 0;
+ s++; if (*s != 'T' && *s != 't') return 0;
+ s++; if (*s != 'Y' && *s != 'y') return 0;
+ }
+ sawinf = 1;
+ }
else
return 0;
- /* we can have an optional exponent part */
- if (*s == 'e' || *s == 'E') {
- numtype &= ~IS_NUMBER_NEG;
- numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV;
- s++;
- if (*s == '+' || *s == '-')
+ if (sawinf)
+ numtype = IS_NUMBER_INFINITY;
+ else {
+ /* we can have an optional exponent part */
+ if (*s == 'e' || *s == 'E') {
+ numtype &= ~IS_NUMBER_NEG;
+ numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV;
s++;
- if (isDIGIT(*s)) {
- do {
- s++;
- } while (isDIGIT(*s));
- }
- else
- return 0;
+ if (*s == '+' || *s == '-')
+ s++;
+ if (isDIGIT(*s)) {
+ do {
+ s++;
+ } while (isDIGIT(*s));
+ }
+ else
+ return 0;
+ }
}
while (isSPACE(*s))
s++;
static char *
uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
{
- STRLEN len;
char *ptr = buf + TYPE_CHARS(UV);
char *ebuf = ptr;
int sign;
- char *p;
if (is_uv)
sign = 0;
int right = 4;
U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
- while(ch = *fptr++) {
+ while((ch = *fptr++)) {
if(reganch & 1) {
reflags[left++] = ch;
}
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (GvIMPORTED_AV_off(dstr)
+ if (!GvIMPORTED_AV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_AV_on(dstr);
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (GvIMPORTED_HV_off(dstr)
+ if (!GvIMPORTED_HV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_HV_on(dstr);
GvASSUMECV_on(dstr);
PL_sub_generation++;
}
- if (GvIMPORTED_CV_off(dstr)
+ if (!GvIMPORTED_CV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_CV_on(dstr);
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (GvIMPORTED_SV_off(dstr)
+ if (!GvIMPORTED_SV(dstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
GvIMPORTED_SV_on(dstr);
if (sflags & SVp_IOK) {
(void)SvIOK_on(dstr);
SvIVX(dstr) = SvIVX(sstr);
- if (SvIsUV(sstr))
+ if (sflags & SVf_IVisUV)
SvIsUV_on(dstr);
}
if (SvAMAGIC(sstr)) {
SvUTF8_off(dstr);
SvTEMP_off(dstr);
- (void)SvOK_off(sstr);
+ (void)SvOK_off(sstr); /* NOTE: nukes most SvFLAGS on sstr */
SvPV_set(sstr, Nullch);
SvLEN_set(sstr, 0);
SvCUR_set(sstr, 0);
if (sflags & SVp_IOK) {
(void)SvIOK_on(dstr);
SvIVX(dstr) = SvIVX(sstr);
- if (SvIsUV(sstr))
+ if (sflags & SVf_IVisUV)
SvIsUV_on(dstr);
}
}
else if (sflags & SVp_NOK) {
SvNVX(dstr) = SvNVX(sstr);
(void)SvNOK_only(dstr);
- if (SvIOK(sstr)) {
+ if (sflags & SVf_IOK) {
(void)SvIOK_on(dstr);
SvIVX(dstr) = SvIVX(sstr);
/* XXXX Do we want to set IsUV for IV(ROK)? Be extra safe... */
- if (SvIsUV(sstr))
+ if (sflags & SVf_IVisUV)
SvIsUV_on(dstr);
}
}
else if (sflags & SVp_IOK) {
(void)SvIOK_only(dstr);
SvIVX(dstr) = SvIVX(sstr);
- if (SvIsUV(sstr))
+ if (sflags & SVf_IVisUV)
SvIsUV_on(dstr);
}
else {
STRLEN len;
if (!sstr)
return;
- if (s = SvPV(sstr, len)) {
+ if ((s = SvPV(sstr, len))) {
if (SvUTF8(sstr))
sv_utf8_upgrade(dstr);
sv_catpvn(dstr,s,len);
SvCUR_set(bigstr, mid - big);
}
/*SUPPRESS 560*/
- else if (i = mid - big) { /* faster from front */
+ else if ((i = mid - big)) { /* faster from front */
midend -= littlelen;
mid = midend;
sv_chop(bigstr,midend-i);
else
pv1 = SvPV(str1, cur1);
- if (!str2)
- return !cur1;
- else
- pv2 = SvPV(str2, cur2);
+ if (cur1) {
+ if (!str2)
+ return 0;
+ if (SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) {
+ if (SvUTF8(str1)) {
+ sv_utf8_upgrade(str2);
+ }
+ else {
+ sv_utf8_upgrade(str1);
+ }
+ }
+ }
+ pv2 = SvPV(str2, cur2);
if (cur1 != cur2)
return 0;
STRLEN cur1, cur2;
char *pv1, *pv2;
I32 retval;
- bool utf1;
if (str1) {
pv1 = SvPV(str1, cur1);
}
/*
+=for apidoc newSVuv
+
+Creates a new SV and copies an unsigned integer into it.
+The reference count for the SV is set to 1.
+
+=cut
+*/
+
+SV *
+Perl_newSVuv(pTHX_ UV u)
+{
+ register SV *sv;
+
+ new_SV(sv);
+ sv_setuv(sv,u);
+ return sv;
+}
+
+/*
=for apidoc newRV_noinc
Creates an RV wrapper for an SV. The reference count for the original
case SVt_PVCV: return "CODE";
case SVt_PVGV: return "GLOB";
case SVt_PVFM: return "FORMAT";
+ case SVt_PVIO: return "IO";
default: return "UNKNOWN";
}
}
{
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, 't');
- if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
+ if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv)))
return TRUE;
}
return FALSE;
vecsv = va_arg(*args, SV*);
else if (svix < svmax)
vecsv = svargs[svix++];
+ else
+ continue;
dotstr = SvPVx(vecsv,dotstrlen);
if (DO_UTF8(vecsv))
is_utf = TRUE;
vecsv = va_arg(*args, SV*);
else if (svix < svmax)
vecsv = svargs[svix++];
+ else {
+ vecstr = (U8*)"";
+ veclen = 0;
+ continue;
+ }
vecstr = (U8*)SvPVx(vecsv,veclen);
utf = DO_UTF8(vecsv);
continue;
iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
switch (intsize) {
case 'h': iv = (short)iv; break;
- default: iv = (int)iv; break;
+ default: break;
case 'l': iv = (long)iv; break;
case 'V': break;
#ifdef HAS_QUAD
uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0;
switch (intsize) {
case 'h': uv = (unsigned short)uv; break;
- default: uv = (unsigned)uv; break;
+ default: break;
case 'l': uv = (unsigned long)uv; break;
case 'V': break;
#ifdef HAS_QUAD
need = 0;
if (c != 'e' && c != 'E') {
i = PERL_INT_MIN;
- (void)frexp(nv, &i);
+ (void)Perl_frexp(nv, &i);
if (i == PERL_INT_MIN)
Perl_die(aTHX_ "panic: frexp");
if (i > 0)
*--eptr = c;
#ifdef USE_LONG_DOUBLE
{
- char* p = PERL_PRIfldbl + sizeof(PERL_PRIfldbl) - 3;
- while (p >= PERL_PRIfldbl) { *--eptr = *p--; }
+ static char const my_prifldbl[] = PERL_PRIfldbl;
+ char const *p = my_prifldbl + sizeof my_prifldbl - 3;
+ while (p >= my_prifldbl) { *--eptr = *p--; }
}
#endif
if (has_precis) {
# include "error: USE_THREADS and USE_ITHREADS are incompatible"
#endif
-#ifndef OpREFCNT_inc
-# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : Nullop)
-#endif
-
#ifndef GpREFCNT_inc
# define GpREFCNT_inc(gp) ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL)
#endif
SV *
Perl_sv_dup(pTHX_ SV *sstr)
{
- U32 sflags;
- int dtype;
- int stype;
SV *dstr;
if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
HvRITER((HV*)dstr) = HvRITER((HV*)sstr);
if (HvARRAY((HV*)sstr)) {
- HE *entry;
STRLEN i = 0;
XPVHV *dxhv = (XPVHV*)SvANY(dstr);
XPVHV *sxhv = (XPVHV*)SvANY(sstr);
ncx->blk_loop.iterdata = (CxPADLOOP(cx)
? cx->blk_loop.iterdata
: gv_dup((GV*)cx->blk_loop.iterdata));
+ ncx->blk_loop.oldcurpad
+ = (SV**)ptr_table_fetch(PL_ptr_table,
+ cx->blk_loop.oldcurpad);
ncx->blk_loop.itersave = sv_dup_inc(cx->blk_loop.itersave);
ncx->blk_loop.iterlval = sv_dup_inc(cx->blk_loop.iterlval);
ncx->blk_loop.iterary = av_dup_inc(cx->blk_loop.iterary);
char *c;
void (*dptr) (void*);
void (*dxptr) (pTHXo_ void*);
+ OP *o;
Newz(54, nss, max, ANY);
case OP_LEAVE:
case OP_SCOPE:
case OP_LEAVEWRITE:
- TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ TOPPTR(nss,ix) = ptr;
+ o = (OP*)ptr;
+ OpREFCNT_inc(o);
break;
default:
TOPPTR(nss,ix) = Nullop;
* their pointers copied. */
IV i;
- SV *sv;
- SV **svp;
# ifdef PERL_OBJECT
CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
ipD, ipS, ipP);
# endif /* PERL_OBJECT */
#else /* !PERL_IMPLICIT_SYS */
IV i;
- SV *sv;
- SV **svp;
PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
PERL_SET_THX(my_perl);
PL_main_cv = cv_dup_inc(proto_perl->Imain_cv);
PL_main_root = OpREFCNT_inc(proto_perl->Imain_root);
PL_main_start = proto_perl->Imain_start;
- PL_eval_root = OpREFCNT_inc(proto_perl->Ieval_root);
+ PL_eval_root = proto_perl->Ieval_root;
PL_eval_start = proto_perl->Ieval_start;
/* runtime control stuff */
}
else {
init_stacks();
+ ENTER; /* perl_destruct() wants to LEAVE; */
}
PL_start_env = proto_perl->Tstart_env; /* XXXXXX */
{
if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
if ( SvOBJECT(GvSV(sv)) ||
- GvAV(sv) && SvOBJECT(GvAV(sv)) ||
- GvHV(sv) && SvOBJECT(GvHV(sv)) ||
- GvIO(sv) && SvOBJECT(GvIO(sv)) ||
- GvCV(sv) && SvOBJECT(GvCV(sv)) )
+ (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
+ (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
+ (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
+ (GvCV(sv) && SvOBJECT(GvCV(sv))) )
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
SvREFCNT_dec(sv);
https://perl5.git.perl.org / perl5.git / blobdiff