]> git.vpit.fr Git - perl/modules/re-engine-Plugin.git/commitdiff
Store the exec callback into the private object
authorVincent Pit <vince@profvince.com>
Sat, 29 Aug 2009 09:28:41 +0000 (11:28 +0200)
committerVincent Pit <vince@profvince.com>
Sat, 29 Aug 2009 09:28:41 +0000 (11:28 +0200)
This fix calls to the wrong exec callback when the engine changes between
compilation and execution.

MANIFEST
Plugin.h
Plugin.xs
t/scope.t [new file with mode: 0644]

index 12e38e645b339222229c59277cee3e700d02d5ce..1380013cb318575d3e4ee2081c8a157e792676e7 100644 (file)
--- 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
index 109854ad2d518be15f5a45cbb9777247cd3d7bc1..7fc63d43760d11933b9cfc86c38fe6a9aa5c22a9 100644 (file)
--- 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 */
index aa30857b0790e6ae39b034aaeaed69dc929ab607..3e9918b7856a0c3d6bd0d0bcf64b2f8b675b2b29 100644 (file)
--- 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 (file)
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\'")';
+}