develooper Front page | perl.perl5.porters | Postings from August 2013

Re: When is PL_curcop NULL?

Thread Previous | Thread Next
From:
Nicholas Clark
Date:
August 5, 2013 20:03
Subject:
Re: When is PL_curcop NULL?
Message ID:
20130805200313.GS3729@plum.flirble.org
On Mon, Aug 05, 2013 at 09:07:53AM -0000, Father Chrysostomos wrote:
> Commit 1df5f7c195 in blead and commit 2ae052418c in maint allowed
> gv_init/newGP to handle the case of PL_curcop being NULL.  In fact,
> 2ae052418c in maint added the code that sets it to NULL, but no tests.

commit 1df5f7c19502d9913cf1f60730ae040812453f58
Author: Nicholas Clark <nick@ccl4.org>
Date:   Wed Jan 10 16:24:27 2007 +0000

    An implementation of change 29735 for blead (PL_curcop could be NULL)
    given that blead's refactoring is not yet in maint.
    
    p4raw-id: //depot/perl@29748

diff --git a/gv.c b/gv.c
index 9f9b0d3..e4c59b5 100644
--- a/gv.c
+++ b/gv.c
@@ -161,7 +161,8 @@ GP *
 Perl_newGP(pTHX_ GV *const gv)
 {
     GP *gp;
-    const char *const file = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
+    const char *const file
+       = (PL_curcop && CopFILE(PL_curcop)) ? CopFILE(PL_curcop) : "";
     STRLEN len = strlen(file);
     U32 hash;
 
@@ -173,7 +174,7 @@ Perl_newGP(pTHX_ GV *const gv)
     gp->gv_sv = newSV(0);
 #endif
 
-    gp->gp_line = CopLINE(PL_curcop);
+    gp->gp_line = PL_curcop ? CopLINE(PL_curcop) : 0;
     /* XXX Ideally this cast would be replaced with a change to const char*
        in the struct.  */
     gp->gp_file_hek = share_hek(file, len, hash);


vs

commit 2ae052418cb5f0db0b999bb3c298ef659ee68352
Author: Nicholas Clark <nick@ccl4.org>
Date:   Tue Jan 9 12:48:39 2007 +0000

    We can get in the messy situation of the COP that PL_curcop pointed
    to getting freed, and as part of the same free overloading decides
    to look for DESTROY, which needs to *create* a GV, which in turn
    was expecting that PL_curcop pointed to something valid. So set
    PL_curcop to NULL if we're freeing the COP that it points to, and
    make Perl_gv_init() cope with a NULL PL_curcop.
    
    p4raw-id: //depot/maint-5.8/perl@29735

diff --git a/gv.c b/gv.c
index ea06f31..9dc65f3 100644
--- a/gv.c
+++ b/gv.c
@@ -145,10 +145,19 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, ST
 #else
     GvSV(gv) = NEWSV(72,0);
 #endif
-    GvLINE(gv) = CopLINE(PL_curcop);
-    /* XXX Ideally this cast would be replaced with a change to const char*
-       in the struct.  */
-    GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
+    if (PL_curcop) {
+       /* We can get in the messy situation of the COP that PL_curcop pointed
+          to getting freed, and as part of the same free overloading decides
+          to look for DESTROY, which gets us in here, needing to *create* a
+          GV.  */
+       GvLINE(gv) = CopLINE(PL_curcop);
+       /* XXX Ideally this cast would be replaced with a change to const char*
+          in the struct.  */
+       GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
+    } else {
+       GvLINE(gv) = 0;
+       GvFILE(gv) = (char *) "";
+    }
     GvCVGEN(gv) = 0;
     GvEGV(gv) = gv;
     sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, NULL, 0);
diff --git a/op.c b/op.c
index 0f4b16c..df77967 100644
--- a/op.c
+++ b/op.c
@@ -542,6 +542,8 @@ S_cop_free(pTHX_ COP* cop)
        SvREFCNT_dec(cop->cop_io);
 #endif
     }
+    if (PL_curcop == cop)
+       PL_curcop = NULL;
 }
 
 void


It looks like a mistake on my part not to add that op.c hunk to the blead
commit.

I suspect that at the time I was fixing problems I'd found while trying
to profile code - Devel::DProf was remarkably good at finding places where
GvFILE etc pointed to garbage. I probably assumed that it wasn't possible to
write a test case.

Experimentation reveals that test cases which will trigger problems on
maint-5.8 without the patch are things like

#!./perl

{
    my $foo = bless [], "bar"; 
    eval 'goto v';
}

v:
__END__


and


#!./perl

{
    my $foo = bless [], "bar"; 
    eval 'exit';
    @bar::ISA = "foo";
}
__END__


although they may not show anything up without valgrind, and possible also
need to be run under -DDEBUGGING with -Do or -Dt

*Those* tests don't fail on blead of 2007, because of the side effects
of this commit of 5 years earlier:

commit 439cb1c4bca8637a65af6ff559799d9f5b05b394
Author: John Peacock <jpeacock@rowman.com>
Date:   Tue Aug 20 18:51:46 2002 -0400

    Re: [PATCH] Version object patch #1
    Date: Tue, 20 Aug 2002 22:51:46 -0400 (Wed 03:51 BST)
    Message-id: <3D630042.6020407@rowman.com>
    
    Subject: Re: [REVISED PATCH] Magic v-strings
    From: John Peacock <jpeacock@rowman.com>
    Date: Wed, 21 Aug 2002 15:08:34 -0400 (20:08 BST)
    Message-id: <3D63E532.7020305@rowman.com>
    
    p4raw-id: //depot/perl@17747


which causes PL_amagic_generation to be 1 at the start of runtime. That
causes overloading resolution to happen at bless time in blead. It's
happening at scope exit time in maint-5.8


I can bust past that and make test cases that fail for a while longer on
blead by changing @ISA to force more GV activity later:

#!./perl

{
    my $foo = bless [], "bar";
    @bar::ISA = "foo";
    eval 'goto v';
}

v: 

__END__


but those stop showing errors with valgrind with this commit:

commit 7c4baf47da775f39e368d242f76a86f4e592cb5a
Author: Dave Mitchell <davem@fdisolutions.com>
Date:   Sat May 12 19:51:37 2007 +0000

    save old PL_curcop value in parser struct

    p4raw-id: //depot/perl@31201



With that commit, PL_curcop is restored to a sane value at scope exit:

@@ -723,6 +722,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter
 void
 Perl_parser_free(pTHX_  const yy_parser *parser)
 {
+    PL_curcop = parser->saved_curcop;
     SvREFCNT_dec(parser->linestr);

     if (parser->rsfp == PerlIO_stdin())


very soon after the COP it was pointing to was freed (for the test cases)
and before I can get anything to read PL_curcop.


I haven't been able to figure out a test case which manages to avoid having
a saved parser on the scope stack. Or a saved parser which is pointing to
a freed curcop.

But I can't say that it's impossible.


> Commit 19bad673 eliminated the check under non-threaded builds (except
> in one spot).
> 
> Do we still need these checks?

I think so, but I can't prove it. Moreover, I think that S_cop_free() should
have this:

+    if (PL_curcop == cop)
+       PL_curcop = NULL;
 }


because without that, we have an interpreter-global variable pointing to
freed memory. And that sort of dangling pointer has been the cause of
several different previous bugs.

Nicholas Clark

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