Make sure we give appropriate method names to auto-generated accessor…

…s and delegation methods, so introspection works out. Also try to handle multi exporting a bit more sanely.
rakudo · Aug 8, 2011 · ed3094f · ed3094f
1 parent ab4eacb
commit ed3094f
Show file tree

Hide file tree

Showing 4 changed files with 12 additions and 9 deletions.
diff --git a/src/Perl6/Metamodel/BOOTSTRAP.pm b/src/Perl6/Metamodel/BOOTSTRAP.pm
@@ -390,7 +390,7 @@ Code.HOW.add_method(Code, 'name', sub ($self) {
         ~pir::getattribute__PPPs(pir::perl6_decontainerize__PP($self),
             Code, '$!do')
     });
-Code.HOW.add_method(Code, '!set_name', sub ($self, $name) {
+Code.HOW.add_method(Code, 'set_name', sub ($self, $name) {
         pir::assign__vPS(
             pir::getattribute__PPPs(pir::perl6_decontainerize__PP($self), Code, '$!do'),
             $name)

diff --git a/src/Perl6/Metamodel/MultiMethodContainer.pm b/src/Perl6/Metamodel/MultiMethodContainer.pm
@@ -91,7 +91,7 @@ role Perl6::Metamodel::MultiMethodContainer {
                     # No proto found, so we'll generate one here.
                     my $proto := $autogen_proto.instantiate_generic(
                         hash( T => $obj ));
-                    $proto."!set_name"($name);
+                    $proto.set_name($name);
                     $proto.add_dispatchee($code);
                     self.add_method($obj, $name, $proto);
                 }

diff --git a/src/core/Attribute.pm b/src/core/Attribute.pm
@@ -63,6 +63,7 @@ my class Attribute {
                         }
 
                 }
+                $meth.set_name($meth_name);
                 $package.HOW.add_method($package, $meth_name, $meth);
             }
         }

diff --git a/src/core/traits.pm b/src/core/traits.pm
@@ -38,9 +38,7 @@ multi trait_mod:<is>(Parameter:D $param, :$copy!) {
 # full-blown serialization, though.
 multi trait_mod:<is>(Routine:D \$r, :$export!) {
     if %*COMPILING {
-        if $r.multi {
-            die "Cannot export an individual multi candidate; export the proto instead";
-        }
+        my $to_export := $r.multi ?? $r.dispatcher !! $r;
         my @tags = 'ALL', 'DEFAULT';
         for @tags -> $tag {
             my $exp_name := '&' ~ $r.name;
@@ -54,9 +52,11 @@ multi trait_mod:<is>(Routine:D \$r, :$export!) {
                 $*ST.install_package_symbol($*EXPORT, $tag, $install_in);
             }
             if $install_in.WHO.exists($exp_name) {
-                die "A symbol $exp_name has already been exported";
+                unless ($install_in.WHO){$exp_name} =:= $to_export {
+                    die "A symbol $exp_name has already been exported";
+                }
             }
-            $*ST.install_package_symbol($install_in, $exp_name, $r);
+            $*ST.install_package_symbol($install_in, $exp_name, $to_export);
         }
     }
 }
@@ -110,9 +110,11 @@ multi trait_mod:<handles>(Attribute:D $target, $thunk) {
         }
 
         method add_delegator_method($attr: $pkg, $meth_name, $call_name) {
-            $pkg.HOW.add_method($pkg, $meth_name, method (**@pos, *%named) is rw {
+            my $meth := method (**@pos, *%named) is rw {
                 $attr.get_value(self)."$call_name"(|@pos, |%named)
-            });
+            };
+            $meth.set_name($meth_name);
+            $pkg.HOW.add_method($pkg, $meth_name, $meth);
         }
 
         method apply_handles($attr: Mu $pkg) {