Front page | perl.perl5.porters |
Postings from March 2003
Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD
Thread Previous
|
Thread Next
From:
Enache Adrian
Date:
March 8, 2003 03:43
Subject:
Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD
Message ID:
20030308113906.GA6877@ratsnest.hole
On Wed, Feb 26, 2003 at 02:14:05AM +0000, hv@crypt.org wrote:
> Hmm, I'd have thought the "cleaner" argument applies the other way
> round: surely it is cleaner to let it be an object than to hack the
> pretence of it?
>
> It seems like it might be helpful at some point to be able to add
> other Regexp:: methods - for introspection, for example, or even
> as a window to enable or disable particular types of optimisation.
Maybe I make some horrible confusion, but I don't see what the
point is; the qr// can be easily blessed later into whatever
package one may like:
$ perl -e '
{ package REGEXP; sub DESTROY { warn "goodbye !\n" } }
$a = qr/a/;
bless $a, REGEXP;
'
goodbye !
(with/out my patch applied the same thing)
Anyway, I attached an updated patch below.
Notice that [perl #20858] looks very similar to that.
playing with this, I just scared out another bug:
$ perl -e 'sub UNIVERSAL::DESTROY { warn } ; $b=1; $a=\$b; bless $a, ITCH'
Warning: something's wrong at -e line 1 during global destruction.
Warning: something's wrong at -e line 1 during global destruction.
Segmentation fault
(three warnings in 5.8.0, one single in 5.6.1, and SEGV in all)
Is anyone else aware of this problem ?
Regards
Adi
-------------------------------------------------------------------
--- /arc/perl-current/ext/Devel/Peek/Peek.t 2003-02-26 04:50:55.000000000 +0200
+++ perl-current/ext/Devel/Peek/Peek.t 2003-03-08 13:16:40.000000000 +0200
@@ -264,15 +264,14 @@ do_test(15,
RV = $ADDR
SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(OBJECT,SMG\\)
+ FLAGS = \\(SMG\\)
IV = 0
NV = 0
PV = 0
MAGIC = $ADDR
MG_VIRTUAL = $ADDR
MG_TYPE = PERL_MAGIC_qr\(r\)
- MG_OBJ = $ADDR
- STASH = $ADDR\\t"Regexp"');
+ MG_OBJ = $ADDR');
do_test(16,
(bless {}, "Tac"),
--- /arc/perl-current/pp_hot.c 2003-03-02 18:34:00.000000000 +0200
+++ perl-current/pp_hot.c 2003-03-08 12:22:28.000000000 +0200
@@ -1146,7 +1146,7 @@ PP(pp_qr)
dSP;
register PMOP *pm = cPMOP;
SV *rv = sv_newmortal();
- SV *sv = newSVrv(rv, "Regexp");
+ SV *sv = newSVrv(rv, Nullch);
if (pm->op_pmdynflags & PMdf_TAINTED)
SvTAINTED_on(rv);
sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
--- /arc/perl-current/sv.c 2003-03-04 08:26:59.000000000 +0200
+++ perl-current/sv.c 2003-03-08 12:29:51.000000000 +0200
@@ -2964,9 +2964,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv,
switch (SvTYPE(sv)) {
case SVt_PVMG:
- if ( ((SvFLAGS(sv) &
- (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
- == (SVs_OBJECT|SVs_SMG))
+ if ( SvFLAGS(sv) & SVs_SMG
&& (mg = mg_find(sv, PERL_MAGIC_qr))) {
regexp *re = (regexp *)mg->mg_obj;
@@ -7665,6 +7663,9 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob)
case SVt_PVIV:
case SVt_PVNV:
case SVt_PVMG:
+ if (SvFLAGS(sv) & SVs_SMG
+ && mg_find(sv,PERL_MAGIC_qr))
+ return "Regexp";
case SVt_PVBM:
if (SvVOK(sv))
return "VSTRING";
Thread Previous
|
Thread Next