develooper Front page | perl.perl5.porters | Postings from May 2008

Re: [perl #51370] Clearing magic (was: [#perl 51370] length($@)>0for empty $@ if utf8 is in use)

Thread Previous | Thread Next
From:
Bram
Date:
May 5, 2008 00:18
Subject:
Re: [perl #51370] Clearing magic (was: [#perl 51370] length($@)>0for empty $@ if utf8 is in use)
Message ID:
20080505091735.elj23sljk8wgwwgw@horde.wizbit.be
Quoting Nicholas Clark <nick@ccl4.org>:

>> >Also, your order mg_free() then mg_clear() is backwards, as mg_clear() will
>> >have to be a no-op this way round, because mg_free will have just freed all
>> >the magic.
>>
>> Copy from an earlier:
>>
>> if (flags & G_KEEPERR)
>>   PL_in_eval |= EVAL_KEEPERR;
>> else {
>>   sv_setpvn_mg(ERRSV,"",0);
>>   if (SvMAGICAL(ERRSV)) {
>>     mg_free(ERRSV);
>>   }
>>   SvPOK_only(ERRSV);
>> }
>>
>>
>> Output:
>>
>> SV = PV(0x814e3c8) at 0x8150518
>>   REFCNT = 1
>>   FLAGS = (POK,pPOK)
>>   PV = 0x815cbe0 ""\0
>>   CUR = 0
>>   LEN = 240
>> SV = PVMG(0x815c8b0) at 0x8150518
>>   REFCNT = 1
>>   FLAGS = (SMG,POK,pPOK)
>>   IV = 0
>>   NV = 0
>>   PV = 0x815cbe0 ""\0
>>   CUR = 0
>>   LEN = 240
>>
>>
>> With the mg_clear added after the mg_free:
>>
>> if (flags & G_KEEPERR)
>>   PL_in_eval |= EVAL_KEEPERR;
>> else {xs
>>   sv_setpvn_mg(ERRSV,"",0);
>>   if (SvMAGICAL(ERRSV)) {
>>     mg_free(ERRSV);
>>     mg_clear(ERRSV);
>>   }
>>   SvPOK_only(ERRSV);
>> }
>>
>>
>> SV = PV(0x814e3e8) at 0x8150538
>>   REFCNT = 1
>>   FLAGS = (POK,pPOK)
>>   PV = 0x815cc00 ""\0
>>   CUR = 0
>>   LEN = 240
>> SV = PVMG(0x815c8d0) at 0x8150538
>>   REFCNT = 1
>>   FLAGS = (POK,pPOK)
>>   IV = 0
>>   NV = 0
>>   PV = 0x815cc00 ""\0
>>   CUR = 0
>>   LEN = 240
>>
>> Whichs shows that it is not a no-op (the SMG flag is gone).
>> Or would that be a bug in mg_clear?
>
> Well, I don't know, but I grep'ed the core for all uses of mg_free() and
> mg_clear() and a had a think. And I think the bug would be in mg_free(),
> which currently reads like this:
>
> int
> Perl_mg_free(pTHX_ SV *sv)
> {
>     MAGIC* mg;
>     MAGIC* moremagic;
>
>     PERL_ARGS_ASSERT_MG_FREE;
>
>     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
>         const MGVTBL* const vtbl = mg->mg_virtual;
> 	moremagic = mg->mg_moremagic;
> 	if (vtbl && vtbl->svt_free)
> 	    CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
> 	if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
> 	    if (mg->mg_len > 0 || mg->mg_type == PERL_MAGIC_utf8)
> 		Safefree(mg->mg_ptr);
> 	    else if (mg->mg_len == HEf_SVKEY)
> 		SvREFCNT_dec((SV*)mg->mg_ptr);
> 	}
> 	if (mg->mg_flags & MGf_REFCOUNTED)
> 	    SvREFCNT_dec(mg->mg_obj);
> 	Safefree(mg);
> 	SvMAGIC_set(sv, moremagic);
>     }
>     SvMAGIC_set(sv, NULL);
>     return 0;
> }
>
> and probably should have a line added at the end to reset all the SvFLAGS
> relating to magic. (which mg_clear() must do somehow, but after 5 minutes of
> trying to trace the code, I can't work out where.

Could this be it?: (mg_clear calls save_magic which calls SvMAGICAL_off)

int
Perl_mg_clear(pTHX_ SV *sv)
{
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;

     PERL_ARGS_ASSERT_MG_CLEAR;

     save_magic(mgs_ix, sv);

     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
         const MGVTBL* const vtbl = mg->mg_virtual;
         /* omit GSKIP -- never set here */

         if (vtbl && vtbl->svt_clear)
             CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
     }

     restore_magic(INT2PTR(void*, (IV)mgs_ix));
     return 0;
}


S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
{
     dVAR;
     MGS* mgs;

     PERL_ARGS_ASSERT_SAVE_MAGIC;

     assert(SvMAGICAL(sv));
     /* Turning READONLY off for a copy-on-write scalar (including shared
        hash keys) is a bad idea.  */
     if (SvIsCOW(sv))
       sv_force_normal_flags(sv, 0);

     SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix));

     mgs = SSPTR(mgs_ix, MGS*);
     mgs->mgs_sv = sv;
     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
     mgs->mgs_ss_ix = PL_savestack_ix;   /* points after the saved  
destructor */

     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
     if (!(SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK))) {
         /* No public flags are set, so promote any private flags to  
public.  */
         SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
     }
}

#define SvMAGICAL_off(sv)       (SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG))

(Curently building and testing with a SvMAGICAL_off(sv); after  
SvMAGIC_set(sv, NULL); )


> Also, I'm now not sure
> which Perl code "1" liner you're using to test this)

See the previous mail/the ticket on RT.

http://rt.perl.org/rt3/Public/Bug/Display.html?id=51370

>
> And then fix up any callers of mg_free() that clear all the SV magic flags
> already, now that mg_free() does it for them. (I found at least one plausible
> place.)
>
>> >>Defining sv_setpvn_clearmg in embed.h
>> >>#define sv_setpvn_clearmg            Perl_sv_setpvn_clearmg
>> >>
>> >>Changing: sv_setpvn(ERRSV,"",0) into sv_setpvn_clearmg(ERRSV,"",0);
>> >
>> >How many of these are there to change?
>>
>> There are 9.
>
> Ah right. I'm not convinced that it's worth it as a one liner function.
> A macro for resetting ERRSV might seem more appropriate.
>
>> Suggestions for the name of this_clearing_thing?
>
> #define clear_errsv() STMT_START { ... do stuff ... } STMT_END
>
> ?

Ok.

>> What version/revision is that? (It never happend with me.)
>
> blead, built with -g and therefore -DDEBUGGING and I think by default UTF-8
> cache checking.

Rebuilding blead with -g to see if I can get a panic.

>
>> But note, this is what would be fixed by clearing the magic...
>
> I'm a bit confused. mg_clear() clearing the magic?

The panic would be fixed by clearing the (utf8-)magic that is attached to $@.

>> The problem is that length still uses the old utf8 length and not the new
>> one.
>> So either a new panic was added for it or something else is different...
>
> $ ./perl -e '${^UTF8CACHE} = 0; eval { 1 };  eval { die "\x{a10d};";  
>  }; $_ = length $@; eval { 1 }; warn length $@'
> 0 at -e line 1.
> $ ./perl -e '${^UTF8CACHE} = 1; eval { 1 };  eval { die "\x{a10d};";  
>  }; $_ = length $@; eval { 1 }; warn length $@'
> 17 at -e line 1.
> $ ./perl -e '${^UTF8CACHE} = -1; eval { 1 };  eval { die   
> "\x{a10d};"; }; $_ = length $@; eval { 1 }; warn length $@'
> panic: sv_len_utf8 cache 17 real 0 for  at -e line 1.
>
>
> (0 disables the caching, 1 is caching mode (the non -DDEBUGGING default), -1
> is caching assertion mode, where the cache store code is enabled, but the
> answers cross checked every time.)
>
>
> Mmm, in the end, reading the documentation and the source, should every
> sv_setpvn(ERRSV, ...); become sv_setpvn_mg(ERRSV, ...), and
> sv_catsv(ERRSV, ...) become sv_catsv_mg(ERRSV, ...) ?
> Will that solve it?

As noted in my original messages: that will solve the length issue but  
then $@ still has the extra flags/magic set.

I'm completly clueless if that would be a problem or not.
(Rafael replied to that that it actually should be sv_setpvn)


Kind regards,

Bram



Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About