Skip to content

Commit

Permalink
[pad] pad_find_my_symbol_sv - pad_findmy_sv alternative with explicit…
Browse files Browse the repository at this point in the history 
… symbol table
  • Loading branch information
Branislav Zahradník committed Dec 10, 2024
1 parent e41bdd0 commit 8dc2fc1
Show file tree
Hide file tree
Showing 6 changed files with 58 additions and 9 deletions.
4 changes: 4 additions & 0 deletions embed.fnc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 \
Expand Down
1 change: 1 addition & 0 deletions embed.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
5 changes: 5 additions & 0 deletions ext/XS-APItest/APItest.xs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 *
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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:
Expand Down
32 changes: 23 additions & 9 deletions ext/XS-APItest/t/pad_scalar.t
View file
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
);

Expand All @@ -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";
Expand All @@ -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($) {
Expand All @@ -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
Expand All @@ -65,13 +71,15 @@ 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 ());
is pad_scalar (PAD_FINDMY_PVN, "bar"), "wobble", $prefix . q (Global 'my $bar'; pad_findmy_pvn ());
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);
Expand All @@ -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;
Expand All @@ -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();
Expand All @@ -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);

Expand All @@ -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;
20 changes: 20 additions & 0 deletions pad.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1038,6 +1038,7 @@ C<flags> 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<pad_findmy_pv> but with explicit symbol table parameter.
Expand All @@ -1052,6 +1053,10 @@ Similar to C<pad_findmy_pv> 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
*/

Expand Down Expand Up @@ -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
Expand Down
5 changes: 5 additions & 0 deletions proto.h
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 8dc2fc1

Please sign in to comment.