The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Required on Windows only for 5.10-5.15.1

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

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

diff --git a/embed.fnc b/embed.fnc
index 71c10af..6b43bfb 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2446,8 +2446,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 21f417d..6164bd0 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2348,6 +2348,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/hv.c b/hv.c
index a230c16..11c5565 100644
--- a/hv.c
+++ b/hv.c
@@ -3286,6 +3286,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 *
@@ -3322,6 +3331,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)
-- 
1.7.5.4