Export store_cop_label for the perl compiler

diff --git a/embed.fnc b/embed.fnc
index 0f4424a..2c35c35 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2456,8 +2456,8 @@ Apon      |void   |sys_init3      |NN int* argc|NN char*** argv|NN char*** env
 Apon   |void   |sys_term
 ApoM   |const char *|fetch_cop_label|NN COP *const cop \
                |NULLOK STRLEN *len|NULLOK U32 *flags
-: Only used  in op.c
-xpoM   |void|store_cop_label \
+: Only used  in op.c and the perl compiler
+ApoM   |void|store_cop_label \
                |NN COP *const cop|NN const char *label|STRLEN len|U32 flags
 
 xpo    |int    |keyword_plugin_standard|NN char* keyword_ptr|STRLEN keyword_len|NN OP** op_ptr

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 3aadc3d..f1766c7 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2396,6 +2396,27 @@ test_cophh()
 #undef msvpvs
 #undef msviv
 
+void
+test_coplabel()
+    PREINIT:
+        COP *cop;
+        char *label;
+        int len, utf8;
+    CODE:
+        cop = &PL_compiling;
+        Perl_store_cop_label(aTHX_ cop, "foo", 3, 0);
+        label = Perl_fetch_cop_label(aTHX_ cop, &len, &utf8);
+        if (strcmp(label,"foo")) croak("fail # fetch_cop_label label");
+        if (len != 3) croak("fail # fetch_cop_label len");
+        if (utf8) croak("fail # fetch_cop_label utf8");
+        /* SMALL GERMAN UMLAUT A */
+        Perl_store_cop_label(aTHX_ cop, "foä", 4, SVf_UTF8);
+        label = Perl_fetch_cop_label(aTHX_ cop, &len, &utf8);
+        if (strcmp(label,"foä")) croak("fail # fetch_cop_label label");
+        if (len != 3) croak("fail # fetch_cop_label len");
+        if (!utf8) croak("fail # fetch_cop_label utf8");
+
+
 HV *
 example_cophh_2hv()
     PREINIT:

diff --git a/global.sym b/global.sym
index 6e60f38..da433ad 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -594,6 +594,7 @@ Perl_sortsv_flags
 Perl_stack_grow
 Perl_start_subparse
 Perl_stashpv_hvname_match
+Perl_store_cop_label
 Perl_str_to_version
 Perl_sv_2bool_flags
 Perl_sv_2cv

diff --git a/hv.c b/hv.c
index c8ed63c..0b46ef6 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -3287,6 +3287,15 @@ Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
     return he;
 }
 
+/*
+=for apidoc fetch_cop_label
+
+Returns the label attached to a cop.
+The flags pointer may be set to C<SVf_UTF8> or 0.
+
+=cut
+*/
+
 /* pp_entereval is aware that labels are stored with a key ':' at the top of
    the linked list.  */
 const char *
@@ -3323,6 +3332,15 @@ Perl_fetch_cop_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
     return chain->refcounted_he_data + 1;
 }
 
+/*
+=for apidoc store_cop_label
+
+Save a label into a C<cop_hints_hash>. You need to set flags to C<SVf_UTF8>
+for a utf-8 label.
+
+=cut
+*/
+
 void
 Perl_store_cop_label(pTHX_ COP *const cop, const char *label, STRLEN len,
                     U32 flags)