Merge branch 'master' of git@github.com:rakudo/rakudo

src/parrot/ClassHOW.pir

@@ -41,16 +41,33 @@ Gets a list of this class' parents.
 
 =cut
 
-.sub 'isa' :method :multi(_,_)
+.sub 'parents' :method
     .param pmc obj
+    .param pmc local         :named('local') :optional
+    .param pmc hierarchical  :named('hierarchical') :optional
     
     .local pmc parrot_class, result_list, parrot_list, it
     result_list = get_hll_global 'Array'
     result_list = result_list.'new'()
     parrot_class = self.'get_parrotclass'(obj)
+    
+    # Fake top of Perl 6 hierarchy
     $S0 = parrot_class.'name'()
-    if $S0 == 'Perl6Object' goto it_loop_end # Fake top of Perl 6 hierarchy
+    if $S0 != 'Perl6Object' goto not_object
+    unless null local goto done
+    $P0 = get_hll_global 'Object'
+    result_list.'push'($P0)
+    goto done
+  not_object:
+
+    # If it's local or default, can just use inspect.
+    unless null hierarchical goto do_hierarchical
+    if null local goto all_parents
     parrot_list = inspect parrot_class, 'parents'
+    goto have_list
+  all_parents:
+    parrot_list = inspect parrot_class, 'all_parents'
+  have_list:
     it = iter parrot_list
   it_loop:
     unless it goto it_loop_end
@@ -60,7 +77,12 @@ Gets a list of this class' parents.
     result_list.'push'($P0)
     goto it_loop
   it_loop_end:
+    goto done
+
+  do_hierarchical:
+    'die'(':hierarchical not yet implemented')
 
+  done:
     .return (result_list)
 .end
 

src/parser/actions.pm

@@ -1394,7 +1394,8 @@ method package_def($/, $key) {
     # At block opening, unshift module name (fully qualified) onto @?NS; otherwise,
     # shift it off.
     if $key eq 'open' {
-        my $add := ~$<module_name>[0] eq '::' ?? '' !! ~$<module_name>[0];
+        my $add := ~$<module_name>[0]<longname><name> eq '::' ?? '' !!
+            (~$<module_name>[0]<longname><name> ~ ~$<module_name>[0]<role_params>);
         my $fqname := +@?NS ?? @?NS[0] ~ '::' ~ $add !! $add;
         @?NS.unshift($fqname);
         return 0;
@@ -1409,8 +1410,8 @@ method package_def($/, $key) {
 
     my $modulename;
     my $is_anon := 0;
-    if $<module_name> && ~$<module_name>[0] ne '::' {
-        $modulename :=  ~$<module_name>[0];
+    if $<module_name> && ~$<module_name>[0]<longname><name> ne '::' {
+        $modulename :=  ~$<module_name>[0]<longname><name> ~ ~$<module_name>[0]<role_params>;
     }
     else {
         $modulename := $block.unique('!ANON');

src/parser/grammar.pg

@@ -693,6 +693,7 @@ rule package_def {
         {{
             $P0 = match['module_name']
             $P0 = $P0[0]
+            $P0 = $P0['longname']
             $P0 = $P0['name']
             $S0 = $P0.'text'()
             match.'add_type'($S0)
@@ -830,8 +831,8 @@ token circumfix {
 }
 
 token module_name {
-    <name>
-    [
+    <longname>
+    $<role_params>=[
         :dba('generic role')
         <?{{
             ## ($+PKGDECL//'') eq 'role' (more like (@?PKGDECL[0]//'') eq 'role')
@@ -844,6 +845,10 @@ token module_name {
     ]?
 }
 
+token longname {
+    <name> <colonpair>*
+}
+
 token name {
     | <identifier> <morename>*
     | <morename>+

src/pmc/p6invocation.pmc

@@ -25,7 +25,7 @@ gets stuck into the lex pad to represent the the candidate list.
 static PMC *get_next_candidate(PARROT_INTERP, PMC *SELF) {
     PMC    *candidates, *current;
     INTVAL  position;
-    
+
     /* Get candidates and position. */
     GETATTR_P6Invocation_candidate_list(interp, SELF, candidates);
     GETATTR_P6Invocation_position(interp, SELF, position);
@@ -98,9 +98,6 @@ pmclass P6Invocation need_ext dynpmc group perl6_group {
         PMC      *lexpad, *first_candidate;
         opcode_t *addr;
 
-        /* We always operate on a clone of ourself. */
-        SELF = VTABLE_clone(interp, SELF);
-
         /* In the straightforward case, we know our first candidate right off the
          * bat; if not, use list. We also nullify first candidate so we hit the
          * candidate list next time we're used. */

src/setting/Object.pm

@@ -14,7 +14,7 @@ class Object is also {
         # First, build list of classes in the order we'll need them.
         my @classes;
         if $super {
-            @classes = self.^isa();
+            @classes = self.^parents(:local);
         } else {
             if $breadth {
                 die ":breadth unimplemented";
@@ -66,7 +66,7 @@ class Object is also {
                     return @result;
                 }
                 my sub compute_c3($class) {
-                    my @immediates = $class.^isa();
+                    my @immediates = $class.^parents(:local);
                     if @immediates.elems == 0 {
                         @classes = $class;
                     } else {

t/spectest.data

@@ -281,6 +281,7 @@ S12-enums/as-role.t
 S12-enums/basic.t
 S12-enums/thorough.t
 S12-introspection/can.t
+S12-introspection/meta-class.t
 S12-methods/calling_sets.t
 S12-methods/calling_syntax.t
 S12-methods/class-and-instance.t