The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

RURBAN / B-C-1.57 / ramblings / Export-store_cop_label-on-Windows.patch 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

              
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