Refactor Perl_store_cop_label() to avoid exposing struct refcounted_he *.
authorNicholas Clark <nick@ccl4.org>
Wed, 1 Sep 2010 06:24:59 +0000 (07:24 +0100)
committerNicholas Clark <nick@ccl4.org>
Wed, 1 Sep 2010 06:24:59 +0000 (07:24 +0100)
Instead pass in a COP, as suggested by Ben Morrow. Also add length and flags
parameters, and remove the comment suggesting this change. The underlying
storage mechanism can honour length and UTF8/not, so there is no harm in
exposing this one level higher.

embed.fnc
hv.c
op.c
proto.h

index a443e9a..ddc3173 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2382,8 +2382,8 @@ Apon      |void   |sys_term
 ApoM   |const char *|fetch_cop_label|NULLOK struct refcounted_he *const chain \
                |NULLOK STRLEN *len|NULLOK U32 *flags
 : Only used  in op.c
-xpoM   |struct refcounted_he *|store_cop_label \
-               |NULLOK struct refcounted_he *const chain|NN const char *label
+xpoM   |void|store_cop_label \
+               |NN COP *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/hv.c b/hv.c
index d29c49c..d8ba456 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -2970,16 +2970,20 @@ Perl_fetch_cop_label(pTHX_ struct refcounted_he *const chain, STRLEN *len,
     return chain->refcounted_he_data + 1;
 }
 
-/* As newSTATEOP currently gets passed plain char* labels, we will only provide
-   that interface. Once it works out how to pass in length and UTF-8 ness, this
-   function will need superseding.  */
-struct refcounted_he *
-Perl_store_cop_label(pTHX_ struct refcounted_he *const chain, const char *label)
+void
+Perl_store_cop_label(pTHX_ COP *const cop, const char *label, STRLEN len,
+                    U32 flags)
 {
     PERL_ARGS_ASSERT_STORE_COP_LABEL;
 
-    return refcounted_he_new_common(chain, ":", 1, HVrhek_PV, HVrhek_PV,
-                                   label, strlen(label));
+    if (flags & ~(SVf_UTF8))
+       Perl_croak(aTHX_ "panic: store_cop_label illegal flag bits 0x%" UVxf,
+                  (UV)flags);
+
+    cop->cop_hints_hash
+       = refcounted_he_new_common(cop->cop_hints_hash, ":", 1, HVrhek_PV,
+                                  flags & SVf_UTF8 ? HVrhek_PV_UTF8 : HVrhek_PV,
+                                  label, len);
 }
 
 /*
diff --git a/op.c b/op.c
index 433face..5ca1823 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4708,8 +4708,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        HINTS_REFCNT_UNLOCK;
     }
     if (label) {
-       cop->cop_hints_hash
-           = Perl_store_cop_label(aTHX_ cop->cop_hints_hash, label);
+       Perl_store_cop_label(aTHX_ cop, label, strlen(label), 0);
                                                     
        PL_hints |= HINT_BLOCK_SCOPE;
        /* It seems that we need to defer freeing this pointer, as other parts
diff --git a/proto.h b/proto.h
index 3e2d3dd..42a769e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6948,10 +6948,11 @@ PERL_CALLCONV void      Perl_sys_init3(int* argc, char*** argv, char*** env)
 
 PERL_CALLCONV void     Perl_sys_term(void);
 PERL_CALLCONV const char *     Perl_fetch_cop_label(pTHX_ struct refcounted_he *const chain, STRLEN *len, U32 *flags);
-PERL_CALLCONV struct refcounted_he *   Perl_store_cop_label(pTHX_ struct refcounted_he *const chain, const char *label)
+PERL_CALLCONV void     Perl_store_cop_label(pTHX_ COP *cop, const char *label, STRLEN len, U32 flags)
+                       __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_STORE_COP_LABEL       \
-       assert(label)
+       assert(cop); assert(label)
 
 
 PERL_CALLCONV int      Perl_keyword_plugin_standard(pTHX_ char* keyword_ptr, STRLEN keyword_len, OP** op_ptr)