develooper 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


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