[svn:parrot] r41871 - in trunk: . compilers/nqp/src compilers/nqp/src/Grammar compilers/nqp/t

[pmichaud at svn.parrot.org]

Author: pmichaud
Date: Thu Oct 15 07:40:08 2009
New Revision: 41871
URL: https://trac.parrot.org/parrot/changeset/41871

Log:
[nqp]:  Add simple class inheritance to NQP.

Added:
   trunk/compilers/nqp/t/30-subclass.t
Modified:
   trunk/MANIFEST
   trunk/compilers/nqp/src/Grammar.pg
   trunk/compilers/nqp/src/Grammar/Actions.pir

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	Thu Oct 15 02:55:45 2009	(r41870)
+++ trunk/MANIFEST	Thu Oct 15 07:40:08 2009	(r41871)
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Sep 30 22:16:16 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Oct 15 07:39:41 2009 UT
 #
 # See below for documentation on the format of this file.
 #
@@ -118,6 +118,7 @@
 compilers/nqp/t/27-ternary.t                                [test]
 compilers/nqp/t/28-return.t                                 [test]
 compilers/nqp/t/29-self.t                                   [test]
+compilers/nqp/t/30-subclass.t                               [test]
 compilers/nqp/t/harness                                     [test]
 compilers/pct/PCT.pir                                       [pct]
 compilers/pct/README.pod                                    []doc

Modified: trunk/compilers/nqp/src/Grammar.pg
==============================================================================
--- trunk/compilers/nqp/src/Grammar.pg	Thu Oct 15 02:55:45 2009	(r41870)
+++ trunk/compilers/nqp/src/Grammar.pg	Thu Oct 15 07:40:08 2009	(r41871)
@@ -301,6 +301,7 @@
 rule package_declarator {
     $<sym>=[module|class]
     <name>
+    [ 'is' <parent=name> ]?
     [
     || ';' <statement_block> {*}                           #= statement_block
     || <block> {*}                                         #= block

Modified: trunk/compilers/nqp/src/Grammar/Actions.pir
==============================================================================
--- trunk/compilers/nqp/src/Grammar/Actions.pir	Thu Oct 15 02:55:45 2009	(r41870)
+++ trunk/compilers/nqp/src/Grammar/Actions.pir	Thu Oct 15 07:40:08 2009	(r41871)
@@ -796,7 +796,21 @@
 ##        $past.namespace($<name><ident>);
 ##        $past.blocktype('declaration');
 ##        $past.pirflags(':init :load');
-##        if ($<sym> eq 'class') { ...code to make class... }
+##        if ($<sym> eq 'class') { 
+##            my $classpast := 
+##                PAST::Op.new(
+##                    PAST::Var.new( :name('P6metaclass'), :scope('package'), 
+##                                   :namespace([]) ),
+##                    ~$<name>,
+##                    :pasttype('callmethod'), :name('new_class')
+##                );
+##            if $<parent> { 
+##                $classpast.push( 
+##                    PAST::Val.new( ~$<parent>[0] , :named('parent') )
+##                );
+##            }
+##            $past.push($classpast);
+##        }
 ##        make $past;
 ##    }
 .sub 'package_declarator' :method
@@ -813,22 +827,23 @@
     past.'lexical'(0)
     $S0 = match['sym']
     if $S0 != 'class' goto class_done
-    .local string inline
-    inline = <<'        INLINE'
-        $P0 = get_root_global ['parrot'], 'P6metaclass'
-        $P1 = split '::', '%s'
-        push_eh subclass_done
-        $P2 = $P0.'new_class'($P1)
-      subclass_done:
-        pop_eh
-        INLINE
-    $S0 = match['name']
-    $I0 = index inline, '%s'
-    substr inline, $I0, 2, $S0
+    .local pmc classvar, classop
+    $P0 = get_hll_global ['PAST'], 'Var'
+    $P1 = new ['ResizablePMCArray']
+    classvar = $P0.'new'( 'name'=>'P6metaclass', 'scope'=>'package', 'namespace'=>$P1)
     $P0 = get_hll_global ['PAST'], 'Op'
-    $P1 = $P0.'new'('inline'=>inline, 'pasttype'=>'inline')
+    $S0 = match['name']
+    classop = $P0.'new'( classvar, $S0, 'pasttype'=>'callmethod', 'name'=>'new_class')
     $P2 = past[0]
-    $P2.'push'($P1)
+    .local pmc parent
+    parent = match['parent']
+    if null parent goto parent_done
+    $S0 = parent[0]
+    $P0 = get_hll_global ['PAST'], 'Val'
+    $P1 = $P0.'new'( 'value'=>$S0, 'named'=>'parent' )
+    classop.'push'($P1)
+  parent_done:
+    $P2.'push'(classop)
   class_done:
     match.'!make'(past)
 .end

Added: trunk/compilers/nqp/t/30-subclass.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/compilers/nqp/t/30-subclass.t	Thu Oct 15 07:40:08 2009	(r41871)
@@ -0,0 +1,34 @@
+#!./parrot nqp.pbc
+
+# class inheritance
+
+plan(6);
+
+class ABC {
+    method foo() {
+        say('ok 1');
+    }
+
+    method bar() {
+        say('ok 3');
+    }
+}
+
+class XYZ is ABC {
+    method foo() {
+        say('ok 2');
+    }
+}
+
+
+my $abc := ABC.new();
+my $xyz := XYZ.new();
+
+$abc.foo();
+$xyz.foo();
+$xyz.bar();
+my $xyzhow := $xyz.HOW;
+if $xyzhow.isa($xyz, ABC) { say('ok 4') }
+if $xyzhow.isa($xyz, XYZ) { say('ok 5') }
+say( $xyzhow.isa($abc, XYZ) ?? 'not ok 6' !! 'ok 6' );
+