# New Ticket Created by David
# Please include the string: [perl #127172]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/Ticket/Display.html?id=127172 >
I propose this patch so as to make private attributes user friendly
just like public attributes. With this patch:
- rakudo will automatically generate private accessors when you
declare a private attribute, in the same manner it does when you
declare a public attribute.
- it will not generate the private accessor should a private method
with the same name exist.
- 'is rw' and 'is readonly' now makes sense for private attributes.
The use case is as follows:
class MyClass {
has $!secret = 5;
method sauce(MyClass $other) {
return self!secret() + $other!secret();
}
}
say MyClass.new().sauce( MyClass.new() );
Instead of having to manually write a private accessor for $!secret,
rakudo now does it for you - user friendly :-)
Patches attached, or can be pulled from
https://github.com/rakudo/rakudo/pull/674
https://github.com/perl6/roast/pull/94
David Ranvig,
>From e07ac0b57b6a9e2b58217354e302469d70ae8325 Mon Sep 17 00:00:00 2001
From: David Ranvig <aut...@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 3095f286791037672b3377099f54ed2cfccc4919 Mon Sep 17 00:00:00 2001
From: David Ranvig <aut...@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
