goto ret_iv_max;
}
}
- else if (numtype) {
- /* The NV may be reconstructed from IV - safe to cache IV,
- which may be calculated by atol(). */
- if (SvTYPE(sv) == SVt_PV)
- sv_upgrade(sv, SVt_PVIV);
- (void)SvIOK_on(sv);
- SvIVX(sv) = Atol(SvPVX(sv));
- }
- else { /* Not a number. Cache 0. */
- dTHR;
-
+ else { /* The NV may be reconstructed from IV - safe to cache IV,
+ which may be calculated by atol(). */
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
(void)SvIOK_on(sv);
- SvIVX(sv) = 0;
- if (ckWARN(WARN_NUMERIC))
+ SvIVX(sv) = Atol(SvPVX(sv));
+ if (! numtype && ckWARN(WARN_NUMERIC))
not_a_number(sv);
}
}
case SVt_PV:
case SVt_PVIV:
case SVt_PVNV:
- case SVt_PVBM: s = "SCALAR"; break;
+ case SVt_PVBM: if (SvROK(sv))
+ s = "REF";
+ else
+ s = "SCALAR"; break;
case SVt_PVLV: s = "LVALUE"; break;
case SVt_PVAV: s = "ARRAY"; break;
case SVt_PVHV: s = "HASH"; break;
}
}
+/*
+=for apidoc sv_utf8_upgrade
+
+Convert the PV of an SV to its UTF8-encoded form.
+
+=cut
+*/
+
void
Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
{
}
}
+/*
+=for apidoc sv_utf8_downgrade
+
+Attempt to convert the PV of an SV from UTF8-encoded to byte encoding.
+This may not be possible if the PV contains non-byte encoding characters;
+if this is the case, either returns false or, if C<fail_ok> is not
+true, croaks.
+
+=cut
+*/
+
bool
Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
{
return TRUE;
}
+/*
+=for apidoc sv_utf8_encode
+
+Convert the PV of an SV to UTF8-encoded, but then turn off the C<SvUTF8>
+flag so that it looks like bytes again. Nothing calls this.
+
+=cut
+*/
+
void
Perl_sv_utf8_encode(pTHX_ register SV *sv)
{
char *name = GvNAME(sstr);
STRLEN len = GvNAMELEN(sstr);
sv_upgrade(dstr, SVt_PVGV);
- sv_magic(dstr, dstr, '*', name, len);
+ sv_magic(dstr, dstr, '*', Nullch, 0);
GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
GvNAME(dstr) = savepvn(name, len);
GvNAMELEN(dstr) = len;
if(const_sv)
const_changed = sv_cmp(const_sv,
op_const_sv(CvSTART((CV*)sref),
- Nullcv));
+ (CV*)sref));
/* ahem, death to those who redefine
* active sort subs */
if (PL_curstackinfo->si_type == PERLSI_SORT &&
Perl_croak(aTHX_
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if ((const_changed || const_sv) && ckWARN(WARN_REDEFINE))
+ if ((const_changed && const_sv) || ckWARN(WARN_REDEFINE))
Perl_warner(aTHX_ WARN_REDEFINE, const_sv ?
"Constant subroutine %s redefined"
: "Subroutine %s redefined",
dref = (SV*)GvIOp(dstr);
GvIOp(dstr) = (IO*)sref;
break;
+ case SVt_PVFM:
+ if (intro)
+ SAVESPTR(GvFORM(dstr));
+ else
+ dref = (SV*)GvFORM(dstr);
+ GvFORM(dstr) = (CV*)sref;
+ break;
default:
if (intro)
SAVESPTR(GvSV(dstr));
SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
}
+/*
+=for apidoc sv_unmagic
+
+Removes magic from an SV.
+
+=cut
+*/
+
int
Perl_sv_unmagic(pTHX_ SV *sv, int type)
{
return 0;
}
+/*
+=for apidoc sv_rvweaken
+
+Weaken a reference.
+
+=cut
+*/
+
SV *
Perl_sv_rvweaken(pTHX_ SV *sv)
{
SvSETMAGIC(bigstr);
}
-/* make sv point to what nstr did */
+/*
+=for apidoc sv_replace
+
+Make the first argument a copy of the second, then delete the original.
+
+=cut
+*/
void
Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
del_SV(nsv);
}
+/*
+=for apidoc sv_clear
+
+Clear an SV, making it empty. Does not free the memory used by the SV
+itself.
+
+=cut
+*/
+
void
Perl_sv_clear(pTHX_ register SV *sv)
{
return sv;
}
+/*
+=for apidoc sv_free
+
+Free the memory used by an SV.
+
+=cut
+*/
+
void
Perl_sv_free(pTHX_ SV *sv)
{
return len;
}
+/*
+=for apidoc sv_len_utf8
+
+Returns the number of characters in the string in an SV, counting wide
+UTF8 bytes as a single character.
+
+=cut
+*/
+
STRLEN
Perl_sv_len_utf8(pTHX_ register SV *sv)
{
*/
I32
-Perl_sv_eq(pTHX_ register SV *str1, register SV *str2)
+Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
{
char *pv1;
STRLEN cur1;
char *pv2;
STRLEN cur2;
+ I32 eq = 0;
+ bool pv1tmp = FALSE;
+ bool pv2tmp = FALSE;
- if (!str1) {
+ if (!sv1) {
pv1 = "";
cur1 = 0;
}
else
- pv1 = SvPV(str1, cur1);
+ pv1 = SvPV(sv1, cur1);
- 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);
- }
+ if (!sv2){
+ pv2 = "";
+ cur2 = 0;
+ }
+ else
+ pv2 = SvPV(sv2, cur2);
+
+ /* do not utf8ize the comparands as a side-effect */
+ if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE && 0) {
+ if (SvUTF8(sv1)) {
+ pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
+ pv2tmp = TRUE;
+ }
+ else {
+ pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1);
+ pv1tmp = TRUE;
}
}
- pv2 = SvPV(str2, cur2);
- if (cur1 != cur2)
- return 0;
+ if (cur1 == cur2)
+ eq = memEQ(pv1, pv2, cur1);
+
+ if (pv1tmp)
+ Safefree(pv1);
+ if (pv2tmp)
+ Safefree(pv2);
- return memEQ(pv1, pv2, cur1);
+ return eq;
}
/*
*/
I32
-Perl_sv_cmp(pTHX_ register SV *str1, register SV *str2)
+Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
{
STRLEN cur1, cur2;
char *pv1, *pv2;
- I32 retval;
+ I32 cmp;
+ bool pv1tmp = FALSE;
+ bool pv2tmp = FALSE;
- if (str1) {
- pv1 = SvPV(str1, cur1);
- }
- else {
+ if (!sv1) {
+ pv1 = "";
cur1 = 0;
}
+ else
+ pv1 = SvPV(sv1, cur1);
- if (str2) {
- if (SvPOK(str2)) {
- if (SvPOK(str1) && SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) {
- /* must upgrade other to UTF8 first */
- if (SvUTF8(str1)) {
- sv_utf8_upgrade(str2);
- }
- else {
- sv_utf8_upgrade(str1);
- /* refresh pointer and length */
- pv1 = SvPVX(str1);
- cur1 = SvCUR(str1);
- }
- }
- pv2 = SvPVX(str2);
- cur2 = SvCUR(str2);
- }
+ if (!sv2){
+ pv2 = "";
+ cur2 = 0;
+ }
+ else
+ pv2 = SvPV(sv2, cur2);
+
+ /* do not utf8ize the comparands as a side-effect */
+ if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) {
+ if (SvUTF8(sv1)) {
+ pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
+ pv2tmp = TRUE;
+ }
else {
- pv2 = sv_2pv(str2, &cur2);
+ pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1);
+ pv1tmp = TRUE;
}
}
- else {
- cur2 = 0;
+
+ if (!cur1) {
+ cmp = cur2 ? -1 : 0;
+ } else if (!cur2) {
+ cmp = 1;
+ } else {
+ I32 retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2);
+
+ if (retval) {
+ cmp = retval < 0 ? -1 : 1;
+ } else if (cur1 == cur2) {
+ cmp = 0;
+ } else {
+ cmp = cur1 < cur2 ? -1 : 1;
+ }
}
- if (!cur1)
- return cur2 ? -1 : 0;
+ if (pv1tmp)
+ Safefree(pv1);
+ if (pv2tmp)
+ Safefree(pv2);
- if (!cur2)
- return 1;
+ return cmp;
+}
- retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2);
+/*
+=for apidoc sv_cmp_locale
- if (retval)
- return retval < 0 ? -1 : 1;
+Compares the strings in two SVs in a locale-aware manner. See
+L</sv_cmp_locale>
- if (cur1 == cur2)
- return 0;
- else
- return cur1 < cur2 ? -1 : 1;
-}
+=cut
+*/
I32
Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2)
#endif /* USE_LOCALE_COLLATE */
+/*
+=for apidoc sv_gets
+
+Get a line from the filehandle and store it into the SV, optionally
+appending to the currently-stored string.
+
+=cut
+*/
+
char *
Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
{
}
}
+/*
+=for apidoc sv_true
+
+Returns true if the SV has a true value by Perl's rules.
+
+=cut
+*/
+
I32
Perl_sv_true(pTHX_ register SV *sv)
{
return sv_2pv(sv, lp);
}
+/*
+=for apidoc sv_pvn_force
+
+Get a sensible string out of the SV somehow.
+
+=cut
+*/
+
char *
Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
{
return sv_pvn(sv,lp);
}
+/*
+=for apidoc sv_pvutf8n_force
+
+Get a sensible UTF8-encoded string out of the SV somehow. See
+L</sv_pvn_force>.
+
+=cut
+*/
+
char *
Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
{
return sv_pvn_force(sv,lp);
}
+/*
+=for apidoc sv_reftype
+
+Returns a string describing what the SV is a reference to.
+
+=cut
+*/
+
char *
Perl_sv_reftype(pTHX_ SV *sv, int ob)
{
case 'v':
vectorize = TRUE;
q++;
- if (args)
- 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;
default:
has_precis = TRUE;
}
+ if (vectorize) {
+ if (args) {
+ vecsv = va_arg(*args, SV*);
+ vecstr = (U8*)SvPVx(vecsv,veclen);
+ utf = DO_UTF8(vecsv);
+ }
+ else if (svix < svmax) {
+ vecsv = svargs[svix++];
+ vecstr = (U8*)SvPVx(vecsv,veclen);
+ utf = DO_UTF8(vecsv);
+ }
+ else {
+ vecstr = (U8*)"";
+ veclen = 0;
+ }
+ }
+
/* SIZE */
switch (*q) {
/* INTEGERS */
case 'p':
+ if (alt)
+ goto unknown;
if (args)
uv = PTR2UV(va_arg(*args, void*));
else
}
}
else if (svix < svmax)
- sv_setuv(svargs[svix++], (UV)i);
+ sv_setuv_mg(svargs[svix++], (UV)i);
continue; /* not "break" */
/* UNKNOWN */
projects / p5sagit/p5-mst-13.2.git / blobdiff