diff --git a/embed.fnc b/embed.fnc index f06ff1cc4c63..19ab0a69b803 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2510,6 +2510,10 @@ Adp |PADOFFSET|pad_find_my_symbol_pvn \ |NN const char *namepv \ |STRLEN namelen \ |U32 flags +Adp |PADOFFSET|pad_find_my_symbol_sv \ + |perl_symbol_table_id find_symbol_table \ + |NN SV *name \ + |U32 flags dp |void |pad_fixup_inner_anons \ |NN PADLIST *padlist \ |NN CV *old_cv \ diff --git a/embed.h b/embed.h index fda0efa1ad9f..f2783df55cce 100644 --- a/embed.h +++ b/embed.h @@ -514,6 +514,7 @@ # define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b) # define pad_find_my_symbol_pv(a,b,c) Perl_pad_find_my_symbol_pv(aTHX_ a,b,c) # define pad_find_my_symbol_pvn(a,b,c,d) Perl_pad_find_my_symbol_pvn(aTHX_ a,b,c,d) +# define pad_find_my_symbol_sv(a,b,c) Perl_pad_find_my_symbol_sv(aTHX_ a,b,c) # define pad_findmy_pv(a,b) Perl_pad_findmy_pv(aTHX_ a,b) # define pad_findmy_pvn(a,b,c) Perl_pad_findmy_pvn(aTHX_ a,b,c) # define pad_findmy_sv(a,b) Perl_pad_findmy_sv(aTHX_ a,b) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 3977577c623a..c6f9fcebba94 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -794,6 +794,7 @@ enum Pad_Find_Method { PAD_FIND_MY_SYMBOL_FOO, PAD_FIND_MY_SYMBOL_PV, PAD_FIND_MY_SYMBOL_PVN, + PAD_FIND_MY_SYMBOL_SV, }; STATIC OP * @@ -851,6 +852,9 @@ THX_ck_entersub_pad_scalar(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) padoff = pad_find_my_symbol_pvn (Perl_Symbol_Table_Scalar, namepv, namelen, SvUTF8(a1)); break; } + case PAD_FIND_MY_SYMBOL_SV: { + padoff = pad_find_my_symbol_sv (Perl_Symbol_Table_Scalar, a1, 0); + } break; default: croak("bad type value for pad_scalar()"); } op_free(entersubop); @@ -4388,6 +4392,7 @@ BOOT: EXPORT_ENUM (stash, PAD_FIND_MY_SYMBOL_FOO); EXPORT_ENUM (stash, PAD_FIND_MY_SYMBOL_PV); EXPORT_ENUM (stash, PAD_FIND_MY_SYMBOL_PVN); + EXPORT_ENUM (stash, PAD_FIND_MY_SYMBOL_SV); } BOOT: diff --git a/ext/XS-APItest/t/pad_scalar.t b/ext/XS-APItest/t/pad_scalar.t index 89ceb10eb0ea..b7bf21e29006 100644 --- a/ext/XS-APItest/t/pad_scalar.t +++ b/ext/XS-APItest/t/pad_scalar.t @@ -1,7 +1,7 @@ use warnings; use strict; -use Test::More tests => 113; +use Test::More tests => 139; use XS::APItest qw ( PAD_FINDMY_FOO @@ -11,6 +11,7 @@ use XS::APItest qw ( PAD_FIND_MY_SYMBOL_FOO PAD_FIND_MY_SYMBOL_PV PAD_FIND_MY_SYMBOL_PVN + PAD_FIND_MY_SYMBOL_SV pad_scalar ); @@ -21,12 +22,14 @@ is pad_scalar (PAD_FINDMY_FOO, "foo"), "NOT_IN_PAD", q (undeclared '$foo is pad_scalar (PAD_FIND_MY_SYMBOL_FOO, "foo"), "NOT_IN_PAD", q (undeclared '$foo'; pad_find_my_symbol_pvs ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PV, "foo"), "NOT_IN_PAD", q (undeclared '$foo'; pad_find_my_symbol_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "foo"), "NOT_IN_PAD", q (undeclared '$foo'; pad_find_my_symbol_pvn ()); +is pad_scalar (PAD_FIND_MY_SYMBOL_SV, "foo"), "NOT_IN_PAD", q (undeclared '$foo'; pad_find_my_symbol_sv ()); is pad_scalar (PAD_FINDMY_SV, "bar"), "NOT_IN_PAD", q (undeclared '$bar'; pad_findmy_sv ()); is pad_scalar (PAD_FINDMY_PVN, "bar"), "NOT_IN_PAD", q (undeclared '$bar'; pad_findmy_pvn ()); is pad_scalar (PAD_FINDMY_PV, "bar"), "NOT_IN_PAD", q (undeclared '$bar'; pad_findmy_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PV, "bar"), "NOT_IN_PAD", q (undeclared '$bar'; pad_find_my_symbol_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "bar"), "NOT_IN_PAD", q (undeclared '$bar'; pad_find_my_symbol_pvn ()); +is pad_scalar (PAD_FIND_MY_SYMBOL_SV, "bar"), "NOT_IN_PAD", q (undeclared '$bar'; pad_find_my_symbol_sv ()); our $foo = "wibble"; my $bar = "wobble"; @@ -37,12 +40,14 @@ is pad_scalar (PAD_FINDMY_FOO, "foo"), "NOT_MY", q ('our $foo'; pad_find is pad_scalar (PAD_FIND_MY_SYMBOL_FOO, "foo"), "NOT_MY", q ('our $foo'; pad_find_my_symbol_pvs ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PV, "foo"), "NOT_MY", q ('our $foo'; pad_find_my_symbol_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "foo"), "NOT_MY", q ('our $foo'; pad_find_my_symbol_pvn ()); +is pad_scalar (PAD_FIND_MY_SYMBOL_SV, "foo"), "NOT_MY", q ('our $foo'; pad_find_my_symbol_sv ()); is pad_scalar (PAD_FINDMY_SV, "bar"), "wobble", q ('my $bar'; pad_findmy_sv ()); is pad_scalar (PAD_FINDMY_PVN, "bar"), "wobble", q ('my $bar'; pad_findmy_pvn ()); is pad_scalar (PAD_FINDMY_PV, "bar"), "wobble", q ('my $bar'; pad_findmy_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PV, "bar"), "wobble", q ('my $bar'; pad_find_my_symbol_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "bar"), "wobble", q ('my $bar'; pad_find_my_symbol_pvn ()); +is pad_scalar (PAD_FIND_MY_SYMBOL_SV, "bar"), "wobble", q ('my $bar'; pad_find_my_symbol_sv ()); sub aa($); sub aa($) { @@ -57,6 +62,7 @@ sub aa($) { ok \pad_scalar (PAD_FINDMY_PV, "xyz") == \$xyz, $prefix . q (private variable; pad_findmy_pv ()); ok \pad_scalar (PAD_FIND_MY_SYMBOL_PV, "xyz") == \$xyz, $prefix . q (private variable; pad_find_my_symbol_pv ()); ok \pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "xyz") == \$xyz, $prefix . q (private variable; pad_find_my_symbol_pvn ()); + ok \pad_scalar (PAD_FIND_MY_SYMBOL_SV, "xyz") == \$xyz, $prefix . q (private variable; pad_find_my_symbol_sv ()); if ($_[0]) { aa(0); # recursive call @@ -65,6 +71,7 @@ sub aa($) { ok \pad_scalar (PAD_FINDMY_PV, "xyz") == \$xyz, q (private variable (after recursive call); pad_findmy_pv ()); ok \pad_scalar (PAD_FIND_MY_SYMBOL_PV, "xyz") == \$xyz, q (private variable (after recursive call); pad_find_my_symbol_pv ()); ok \pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "xyz") == \$xyz, q (private variable (after recursive call); pad_find_my_symbol_pvn ()); + ok \pad_scalar (PAD_FIND_MY_SYMBOL_SV, "xyz") == \$xyz, q (private variable (after recursive call); pad_find_my_symbol_sv ()); } is pad_scalar (PAD_FINDMY_SV, "bar"), "wobble", $prefix . q (Global 'my $bar'; pad_findmy_sv ()); @@ -72,6 +79,7 @@ sub aa($) { is pad_scalar (PAD_FINDMY_PV, "bar"), "wobble", $prefix . q (Global 'my $bar'; pad_findmy_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PV, "bar"), "wobble", $prefix . q (Global 'my $bar'; pad_find_my_symbol_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "bar"), "wobble", $prefix . q (Global 'my $bar'; pad_find_my_symbol_pvn ()); + is pad_scalar (PAD_FIND_MY_SYMBOL_SV, "bar"), "wobble", $prefix . q (Global 'my $bar'; pad_find_my_symbol_sv ()); } aa(1); @@ -82,14 +90,15 @@ sub bb() { my $counter = 0; my $foo = \$counter; return sub { - ok pad_scalar (PAD_FINDMY_SV, "foo") == \pad_scalar (PAD_FINDMY_SV, "counter"); - ok pad_scalar (PAD_FINDMY_PVN, "foo") == \pad_scalar (PAD_FINDMY_SV, "counter"); - ok pad_scalar (PAD_FINDMY_PV, "foo") == \pad_scalar (PAD_FINDMY_SV, "counter"); - ok pad_scalar (PAD_FINDMY_FOO, "foo") == \pad_scalar (PAD_FINDMY_SV, "counter"); - ok pad_scalar (PAD_FIND_MY_SYMBOL_PV, "foo") == \pad_scalar (PAD_FINDMY_SV, "counter"); - ok pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "foo") == \pad_scalar (PAD_FINDMY_SV, "counter"); + ok pad_scalar (PAD_FINDMY_SV, "foo") == \pad_scalar(PAD_FINDMY_SV, "counter"); + ok pad_scalar (PAD_FINDMY_PVN, "foo") == \pad_scalar(PAD_FINDMY_SV, "counter"); + ok pad_scalar (PAD_FINDMY_PV, "foo") == \pad_scalar(PAD_FINDMY_SV, "counter"); + ok pad_scalar (PAD_FINDMY_FOO, "foo") == \pad_scalar(PAD_FINDMY_SV, "counter"); + ok pad_scalar (PAD_FIND_MY_SYMBOL_PV, "foo") == \pad_scalar(PAD_FINDMY_SV, "counter"); + ok pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "foo") == \pad_scalar(PAD_FINDMY_SV, "counter"); + ok pad_scalar (PAD_FIND_MY_SYMBOL_SV, "foo") == \pad_scalar(PAD_FINDMY_SV, "counter"); - my $modulus = pad_scalar (PAD_FINDMY_SV, "counter") % 5; + my $modulus = pad_scalar (PAD_FINDMY_SV, "counter") % 6; return pad_scalar (PAD_FINDMY_SV, "counter")++ if $modulus == 0; @@ -103,8 +112,11 @@ sub bb() { return pad_scalar (PAD_FIND_MY_SYMBOL_PV, "counter")++ if $modulus == 3; + return pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "counter")++ + if $modulus == 4; + $all_increment_called = 1; - return pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "counter")++; + return pad_scalar (PAD_FIND_MY_SYMBOL_SV, "counter")++; }; } my $a = bb(); @@ -117,6 +129,7 @@ is $b->(), 0; is $b->(), 1; is $a->(), 4; is $b->(), 2; +is $a->(), 5; ok $all_increment_called, q (all pad scalar methods called for increment); @@ -127,5 +140,6 @@ is pad_scalar (PAD_FINDMY_FOO, "foo"), "NOT_MY", q ('my $foo' still unde is pad_scalar (PAD_FIND_MY_SYMBOL_FOO, "foo"), "NOT_MY", q ('my $foo' still undeclared; pad_find_my_symbol_pvs ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PV, "foo"), "NOT_MY", q ('my $foo' still undeclared; pad_find_my_symbol_pv ()); is pad_scalar (PAD_FIND_MY_SYMBOL_PVN, "foo"), "NOT_MY", q ('my $foo' still undeclared; pad_find_my_symbol_pvn ()); +is pad_scalar (PAD_FIND_MY_SYMBOL_SV, "foo"), "NOT_MY", q ('my $foo' still undeclared; pad_find_my_symbol_sv ()); 1; diff --git a/pad.c b/pad.c index 594e2acc276e..47a298dd6235 100644 --- a/pad.c +++ b/pad.c @@ -1038,6 +1038,7 @@ C is reserved and must be zero. =for apidoc pad_find_my_symbol_pv =for apidoc_item pad_find_my_symbol_pvn =for apidoc_item pad_find_my_symbol_pvs +=for apidoc_item pad_find_my_symbol_sv Similar to C but with explicit symbol table parameter. @@ -1052,6 +1053,10 @@ Similar to C but with explicit symbol table parameter. pad_findmy_pvs ("$self", 0); pad_find_my_symbol_pvs (Perl_Symbol_Scalar, "self", 0); + // sv (string) means SV * with context "string" + pad_findmy_sv (sv ("$self"), 0); + pad_find_my_symbol_pvs (Perl_Symbol_Scalar, sv ("self"), 0); + =cut */ @@ -1147,6 +1152,21 @@ Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags) return pad_find_my_symbol_pvn (*namepv, namepv + 1, namelen - 1, flags); } +PADOFFSET +Perl_pad_find_my_symbol_sv( + pTHX_ + perl_symbol_table_id find_symbol_table, + SV * name, + U32 flags +) +{ + char *namepv; + STRLEN namelen; + PERL_ARGS_ASSERT_PAD_FIND_MY_SYMBOL_SV; + namepv = SvPVutf8(name, namelen); + return pad_find_my_symbol_pvn (find_symbol_table, namepv, namelen, flags); +} + /* =for apidoc find_rundefsv diff --git a/proto.h b/proto.h index e87057fc538f..9d69cc540312 100644 --- a/proto.h +++ b/proto.h @@ -3457,6 +3457,11 @@ Perl_pad_find_my_symbol_pvn(pTHX_ perl_symbol_table_id find_symbol_table, const #define PERL_ARGS_ASSERT_PAD_FIND_MY_SYMBOL_PVN \ assert(namepv) +PERL_CALLCONV PADOFFSET +Perl_pad_find_my_symbol_sv(pTHX_ perl_symbol_table_id find_symbol_table, SV *name, U32 flags); +#define PERL_ARGS_ASSERT_PAD_FIND_MY_SYMBOL_SV \ + assert(name) + PERL_CALLCONV PADOFFSET Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags); #define PERL_ARGS_ASSERT_PAD_FINDMY_PV \