This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop /[.zog.]/ and /[[.zog.]]/ from leaking
authorFather Chrysostomos <sprout@cpan.org>
Mon, 19 Nov 2012 01:44:20 +0000 (17:44 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 19 Nov 2012 04:17:18 +0000 (20:17 -0800)
Before croaking, we need to free any SVs we might have allocated tem-
porarily.  Also, Simple_vFAIL does not free the regular expression.
For that we need vFAIL.

embed.fnc
embed.h
proto.h
regcomp.c
t/op/svleak.t

index 9fc591d..3b92083 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1981,7 +1981,8 @@ Es        |I32    |study_chunk    |NN struct RExC_state_t *pRExC_state \
 EsRn   |U32    |add_data       |NN struct RExC_state_t *pRExC_state|U32 n \
                                |NN const char *s
 rs     |void   |re_croak2      |NN const char* pat1|NN const char* pat2|...
-Es     |I32    |regpposixcc    |NN struct RExC_state_t *pRExC_state|I32 value
+Es     |I32    |regpposixcc    |NN struct RExC_state_t *pRExC_state \
+                               |I32 value|NULLOK SV *free_me
 Es     |I32    |make_trie      |NN struct RExC_state_t *pRExC_state \
                                |NN regnode *startbranch|NN regnode *first \
                                |NN regnode *last|NN regnode *tail \
diff --git a/embed.h b/embed.h
index de3b947..8842e64 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define regclass(a,b,c)                S_regclass(aTHX_ a,b,c)
 #define reginsert(a,b,c,d)     S_reginsert(aTHX_ a,b,c,d)
 #define regpiece(a,b,c)                S_regpiece(aTHX_ a,b,c)
-#define regpposixcc(a,b)       S_regpposixcc(aTHX_ a,b)
+#define regpposixcc(a,b,c)     S_regpposixcc(aTHX_ a,b,c)
 #define regtail(a,b,c,d)       S_regtail(aTHX_ a,b,c,d)
 #define reguni(a,b,c)          S_reguni(aTHX_ a,b,c)
 #define regwhite               S_regwhite
diff --git a/proto.h b/proto.h
index ccde34d..7a60c70 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6590,7 +6590,7 @@ STATIC regnode*   S_regpiece(pTHX_ struct RExC_state_t *pRExC_state, I32 *flagp, U
 #define PERL_ARGS_ASSERT_REGPIECE      \
        assert(pRExC_state); assert(flagp)
 
-STATIC I32     S_regpposixcc(pTHX_ struct RExC_state_t *pRExC_state, I32 value)
+STATIC I32     S_regpposixcc(pTHX_ struct RExC_state_t *pRExC_state, I32 value, SV *free_me)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_REGPPOSIXCC   \
        assert(pRExC_state)
index 831f8a9..b0f917f 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -11163,7 +11163,7 @@ S_regwhite( RExC_state_t *pRExC_state, char *p )
 #define POSIXCC(c) (POSIXCC_DONE(c) || POSIXCC_NOTYET(c))
 
 STATIC I32
-S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
+S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value, SV *free_me)
 {
     dVAR;
     I32 namedclass = OOB_NAMEDCLASS;
@@ -11273,7 +11273,8 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
                       the class closes */
                    while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse) != ']')
                        RExC_parse++;
-                   Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
+                   SvREFCNT_dec(free_me);
+                   vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
                }
            } else {
                /* Maternal grandfather:
@@ -11565,7 +11566,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
                   the class closes */
                while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse++) != ']')
                    NOOP;
-               Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
+               SvREFCNT_dec(listsv);
+               vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
            }
        }
     }
@@ -11598,7 +11600,7 @@ parseit:
 
        nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0;
        if (value == '[' && POSIXCC(nextvalue))
-           namedclass = regpposixcc(pRExC_state, value);
+           namedclass = regpposixcc(pRExC_state, value, listsv);
        else if (value == '\\') {
            if (UTF) {
                value = utf8n_to_uvchr((U8*)RExC_parse,
index 2d9c692..abff729 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 74;
+plan tests => 76;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -184,6 +184,8 @@ eleak(2,0,'/[\xdf]/i');
 eleak(2,0,'s![^/]!!');
 eleak(2,0,'/[pp]/');
 eleak(2,0,'/[[:ascii:]]/');
+eleak(2,0,'/[[.zog.]]/');
+eleak(2,0,'/[.zog.]/');
 eleak(2,0,'chr(0x100) =~ /[[:punct:]]/');
 eleak(2,0,'chr(0x100) =~ /[[:^punct:]]/');
 leak(2,0,sub { /(??{})/ }, '/(??{})/');