* lib/utf8.t lib/Unicode/Collate/t/index.t
* --jhi
*/
-#define ASSERT_UTF8_CACHE(cache) \
+# define ASSERT_UTF8_CACHE(cache) \
STMT_START { if (cache) { assert((cache)[0] <= (cache)[1]); \
assert((cache)[2] <= (cache)[3]); \
assert((cache)[3] <= (cache)[1]);} \
} STMT_END
#else
-#define ASSERT_UTF8_CACHE(cache) NOOP
+# define ASSERT_UTF8_CACHE(cache) NOOP
#endif
#ifdef PERL_OLD_COPY_ON_WRITE
void*
Perl_get_arena(pTHX_ int arena_size)
{
+ dVAR;
struct arena_desc* adesc;
struct arena_set *newroot, **aroot = (struct arena_set**) &PL_body_arenas;
int curr;
newroot->set_size = ARENAS_PER_SET;
newroot->next = *aroot;
*aroot = newroot;
- DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", *aroot));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", (void*)*aroot));
}
/* ok, now have arena-set with at least 1 empty/available arena-desc */
return grok_number(sbegin, len, NULL);
}
+STATIC bool
+S_glob_2number(pTHX_ GV * const gv)
+{
+ const U32 wasfake = SvFLAGS(gv) & SVf_FAKE;
+ SV *const buffer = sv_newmortal();
+
+ /* FAKE globs can get coerced, so need to turn this off temporarily if it
+ is on. */
+ SvFAKE_off(gv);
+ gv_efullname3(buffer, gv, "*");
+ SvFLAGS(gv) |= wasfake;
+
+ /* We know that all GVs stringify to something that is not-a-number,
+ so no need to test that. */
+ if (ckWARN(WARN_NUMERIC))
+ not_a_number(buffer);
+ /* We just want something true to return, so that S_sv_2iuv_common
+ can tail call us and return true. */
+ return TRUE;
+}
+
STATIC char *
-S_glob_2inpuv(pTHX_ GV *gv, STRLEN *len, bool want_number)
+S_glob_2pv(pTHX_ GV * const gv, STRLEN * const len)
{
const U32 wasfake = SvFLAGS(gv) & SVf_FAKE;
SV *const buffer = sv_newmortal();
gv_efullname3(buffer, gv, "*");
SvFLAGS(gv) |= wasfake;
- if (want_number) {
- /* We know that all GVs stringify to something that is not-a-number,
- so no need to test that. */
- if (ckWARN(WARN_NUMERIC))
- not_a_number(buffer);
- /* We just want something true to return, so that S_sv_2iuv_common
- can tail call us and return true. */
- return (char *) 1;
- } else {
- assert(SvPOK(buffer));
- if (len) {
- *len = SvCUR(buffer);
- }
- return SvPVX(buffer);
- }
+ assert(SvPOK(buffer));
+ *len = SvCUR(buffer);
+ return SvPVX(buffer);
}
/* Actually, ISO C leaves conversion of UV to IV undefined, but
if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
SvIOK_on(sv);
} else {
- /*EMPTY*/; /* Integer is imprecise. NOK, IOKp */
+ NOOP; /* Integer is imprecise. NOK, IOKp */
}
/* UV will not work better than IV */
} else {
if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
SvIOK_on(sv);
} else {
- /*EMPTY*/; /* Integer is imprecise. NOK, IOKp, is UV */
+ NOOP; /* Integer is imprecise. NOK, IOKp, is UV */
}
}
SvIsUV_on(sv);
}
}
else {
- if (isGV_with_GP(sv)) {
- return (bool)PTR2IV(glob_2inpuv((GV *)sv, NULL, TRUE));
- }
+ if (isGV_with_GP(sv))
+ return glob_2number((GV *)sv);
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
}
else {
if (isGV_with_GP(sv)) {
- glob_2inpuv((GV *)sv, NULL, TRUE);
+ glob_2number((GV *)sv);
return 0.0;
}
STRLEN len;
if (SvIOKp(sv)) {
- len = SvIsUV(sv) ? my_sprintf(tbuf,"%"UVuf, (UV)SvUVX(sv))
- : my_sprintf(tbuf,"%"IVdf, (IV)SvIVX(sv));
+ len = SvIsUV(sv)
+#ifdef USE_SNPRINTF
+ ? snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv))
+ : snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv));
+#else
+ ? my_sprintf(tbuf, "%"UVuf, (UV)SvUVX(sv))
+ : my_sprintf(tbuf, "%"IVdf, (IV)SvIVX(sv));
+#endif /* #ifdef USE_SNPRINTF */
} else {
Gconvert(SvNVX(sv), NV_DIG, 0, tbuf);
len = strlen(tbuf);
#endif
}
else {
- if (isGV_with_GP(sv)) {
- return glob_2inpuv((GV *)sv, lp, FALSE);
- }
+ if (isGV_with_GP(sv))
+ return glob_2pv((GV *)sv, lp);
if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
it was a const and its value changed. */
if (CvCONST(cv) && CvCONST((CV*)sref)
&& cv_const_sv(cv) == cv_const_sv((CV*)sref)) {
- /*EMPTY*/
+ NOOP;
/* They are 2 constant subroutines generated from
the same constant. This probably means that
they are really the "same" proxy subroutine
}
}
if (type >= SVt_PVMG) {
- HV *ourstash;
- if ((type == SVt_PVMG || type == SVt_PVGV) &&
- (ourstash = OURSTASH(sv))) {
- SvREFCNT_dec(ourstash);
+ if ((type == SVt_PVMG || type == SVt_PVGV) && SvPAD_OUR(sv)) {
+ SvREFCNT_dec(OURSTASH(sv));
} else if (SvMAGIC(sv))
mg_free(sv);
if (type == SVt_PVMG && SvPAD_TYPED(sv))
PL_utf8cache = 0;
Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVf
" real %"UVf" for %"SVf,
- (UV) ulen, (UV) real, sv);
+ (UV) ulen, (UV) real, (void*)sv);
}
}
}
/* Walk forwards to find the byte corresponding to the passed in UTF-8
offset. */
static STRLEN
-S_sv_pos_u2b_forwards(pTHX_ const U8 *const start, const U8 *const send,
+S_sv_pos_u2b_forwards(const U8 *const start, const U8 *const send,
STRLEN uoffset)
{
const U8 *s = start;
- PERL_UNUSED_CONTEXT;
-
while (s < send && uoffset--)
s += UTF8SKIP(s);
if (s > send) {
whether to walk forwards or backwards to find the byte corresponding to
the passed in UTF-8 offset. */
static STRLEN
-S_sv_pos_u2b_midway(pTHX_ const U8 *const start, const U8 *send,
+S_sv_pos_u2b_midway(const U8 *const start, const U8 *send,
STRLEN uoffset, STRLEN uend)
{
STRLEN backw = uend - uoffset;
/* The assumption is that going forwards is twice the speed of going
forward (that's where the 2 * backw comes from).
(The real figure of course depends on the UTF-8 data.) */
- return S_sv_pos_u2b_forwards(aTHX_ start, send, uoffset);
+ return sv_pos_u2b_forwards(start, send, uoffset);
}
while (backw--) {
if ((*mgp)->mg_len != -1) {
/* And we know the end too. */
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0, send,
+ + sv_pos_u2b_midway(start + boffset0, send,
uoffset - uoffset0,
(*mgp)->mg_len - uoffset0);
} else {
boffset = boffset0
- + S_sv_pos_u2b_forwards(aTHX_ start + boffset0,
+ + sv_pos_u2b_forwards(start + boffset0,
send, uoffset - uoffset0);
}
}
}
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0,
+ + sv_pos_u2b_midway(start + boffset0,
start + cache[1],
uoffset - uoffset0,
cache[0] - uoffset0);
} else {
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0,
+ + sv_pos_u2b_midway(start + boffset0,
start + cache[3],
uoffset - uoffset0,
cache[2] - uoffset0);
/* In fact, offset0 is either 0, or less than offset, so don't
need to worry about the other possibility. */
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0, send,
+ + sv_pos_u2b_midway(start + boffset0, send,
uoffset - uoffset0,
(*mgp)->mg_len - uoffset0);
found = TRUE;
if (!found || PL_utf8cache < 0) {
const STRLEN real_boffset
- = boffset0 + S_sv_pos_u2b_forwards(aTHX_ start + boffset0,
+ = boffset0 + sv_pos_u2b_forwards(start + boffset0,
send, uoffset - uoffset0);
if (found && PL_utf8cache < 0) {
PL_utf8cache = 0;
Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVf
" real %"UVf" for %"SVf,
- (UV) boffset, (UV) real_boffset, sv);
+ (UV) boffset, (UV) real_boffset, (void*)sv);
}
}
boffset = real_boffset;
STRLEN uoffset = (STRLEN) *offsetp;
const U8 * const send = start + len;
MAGIC *mg = NULL;
- STRLEN boffset = S_sv_pos_u2b_cached(aTHX_ sv, &mg, start, send,
+ const STRLEN boffset = sv_pos_u2b_cached(sv, &mg, start, send,
uoffset, 0, 0);
*offsetp = (I32) boffset;
if (lenp) {
/* Convert the relative offset to absolute. */
- STRLEN uoffset2 = uoffset + (STRLEN) *lenp;
- STRLEN boffset2
- = S_sv_pos_u2b_cached(aTHX_ sv, &mg, start, send, uoffset2,
+ const STRLEN uoffset2 = uoffset + (STRLEN) *lenp;
+ const STRLEN boffset2
+ = sv_pos_u2b_cached(sv, &mg, start, send, uoffset2,
uoffset, boffset) - boffset;
*lenp = boffset2;
SAVEI8(PL_utf8cache);
PL_utf8cache = 0;
Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVf
- " real %"UVf" for %"SVf, (UV) utf8, (UV) realutf8, sv);
+ " real %"UVf" for %"SVf, (UV) utf8, (UV) realutf8, (void*)sv);
}
}
PL_utf8cache = 0;
Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVf
" real %"UVf" for %"SVf,
- (UV) len, (UV) real_len, sv);
+ (UV) len, (UV) real_len, (void*)sv);
}
}
len = real_len;
*
* - jik 9/25/96
*/
- if (!(cnt < sizeof(buf) && PerlIO_eof(fp)))
+ if (!(cnt < (I32)sizeof(buf) && PerlIO_eof(fp)))
goto screamer2;
}
SvUTF8_on (sv);
Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
return sv;
- } else if (flags & HVhek_REHASH) {
+ } else if (flags & (HVhek_REHASH|HVhek_UNSHARED)) {
/* We don't have a pointer to the hv, so we have to replicate the
flag into every HEK. This hv is using custom a hasing
algorithm. Hence we can't return a shared string scalar, as
that would contain the (wrong) hash value, and might get passed
- into an hv routine with a regular hash */
+ into an hv routine with a regular hash.
+ Similarly, a hash that isn't using shared hash keys has to have
+ the flag in every key so that we know not to try to call
+ share_hek_kek on it. */
SV * const sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
if (HEK_UTF8(hek))
else
io = 0;
if (!io)
- Perl_croak(aTHX_ "Bad filehandle: %"SVf, sv);
+ Perl_croak(aTHX_ "Bad filehandle: %"SVf, (void*)sv);
break;
}
return io;
LEAVE;
if (!GvCVu(gv))
Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
- sv);
+ (void*)sv);
}
return GvCVu(gv);
}
* --jhi */
#if defined(HAS_LONG_DOUBLE)
elen = ((intsize == 'q')
+# ifdef USE_SNPRINTF
+ ? snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
+ : snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
+# else
? my_sprintf(PL_efloatbuf, ptr, nv)
: my_sprintf(PL_efloatbuf, ptr, (double)nv));
+# endif /* #ifdef USE_SNPRINTF */
#else
elen = my_sprintf(PL_efloatbuf, ptr, nv);
#endif
(UV)c & 0xFF);
} else
sv_catpvs(msg, "end of string");
- Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, msg); /* yes, this is reentrant */
+ Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, (void*)msg); /* yes, this is reentrant */
}
/* output mangled stuff ... */
ret->gp_cv = cv_dup_inc(gp->gp_cv, param);
ret->gp_cvgen = gp->gp_cvgen;
ret->gp_line = gp->gp_line;
- ret->gp_file = gp->gp_file; /* points to COP.cop_file */
+ ret->gp_file_hek = hek_dup(gp->gp_file_hek, param);
return ret;
}
case SVt_PVGV:
if (GvUNIQUE((GV*)sstr)) {
- /*EMPTY*/; /* Do sharing here, and fall through */
+ NOOP; /* Do sharing here, and fall through */
}
case SVt_PVIO:
case SVt_PVFM:
missing by always going for the destination.
FIXME - instrument and check that assumption */
if (sv_type >= SVt_PVMG) {
- HV *ourstash;
- if ((sv_type == SVt_PVMG) && (ourstash = OURSTASH(dstr))) {
- OURSTASH_set(dstr, hv_dup_inc(ourstash, param));
+ if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
+ OURSTASH_set(dstr, hv_dup_inc(OURSTASH(dstr), param));
} else if (SvMAGIC(dstr))
SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
if (SvSTASH(dstr))
if (IoDIRP(dstr)) {
IoDIRP(dstr) = dirp_dup(IoDIRP(dstr));
} else {
- /*EMPTY*/;
+ NOOP;
/* IoDIRP(dstr) is already a copy of IoDIRP(sstr) */
}
}
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
SvFLAGS(&PL_sv_no) = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
- SvPV_set(&PL_sv_no, SAVEPVN(PL_No, 0));
+ SvPV_set(&PL_sv_no, savepvn(PL_No, 0));
SvCUR_set(&PL_sv_no, 0);
SvLEN_set(&PL_sv_no, 1);
SvIV_set(&PL_sv_no, 0);
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
SvFLAGS(&PL_sv_yes) = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
- SvPV_set(&PL_sv_yes, SAVEPVN(PL_Yes, 1));
+ SvPV_set(&PL_sv_yes, savepvn(PL_Yes, 1));
SvCUR_set(&PL_sv_yes, 1);
SvLEN_set(&PL_sv_yes, 2);
SvIV_set(&PL_sv_yes, 1);
S_find_array_subscript(pTHX_ AV *av, SV* val)
{
dVAR;
- SV** svp;
- I32 i;
if (!av || SvMAGICAL(av) || !AvARRAY(av) ||
(AvFILLp(av) > FUV_MAX_SEARCH_SIZE))
return -1;
- svp = AvARRAY(av);
- for (i=AvFILLp(av); i>=0; i--) {
- if (svp[i] == val && svp[i] != &PL_sv_undef)
- return i;
+ if (val != &PL_sv_undef) {
+ SV ** const svp = AvARRAY(av);
+ I32 i;
+
+ for (i=AvFILLp(av); i>=0; i--)
+ if (svp[i] == val)
+ return i;
}
return -1;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff