Skip to content

Commit

Permalink
Merge re_eval jumbo fix branch into blead
Browse files Browse the repository at this point in the history
This re_eval branch contains around 130 commits that collectively
reimplement the /(?{})/ mechanism. See the individual commits
and the changes to pod/* for more details, but the main highlights are:

=item *

Code blocks within patterns are now parsed in the same pass as the
surrounding code; in particular it is no longer necessary to have balanced
braces: this now works:

    /(?{  $x='{'  })/

This means that this error message is longer generated:

    Sequence (?{...}) not terminated or not {}-balanced in regex

but a new error may be seen:

    Sequence (?{...}) not terminated with ')'

In addition, literal code blocks within run-time patterns are only
compiled once, at perl compile-time:

    for my $p (...) {
        # this 'FOO' block of code is compiled once, at the same time as
        # the surrounding 'for' loop
        /$p{(?{FOO;})/;
    }

=item *

Lexical variables are now sane as regards scope, recursion and closure
behaviour. In particular, C</A(?{B})C/> behaves (from a closure viewpoint)
exactly like C</A/ && do { B } && /C/>, while  C<qr/A(?{B})C/> is like
C<sub {/A/ && do { B } && /C/}>. So this code now works how you might
expect, creating three regexes that match 1,2, and 3:

    for my $i (0..2) {
        push @r, qr/^(??{$i})$/;
    }
    "1" =~ $r[1]; # matches

=item *

The C<use re 'eval'> pragma is now strictly only required for code blocks
defined at runtime; in particular in the following, the text of the $r
pattern is still interpolated into the new pattern and recompiled, but
the individual compiled code-blocks within $r are reused rather than being
recompiled, and C<use re 'eval'> isn't needed any more:

    my $r = qr/abc(?{....})def/;
    /xyz$r/;

=item *

Flow control operators no longer crash. Each code block runs in a new
dynamic scope, so C<next> etc. will not see any enclosing loops and
C<caller> will not see any calling subroutines. C<return> returns a value
from the code block, not from any enclosing subroutine.

=item *

Perl normally caches the compilation of run-time patterns, and doesn't
recompile if the pattern hasn't changed; but this is now disabled if
required for the correct behaviour of closures; for example:

    my $code = '(??{$x})';
    for my $x (1..3) {
        $x =~ /$code/; # recompile to see fresh value of $x each time
    }

=item *

C</msix> and C<(?msix)> etc. flags are now propagated into the return
value from C<(??{})>; this now works:

    "AB" =~ /a(??{'b'})/i;

=item *

Warnings and errors will appear to come from the surrounding code (or for
run-time code blocks, from an eval) rather than from an C<re_eval>:

    use re 'eval'; $c = '(?{ warn "foo" })'; /$c/;
    /(?{ warn "foo" })/;

formerly gave:

    foo at (re_eval 1) line 1.
    foo at (re_eval 2) line 1.

and now gives:

    foo at (eval 1) line 1.
    foo at /tmp/foo line 2.

=item *

In the pluggable regex API, the regexp_engine struct has acquired a new
field C<op_comp>, which is currently just for perl's internal use, and
should be initialised to NULL by other regexp plugin modules.
  • Loading branch information
iabyn committed Jun 14, 2012
2 parents 3630f57 + db70367 commit eb58a7e
Show file tree
Hide file tree
Showing 64 changed files with 3,949 additions and 1,865 deletions.
1 change: 1 addition & 0 deletions MANIFEST
Original file line number Diff line number Diff line change
Expand Up @@ -5393,6 +5393,7 @@ t/re/qr-72922.t Test for bug #72922
t/re/qr_gc.t See if qr doesn't leak
t/re/qrstack.t See if qr expands the stack properly
t/re/qr.t See if qr works
t/re/recompile.t See if pattern caching/recompilation works
t/re/reg_60508.t See if bug #60508 is fixed
t/re/reg_email.t See if regex recursion works by parsing email addresses
t/re/reg_email_thr.t See if regex recursion works by parsing email addresses in another thread
Expand Down
39 changes: 36 additions & 3 deletions cop.h
Original file line number Diff line number Diff line change
Expand Up @@ -1180,6 +1180,12 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
U8 hasargs = 0 /* used by PUSHSUB */

#define PUSH_MULTICALL(the_cv) \
PUSH_MULTICALL_WITHDEPTH(the_cv, 1);

/* Like PUSH_MULTICALL, but allows you to specify the CvDEPTH increment,
* rather than the default of 1 (this isn't part of the public API) */

#define PUSH_MULTICALL_WITHDEPTH(the_cv, depth) \
STMT_START { \
CV * const _nOnclAshIngNamE_ = the_cv; \
CV * const cv = _nOnclAshIngNamE_; \
Expand All @@ -1191,7 +1197,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
PUSHSTACKi(PERLSI_SORT); \
PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp); \
PUSHSUB(cx); \
if (++CvDEPTH(cv) >= 2) { \
CvDEPTH(cv) += depth; \
if (CvDEPTH(cv) >= 2) { \
PERL_STACK_OVERFLOW_CHECK(); \
Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
} \
Expand All @@ -1209,15 +1216,41 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.

#define POP_MULTICALL \
STMT_START { \
if (! --CvDEPTH(multicall_cv)) \
LEAVESUB(multicall_cv); \
if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) { \
LEAVESUB(multicall_cv); \
} \
POPBLOCK(cx,PL_curpm); \
POPSTACK; \
CATCH_SET(multicall_oldcatch); \
LEAVE; \
SPAGAIN; \
} STMT_END

/* Change the CV of an already-pushed MULTICALL CxSUB block.
* (this isn't part of the public API) */

#define CHANGE_MULTICALL_WITHDEPTH(the_cv, depth) \
STMT_START { \
CV * const _nOnclAshIngNamE_ = the_cv; \
CV * const cv = _nOnclAshIngNamE_; \
AV * const padlist = CvPADLIST(cv); \
cx = &cxstack[cxstack_ix]; \
assert(cx->cx_type & CXp_MULTICALL); \
if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) { \
LEAVESUB(multicall_cv); \
} \
cx->cx_type &= ~CXp_HASARGS; \
PUSHSUB(cx); \
CvDEPTH(cv) += depth; \
if (CvDEPTH(cv) >= 2) { \
PERL_STACK_OVERFLOW_CHECK(); \
Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
} \
SAVECOMPPAD(); \
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
multicall_cv = cv; \
multicall_cop = CvSTART(cv); \
} STMT_END
/*
* Local variables:
* c-indentation-style: bsd
Expand Down
5 changes: 4 additions & 1 deletion dist/B-Deparse/Deparse.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4587,7 +4587,10 @@ sub matchop {
carp("found ".$kid->name." where regcomp expected");
} else {
($re, $quote) = $self->regcomp($kid, 21, $extended);
my $matchop = $kid->first->first;
my $matchop = $kid->first;
if ($matchop->name eq 'regcrest') {
$matchop = $matchop->first;
}
if ($matchop->name =~ /^(?:match|transr?|subst)\z/
&& $matchop->flags & OPf_SPECIAL) {
$rhs_bound_to_defsv = 1;
Expand Down
16 changes: 14 additions & 2 deletions dump.c
Original file line number Diff line number Diff line change
Expand Up @@ -613,6 +613,15 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
op_dump(pm->op_pmreplrootu.op_pmreplroot);
}
if (pm->op_code_list) {
if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
do_op_dump(level, file, pm->op_code_list);
}
else
Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
PTR2UV(pm->op_code_list));
}
if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
SV * const tmpsv = pm_description(pm);
Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
Expand All @@ -630,6 +639,9 @@ const struct flag_to_name pmflags_flags_names[] = {
{PMf_RETAINT, ",RETAINT"},
{PMf_EVAL, ",EVAL"},
{PMf_NONDESTRUCT, ",NONDESTRUCT"},
{PMf_HAS_CV, ",HAS_CV"},
{PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
{PMf_IS_QR, ",IS_QR"}
};

static SV *
Expand Down Expand Up @@ -2040,8 +2052,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
(UV)(r->gofs));
Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %"UVuf"\n",
(UV)(r->pre_prefix));
Perl_dump_indent(aTHX_ level, file, " SEEN_EVALS = %"UVuf"\n",
(UV)(r->seen_evals));
Perl_dump_indent(aTHX_ level, file, " SUBLEN = %"IVdf"\n",
(IV)(r->sublen));
if (r->subbeg)
Expand All @@ -2062,6 +2072,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
PTR2UV(r->pprivate));
Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%"UVxf"\n",
PTR2UV(r->offs));
Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%"UVxf"\n",
PTR2UV(r->qr_anoncv));
#ifdef PERL_OLD_COPY_ON_WRITE
Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%"UVxf"\n",
PTR2UV(r->saved_copy));
Expand Down
27 changes: 14 additions & 13 deletions embed.fnc
Original file line number Diff line number Diff line change
Expand Up @@ -1024,7 +1024,7 @@ Apd |void |packlist |NN SV *cat|NN const char *pat|NN const char *patend|NN SV
s |void |pidgone |Pid_t pid|int status
#endif
: Used in perly.y
p |OP* |pmruntime |NN OP *o|NN OP *expr|bool isreg
p |OP* |pmruntime |NN OP *o|NN OP *expr|bool isreg|I32 floor
#if defined(PERL_IN_OP_C)
s |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl
#endif
Expand Down Expand Up @@ -1056,8 +1056,15 @@ Ap |void |regfree_internal|NN REGEXP *const rx
#if defined(USE_ITHREADS)
Ap |void* |regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param
#endif
EXp |regexp_engine const *|current_re_engine
Ap |REGEXP*|pregcomp |NN SV * const pattern|const U32 flags
Ap |REGEXP*|re_compile |NN SV * const pattern|U32 flags
p |REGEXP*|re_op_compile |NULLOK SV ** const patternp \
|int pat_count|NULLOK OP *expr \
|NN const regexp_engine* eng \
|NULLOK REGEXP *VOL old_re \
|NULLOK bool *is_bare_re \
|U32 rx_flags|U32 pm_flags
Ap |REGEXP*|re_compile |NN SV * const pattern|U32 orig_rx_flags
Ap |char* |re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|NN char* strpos \
|NN char* strend|const U32 flags \
|NULLOK re_scream_pos_data *data
Expand Down Expand Up @@ -1267,13 +1274,6 @@ Apd |I32 |sv_cmp_locale_flags |NULLOK SV *const sv1 \
Amd |char* |sv_collxfrm |NN SV *const sv|NN STRLEN *const nxp
Apd |char* |sv_collxfrm_flags |NN SV *const sv|NN STRLEN *const nxp|I32 const flags
#endif
: Frustratingly, because regcomp.c is also compiled as ext/re/re_comp.c,
: anything it needs has to be exported. So this has to be X. I'd rather it
: wasn't.
Xpo |OP* |sv_compile_2op_is_broken|NN SV *sv|NN OP **startop \
|NN const char *code|NN PAD **padp
ApD |OP* |sv_compile_2op |NN SV *sv|NN OP **startop \
|NN const char *code|NN PAD **padp
Apd |int |getcwd_sv |NN SV* sv
Apd |void |sv_dec |NULLOK SV *const sv
Apd |void |sv_dec_nomg |NULLOK SV *const sv
Expand Down Expand Up @@ -1859,7 +1859,7 @@ sR |I32 |dopoptoloop |I32 startingblock
sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock
sR |I32 |dopoptowhen |I32 startingblock
s |void |save_lines |NULLOK AV *array|NN SV *sv
s |bool |doeval |int gimme|NULLOK OP** startop \
s |bool |doeval |int gimme \
|NULLOK CV* outside|U32 seq|NULLOK HV* hh
sR |PerlIO *|check_type_and_open|NN SV *name
#ifndef PERL_DISABLE_PMC
Expand Down Expand Up @@ -1996,8 +1996,8 @@ ERs |I32 |regrepeat |NN const regexp *prog|NN const regnode *p|I32 max|int depth
ERs |I32 |regtry |NN regmatch_info *reginfo|NN char **startpos
ERs |bool |reginclass |NULLOK const regexp * const prog|NN const regnode * const n|NN const U8 * const p|NULLOK STRLEN *lenp\
|bool const do_utf8sv_is_utf8
Es |CHECKPOINT|regcppush |I32 parenfloor
Es |char* |regcppop |NN const regexp *rex
Es |CHECKPOINT|regcppush |NN const regexp *rex|I32 parenfloor
Es |void |regcppop |NN regexp *rex
ERsn |U8* |reghop3 |NN U8 *s|I32 off|NN const U8 *lim
ERsM |SV* |core_regclass_swash|NULLOK const regexp *prog \
|NN const struct regnode *node|bool doinit \
Expand Down Expand Up @@ -2114,7 +2114,8 @@ s |char* |scan_ident |NN char *s|NN const char *send|NN char *dest \
|STRLEN destlen|I32 ck_uni
sR |char* |scan_inputsymbol|NN char *start
sR |char* |scan_pat |NN char *start|I32 type
sR |char* |scan_str |NN char *start|int keep_quoted|int keep_delims
sR |char* |scan_str |NN char *start|int keep_quoted \
|int keep_delims|int re_reparse
sR |char* |scan_subst |NN char *start
sR |char* |scan_trans |NN char *start
s |char* |scan_word |NN char *s|NN char *dest|STRLEN destlen \
Expand Down
11 changes: 6 additions & 5 deletions embed.h
Original file line number Diff line number Diff line change
Expand Up @@ -558,7 +558,6 @@
#define sv_clear(a) Perl_sv_clear(aTHX_ a)
#define sv_cmp_flags(a,b,c) Perl_sv_cmp_flags(aTHX_ a,b,c)
#define sv_cmp_locale_flags(a,b,c) Perl_sv_cmp_locale_flags(aTHX_ a,b,c)
#define sv_compile_2op(a,b,c,d) Perl_sv_compile_2op(aTHX_ a,b,c,d)
#define sv_copypv(a,b) Perl_sv_copypv(aTHX_ a,b)
#define sv_dec(a) Perl_sv_dec(aTHX_ a)
#define sv_dec_nomg(a) Perl_sv_dec_nomg(aTHX_ a)
Expand Down Expand Up @@ -857,6 +856,7 @@
#if defined(PERL_CORE) || defined(PERL_EXT)
#define _is_utf8__perl_idstart(a) Perl__is_utf8__perl_idstart(aTHX_ a)
#define av_reify(a) Perl_av_reify(aTHX_ a)
#define current_re_engine() Perl_current_re_engine(aTHX)
#define is_utf8_X_L(a) Perl_is_utf8_X_L(aTHX_ a)
#define is_utf8_X_LV(a) Perl_is_utf8_X_LV(aTHX_ a)
#define is_utf8_X_LVT(a) Perl_is_utf8_X_LVT(aTHX_ a)
Expand Down Expand Up @@ -972,7 +972,7 @@
#define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e)
#define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b)
#define regcppop(a) S_regcppop(aTHX_ a)
#define regcppush(a) S_regcppush(aTHX_ a)
#define regcppush(a,b) S_regcppush(aTHX_ a,b)
#define reghop3 S_reghop3
#define reghopmaybe3 S_reghopmaybe3
#define reginclass(a,b,c,d,e) S_reginclass(aTHX_ a,b,c,d,e)
Expand Down Expand Up @@ -1173,7 +1173,8 @@
#define parse_unicode_opts(a) Perl_parse_unicode_opts(aTHX_ a)
#define parser_free(a) Perl_parser_free(aTHX_ a)
#define peep(a) Perl_peep(aTHX_ a)
#define pmruntime(a,b,c) Perl_pmruntime(aTHX_ a,b,c)
#define pmruntime(a,b,c,d) Perl_pmruntime(aTHX_ a,b,c,d)
#define re_op_compile(a,b,c,d,e,f,g,h) Perl_re_op_compile(aTHX_ a,b,c,d,e,f,g,h)
#define refcounted_he_chain_2hv(a,b) Perl_refcounted_he_chain_2hv(aTHX_ a,b)
#define refcounted_he_fetch_pv(a,b,c,d) Perl_refcounted_he_fetch_pv(aTHX_ a,b,c,d)
#define refcounted_he_fetch_pvn(a,b,c,d,e) Perl_refcounted_he_fetch_pvn(aTHX_ a,b,c,d,e)
Expand Down Expand Up @@ -1464,7 +1465,7 @@
#define destroy_matcher(a) S_destroy_matcher(aTHX_ a)
#define do_smartmatch(a,b,c) S_do_smartmatch(aTHX_ a,b,c)
#define docatch(a) S_docatch(aTHX_ a)
#define doeval(a,b,c,d,e) S_doeval(aTHX_ a,b,c,d,e)
#define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
#define dofindlabel(a,b,c,d,e,f) S_dofindlabel(aTHX_ a,b,c,d,e,f)
#define doparseform(a) S_doparseform(aTHX_ a)
#define dopoptoeval(a) S_dopoptoeval(aTHX_ a)
Expand Down Expand Up @@ -1584,7 +1585,7 @@
#define scan_ident(a,b,c,d,e) S_scan_ident(aTHX_ a,b,c,d,e)
#define scan_inputsymbol(a) S_scan_inputsymbol(aTHX_ a)
#define scan_pat(a,b) S_scan_pat(aTHX_ a,b)
#define scan_str(a,b,c) S_scan_str(aTHX_ a,b,c)
#define scan_str(a,b,c,d) S_scan_str(aTHX_ a,b,c,d)
#define scan_subst(a) S_scan_subst(aTHX_ a)
#define scan_trans(a) S_scan_trans(aTHX_ a)
#define scan_word(a,b,c,d,e) S_scan_word(aTHX_ a,b,c,d,e)
Expand Down
1 change: 0 additions & 1 deletion embedvar.h
Original file line number Diff line number Diff line change
Expand Up @@ -277,7 +277,6 @@
#define PL_regdummy (vTHX->Iregdummy)
#define PL_regex_pad (vTHX->Iregex_pad)
#define PL_regex_padav (vTHX->Iregex_padav)
#define PL_reginterp_cnt (vTHX->Ireginterp_cnt)
#define PL_registered_mros (vTHX->Iregistered_mros)
#define PL_regmatch_slab (vTHX->Iregmatch_slab)
#define PL_regmatch_state (vTHX->Iregmatch_state)
Expand Down
4 changes: 4 additions & 0 deletions ext/B/B.pm
Original file line number Diff line number Diff line change
Expand Up @@ -1163,6 +1163,10 @@ Since Perl 5.9.5
Only when perl was compiled with ithreads.
=item code_list
Since perl 5.17.1
=back
=head2 B::SVOP METHOD
Expand Down
2 changes: 2 additions & 0 deletions ext/B/B.xs
Original file line number Diff line number Diff line change
Expand Up @@ -864,6 +864,7 @@ threadsv_names()
#define OP_private_ix U8p | offsetof(struct op, op_private)

#define PMOP_pmflags_ix U32p | offsetof(struct pmop, op_pmflags)
#define PMOP_code_list_ix OPp | offsetof(struct pmop, op_code_list)

#ifdef USE_ITHREADS
#define PMOP_pmoffset_ix IVp | offsetof(struct pmop, op_pmoffset)
Expand Down Expand Up @@ -922,6 +923,7 @@ next(o)
B::LOOP::nextop = LOOP_nextop_ix
B::LOOP::lastop = LOOP_lastop_ix
B::PMOP::pmflags = PMOP_pmflags_ix
B::PMOP::code_list = PMOP_code_list_ix
B::SVOP::sv = SVOP_sv_ix
B::SVOP::gv = SVOP_gv_ix
B::PADOP::padix = PADOP_padix_ix
Expand Down
4 changes: 2 additions & 2 deletions ext/Devel-Peek/t/Peek.t
Original file line number Diff line number Diff line change
Expand Up @@ -349,15 +349,15 @@ do_test('reference to regexp',
MINLENRET = 3
GOFS = 0
PRE_PREFIX = 4
SEEN_EVALS = 0
SUBLEN = 0
SUBBEG = 0x0
ENGINE = $ADDR
MOTHER_RE = $ADDR
PAREN_NAMES = 0x0
SUBSTRS = $ADDR
PPRIVATE = $ADDR
OFFS = $ADDR'
OFFS = $ADDR
QR_ANONCV = 0x0'
));
} else {
do_test('reference to regexp',
Expand Down
7 changes: 4 additions & 3 deletions ext/re/re.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ package re;
use strict;
use warnings;

our $VERSION = "0.19";
our $VERSION = "0.20";
our @ISA = qw(Exporter);
our @EXPORT_OK = ('regmust',
qw(is_regexp regexp_pattern
Expand Down Expand Up @@ -284,8 +284,9 @@ other transformations.
When C<use re 'eval'> is in effect, a regexp is allowed to contain
C<(?{ ... })> zero-width assertions and C<(??{ ... })> postponed
subexpressions, even if the regular expression contains
variable interpolation. That is normally disallowed, since it is a
subexpressions that are derived from variable interpolation, rather than
appearing literally within the regexp. That is normally disallowed, since
it is a
potential security risk. Note that this pragma is ignored when the regular
expression is obtained from tainted data, i.e. evaluation is always
disallowed with tainted regular expressions. See L<perlre/(?{ code })>
Expand Down
7 changes: 6 additions & 1 deletion ext/re/re.xs
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,10 @@
START_EXTERN_C

extern REGEXP* my_re_compile (pTHX_ SV * const pattern, const U32 pm_flags);
extern REGEXP* my_re_op_compile (pTHX_ SV ** const patternp, int pat_count,
OP *expr, const regexp_engine* eng, REGEXP *VOL old_re,
bool *is_bare_re, U32 rx_flags, U32 pm_flags);

extern I32 my_regexec (pTHX_ REGEXP * const prog, char* stringarg, char* strend,
char* strbeg, I32 minend, SV* screamer,
void* data, U32 flags);
Expand Down Expand Up @@ -57,8 +61,9 @@ const struct regexp_engine my_reg_engine = {
my_reg_named_buff_iter,
my_reg_qr_package,
#if defined(USE_ITHREADS)
my_regdupe
my_regdupe,
#endif
my_re_op_compile,
};

MODULE = re PACKAGE = re
Expand Down
1 change: 1 addition & 0 deletions ext/re/re_top.h
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@
#define Perl_regprop my_regprop
#define Perl_re_intuit_start my_re_intuit_start
#define Perl_re_compile my_re_compile
#define Perl_re_op_compile my_re_op_compile
#define Perl_regfree_internal my_regfree
#define Perl_re_intuit_string my_re_intuit_string
#define Perl_regdupe_internal my_regdupe
Expand Down
11 changes: 10 additions & 1 deletion ext/re/t/reflags.t
Original file line number Diff line number Diff line change
Expand Up @@ -10,26 +10,35 @@ BEGIN {

use strict;

use Test::More tests => 53;
use Test::More tests => 62;

my @flags = qw( a d l u );

use re '/i';
ok "Foo" =~ /foo/, 'use re "/i"';
ok "Foo" =~ /(??{'foo'})/, 'use re "/i" (??{})';
no re '/i';
ok "Foo" !~ /foo/, 'no re "/i"';
ok "Foo" !~ /(??{'foo'})/, 'no re "/i" (??{})';
use re '/x';
ok "foo" =~ / foo /, 'use re "/x"';
ok "foo" =~ / (??{' foo '}) /, 'use re "/x" (??{})';
no re '/x';
ok "foo" !~ / foo /, 'no re "/x"';
ok "foo" !~ /(??{' foo '})/, 'no re "/x" (??{})';
ok "foo" !~ / (??{'foo'}) /, 'no re "/x" (??{})';
use re '/s';
ok "\n" =~ /./, 'use re "/s"';
ok "\n" =~ /(??{'.'})/, 'use re "/s" (??{})';
no re '/s';
ok "\n" !~ /./, 'no re "/s"';
ok "\n" !~ /(??{'.'})/, 'no re "/s" (??{})';
use re '/m';
ok "\nfoo" =~ /^foo/, 'use re "/m"';
ok "\nfoo" =~ /(??{'^'})foo/, 'use re "/m" (??{})';
no re '/m';
ok "\nfoo" !~ /^foo/, 'no re "/m"';
ok "\nfoo" !~ /(??{'^'})foo/, 'no re "/m" (??{})';

use re '/xism';
ok qr// =~ /(?=.*x)(?=.*i)(?=.*s)(?=.*m)/, 'use re "/multiple"';
Expand Down
Loading

0 comments on commit eb58a7e

Please sign in to comment.