diff options
| author | Reini Urban <rurban@x-ray.at> | 2011-06-21 07:55:56 -0500 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-07-16 18:39:57 -0700 |
| commit | 8375c93eec5677d8587491a0541d33bc206a445a (patch) | |
| tree | 37b5d2f3b947005746a3c36ab49ef807818c1ee1 | |
| parent | 2baee27b98a9b7fe8a3209fb0cb6e1ab7386dfc4 (diff) | |
| download | perl-8375c93eec5677d8587491a0541d33bc206a445a.tar.gz | |
Export store_cop_label for the perl compiler
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 21 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | hv.c | 18 |
4 files changed, 42 insertions, 2 deletions
@@ -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 @@ -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) |