"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
-S_grok_number(pTHX_ 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;
- char* radix = ".";
- STRLEN radixlen = 1;
- bool radixfound;
-
- while (isSPACE(*s))
- s++;
- if (*s == '-') {
- s++;
- numtype = IS_NUMBER_NEG;
- }
- else if (*s == '+')
- s++;
-
-#ifdef USE_LOCALE_NUMERIC
- if (PL_numeric_radix_sv && IN_LOCALE)
- radix = SvPV(PL_numeric_radix_sv, radixlen);
-#endif
-
- /* 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 (s + radixlen <= send && memEQ(s, radix, radixlen))
- radixfound = TRUE;
-#ifdef USE_LOCALE_NUMERIC
- /* if we did change the radix and the radix is not the "."
- * retry with the "." (in case of mixed data) */
- else if (IN_LOCALE && !(*radix == '.' && radixlen == 1) && *s == '.') {
- radixlen = 1;
- radixfound = TRUE;
- }
-#endif
- if (radixfound) {
- s += radixlen;
- numtype |= IS_NUMBER_NOT_INT;
- while (isDIGIT(*s)) /* optional digits after the radix */
- s++;
- }
- }
- else {
- if (s + radixlen <= send && memEQ(s, radix, radixlen))
- radixfound = TRUE;
-#ifdef USE_LOCALE_NUMERIC
- else if (IN_LOCALE && !(*radix == '.' && radixlen == 1) && *s == '.') {
- radixlen = 1;
- radixfound = TRUE;
- }
-#endif
- if (radixfound) {
- s += radixlen;
- 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
#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;
}
}
HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
- if(HvNAME((HV*)dstr))
- av_push(PL_clone_callbacks,dstr);
+ /* If HvNAME() is set hv _may_ be a stash
+ - record it for possible callback
+ */
+ if(HvNAME((HV*)dstr))
+ av_push(PL_clone_callbacks, dstr);
break;
case SVt_PVFM:
SvANY(dstr) = new_XPVFM();
PL_ptr_table = NULL;
}
+ /* For the (possible) stashes identified above
+ - check that they are stashes
+ - if they are see if the ->CLONE method is defined
+ - if it is call it
+ */
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;
-
+ if (gv_stashpv(HvNAME(stash),0)) {
+ GV* cloner = gv_fetchmethod_autoload(stash,"CLONE",0);
+ if (cloner && GvCV(cloner)) {
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(newSVpv(HvNAME(stash),0));
+ PUTBACK;
+ call_sv((SV*)GvCV(cloner), G_DISCARD);
+ FREETMPS;
+ LEAVE;
+ }
}
}