Give isSCRIPT_RUN() an extra parameter

This allows it to return the script of the run.

diff --git a/embed.fnc b/embed.fnc
index 02546ff..3b0ecaf 100644 (file)
--- 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 d53dff9..0645565 100644 (file)
--- 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 0755630..e6b6b21 100644 (file)
--- 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 0ce50ff..8b3602c 100644 (file)
--- 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;
 }