}
}
- if (DO_UTF8(sv)) {
+ {
+ /* You can't know whether it's UTF-8 until you get the string again...
+ */
const U8 *s = (U8*)SvPV_const(sv, len);
- len = utf8_length(s, s + len);
+
+ if (DO_UTF8(sv)) {
+ len = utf8_length(s, s + len);
+ }
}
- else
- (void)SvPV_const(sv, len);
return len;
}
if (mg->mg_flags & MGf_REFCOUNTED)
SvREFCNT_dec(mg->mg_obj);
Safefree(mg);
+ SvMAGIC_set(sv, moremagic);
}
SvMAGIC_set(sv, NULL);
return 0;
if (rx) {
if (mg->mg_obj) { /* @+ */
/* return the number possible */
- return rx->nparens;
+ return RX_NPARENS(rx);
} else { /* @- */
- I32 paren = rx->lastparen;
+ I32 paren = RX_LASTPAREN(rx);
/* return the last filled */
while ( paren >= 0
- && (rx->offs[paren].start == -1
- || rx->offs[paren].end == -1) )
+ && (RX_OFFS(rx)[paren].start == -1
+ || RX_OFFS(rx)[paren].end == -1) )
paren--;
return (U32)paren;
}
register I32 t;
if (paren < 0)
return 0;
- if (paren <= (I32)rx->nparens &&
- (s = rx->offs[paren].start) != -1 &&
- (t = rx->offs[paren].end) != -1)
+ if (paren <= (I32)RX_NPARENS(rx) &&
+ (s = RX_OFFS(rx)[paren].start) != -1 &&
+ (t = RX_OFFS(rx)[paren].end) != -1)
{
register I32 i;
if (mg->mg_obj) /* @+ */
i = s;
if (i > 0 && RX_MATCH_UTF8(rx)) {
- const char * const b = rx->subbeg;
+ const char * const b = RX_SUBBEG(rx);
if (b)
i = utf8_length((U8*)b, (U8*)(b+i));
}
}
case '+':
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- paren = rx->lastparen;
+ paren = RX_LASTPAREN(rx);
if (paren)
goto getparen;
}
return 0;
case '\016': /* ^N */
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- paren = rx->lastcloseparen;
+ paren = RX_LASTCLOSEPAREN(rx);
if (paren)
goto getparen;
}
sv_setiv(sv, (IV)PL_hints);
break;
case '\011': /* ^I */ /* NOT \t in EBCDIC */
- if (PL_inplace)
- sv_setpv(sv, PL_inplace);
- else
- sv_setsv(sv, &PL_sv_undef);
+ sv_setpv(sv, PL_inplace); /* Will undefine sv if PL_inplace is NULL */
break;
case '\017': /* ^O & ^OPEN */
if (nextchar == '\0') {
break;
case '+':
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- if (rx->lastparen) {
- CALLREG_NUMBUF_FETCH(rx,rx->lastparen,sv);
+ if (RX_LASTPAREN(rx)) {
+ CALLREG_NUMBUF_FETCH(rx,RX_LASTPAREN(rx),sv);
break;
}
}
break;
case '\016': /* ^N */
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- if (rx->lastcloseparen) {
- CALLREG_NUMBUF_FETCH(rx,rx->lastcloseparen,sv);
+ if (RX_LASTCLOSEPAREN(rx)) {
+ CALLREG_NUMBUF_FETCH(rx,RX_LASTCLOSEPAREN(rx),sv);
break;
}
sv_setpv(sv,s);
else {
sv_setpv(sv,GvENAME(PL_defoutgv));
- sv_catpv(sv,"_TOP");
+ sv_catpvs(sv,"_TOP");
}
break;
case '~':
sigaddset(&set,i);
sigprocmask(SIG_BLOCK, &set, &save);
ENTER;
- save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+ save_sv = newSVpvn((char *)(&save), sizeof(sigset_t));
SAVEFREESV(save_sv);
SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
#endif
sigaddset(&set,i);
sigprocmask(SIG_BLOCK, &set, &save);
ENTER;
- save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+ save_sv = newSVpvn((char *)(&save), sizeof(sigset_t));
SAVEFREESV(save_sv);
SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
#endif
}
int
+Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
+{
+ dVAR;
+ HV* stash;
+
+ /* Bail out if destruction is going on */
+ if(PL_dirty) return 0;
+
+ av_clear((AV*)sv);
+
+ /* XXX see comments in magic_setisa */
+ stash = GvSTASH(
+ SvTYPE(mg->mg_obj) == SVt_PVGV
+ ? (GV*)mg->mg_obj
+ : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+ );
+
+ mro_isa_changed_in(stash);
+
+ return 0;
+}
+
+int
Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
{
dVAR;
if (n > 1) {
if (mg->mg_ptr) {
if (mg->mg_len >= 0)
- PUSHs(sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len)));
+ mPUSHp(mg->mg_ptr, mg->mg_len);
else if (mg->mg_len == HEf_SVKEY)
PUSHs((SV*)mg->mg_ptr);
}
else if (mg->mg_type == PERL_MAGIC_tiedelem) {
- PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+ mPUSHi(mg->mg_len);
}
}
if (n > 2) {
}
int
-Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
-{
- GV* gv;
- PERL_UNUSED_ARG(mg);
-
- Perl_croak(aTHX_ "Perl_magic_setglob is dead code?");
-
- if (!SvOK(sv))
- return 0;
- if (isGV_with_GP(sv)) {
- /* We're actually already a typeglob, so don't need the stuff below.
- */
- return 0;
- }
- gv = gv_fetchsv(sv, GV_ADD, SVt_PVGV);
- if (sv == (SV*)gv)
- return 0;
- if (GvGP(sv))
- gp_free((GV*)sv);
- GvGP(sv) = gp_ref(GvGP(gv));
- return 0;
-}
-
-int
Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
{
STRLEN len;
}
int
-Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg)
-{
- PERL_UNUSED_ARG(mg);
- sv_unmagic(sv, PERL_MAGIC_bm);
- SvTAIL_off(sv);
- SvVALID_off(sv);
- return 0;
-}
-
-int
-Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg)
-{
- PERL_UNUSED_ARG(mg);
- sv_unmagic(sv, PERL_MAGIC_fm);
- SvCOMPILED_off(sv);
- return 0;
-}
-
-int
Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
{
const struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
int
Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
{
- PERL_UNUSED_ARG(mg);
- sv_unmagic(sv, PERL_MAGIC_qr);
- return 0;
-}
-
-int
-Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
-{
- dVAR;
- regexp * const re = (regexp *)mg->mg_obj;
- PERL_UNUSED_ARG(sv);
-
- ReREFCNT_dec(re);
- return 0;
+ const char type = mg->mg_type;
+ if (type == PERL_MAGIC_qr) {
+ } else if (type == PERL_MAGIC_bm) {
+ SvTAIL_off(sv);
+ SvVALID_off(sv);
+ } else {
+ assert(type == PERL_MAGIC_fm);
+ SvCOMPILED_off(sv);
+ }
+ return sv_unmagic(sv, type);
}
#ifdef USE_LOCALE_COLLATE
/* Opening for input is more common than opening for output, so
ensure that hints for input are sooner on linked list. */
- tmp = sv_2mortal(out ? newSVpvn(out + 1, start + len - out - 1)
- : newSVpvs(""));
- SvFLAGS(tmp) |= SvUTF8(sv);
+ tmp = out ? newSVpvn_flags(out + 1, start + len - out - 1,
+ SVs_TEMP | SvUTF8(sv))
+ : newSVpvn_flags("", 0, SVs_TEMP | SvUTF8(sv));
tmp_he
= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
- sv_2mortal(newSVpvs("open>")), tmp);
+ newSVpvs_flags("open>", SVs_TEMP),
+ tmp);
/* The UTF-8 setting is carried over */
sv_setpvn(tmp, start, out ? (STRLEN)(out - start) : len);
PL_compiling.cop_hints_hash
= Perl_refcounted_he_new(aTHX_ tmp_he,
- sv_2mortal(newSVpvs("open<")), tmp);
+ newSVpvs_flags("open<", SVs_TEMP),
+ tmp);
}
break;
case '\020': /* ^P */
#endif
EXTEND(SP, 2);
PUSHs((SV*)rv);
- PUSHs(newSVpv((char *)sip, sizeof(*sip)));
+ mPUSHp((char *)sip, sizeof(*sip));
}
}
Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
{
dVAR;
- assert(mg->mg_len == HEf_SVKEY);
+ SV *key = (mg->mg_len == HEf_SVKEY) ? (SV *)mg->mg_ptr
+ : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
/* mg->mg_obj isn't being used. If needed, it would be possible to store
an alternative leaf in there, with PL_compiling.cop_hints being used if
forgetting to do it, and consequent subtle errors. */
PL_hints |= HINT_LOCALIZE_HH;
PL_compiling.cop_hints_hash
- = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
- (SV *)mg->mg_ptr, sv);
+ = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash, key, sv);
return 0;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff