summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc7
-rw-r--r--embed.h2
-rw-r--r--proto.h10
-rw-r--r--regexec.c14
4 files changed, 23 insertions, 10 deletions
diff --git a/embed.fnc b/embed.fnc
index 02546ffb3f..3b0ecaf308 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -896,8 +896,11 @@ ADMpR |bool |is_utf8_punct |NN const U8 *p
ADMpR |bool |is_utf8_xdigit |NN const U8 *p
AMpR |bool |_is_utf8_mark |NN const U8 *p
ADMpR |bool |is_utf8_mark |NN const U8 *p
-EXdpR |bool |isSCRIPT_RUN |NN const U8 *s|NN const U8 *send \
- |const bool utf8_target
+#if defined(PERL_CORE) || defined(PERL_EXT)
+EXdpR |bool |isSCRIPT_RUN |NN const U8 *s|NN const U8 *send \
+ |const bool utf8_target \
+ |NULLOK SCX_enum * ret_script
+#endif
: Used in perly.y
p |OP* |jmaybe |NN OP *o
: Used in pp.c
diff --git a/embed.h b/embed.h
index d53dff9123..0645565de5 100644
--- a/embed.h
+++ b/embed.h
@@ -918,7 +918,6 @@
#define current_re_engine() Perl_current_re_engine(aTHX)
#define cv_ckproto_len_flags(a,b,c,d,e) Perl_cv_ckproto_len_flags(aTHX_ a,b,c,d,e)
#define grok_atoUV Perl_grok_atoUV
-#define isSCRIPT_RUN(a,b,c) Perl_isSCRIPT_RUN(aTHX_ a,b,c)
#define mg_find_mglob(a) Perl_mg_find_mglob(aTHX_ a)
#define multiconcat_stringify(a) Perl_multiconcat_stringify(aTHX_ a)
#define multideref_stringify(a,b) Perl_multideref_stringify(aTHX_ a,b)
@@ -997,6 +996,7 @@
#define sv_or_pv_pos_u2b(a,b,c,d) S_sv_or_pv_pos_u2b(aTHX_ a,b,c,d)
# endif
# if defined(PERL_CORE) || defined(PERL_EXT)
+#define isSCRIPT_RUN(a,b,c,d) Perl_isSCRIPT_RUN(aTHX_ a,b,c,d)
#define variant_under_utf8_count S_variant_under_utf8_count
# endif
# if defined(PERL_IN_REGCOMP_C)
diff --git a/proto.h b/proto.h
index 0755630a94..e6b6b21f65 100644
--- a/proto.h
+++ b/proto.h
@@ -1393,11 +1393,6 @@ PERL_CALLCONV bool Perl_isIDFIRST_lazy(pTHX_ const char* p)
#define PERL_ARGS_ASSERT_ISIDFIRST_LAZY \
assert(p)
-PERL_CALLCONV bool Perl_isSCRIPT_RUN(pTHX_ const U8 *s, const U8 *send, const bool utf8_target)
- __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_ISSCRIPT_RUN \
- assert(s); assert(send)
-
/* PERL_CALLCONV bool Perl_is_ascii_string(const U8* const s, STRLEN len)
__attribute__warn_unused_result__
__attribute__pure__; */
@@ -4378,6 +4373,11 @@ PERL_STATIC_INLINE STRLEN S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLE
#endif
#endif
#if defined(PERL_CORE) || defined(PERL_EXT)
+PERL_CALLCONV bool Perl_isSCRIPT_RUN(pTHX_ const U8 *s, const U8 *send, const bool utf8_target, SCX_enum * ret_script)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_ISSCRIPT_RUN \
+ assert(s); assert(send)
+
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE Size_t S_variant_under_utf8_count(const U8* const s, const U8* const e)
__attribute__warn_unused_result__;
diff --git a/regexec.c b/regexec.c
index 0ce50ff232..8b3602c3aa 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7653,7 +7653,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
case SRCLOSE: /* (*SCRIPT_RUN: ... ) */
- if (! isSCRIPT_RUN(script_run_begin, (U8 *) locinput, utf8_target))
+ if (! isSCRIPT_RUN(script_run_begin, (U8 *) locinput, utf8_target, NULL))
{
sayNO;
}
@@ -10305,7 +10305,7 @@ Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, cons
}
bool
-Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target)
+Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target, SCX_enum * ret_script)
{
/* Checks that every character in the sequence from 's' to 'send' is one of
* three scripts: Common, Inherited, and possibly one other. Additionally
@@ -10667,6 +10667,16 @@ Perl_isSCRIPT_RUN(pTHX_ const U8 * s, const U8 * send, const bool utf8_target)
} /* end of looping through CLOSESR text */
Safefree(intersection);
+
+ if (ret_script != NULL) {
+ if (retval) {
+ *ret_script = script_of_run;
+ }
+ else {
+ *ret_script = SCX_INVALID;
+ }
+ }
+
return retval;
}