add Aliased role, per a bit of back-and-forth on IRC w/ jnthn and the…

… #perl6 crew
cjfields · Sep 8, 2014 · e39269b · e39269b
1 parent b11b523
commit e39269b
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 5 deletions.
diff --git a/lib/Bio/Role/Aliased.pm6 b/lib/Bio/Role/Aliased.pm6
@@ -1,10 +1,14 @@
+role Bio::Role::Aliased;
+
 # this is a stub for aliasing attributes; aliases are ro for now
 # based on a simple aliasing trait by Jonathan Worthington
 
-multi trait_mod:<is>(AttributeDeclarand $a, $names, :$aliased!) {
-    my $accessor_name = $a.name.substr(2);
-    my $get = method { self."$accessor_name" };
-    for $names.list -> $name {
-        $a.how.add_method($a.how, $name, $get);
+multi trait_mod:<is>(Attribute:D $attr, :$aliased!) is export {
+    my $accessor_name = $attr.name.substr(2);
+
+    for $aliased.list -> $name {
+        $attr.package.HOW.add_method($attr.HOW, $name, method {
+            self."$accessor_name"()
+        } );
     }
 }
diff --git a/t/Role/Aliased.t b/t/Role/Aliased.t
@@ -0,0 +1,27 @@
+use v6;
+
+use Test;
+
+use Bio::Role::Aliased;
+
+class Stub {
+    has $.a is aliased('foo', 'baz');
+    has $.long_name is aliased('bar');
+};
+
+my $test = Stub.new(:a<hi there>, :long_name<Long time no see>);
+
+Stub.^methods.say;
+
+is($test.a, 'hi there', '');
+ok($test.can('foo'), 'adds alias');
+ok($test.can('baz'), 'adds alias');
+
+# Does not work, get "No such method 'foo' for invocant of type 'Stub'"
+is($test.foo, 'hi there');
+is($test.baz, 'hi there');
+
+is($test.long_name, 'Long time no see');
+is($test.bar, 'Long time no see');
+
+done();