Make a few parse fcns accessible to B::Hooks::Parser

This module had made copies of three functions from toke.c many releases
ago, and they stagnated.  Most outside code has no business calling
them, but the least worst choice I believe is to make them accessible,
but hide that fact.

This commit makes them accessible to modules that have defined PERL_EXT.
It does not document their API's, and marks them as subject to change,
so they aren't even listed as available in the docs.  In other words,
you'd have to really go digging to find out you could use them.

And the API of two of the three had changed since the code was
originally stolen.  So that "subject to change" actually has happened.
We should feel free to change the API as needed, and B::Hooks::Parser
will have to be updated.

Thanks to Tony Cook for advising me on this area unfamiliar to me.

diff --git a/embed.fnc b/embed.fnc
index e2ca5c5..88cece4 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2744,6 +2744,12 @@ EXpR     |SV*    |get_and_check_backslash_N_name|NN const char* s        \
                                |const bool is_utf8                     \
                                |NN const char** error_msg
 
+EXpMR  |char*  |scan_str       |NN char *start|int keep_quoted \
+                               |int keep_delims|int re_reparse \
+                               |NULLOK char **delimp
+EXpM   |char*  |scan_word      |NN char *s|NN char *dest|STRLEN destlen \
+                               |int allow_package|NN STRLEN *slp
+EXpMR  |char*  |skipspace_flags|NN char *s|U32 flags
 #if defined(PERL_IN_TOKE_C)
 s      |void   |check_uni
 s      |void   |force_next     |I32 type
@@ -2761,16 +2767,10 @@ s       |char*  |scan_ident     |NN char *s|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|int re_reparse \
-                               |NULLOK char **delimp
 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 \
-                               |int allow_package|NN STRLEN *slp
 s      |void   |update_debugger_info|NULLOK SV *orig_sv \
                                |NULLOK const char *const buf|STRLEN len
-sR     |char*  |skipspace_flags|NN char *s|U32 flags
 sR     |char*  |swallow_bom    |NN U8 *s
 #ifndef PERL_NO_UTF16_FILTER
 s      |I32    |utf16_textfilter|int idx|NN SV *sv|int maxlen

diff --git a/embed.h b/embed.h
index 94acff2..930a44a 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1101,6 +1101,9 @@
 #define reg_qr_package(a)      Perl_reg_qr_package(aTHX_ a)
 #define reg_temp_copy(a,b)     Perl_reg_temp_copy(aTHX_ a,b)
 #define report_uninit(a)       Perl_report_uninit(aTHX_ a)
+#define scan_str(a,b,c,d,e)    Perl_scan_str(aTHX_ a,b,c,d,e)
+#define scan_word(a,b,c,d,e)   Perl_scan_word(aTHX_ a,b,c,d,e)
+#define skipspace_flags(a,b)   Perl_skipspace_flags(aTHX_ a,b)
 #define sv_magicext_mglob(a)   Perl_sv_magicext_mglob(aTHX_ a)
 #define sv_only_taint_gmagic   S_sv_only_taint_gmagic
 #define swash_fetch(a,b,c)     Perl_swash_fetch(aTHX_ a,b,c)
@@ -2046,11 +2049,8 @@
 #define scan_ident(a,b,c,d)    S_scan_ident(aTHX_ a,b,c,d)
 #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,d,e)    S_scan_str(aTHX_ a,b,c,d,e)
 #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)
-#define skipspace_flags(a,b)   S_skipspace_flags(aTHX_ a,b)
 #define sublex_done()          S_sublex_done(aTHX)
 #define sublex_push()          S_sublex_push(aTHX)
 #define sublex_start()         S_sublex_start(aTHX)

diff --git a/proto.h b/proto.h
index b9662c6..63f53cd 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3108,12 +3108,20 @@ PERL_CALLCONV char*     Perl_scan_num(pTHX_ const char* s, YYSTYPE *lvalp);
 PERL_CALLCONV NV       Perl_scan_oct(pTHX_ const char* start, STRLEN len, STRLEN* retlen);
 #define PERL_ARGS_ASSERT_SCAN_OCT      \
        assert(start); assert(retlen)
+PERL_CALLCONV char*    Perl_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse, char **delimp)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_SCAN_STR      \
+       assert(start)
+
 PERL_CALLCONV const char*      Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv);
 #define PERL_ARGS_ASSERT_SCAN_VERSION  \
        assert(s); assert(rv)
 PERL_CALLCONV char*    Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv);
 #define PERL_ARGS_ASSERT_SCAN_VSTRING  \
        assert(s); assert(e); assert(sv)
+PERL_CALLCONV char*    Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp);
+#define PERL_ARGS_ASSERT_SCAN_WORD     \
+       assert(s); assert(dest); assert(slp)
 PERL_CALLCONV U32      Perl_seed(pTHX);
 PERL_CALLCONV void     Perl_set_caret_X(pTHX);
 PERL_CALLCONV void     Perl_set_context(void *t);
@@ -3132,6 +3140,11 @@ PERL_CALLCONV void       Perl_setfd_inhexec_for_sysfd(pTHX_ int fd);
 PERL_CALLCONV HEK*     Perl_share_hek(pTHX_ const char* str, SSize_t len, U32 hash);
 #define PERL_ARGS_ASSERT_SHARE_HEK     \
        assert(str)
+PERL_CALLCONV char*    Perl_skipspace_flags(pTHX_ char *s, U32 flags)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_SKIPSPACE_FLAGS       \
+       assert(s)
+
 PERL_CALLCONV void     Perl_sortsv(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t cmp);
 #define PERL_ARGS_ASSERT_SORTSV        \
        assert(cmp)
@@ -6117,11 +6130,6 @@ STATIC char*     S_scan_pat(pTHX_ char *start, I32 type)
 #define PERL_ARGS_ASSERT_SCAN_PAT      \
        assert(start)
 
-STATIC char*   S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse, char **delimp)
-                       __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_SCAN_STR      \
-       assert(start)
-
 STATIC char*   S_scan_subst(pTHX_ char *start)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_SCAN_SUBST    \
@@ -6132,14 +6140,6 @@ STATIC char*     S_scan_trans(pTHX_ char *start)
 #define PERL_ARGS_ASSERT_SCAN_TRANS    \
        assert(start)
 
-STATIC char*   S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp);
-#define PERL_ARGS_ASSERT_SCAN_WORD     \
-       assert(s); assert(dest); assert(slp)
-STATIC char*   S_skipspace_flags(pTHX_ char *s, U32 flags)
-                       __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_SKIPSPACE_FLAGS       \
-       assert(s)
-
 STATIC I32     S_sublex_done(pTHX)
                        __attribute__warn_unused_result__;
 

diff --git a/toke.c b/toke.c
index c87cf1c..2f9c1d5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1885,8 +1885,8 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len)
 #define skipspace(s) skipspace_flags(s, 0)
 #define peekspace(s) skipspace_flags(s, LEX_NO_INCLINE)
 
-STATIC char *
-S_skipspace_flags(pTHX_ char *s, U32 flags)
+char *
+Perl_skipspace_flags(pTHX_ char *s, U32 flags)
 {
     PERL_ARGS_ASSERT_SKIPSPACE_FLAGS;
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
@@ -9434,8 +9434,8 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package,
 /* Returns a NUL terminated string, with the length of the string written to
    *slp
    */
-STATIC char *
-S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
+char *
+Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
     char *d = dest;
     char * const e = d + destlen - 3;  /* two-character token, ending NUL */
@@ -10664,8 +10664,8 @@ S_scan_inputsymbol(pTHX_ char *start)
    SvIVX of the SV.
 */
 
-STATIC char *
-S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re_reparse,
+char *
+Perl_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re_reparse,
                 char **delimp
     )
 {