]> git.vpit.fr Git - perl/modules/re-engine-Plugin.git/commitdiff
This is 0.03 v0.03
authorVincent Pit <vince@profvince.com>
Thu, 17 May 2007 23:26:00 +0000 (23:26 +0000)
committerVincent Pit <vince@profvince.com>
Thu, 17 May 2007 23:26:00 +0000 (23:26 +0000)
.gitignore [deleted file]
Changes [deleted file]
TODO [deleted file]
contrib/capture_hook.patch [deleted file]
t/captures.t [deleted file]
t/flags.t [deleted file]
t/minlen-get.t [deleted file]
t/minlen-set.t [deleted file]

diff --git a/.gitignore b/.gitignore
deleted file mode 100644 (file)
index ae275c8..0000000
+++ /dev/null
@@ -1 +0,0 @@
-^\.git
\ No newline at end of file
diff --git a/Changes b/Changes
deleted file mode 100644 (file)
index f0f3903..0000000
--- a/Changes
+++ /dev/null
@@ -1,4 +0,0 @@
-Revision history for Perl extension re::engine::Plugin
-
-0.01 Sun Feb 18 2007
-        - Initial release, incomplete
\ No newline at end of file
diff --git a/TODO b/TODO
deleted file mode 100644 (file)
index d06b5d3..0000000
--- a/TODO
+++ /dev/null
@@ -1,19 +0,0 @@
-Store callbacks in $^H to have a lexical pragma
-
-Make match vars work
-
-Change perl internals to allow match vars to be arbitary SV*? Can only
-be offsets into a string now, Perhaps cheat and pack SV* into two
-I32*?
-
-    I32 *startp;            /* Array of offsets from start of string (@-) */
-       I32 *endp;              /* Array of offsets from start of string (@+) */
-
-That requires changes 
-    
-
-allow comp and exec callbacks not to be specified
-
-bless into the package that import gets called with
-
-Make move eval.t files when the rest of the callbacks are implemented
diff --git a/contrib/capture_hook.patch b/contrib/capture_hook.patch
deleted file mode 100644 (file)
index effa781..0000000
+++ /dev/null
@@ -1,303 +0,0 @@
-Index: D:/dev/perl/ver/zoro/embed.h
-===================================================================
---- D:/dev/perl/ver/zoro/embed.h       (revision 972)
-+++ D:/dev/perl/ver/zoro/embed.h       (revision 973)
-@@ -698,6 +698,8 @@
- #if defined(PERL_CORE) || defined(PERL_EXT)
- #define reg_named_buff_get    Perl_reg_named_buff_get
- #define reg_numbered_buff_get Perl_reg_numbered_buff_get
-+#endif
-+#if defined(PERL_CORE) || defined(PERL_EXT)
- #define regprop                       Perl_regprop
- #endif
- #define repeatcpy             Perl_repeatcpy
-@@ -2915,7 +2917,9 @@
- #define regnext(a)            Perl_regnext(aTHX_ a)
- #if defined(PERL_CORE) || defined(PERL_EXT)
- #define reg_named_buff_get(a,b,c)     Perl_reg_named_buff_get(aTHX_ a,b,c)
--#define reg_numbered_buff_get(a,b,c,d)        Perl_reg_numbered_buff_get(aTHX_ a,b,c,d)
-+#define reg_numbered_buff_get(a,b,c)  Perl_reg_numbered_buff_get(aTHX_ a,b,c)
-+#endif
-+#if defined(PERL_CORE) || defined(PERL_EXT)
- #define regprop(a,b,c)                Perl_regprop(aTHX_ a,b,c)
- #endif
- #define repeatcpy(a,b,c,d)    Perl_repeatcpy(aTHX_ a,b,c,d)
-Index: D:/dev/perl/ver/zoro/regcomp.c
-===================================================================
---- D:/dev/perl/ver/zoro/regcomp.c     (revision 972)
-+++ D:/dev/perl/ver/zoro/regcomp.c     (revision 973)
-@@ -4692,58 +4692,53 @@
-     return(r);
- }
--#undef CORE_ONLY_BLOCK
- #undef RE_ENGINE_PTR
--#ifndef PERL_IN_XSUB_RE
-+
- SV*
--Perl_reg_named_buff_get(pTHX_ SV* namesv, const REGEXP * const from_re, U32 flags)
-+Perl_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags)
- {
-     AV *retarray = NULL;
-     SV *ret;
-     if (flags & 1) 
-         retarray=newAV();
--    
--    if (from_re || PL_curpm) {
--        const REGEXP * const rx = from_re ? from_re : PM_GETRE(PL_curpm);
--        if (rx && rx->paren_names) {            
--            HE *he_str = hv_fetch_ent( rx->paren_names, namesv, 0, 0 );
--            if (he_str) {
--                IV i;
--                SV* sv_dat=HeVAL(he_str);
--                I32 *nums=(I32*)SvPVX(sv_dat);
--                for ( i=0; i<SvIVX(sv_dat); i++ ) {
--                    if ((I32)(rx->nparens) >= nums[i]
--                        && rx->startp[nums[i]] != -1
--                        && rx->endp[nums[i]] != -1)
--                    {
--                        ret = reg_numbered_buff_get(nums[i],rx,NULL,0);
--                        if (!retarray) 
--                            return ret;
--                    } else {
--                        ret = newSVsv(&PL_sv_undef);
--                    }
--                    if (retarray) {
--                        SvREFCNT_inc(ret); 
--                        av_push(retarray, ret);
--                    }
-+        
-+    if (rx && rx->paren_names) {            
-+        HE *he_str = hv_fetch_ent( rx->paren_names, namesv, 0, 0 );
-+        if (he_str) {
-+            IV i;
-+            SV* sv_dat=HeVAL(he_str);
-+            I32 *nums=(I32*)SvPVX(sv_dat);
-+            for ( i=0; i<SvIVX(sv_dat); i++ ) {
-+                if ((I32)(rx->nparens) >= nums[i]
-+                    && rx->startp[nums[i]] != -1
-+                    && rx->endp[nums[i]] != -1)
-+                {
-+                    ret = CALLREG_NUMBUF(rx,nums[i],NULL);
-+                    if (!retarray) 
-+                        return ret;
-+                } else {
-+                    ret = newSVsv(&PL_sv_undef);
-                 }
--                if (retarray)
--                    return (SV*)retarray;
-+                if (retarray) {
-+                    SvREFCNT_inc(ret); 
-+                    av_push(retarray, ret);
-+                }
-             }
-+            if (retarray)
-+                return (SV*)retarray;
-         }
-     }
-     return NULL;
- }
- SV*
--Perl_reg_numbered_buff_get(pTHX_ I32 paren, const REGEXP * const rx, SV* usesv, U32 flags)
-+Perl_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv)
- {
-     char *s = NULL;
-     I32 i = 0;
-     I32 s1, t1;
-     SV *sv = usesv ? usesv : newSVpvs("");
--    PERL_UNUSED_ARG(flags);
-         
-     if (!rx->subbeg) {
-         sv_setsv(sv,&PL_sv_undef);
-@@ -4812,8 +4807,8 @@
-     }
-     return sv;
- }
--#endif
-+
- /* Scans the name of a named buffer from the pattern.
-  * If flags is REG_RSN_RETURN_NULL returns null.
-  * If flags is REG_RSN_RETURN_NAME returns an SV* containing the name
-Index: D:/dev/perl/ver/zoro/regcomp.h
-===================================================================
---- D:/dev/perl/ver/zoro/regcomp.h     (revision 972)
-+++ D:/dev/perl/ver/zoro/regcomp.h     (revision 973)
-@@ -463,6 +463,8 @@
-         Perl_re_intuit_start,
-         Perl_re_intuit_string, 
-         Perl_regfree_internal, 
-+        Perl_reg_numbered_buff_get,
-+        Perl_reg_named_buff_get,
- #if defined(USE_ITHREADS)        
-         Perl_regdupe_internal
- #endif        
-Index: D:/dev/perl/ver/zoro/regexp.h
-===================================================================
---- D:/dev/perl/ver/zoro/regexp.h      (revision 972)
-+++ D:/dev/perl/ver/zoro/regexp.h      (revision 973)
-@@ -111,6 +111,8 @@
-                           struct re_scream_pos_data_s *data);
-     SV*           (*checkstr) (pTHX_ regexp *prog);
-     void    (*free) (pTHX_ struct regexp* r);
-+    SV*     (*numbered_buff_get) (pTHX_ const REGEXP * const rx, I32 paren, SV* usesv);
-+    SV*     (*named_buff_get)(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags);
- #ifdef USE_ITHREADS
-     void* (*dupe) (pTHX_ const regexp *r, CLONE_PARAMS *param);
- #endif    
-Index: D:/dev/perl/ver/zoro/perl.h
-===================================================================
---- D:/dev/perl/ver/zoro/perl.h        (revision 972)
-+++ D:/dev/perl/ver/zoro/perl.h        (revision 973)
-@@ -219,6 +219,13 @@
- #define CALLREGFREE_PVT(prog) \
-     if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
-+#define CALLREG_NUMBUF(rx,paren,usesv) \
-+    CALL_FPTR((rx)->engine->numbered_buff_get)(aTHX_ (rx),(paren),(usesv))
-+
-+#define CALLREG_NAMEDBUF(rx,name,flags) \
-+    CALL_FPTR((rx)->engine->named_buff_get)(aTHX_ (rx),(name),(flags))
-+
-+        
- #if defined(USE_ITHREADS)         
- #define CALLREGDUPE(prog,param) \
-     Perl_re_dup(aTHX_ (prog),(param))
-Index: D:/dev/perl/ver/zoro/proto.h
-===================================================================
---- D:/dev/perl/ver/zoro/proto.h       (revision 972)
-+++ D:/dev/perl/ver/zoro/proto.h       (revision 973)
-@@ -1888,12 +1888,15 @@
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1);
--PERL_CALLCONV SV*     Perl_reg_named_buff_get(pTHX_ SV* namesv, const REGEXP * const from_re, U32 flags)
--                      __attribute__nonnull__(pTHX_1);
--PERL_CALLCONV SV*     Perl_reg_numbered_buff_get(pTHX_ I32 paren, const REGEXP * const rx, SV* usesv, U32 flags)
-+PERL_CALLCONV SV*     Perl_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags)
-+                      __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
-+PERL_CALLCONV SV*     Perl_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv)
-+                      __attribute__nonnull__(pTHX_1);
-+
-+
- PERL_CALLCONV void    Perl_regprop(pTHX_ const regexp *prog, SV* sv, const regnode* o)
-                       __attribute__nonnull__(pTHX_2)
-                       __attribute__nonnull__(pTHX_3);
-Index: D:/dev/perl/ver/zoro/ext/re/re.xs
-===================================================================
---- D:/dev/perl/ver/zoro/ext/re/re.xs  (revision 972)
-+++ D:/dev/perl/ver/zoro/ext/re/re.xs  (revision 973)
-@@ -22,6 +22,8 @@
- extern SV*    my_re_intuit_string (pTHX_ regexp *prog);
- extern void   my_regfree (pTHX_ struct regexp* r);
-+extern SV*      my_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv);
-+extern SV*      my_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags);
- #if defined(USE_ITHREADS)
- extern void*  my_regdupe (pTHX_ const regexp *r, CLONE_PARAMS *param);
- #endif
-@@ -36,6 +38,8 @@
-         my_re_intuit_start, 
-         my_re_intuit_string, 
-         my_regfree, 
-+        my_reg_numbered_buff_get,
-+        my_reg_named_buff_get,
- #if defined(USE_ITHREADS)
-         my_regdupe 
- #endif
-@@ -213,7 +217,7 @@
- {
-     re = get_re_arg( aTHX_ qr, 1, NULL);
-     if (SvPOK(sv) && re && re->paren_names) {
--        bufs = Perl_reg_named_buff_get(aTHX_ sv, re ,all && SvTRUE(all));
-+        bufs = CALLREG_NAMEDBUF(re,sv,all && SvTRUE(all));
-         if (bufs) {
-             if (all && SvTRUE(all))
-                 XPUSHs(newRV(bufs));
-Index: D:/dev/perl/ver/zoro/ext/re/re_top.h
-===================================================================
---- D:/dev/perl/ver/zoro/ext/re/re_top.h       (revision 972)
-+++ D:/dev/perl/ver/zoro/ext/re/re_top.h       (revision 973)
-@@ -16,6 +16,8 @@
- #define Perl_regfree_internal   my_regfree
- #define Perl_re_intuit_string   my_re_intuit_string
- #define Perl_regdupe_internal   my_regdupe
-+#define Perl_reg_numbered_buff_get  my_reg_numbered_buff_get
-+#define Perl_reg_named_buff_get  my_reg_named_buff_get
- #define PERL_NO_GET_CONTEXT
-Index: D:/dev/perl/ver/zoro/mg.c
-===================================================================
---- D:/dev/perl/ver/zoro/mg.c  (revision 972)
-+++ D:/dev/perl/ver/zoro/mg.c  (revision 973)
-@@ -863,7 +863,7 @@
-                * XXX Does the new way break anything?
-                */
-               paren = atoi(mg->mg_ptr); /* $& is in [0] */
--              reg_numbered_buff_get( paren, rx, sv, 0);
-+              CALLREG_NUMBUF(rx,paren,sv);
-               break;
-           }
-           sv_setsv(sv,&PL_sv_undef);
-@@ -872,7 +872,7 @@
-     case '+':
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           if (rx->lastparen) {
--              reg_numbered_buff_get( rx->lastparen, rx, sv, 0);
-+              CALLREG_NUMBUF(rx,rx->lastparen,sv);
-               break;
-           }
-       }
-@@ -881,7 +881,7 @@
-     case '\016':              /* ^N */
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-           if (rx->lastcloseparen) {
--              reg_numbered_buff_get( rx->lastcloseparen, rx, sv, 0);
-+              CALLREG_NUMBUF(rx,rx->lastcloseparen,sv);
-               break;
-           }
-@@ -891,16 +891,16 @@
-     case '`':
-       do_prematch_fetch:
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
--        reg_numbered_buff_get( -2, rx, sv, 0);
--        break;
-+          CALLREG_NUMBUF(rx,-2,sv);
-+          break;
-       }
-       sv_setsv(sv,&PL_sv_undef);
-       break;
-     case '\'':
-       do_postmatch_fetch:
-       if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
--        reg_numbered_buff_get( -1, rx, sv, 0);
--        break;
-+          CALLREG_NUMBUF(rx,-1,sv);
-+          break;
-       }
-       sv_setsv(sv,&PL_sv_undef);
-       break;
-Index: D:/dev/perl/ver/zoro/embed.fnc
-===================================================================
---- D:/dev/perl/ver/zoro/embed.fnc     (revision 972)
-+++ D:/dev/perl/ver/zoro/embed.fnc     (revision 973)
-@@ -691,8 +691,10 @@
-                               |NN char* strend|NN char* strbeg|I32 minend \
-                               |NN SV* screamer|NULLOK void* data|U32 flags
- ApR   |regnode*|regnext       |NN regnode* p
--EXp   |SV*|reg_named_buff_get |NN SV* namesv|NULLOK const REGEXP * const from_re|U32 flags
--EXp   |SV*|reg_numbered_buff_get|I32 paren|NN const REGEXP * const rx|NULLOK SV* usesv|U32 flags
-+
-+EXp   |SV*|reg_named_buff_get |NN const REGEXP * const rx|NN SV* namesv|U32 flags
-+EXp   |SV*|reg_numbered_buff_get|NN const REGEXP * const rx|I32 paren|NULLOK SV* usesv
-+
- Ep    |void   |regprop        |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o
- Ap    |void   |repeatcpy      |NN char* to|NN const char* from|I32 len|I32 count
- ApP   |char*  |rninstr        |NN const char* big|NN const char* bigend \
diff --git a/t/captures.t b/t/captures.t
deleted file mode 100644 (file)
index 0077b94..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
-=pod
-
-Test the B<captures> method
-
-=cut
-
-use strict;
-
-use feature ':5.10';
-
-#use Test::More tests => 1;
-use Test::More skip_all => 'TODO: implement';
-
-use re::engine::Plugin (
-    comp => sub {
-        my $re = shift;
-    },
-    exec => sub {
-        my ($re, $str) = @_;
-
-        # 
-        #$re->captures( [ 1 .. 4 ] );
-        #$re->captures( sub {} );
-
-        $re->named_captures( );
-
-        1; # matched
-    }
-);
-
-if ("string" =~ /./g) {
-    cmp_ok $1, '==', 1337;
-    cmp_ok $+{named}, '==', 5;
-}
diff --git a/t/flags.t b/t/flags.t
deleted file mode 100644 (file)
index 7d04c32..0000000
--- a/t/flags.t
+++ /dev/null
@@ -1,59 +0,0 @@
-=pod
-
-Test the B<flags> method
-
-=cut
-
-use strict;
-
-use feature ':5.10';
-
-use Test::More tests => 28;
-
-my @tests = (
-    sub { cmp_ok shift, 'eq', '', => 'no flags' },
-    sub { like shift, qr/c/ => '/c' },
-    sub { cmp_ok shift, 'eq', 'g' => '/g' },
-    sub { cmp_ok shift, 'eq', 'i' => '/i' },
-    sub { cmp_ok shift, 'eq', 'm' => '/m' },
-    sub { cmp_ok shift, 'eq', ''  => '/o' },
-    sub { cmp_ok shift, 'eq', 's' => '/s' },
-    sub { cmp_ok shift, 'eq', 'x' => '/x' },
-    sub { cmp_ok shift, 'eq', 'p' => '/p' },
-    sub { like $_[0], qr/$_/ => "/$_ in $_[0]" for unpack "(A)*", "xi" },
-    sub { like $_[0], qr/$_/ => "/$_ in $_[0]" for unpack "(A)*", "xs" },
-    sub { like $_[0], qr/$_/ => "/$_ in $_[0]" for unpack "(A)*", "cgimsxp" },
-    sub { like $_[0], qr/$_/ => "/$_ in $_[0]" for unpack "(A)*", "e" },
-    sub { like $_[0], qr/$_/ => "/$_ in $_[0]" for unpack "(A)*", "egimsxp" },
-);
-
-use re::engine::Plugin (
-    exec => sub {
-        my ($re, $str) = @_;
-
-        my $t = shift @tests;
-
-        $t->($re->flags);
-    }
-);
-
-# Provide a pattern that can match to avoid running into regexp
-# optimizations that won't call exec on C<"" =~ //>;
-
-"" =~ /x/;
-"" =~ /x/cg; # meaningless without /g
-"" =~ /x/g;
-"" =~ /x/i;
-"" =~ /x/m;
-"" =~ /x/o;
-"" =~ /x/s;
-"" =~ /x/x;
-"" =~ /x/p;
-"" =~ /x/xi;
-"" =~ /x/xs;
-"" =~ /x/cgimosxp;
-
-my $_ = "";
-
-$_ =~ s/1/2/e;
-$_ =~ s/1/2/egimosxp;
diff --git a/t/minlen-get.t b/t/minlen-get.t
deleted file mode 100644 (file)
index f56e8ed..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-use strict;
-
-use Test::More tests => 2;
-
-use re::engine::Plugin (
-    comp => sub {
-        my $re = shift;
-        $re->minlen(2);
-    },
-    exec => sub {
-        my $re = shift;
-        my $minlen = $re->minlen;
-        cmp_ok $minlen, '==', 2, 'minlen accessor';
-    },
-);
-
-pass "making match";
-"str" =~ /pattern/;
diff --git a/t/minlen-set.t b/t/minlen-set.t
deleted file mode 100644 (file)
index 51fa823..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-use strict;
-
-use Test::More tests => 1;
-
-use re::engine::Plugin (
-    comp => sub {
-        my $re = shift;
-        $re->minlen(length("str") + 1); # make "str" too short
-    },
-    exec => sub { fail "exec called" },
-);
-
-pass "making match";
-"str" =~ /pattern/;