From: Vincent Pit <vince@profvince.com>
Date: Sat, 29 Aug 2009 09:28:41 +0000 (+0200)
Subject: Store the exec callback into the private object
X-Git-Tag: v0.08~11
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Plugin.git;a=commitdiff_plain;h=47afe57f6afc7b312d1da725bb38f99ae70b157a

Store the exec callback into the private object

This fix calls to the wrong exec callback when the engine changes between
compilation and execution.
---

diff --git a/MANIFEST b/MANIFEST
index 12e38e6..1380013 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -28,6 +28,7 @@ t/methods/str/undef.t
 t/num_buff/FETCH.t
 t/num_buff/LENGTH.t
 t/num_buff/STORE.t
+t/scope.t
 t/taint/rx.t
 t/taint/util.t
 t/usage/basic.pm
diff --git a/Plugin.h b/Plugin.h
index 109854a..7fc63d4 100644
--- a/Plugin.h
+++ b/Plugin.h
@@ -77,10 +77,8 @@ typedef struct replug {
     /* The ->stash */
     SV * stash;
 
-    /*
-     * Callbacks
-     */
-
+    /* Callbacks */
+    SV * cb_exec;
     SV * cb_free;
 
     /* ->num_captures */
diff --git a/Plugin.xs b/Plugin.xs
index aa30857..3e9918b 100644
--- a/Plugin.xs
+++ b/Plugin.xs
@@ -331,6 +331,14 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
         LEAVE;
     }
 
+    /* If there's an exec callback, store it into the private object so
+     * that it will be the one to be called, even if the engine changes
+     * in between */
+    if (h && h->exec) {
+        re->cb_exec = h->exec;
+	SvREFCNT_inc_simple_void_NN(h->exec);
+    }
+
     /* If any of the comp-time accessors were called we'll have to
      * update the regexp struct with the new info.
      */
@@ -349,11 +357,9 @@ Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
     dSP;
     I32 matched;
     struct regexp *rx = rxREGEXP(RX);
-    const rep_hint_t *h;
     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 
-    h = rep_hint();
-    if (h && h->exec) {
+    if (self->cb_exec) {
         /* Store the current str for ->str */
         self->str = (SV*)sv;
         SvREFCNT_inc(self->str);
@@ -366,7 +372,7 @@ Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
         XPUSHs(sv);
         PUTBACK;
 
-        call_sv(h->exec, G_SCALAR);
+        call_sv(self->cb_exec, G_SCALAR);
  
         SPAGAIN;
 
diff --git a/t/scope.t b/t/scope.t
new file mode 100644
index 0000000..5ce6716
--- /dev/null
+++ b/t/scope.t
@@ -0,0 +1,49 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6 * 2;
+
+my @comp = (0, 0);
+my @exec = (0, 0);
+
+my $rx;
+
+{
+ use re::engine::Plugin comp => sub { ++$comp[0] },
+                        exec => sub { ++$exec[0]; 0 };
+
+ eval '$rx = qr/foo/';
+ is "@comp", '1 0', 'is compiled with the first engine';
+ is "@exec", '0 0', 'not executed yet';
+}
+
+"abc" =~ /$rx/;
+is "@comp", '1 0', 'was compiled with the first engine';
+is "@exec", '1 0', 'is executed with the first engine';
+
+{
+ use re::engine::Plugin comp => sub { ++$comp[1] },
+                        exec => sub { ++$exec[1]; 0 };
+
+ "def" =~ /$rx/;
+ is "@comp", '1 0', 'was still compiled with the first engine';
+ is "@exec", '2 0', 'is executed with the first engine again';
+
+ eval '$rx = qr/bar/';
+ is "@comp", '1 1', 'is compiled with the second engine';
+ is "@exec", '2 0', 'not executed since last time';
+}
+
+"ghi" =~ /$rx/;
+is "@comp", '1 1', 'was compiled with the second engine';
+is "@exec", '2 1', 'is executed with the second engine';
+
+{
+ use re 'debug';
+
+ "jkl" =~ /$rx/;
+ is "@comp", '1 1', 'was still compiled with the second engine';
+ is "@exec", '2 2', 'is executed with the second engine again (and not with "re \'debug\'")';
+}