diff options
| author | Reini Urban <rurban@x-ray.at> | 2011-04-12 14:14:01 +0200 |
|---|---|---|
| committer | Tony Cook <tony@develop-help.com> | 2011-05-11 21:29:15 +1000 |
| commit | 55c07be0fc779bfdf6576b3b6c1f06730ddeb732 (patch) | |
| tree | ac1447cd9a993f02a3cbd8a26197468e770d57f6 | |
| parent | 3877b8687a9b2c100cf233dee15e05d7bd899882 (diff) | |
| download | perl-55c07be0fc779bfdf6576b3b6c1f06730ddeb732.tar.gz | |
Export store_cop_label for the perl compiler
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 20 | ||||
| -rw-r--r-- | ext/XS-APItest/t/coplabel.t | 10 | ||||
| -rwxr-xr-x[-rw-r--r--] | global.sym | 0 | ||||
| -rw-r--r-- | hv.c | 18 |
5 files changed, 50 insertions, 2 deletions
@@ -2442,8 +2442,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 +EXpoM |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 4fa4e1ec63..ae118eed6b 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -2348,6 +2348,26 @@ 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"); + Perl_store_cop_label(aTHX_ cop, "foä", 3, 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/ext/XS-APItest/t/coplabel.t b/ext/XS-APItest/t/coplabel.t new file mode 100644 index 0000000000..8f0e0e3970 --- /dev/null +++ b/ext/XS-APItest/t/coplabel.t @@ -0,0 +1,10 @@ +use warnings; +use strict; +use Test::More tests => 1; + +use XS::APItest; + +XS::APItest::test_coplabel(); +ok 1; + +1; diff --git a/global.sym b/global.sym index 89fb825745..89fb825745 100644..100755 --- a/global.sym +++ b/global.sym @@ -3396,6 +3396,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 * @@ -3432,6 +3441,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) |