Skip to content

Commit

Permalink
Workaround for bug #2255
Browse files Browse the repository at this point in the history 
rakudo/rakudo#2255

Fixed incorrect TypeCheck exception throw
  • Loading branch information
@vrurg
vrurg committed Sep 8, 2018
1 parent b08248f commit 287c1b8
Show file tree
Hide file tree
Showing 3 changed files with 104 additions and 38 deletions.
94 changes: 57 additions & 37 deletions lib/AttrX/Mooish.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -421,9 +421,42 @@ my %attr-data;
# found. Always uses attribute mode if defined as Bool
enum PvtMode <pvmForce pvmNever pvmAsAttr pvmAuto>;

my role AttrXMooishClassHOW { ... }
role AttrXMooishClassHOW { ... }

my role AttrXMooishAttributeHOW {
role AttrXMooishHelper {
method setup-helpers ( Mu \type, $attr ) {
#note "SETUP HELPERS ON ", type.^name, " // ", type.HOW.^name;
type.^add_private_method("gimme-{$attr.base-name}", method { "gimme for {$attr.base-name}" } );
my %helpers =
:clearer( method { $attr.clear-attr( self.WHICH ) } ),
:predicate( method { $attr.is-set( self.WHICH ) } ),
;

for %helpers.keys -> $helper {
next unless $attr."$helper"();
#note "op2method for helper $helper";
my $helper-name = $attr.opt2method( $helper );

X::Fatal.new( message => "Cannot install {$helper} {$helper-name}: method already defined").throw
if type.^declares_method( $helper-name );

my $m = %helpers{$helper};
$m.set_name( $helper-name );
#note "Installing helper $helper $helper-name on {type.^name} // {$m.WHICH}";
#note "HELPER:", %helpers{$helper}.name, " // ", $m.^can("CALL-ME"), " // ", $m.^name;

if $attr.has_accessor { # I.e. – public?
#note ". Installing public $helper-name";
type.^add_method( $helper-name, $m );
} else {
#note "! Installing private $helper-name";
type.^add_private_method( $helper-name, $m );
}
}
}
}

role AttrXMooishAttributeHOW {
has $.base-name = self.name.substr(2);
has $.sigil = self.name.substr( 0, 1 );
has $.lazy is rw = False;
Expand Down Expand Up @@ -455,15 +488,16 @@ my role AttrXMooishAttributeHOW {
$opt ~~ Bool ?? $prefix ~ '-' ~ $!base-name !! $opt;
}

method !opt2method( Str $oname ) {
method opt2method( Str $oname ) {
#note "%opt2prefix: ", %opt2prefix;
#note "option name in opt2method: $oname // ", %opt2prefix{$oname};
self!bool-str-meth-name( self."$oname"(), %opt2prefix{$oname} );
}

method compose ( Mu \type ) {

#note "+++ composing {$.name} on {type.WHO} {type.WHICH}";
#note "+++ composing {$.name} on {type.^name} {type.HOW}";
#note "ATTR PACKAGE:", $.package.^name;

unless type.HOW ~~ AttrXMooishClassHOW {
#note "Installing AttrXMooishClassHOW on {type.WHICH}";
Expand All @@ -472,32 +506,6 @@ my role AttrXMooishAttributeHOW {

callsame;

my $attr = self;
my %helpers =
clearer => my method { $attr.clear-attr( self.WHICH ) },
predicate => my method { $attr.is-set( self.WHICH ) },
;

for %helpers.keys -> $helper {
next unless self."$helper"();
#note "op2method for helper $helper";
my $helper-name = self!opt2method( $helper );

X::Fatal.new( message => "Cannot install {$helper} {$helper-name}: method already defined").throw
if type.^declares_method( $helper-name );

my &m = %helpers{$helper};
&m.set_name( $helper-name );
#note "HELPER:", %helpers{$helper}.name;

if $.has_accessor { # I.e. – public?
type.^add_method( $helper-name, %helpers{$helper} );
} else {
type.^add_private_method( $helper-name, %helpers{$helper} );
}
}


self.setup-types;

self.invoke-composer( type );
Expand Down Expand Up @@ -620,8 +628,8 @@ my role AttrXMooishAttributeHOW {
#note "Type {$.type.^definite ?? "IS" !! "ISN'T"} definite";
X::TypeCheck.new(
:$operation,
got => 'Nil',
expected => "{$.type.^name}:D",
got => $value,
expected => $.type,
).throw if $.type.^definite;
}
}
Expand Down Expand Up @@ -704,6 +712,7 @@ my role AttrXMooishAttributeHOW {
}

method clear-attr ( $obj-id ) {
#note "Clearing {$.name} on $obj-id";
%attr-data{$obj-id}{$.name}<value>:delete;
}

Expand Down Expand Up @@ -795,7 +804,7 @@ my role AttrXMooishAttributeHOW {
method invoke-composer ( Mu \type ) {
return unless $!composer;
#note "My type for composer: ", $.package;
my $comp-name = self!opt2method( 'composer' );
my $comp-name = self.opt2method( 'composer' );
#note "Looking for method $comp-name";
my $composer = type.^find_private_method( $comp-name );
X::Method::NotFound.new(
Expand All @@ -807,12 +816,14 @@ my role AttrXMooishAttributeHOW {
}
}

my role AttrXMooishClassHOW {
role AttrXMooishClassHOW does AttrXMooishHelper {

method compose ( Mu \type ) {
#note "??? Compose on ", type.^name;
callsame;
#note "??? DONE compose on ", type.^name;
for type.^attributes.grep( AttrXMooishAttributeHOW ) -> $attr {
self.setup-helpers( type, $attr );
}
nextsame;
}

method add_method(Mu $obj, $name, $code_obj, :$nowrap=False) {
Expand Down Expand Up @@ -910,7 +921,15 @@ my role AttrXMooishClassHOW {
}
}

my role AttrXMooishRoleHOW {
role AttrXMooishRoleHOW does AttrXMooishHelper {
method compose (Mu \type) {
#note "COMPOSING ROLE ", type.^name, " // ", type.HOW.^name;
for type.^attributes.grep( AttrXMooishAttributeHOW ) -> $attr {
self.setup-helpers( type, $attr );
}
nextsame
}

method specialize(Mu \r, Mu:U \obj, *@pos_args, *%named_args) {
#note "*** Specializing role {r.^name} on {obj.WHO}";
#note "CLASS HAS THE ROLE:", obj.HOW ~~ AttrXMooishClassHOW;
Expand Down Expand Up @@ -970,6 +989,7 @@ multi trait_mod:<is>( Attribute:D $attr, :$mooish! ) is export {
}
when 'clearer' | 'predicate' {
my $opt = $_;

given $option{$opt} {
X::Fatal.new( message => "Unsupported {$opt} type of {.WHAT} for attribute {$attr.name}; can only be Bool or Str" ).throw
unless $_ ~~ Bool | Str;
Expand Down
2 changes: 1 addition & 1 deletion t/010-base.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -210,7 +210,7 @@ subtest "Validating values", {
lives-ok { $inst.bar = "a string" }, "assignment of defined value";
throws-like { $inst.bar = Nil },
X::TypeCheck,
message => q{Type check failed in assignment to attribute $!bar; expected "Str:D:D" but got "Nil"},
message => q{Type check failed in assignment to attribute $!bar; expected Str:D but got Any (Any)},
"assignment of Nil to a definite type attribute";

my class Foo4 {
Expand Down
46 changes: 46 additions & 0 deletions t/020-role.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -113,6 +113,52 @@ subtest "Require method", {
is $inst.bar, "filtered-FooR2(fubar)", "role's requirement";
}

subtest "Private Methods", {
plan 6;
my $inst;

my role FooRole {
has %!foo is mooish(:lazy, :clearer);
has $.build-count = 0;

method !build-foo { $!build-count++; :a("private foo") }

method cleanup {
self!clear-foo;
}

method get-foo { %!foo }
}

my role BarRole does FooRole {
has $.bar is mooish(:lazy, :clearer);
method for-punning { "ok" }
method build-bar { "public bar" }
}

my role BazRole {
has $.baz is mooish(:lazy, :clearer);
method build-baz { "public baz" }
}

my class FooR1 does BarRole does BazRole {
method re-clean { self!clear-foo }
}

$inst = FooR1.new;

BarRole.for-punning;

is $inst.get-foo<a>, "private foo", "default build";
is $inst.build-count, 1, "build count is 2";
$inst.cleanup;
is $inst.get-foo<a>, "private foo", "build after role-initiated clear";
is $inst.build-count, 2, "build count is 2";
$inst.re-clean;
is $inst.get-foo<a>, "private foo", "build after class-initiated clear";
is $inst.build-count, 3, "build count is 3";
}

done-testing;

# vim: ft=perl6

0 comments on commit 287c1b8

Please sign in to comment.