"Argument \"%s\" isn't numeric", tmpbuf);
}
-#define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not
- int). value returned in pointed-
- to UV */
-#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
-#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation */
-#define IS_NUMBER_NEG 0x08 /* leading minus sign */
-#define IS_NUMBER_INFINITY 0x10 /* this is big */
-
-static int
-grok_number(const char *pv, STRLEN len, UV *valuep)
-{
- const char *s = pv;
- const char *send = pv + len;
- const UV max_div_10 = UV_MAX / 10;
- const char max_mod_10 = UV_MAX % 10 + '0';
- int numtype = 0;
- int sawinf = 0;
-#ifdef USE_LOCALE_NUMERIC
- bool specialradix = FALSE;
-#endif
-
- while (isSPACE(*s))
- s++;
- if (*s == '-') {
- s++;
- numtype = IS_NUMBER_NEG;
- }
- else if (*s == '+')
- s++;
-
- /* next must be digit or the radix separator or beginning of infinity */
- if (isDIGIT(*s)) {
- /* UVs are at least 32 bits, so the first 9 decimal digits cannot
- overflow. */
- UV value = *s - '0';
- /* This construction seems to be more optimiser friendly.
- (without it gcc does the isDIGIT test and the *s - '0' separately)
- With it gcc on arm is managing 6 instructions (6 cycles) per digit.
- In theory the optimiser could deduce how far to unroll the loop
- before checking for overflow. */
- int digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- digit = *++s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- /* Now got 9 digits, so need to check
- each time for overflow. */
- digit = *++s - '0';
- while (digit >= 0 && digit <= 9
- && (value < max_div_10
- || (value == max_div_10
- && *s <= max_mod_10))) {
- value = value * 10 + digit;
- digit = *++s - '0';
- }
- if (digit >= 0 && digit <= 9) {
- /* value overflowed.
- skip the remaining digits, don't
- worry about setting *valuep. */
- do {
- s++;
- } while (isDIGIT(*s));
- numtype |=
- IS_NUMBER_GREATER_THAN_UV_MAX;
- goto skip_value;
- }
- }
- }
- }
- }
- }
- }
- }
- }
- numtype |= IS_NUMBER_IN_UV;
- if (valuep)
- *valuep = value;
-
- skip_value:
- if (
-#ifdef USE_LOCALE_NUMERIC
- (specialradix = IS_NUMERIC_RADIX(s, send)) ||
-#endif
- *s == '.') {
-#ifdef USE_LOCALE_NUMERIC
- if (specialradix)
- s += SvCUR(PL_numeric_radix_sv);
- else
-#endif
- s++;
- numtype |= IS_NUMBER_NOT_INT;
- while (isDIGIT(*s)) /* optional digits after the radix */
- s++;
- }
- }
- else if (
-#ifdef USE_LOCALE_NUMERIC
- (specialradix = IS_NUMERIC_RADIX(s, send)) ||
-#endif
- *s == '.'
- ) {
-#ifdef USE_LOCALE_NUMERIC
- if (specialradix)
- s += SvCUR(PL_numeric_radix_sv);
- else
-#endif
- s++;
- numtype |= IS_NUMBER_NOT_INT;
- /* no digits before the radix means we need digits after it */
- if (isDIGIT(*s)) {
- do {
- s++;
- } while (isDIGIT(*s));
- numtype |= IS_NUMBER_IN_UV;
- if (valuep) {
- /* integer approximation is valid - it's 0. */
- *valuep = 0;
- }
- }
- 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;
- s++;
- }
- sawinf = 1;
- }
- else /* Add test for NaN here. */
- return 0;
-
- if (sawinf) {
- numtype &= IS_NUMBER_NEG; /* Keep track of sign */
- numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
- } else {
- /* we can have an optional exponent part */
- if (*s == 'e' || *s == 'E') {
- /* The only flag we keep is sign. Blow away any "it's UV" */
- numtype &= IS_NUMBER_NEG;
- numtype |= IS_NUMBER_NOT_INT;
- s++;
- if (*s == '-' || *s == '+')
- s++;
- if (isDIGIT(*s)) {
- do {
- s++;
- } while (isDIGIT(*s));
- }
- else
- return 0;
- }
- }
- while (isSPACE(*s))
- s++;
- if (s >= send)
- return numtype;
- if (len == 10 && memEQ(pv, "0 but true", 10)) {
- if (valuep)
- *valuep = 0;
- return IS_NUMBER_IN_UV;
- }
- return 0;
-}
-
/*
=for apidoc looks_like_number
/* The IV slot will have been set from value returned by
grok_number above. The NV slot has just been set using
Atof. */
+ SvNOK_on(sv);
assert (SvIOKp(sv));
} else {
if (((UV)1 << NV_PRESERVES_UV_BITS) >
/* The UV slot will have been set from value returned by
grok_number above. The NV slot has just been set using
Atof. */
+ SvNOK_on(sv);
assert (SvIOKp(sv));
} else {
if (((UV)1 << NV_PRESERVES_UV_BITS) >
sv_upgrade(sv, SVt_PVNV);
else
sv_upgrade(sv, SVt_NV);
-#if defined(USE_LONG_DOUBLE)
+#ifdef USE_LONG_DOUBLE
DEBUG_c({
STORE_NUMERIC_LOCAL_SET_STANDARD();
PerlIO_printf(Perl_debug_log,
if (SvNOKp(sv) && !(SvIOK(sv) || SvPOK(sv))) {
SvNOK_on(sv);
}
- else if (SvIOKp(sv) &&
- (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || /* XXX check this logic */
- !grok_number(SvPVX(sv), SvCUR(sv),NULL)))
- {
+ else if (SvIOKp(sv)) {
SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
#ifdef NV_PRESERVES_UV
SvNOK_on(sv);
} else {
SvNOKp_on(sv);
SvIOKp_on(sv);
-
+
if (numtype & IS_NUMBER_NEG) {
SvIVX(sv) = -(IV)value;
} else if (value <= (UV)IV_MAX) {
} else {
/* between IV_MAX and NV(UV_MAX).
Could be slightly > UV_MAX */
-
+
if (numtype & IS_NUMBER_NOT_INT) {
/* UV and NV both imprecise. */
} else {
if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
== IS_NUMBER_IN_UV) {
/* It's defintately an integer */
- if (!(numtype & IS_NUMBER_NEG))
+ if (!(numtype & IS_NUMBER_NEG))
return value;
}
if (!numtype) {
#endif
if (intro) {
- GP *gp;
- gp_free((GV*)dstr);
GvINTRO_off(dstr); /* one-shot flag */
- Newz(602,gp, 1, GP);
- GvGP(dstr) = gp_ref(gp);
- GvSV(dstr) = NEWSV(72,0);
GvLINE(dstr) = CopLINE(PL_curcop);
GvEGV(dstr) = (GV*)dstr;
}
&& how != PERL_MAGIC_regex_global
&& how != PERL_MAGIC_bm
&& how != PERL_MAGIC_fm
- && how != PERL_MAGIC_sv
+ && how != PERL_MAGIC_sv
)
{
Perl_croak(aTHX_ PL_no_modify);
}
HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
+ if(HvNAME((HV*)dstr))
+ av_push(PL_clone_callbacks, dstr);
break;
case SVt_PVFM:
SvANY(dstr) = new_XPVFM();
while (i-- > 0) {
PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
}
+ PL_clone_callbacks = newAV(); /* Setup array of objects to callbackon */
PL_envgv = gv_dup(proto_perl->Ienvgv);
PL_incgv = gv_dup(proto_perl->Iincgv);
PL_hintgv = gv_dup(proto_perl->Ihintgv);
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
}
+
+ while(av_len(PL_clone_callbacks) != -1) {
+ HV* stash = (HV*) av_shift(PL_clone_callbacks);
+ CV* cloner = (CV*) gv_fetchmethod_autoload(stash,"CLONE",0);
+ if(cloner) {
+ dSP;
+ cloner = GvCV(cloner);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(newSVpv(HvNAME(stash),0));
+ PUTBACK;
+ call_sv((SV*)cloner, G_DISCARD);
+ FREETMPS;
+ LEAVE;
+
+ }
+ }
#ifdef PERL_OBJECT
return (PerlInterpreter*)pPerl;
projects / p5sagit/p5-mst-13.2.git / blobdiff