[svn:parrot] r29764 - in trunk/languages/perl6/src: builtins parser

[jonathan]

Author: jonathan
Date: Sat Jul 26 10:40:23 2008
New Revision: 29764

Modified:
   trunk/languages/perl6/src/builtins/guts.pir
   trunk/languages/perl6/src/parser/actions.pm

Log:
[rakudo] If you don't specify a type constraint that is a proto-object, we 
shouldn't default an attribute to containing Object proto-object.

Modified: trunk/languages/perl6/src/builtins/guts.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/guts.pir (original)
+++ trunk/languages/perl6/src/builtins/guts.pir Sat Jul 26 10:40:23 2008
@@ -380,7 +380,12 @@
 .sub '!keyword_has'
     .param pmc class
     .param string attr_name
-    .param pmc type
+    .param pmc type     :optional
+    .param int got_type :opt_flag
+    if got_type goto with_type
+    class.'add_attribute'(attr_name)
+    .return ()
+  with_type:
     class.'add_attribute'(attr_name, type)
 .end
 

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Sat Jul 26 10:40:23 2008
@@ -1829,18 +1829,33 @@
     }
 
     # Add attribute to class (always name it with ! twigil).
-    $class_def.push(
-        PAST::Op.new(
-            :pasttype('call'),
-            :name('!keyword_has'),
-            PAST::Var.new(
-                :name('$def'),
-                :scope('lexical')
-            ),
-            PAST::Val.new( :value($name) ),
-            build_type($/<scoped><fulltypename>)
-        )
-    );
+    if $/<scoped><fulltypename> {
+        $class_def.push(
+            PAST::Op.new(
+                :pasttype('call'),
+                :name('!keyword_has'),
+                PAST::Var.new(
+                    :name('$def'),
+                    :scope('lexical')
+                ),
+                PAST::Val.new( :value($name) ),
+                build_type($/<scoped><fulltypename>)
+            )
+        );
+    }
+    else {
+        $class_def.push(
+            PAST::Op.new(
+                :pasttype('call'),
+                :name('!keyword_has'),
+                PAST::Var.new(
+                    :name('$def'),
+                    :scope('lexical')
+                ),
+                PAST::Val.new( :value($name) )
+            )
+        );
+    }
 
     # Is there any "handles" trait verb or an "is rw" or "is ro"?
     my $rw := 0;