Support for auto-generating private accessors. #5001
Labels
Comments
From autark@gmail.comI propose this patch so as to make private attributes user friendly - rakudo will automatically generate private accessors when you The use case is as follows: class MyClass { method sauce(MyClass $other) { say MyClass.new().sauce( MyClass.new() ); Instead of having to manually write a private accessor for $!secret, Patches attached, or can be pulled from David Ranvig, |
From autark@gmail.com0001-Add-tests-for-auto-generated-private-accessors.patchFrom e07ac0b57b6a9e2b58217354e302469d70ae8325 Mon Sep 17 00:00:00 2001
From: David Ranvig <autark@gmail.com>
Date: Tue, 5 Jan 2016 19:03:00 +0100
Subject: [PATCH] Add tests for auto-generated private accessors.
---
S12-attributes/instance.t | 90 +++++++++++++++++++++++++++++++++++++++++-
S12-introspection/attributes.t | 5 ++-
integration/weird-errors.t | 16 +-------
3 files changed, 93 insertions(+), 18 deletions(-)
diff --git a/S12-attributes/instance.t b/S12-attributes/instance.t
index 9b6b8c0..2a604e8 100644
--- a/S12-attributes/instance.t
+++ b/S12-attributes/instance.t
@@ -2,7 +2,7 @@ use v6;
use Test;
-plan 150;
+plan 169;
=begin pod
@@ -716,4 +716,92 @@ throws-like q[class RT74274 { has $!a }; my $a = RT74274.new(a => 42);
;
}
+# has $!foo declares private readonly accessor
+{
+ my class PrivateAccessor {
+ has $!secret = 42;
+ method peek() { self!secret(); }
+ method poke($overt) { self!secret = $overt; }
+ }
+
+ my $pa = PrivateAccessor.new();
+ ok(!$pa.can("secret"), 'PrivateAccessor does not have a public accessor');
+ is($pa.peek(), 42, '...but it has a private accessor');
+ dies-ok { $pa.poke(43) }, '...which is a readonly accessor';
+}
+
+# has $!foo is readonly declares private readonly accessor
+{
+ my class PrivateAccessor {
+ has $!secret is readonly = 42;
+ method peek() { self!secret(); }
+ method poke($overt) { self!secret = $overt; }
+ }
+
+ my $pa = PrivateAccessor.new();
+ ok(!$pa.can("secret"), 'PrivateAccessor does not have a public accessor');
+ is($pa.peek(), 42, '...but it has a private accessor');
+ dies-ok { $pa.poke(43) }, '...which is a readonly accessor';
+}
+
+# has $!foo is rw declares private rw accessor
+{
+ my class PrivateAccessor {
+ has $!secret is rw = 42;
+ method peek() { self!secret(); }
+ method poke($overt) { self!secret = $overt; }
+ }
+
+ my $pa = PrivateAccessor.new();
+ ok(!$pa.can("secret"), 'PrivateAccessor does not have a public accessor');
+ is($pa.peek(), 42, '...but it has a private accessor');
+ lives-ok { $pa.poke(43) }, '...which is a rw accessor';
+ is($pa.peek(), 43, '...that works');
+}
+
+# has $!foo does not declare a private accessor if there is already one defined
+{
+ my class PrivateAccessor {
+ has $!secret = 42;
+ method !secret() { $!secret + 1; }
+ method peek() { self!secret(); }
+ }
+
+ my $pa = PrivateAccessor.new();
+ ok(!$pa.can("secret"), 'PrivateAccessor does not have a public accessor');
+ is($pa.peek(), 43, '...the private accessor is not auto-generated');
+}
+
+# has $!foo does declare a private accessor if there is a public one defined
+{
+ my class PrivateAccessor {
+ has $!secret = 42;
+ method secret() { $!secret + 1; }
+ method peek() { self!secret(); }
+ }
+
+ my $pa = PrivateAccessor.new();
+ ok($pa.can("secret"), 'PrivateAccessor does have a public accessor');
+ is($pa.secret(), 43, '...but it is not auto-generated');
+ is($pa.peek(), 42, '...the private accessor is auto-generated');
+}
+
+# Can peruse private accessor within class for objects other than invocant
+{
+ my class PrivateAccessor {
+ has $!secret is rw;
+ submethod BUILD(:$!secret) {}
+ method sauce(PrivateAccessor $other) { self!secret() + $other!secret() }
+ method swap-secrets(PrivateAccessor $other) { (self!secret, $other!secret) = ($other!secret, self!secret) }
+ method peek() { $!secret }
+ }
+
+ my $secret1 = PrivateAccessor.new(:secret(5));
+ my $secret2 = PrivateAccessor.new(:secret(9));
+ is($secret1.sauce($secret2), 14, 'PrivateAccessor can access private data for other than invocant');
+ lives-ok { $secret1.swap-secrets($secret2) }, '...and can modify the data as well since it is declared as rw';
+ is($secret1.peek(), 9, '...secret1 contains secret2');
+ is($secret2.peek(), 5, '...and secret2 contains secret1');
+}
+
# vim: ft=perl6
diff --git a/S12-introspection/attributes.t b/S12-introspection/attributes.t
index 3247476..4f3eabe 100644
--- a/S12-introspection/attributes.t
+++ b/S12-introspection/attributes.t
@@ -2,7 +2,7 @@ use v6;
use Test;
-plan 30;
+plan 31;
=begin pod
@@ -34,7 +34,8 @@ ok !@attrs[0].readonly, 'first attribute is not readonly';
is @attrs[1].name, '$!b', 'second attribute had correct name';
is @attrs[1].type.gist, '(Int)', 'second attribute had correct type';
-is @attrs[1].has_accessor, False, 'second attribute has no accessor';
+is @attrs[1].has_accessor, False, 'second attribute has no public accessor';
+is @attrs[1].has_private_accessor, True, 'second attribute has private accessor';
ok @attrs[1].build ~~ Code, 'second attribute has build block';
is @attrs[1].build().(C, $_), 42,
'second attribute build block gives expected value';
diff --git a/integration/weird-errors.t b/integration/weird-errors.t
index 6ea8f0c..5d43589 100644
--- a/integration/weird-errors.t
+++ b/integration/weird-errors.t
@@ -3,7 +3,7 @@ use Test;
use lib 't/spec/packages';
use Test::Util;
-plan 20;
+plan 19;
# this used to segfault in rakudo
#?niecza skip 'todo'
@@ -131,20 +131,6 @@ is_run '{;}',
},
'empty code block does not crash (used to do that on JVM)';
-# RT #125227
-{
- my $code = q:to'--END--';
- class C {
- has $!x is rw;
- }
- --END--
- is_run(
- $code,
- { status => 0, err => -> $o { $o ~~ /useless/ && $o ~~ /':2'/ } },
- 'useless use of is rw reported on meaningful line'
- );
-}
-
{
is_run('(1,2,3).map({ die "oh noes" })',
{
--
2.1.4
|
From autark@gmail.com0001-Implement-support-for-auto-generating-private-access.patchFrom 3095f286791037672b3377099f54ed2cfccc4919 Mon Sep 17 00:00:00 2001
From: David Ranvig <autark@gmail.com>
Date: Tue, 5 Jan 2016 18:57:26 +0100
Subject: [PATCH] Implement support for auto-generating private accessors.
'has $!foo' will auto-generate accessors in the same manner as 'has
$.foo' does, but the resulting accessor will be private. No accessor
is auto-generated should a privatly defined method with the same name
already exist. 'is rw' and 'is readonly' now makes sense for private
attributes as well.
---
src/Perl6/Actions.nqp | 1 +
src/Perl6/Metamodel/BOOTSTRAP.nqp | 9 ++++++++-
src/Perl6/Metamodel/EnumHOW.nqp | 1 +
src/Perl6/Metamodel/PrivateMethodContainer.nqp | 6 ++++++
src/core/Attribute.pm | 14 ++++++++++----
src/core/traits.pm | 4 ++--
6 files changed, 28 insertions(+), 7 deletions(-)
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
index d659aa6..0d0e0dd 100644
--- a/src/Perl6/Actions.nqp
+++ b/src/Perl6/Actions.nqp
@@ -3102,6 +3102,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
my %config := hash(
name => $attrname,
has_accessor => $twigil eq '.',
+ has_private_accessor => $twigil eq '!',
container_descriptor => $descriptor,
type => %cont_info<bind_constraint>,
package => $*W.find_symbol(['$?CLASS']));
diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp
index 8964f56..23f2099 100644
--- a/src/Perl6/Metamodel/BOOTSTRAP.nqp
+++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp
@@ -1104,6 +1104,7 @@ BEGIN {
# has str $!name;
# has int $!rw;
# has int $!has_accessor;
+ # has int $!has_private_accessor;
# has Mu $!type;
# has Mu $!container_descriptor;
# has Mu $!auto_viv_container;
@@ -1119,6 +1120,7 @@ BEGIN {
Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!ro>, :type(int), :package(Attribute)));
Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!required>, :type(int), :package(Attribute)));
Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!has_accessor>, :type(int), :package(Attribute)));
+ Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!has_private_accessor>, :type(int), :package(Attribute)));
Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!type>, :type(Mu), :package(Attribute)));
Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!container_descriptor>, :type(Mu), :package(Attribute)));
Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!auto_viv_container>, :type(Mu), :package(Attribute)));
@@ -1134,11 +1136,12 @@ BEGIN {
# Need new and accessor methods for Attribute in here for now.
Attribute.HOW.add_method(Attribute, 'new',
nqp::getstaticcode(sub ($self, :$name!, :$type!, :$package!, :$inlined = 0, :$has_accessor,
- :$positional_delegate = 0, :$associative_delegate = 0, *%other) {
+ :$has_private_accessor, :$positional_delegate = 0, :$associative_delegate = 0, *%other) {
my $attr := nqp::create($self);
nqp::bindattr_s($attr, Attribute, '$!name', $name);
nqp::bindattr($attr, Attribute, '$!type', nqp::decont($type));
nqp::bindattr_i($attr, Attribute, '$!has_accessor', $has_accessor);
+ nqp::bindattr_i($attr, Attribute, '$!has_private_accessor', $has_private_accessor);
nqp::bindattr($attr, Attribute, '$!package', $package);
nqp::bindattr_i($attr, Attribute, '$!inlined', $inlined);
if nqp::existskey(%other, 'container_descriptor') {
@@ -1188,6 +1191,10 @@ BEGIN {
nqp::p6bool(nqp::getattr_i(nqp::decont($self),
Attribute, '$!has_accessor'));
}));
+ Attribute.HOW.add_method(Attribute, 'has_private_accessor', nqp::getstaticcode(sub ($self) {
+ nqp::p6bool(nqp::getattr_i(nqp::decont($self),
+ Attribute, '$!has_private_accessor'));
+ }));
Attribute.HOW.add_method(Attribute, 'rw', nqp::getstaticcode(sub ($self) {
nqp::p6bool(nqp::getattr_i(nqp::decont($self),
Attribute, '$!rw'));
diff --git a/src/Perl6/Metamodel/EnumHOW.nqp b/src/Perl6/Metamodel/EnumHOW.nqp
index c3a735d..5b5e017 100644
--- a/src/Perl6/Metamodel/EnumHOW.nqp
+++ b/src/Perl6/Metamodel/EnumHOW.nqp
@@ -8,6 +8,7 @@ class Perl6::Metamodel::EnumHOW
does Perl6::Metamodel::Stashing
does Perl6::Metamodel::AttributeContainer
does Perl6::Metamodel::MethodContainer
+ does Perl6::Metamodel::PrivateMethodContainer
does Perl6::Metamodel::MultiMethodContainer
does Perl6::Metamodel::RoleContainer
does Perl6::Metamodel::BaseType
diff --git a/src/Perl6/Metamodel/PrivateMethodContainer.nqp b/src/Perl6/Metamodel/PrivateMethodContainer.nqp
index d201e9d..196535c 100644
--- a/src/Perl6/Metamodel/PrivateMethodContainer.nqp
+++ b/src/Perl6/Metamodel/PrivateMethodContainer.nqp
@@ -21,4 +21,10 @@ role Perl6::Metamodel::PrivateMethodContainer {
%!private_methods{$name} !!
nqp::null()
}
+
+ # Checks if this package (not its parents) declares a given
+ # private method.
+ method declares_private_method($obj, $name) {
+ %!private_methods{$name} ?? 1 !! 0;
+ }
}
diff --git a/src/core/Attribute.pm b/src/core/Attribute.pm
index 994718c..0c4f48e 100644
--- a/src/core/Attribute.pm
+++ b/src/core/Attribute.pm
@@ -3,6 +3,7 @@ my class Attribute { # declared in BOOTSTRAP
# has str $!name;
# has int $!rw;
# has int $!has_accessor;
+ # has int $!has_private_accessor;
# has Mu $!type;
# has Mu $!container_descriptor;
# has Mu $!auto_viv_container;
@@ -17,10 +18,11 @@ my class Attribute { # declared in BOOTSTRAP
method compose(Mu $package) {
# Generate accessor method, if we're meant to have one.
- if self.has_accessor {
+ if self.has_accessor || self.has_private_accessor {
my str $name = nqp::unbox_s(self.name);
- my $meth_name := nqp::substr($name, 2);
- unless $package.^declares_method($meth_name) {
+ my $meth_name := nqp::substr($name, 2);
+ my $has_method = self.has_private_accessor ?? $package.^declares_private_method($meth_name) !! $package.^declares_method($meth_name);
+ unless $has_method {
my $dcpkg := nqp::decont($package);
my $meth;
my int $attr_type = nqp::objprimspec($!type);
@@ -77,7 +79,11 @@ my class Attribute { # declared in BOOTSTRAP
}
}
$meth.set_name($meth_name);
- $package.^add_method($meth_name, $meth);
+ if self.has_private_accessor {
+ $package.^add_private_method($meth_name, $meth);
+ } else {
+ $package.^add_method($meth_name, $meth);
+ }
}
}
diff --git a/src/core/traits.pm b/src/core/traits.pm
index e770843..da2cd24 100644
--- a/src/core/traits.pm
+++ b/src/core/traits.pm
@@ -74,11 +74,11 @@ multi sub trait_mod:<is>(Attribute:D $attr, |c ) {
}
multi sub trait_mod:<is>(Attribute:D $attr, :$rw!) {
$attr.set_rw();
- warn "useless use of 'is rw' on $attr.name()" unless $attr.has_accessor;
+ warn "useless use of 'is rw' on $attr.name()" unless $attr.has_accessor || $attr.has_private_accessor;
}
multi sub trait_mod:<is>(Attribute:D $attr, :$readonly!) {
$attr.set_readonly();
- warn "useless use of 'is readonly' on $attr.name()" unless $attr.has_accessor;
+ warn "useless use of 'is readonly' on $attr.name()" unless $attr.has_accessor || $attr.has_private_accessor;
}
multi sub trait_mod:<is>(Attribute $attr, :$required!) {
$attr.set_required();
--
2.1.4
|
From @lizmat
Yes, but at what overhead? I’d rather see a module space solution in the form of a trait: class MyClass { In most cases when I’v created classes, I want private attributes to be private. If you really need to be able to access them for objects other than self, or from the outside, either make it an attribute with an accessor, or create your own accessor method. To make it DRY, a trait would be best! my 2c worth Liz |
|
The RT System itself - Status changed from 'new' to 'open' |
From @cokeSorry for the delay in responding. This patch no long applies cleanly (though much of it does). If you would still like to pursue this issue, please submit a PR to the rakudo github project, which will make it easier to review and apply. -- |
|
@coke - Status changed from 'open' to 'rejected' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#127172 (status was 'rejected')
Searchable as RT127172$
The text was updated successfully, but these errors were encountered: