From bd9f07bb63ab85ef6d4248a6be975b55c89648da Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Wed, 1 Nov 2017 20:28:44 -0700 Subject: [PATCH 1/3] Fix ->methods to work with constants (and perl 5.28) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Constants created by ‘use constant’ are store in the stash as scalar references, whereas constants created by sub foo () { 42 } are stored as subs-in-globs. Before this commit, $class->mc->methods would return the latter kind of constant, and skip the former, unless someone at some point hap- pened to take a reference to one of the former before ->mc->methods got called. If we are going to be poking around in stashes like this, then we do need to be are of what kind of stuff perl sneaks in there. Constants should not be treated inconsistently because of the internal rep- resentation. Also, if I get my way, most subs will start to be stored in stashes as simple coderefs (which saves LOTS of memory), in perl 5.28. This commit kills two stones with one bird: it handles constants cor- rectly (an existing bug) and gets ready for the optimization that I am almost certain will make it into perl 5.28. We don’t need new tests for the latter, because my optimization makes existing tests fail. (For more info on the optimization, see and also .) --- lib/perl5i/2/Meta.pm | 14 ++++++++++++-- t/Meta/methods.t | 8 ++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/lib/perl5i/2/Meta.pm b/lib/perl5i/2/Meta.pm index f0d34cf..efdb3a8 100644 --- a/lib/perl5i/2/Meta.pm +++ b/lib/perl5i/2/Meta.pm @@ -70,8 +70,18 @@ sub methods { my $sym_table = $class->mc->symbol_table; for my $name (keys %$sym_table) { my $glob = $sym_table->{$name}; - next unless ref \$glob eq "GLOB"; - next unless my $code = *{$glob}{CODE}; + my $code; + if (ref $glob) { + if (ref $glob ne 'CODE') { # constant + $all_methods{$name} = $class; + next; + } + $code = $glob; + } + else { + next unless ref \$glob eq "GLOB"; + next unless $code = *{$glob}{CODE}; + } my $sig = $code->signature; next if $sig and !$sig->is_method; $all_methods{$name} = $class; diff --git a/t/Meta/methods.t b/t/Meta/methods.t index f515409..cf8e49d 100644 --- a/t/Meta/methods.t +++ b/t/Meta/methods.t @@ -172,4 +172,12 @@ note "func gets filtered out of methods list"; { can_ok( $class, 'as_func'); # sanity check } +note "constants count as methods, regardless of how they came to be"; { + { package Foo; use constant a => 1; sub b () { 2 } } + is_deeply + scalar "Foo"->mc->methods->sort, + scalar [qw[ a b ]]->sort, + "constants count as methods"; +} + done_testing; From f7ceb614317be99d14ab25fe16349426364be15d Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 12 Nov 2017 17:13:32 -0800 Subject: [PATCH 2/3] Test explicitly reified constant MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In 5.28, sub b(){2} now creates a shorthand constant the way ‘use constant’ has done since 5.10. So test another, reified constant sub as well. --- lib/perl5i/2/MethodInfo.pm | 0 t/Meta/methods.t | 9 +++++++-- 2 files changed, 7 insertions(+), 2 deletions(-) create mode 100644 lib/perl5i/2/MethodInfo.pm diff --git a/lib/perl5i/2/MethodInfo.pm b/lib/perl5i/2/MethodInfo.pm new file mode 100644 index 0000000..e69de29 diff --git a/t/Meta/methods.t b/t/Meta/methods.t index cf8e49d..b48d8fd 100644 --- a/t/Meta/methods.t +++ b/t/Meta/methods.t @@ -173,10 +173,15 @@ note "func gets filtered out of methods list"; { } note "constants count as methods, regardless of how they came to be"; { - { package Foo; use constant a => 1; sub b () { 2 } } + { + package Foo; + use constant a => 1; + sub b () { 2 } + sub c () { 3 } () = \&c; + } is_deeply scalar "Foo"->mc->methods->sort, - scalar [qw[ a b ]]->sort, + scalar [qw[ a b c ]]->sort, "constants count as methods"; } From 316a2ca6983dd863fb8e0818fbd2e95899ad144b Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 12 Nov 2017 17:14:48 -0800 Subject: [PATCH 3/3] Make ->mc->methods return an object This is just a proof of concept, with one method showing how this could be implemented. --- MANIFEST | 1 + lib/perl5i/2/CODE.pm | 12 ++++++++++++ lib/perl5i/2/Meta.pm | 15 ++++++++++++--- lib/perl5i/2/MethodInfo.pm | 28 ++++++++++++++++++++++++++++ 4 files changed, 53 insertions(+), 3 deletions(-) diff --git a/MANIFEST b/MANIFEST index b9f4d35..9f21b54 100644 --- a/MANIFEST +++ b/MANIFEST @@ -39,6 +39,7 @@ lib/perl5i/2/HASH.pm lib/perl5i/2/Meta.pm lib/perl5i/2/Meta/Class.pm lib/perl5i/2/Meta/Instance.pm +lib/perl5i/2/MethodInfo.pm lib/perl5i/2/RequireMessage.pm lib/perl5i/2/SCALAR.pm lib/perl5i/2/Signature.pm diff --git a/lib/perl5i/2/CODE.pm b/lib/perl5i/2/CODE.pm index b32184d..8740678 100644 --- a/lib/perl5i/2/CODE.pm +++ b/lib/perl5i/2/CODE.pm @@ -17,4 +17,16 @@ sub signature { return $Signatures{$_[0]}; } +sub is_constant { + require B; + # Use eval to take advantage of compile-time constants. + eval ' + no warnings "redefine"; + sub is_constant { + not not B::svref_2object($_[0])->CvFLAGS & B::CVf_CONST + } + '; + goto &is_constant; +} + 1; diff --git a/lib/perl5i/2/Meta.pm b/lib/perl5i/2/Meta.pm index efdb3a8..589ecaa 100644 --- a/lib/perl5i/2/Meta.pm +++ b/lib/perl5i/2/Meta.pm @@ -47,6 +47,8 @@ sub linear_isa { } sub methods { + require perl5i::2::MethodInfo; + my $self = shift; my $opts = shift // {}; my $top = $self->class; @@ -73,7 +75,9 @@ sub methods { my $code; if (ref $glob) { if (ref $glob ne 'CODE') { # constant - $all_methods{$name} = $class; + $all_methods{$name} = + perl5i::2::MethodInfo->new($class, $name, + \$sym_table->{$name}); next; } $code = $glob; @@ -84,11 +88,16 @@ sub methods { } my $sig = $code->signature; next if $sig and !$sig->is_method; - $all_methods{$name} = $class; + $all_methods{$name} = + perl5i::2::MethodInfo->new($class, $name, + \$sym_table->{$name}); } } - return wantarray ? keys %all_methods : [keys %all_methods]; + my @ret = map perl5i::2::MethodInfo->new($_, $all_methods{$_}), + keys %all_methods; + + return wantarray ? values %all_methods : [values %all_methods]; } sub symbol_table { diff --git a/lib/perl5i/2/MethodInfo.pm b/lib/perl5i/2/MethodInfo.pm index e69de29..2fc8e17 100644 --- a/lib/perl5i/2/MethodInfo.pm +++ b/lib/perl5i/2/MethodInfo.pm @@ -0,0 +1,28 @@ +package perl5i::2::MethodInfo; + +use strict; +use warnings; +use 5.010_000; +use perl5i::2::autobox; +use overload '""' => sub { shift->{name} }, fallback => 1; + +sub new { + my ($this_class, $that_class, $meth, $stashelem) = @_; + return bless { name => $meth, + package => $that_class, + stashelem => $stashelem }, $this_class; +} + +# Delegate these methods to the CODE autobox class. +for my $method (qw( is_constant )) { + no strict 'refs'; + *$method = sub { + my $self = shift; + my $sub = ref $self->{stashelem} eq 'GLOB' + ? *{$self->{stashelem}}{CODE} + : *{"$self->{package}:\:$self->{name}"}{CODE}; # reify + $sub->$method + } +} + +1;