From 8375c93eec5677d8587491a0541d33bc206a445a Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Tue, 21 Jun 2011 07:55:56 -0500
Subject: Export store_cop_label for the perl compiler

---
 embed.fnc                 |  4 ++--
 ext/XS-APItest/APItest.xs | 21 +++++++++++++++++++++
 global.sym                |  1 +
 hv.c                      | 18 ++++++++++++++++++
 4 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 0f4424a4b0..2c35c35230 100644
--- 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 3aadc3dcfe..f1766c795e 100644
--- 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 6e60f38bd3..da433ade38 100644
--- 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 c8ed63c3e3..0b46ef6635 100644
--- 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)
-- 
cgit v1.2.1