From 6229131d8422b8bcbedecd3821b2d0add043ee1a Mon Sep 17 00:00:00 2001
From: jnthn <jnthn@jnthn.net>
Date: Wed, 20 May 2009 14:02:07 +0200
Subject: [PATCH] Fix typed array and hash attributes so that the type checking
 is enforced. Resolves RT#64594.

---
 src/classes/Object.pir | 21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

diff --git a/src/classes/Object.pir b/src/classes/Object.pir
index a31249e80d6..ef3b35c23df 100644
--- a/src/classes/Object.pir
+++ b/src/classes/Object.pir
@@ -280,12 +280,13 @@ the object's type and address.
   attrinit_loop:
     unless it goto attrinit_done
     .local string attrname
-    .local pmc attrhash, itypeclass
+    .local pmc attrhash, itypeclass, type
     attrname = shift it
     attrhash = attributes[attrname]
     itypeclass = attrhash['itype']
-    unless null itypeclass goto attrinit_itype
+    type = attrhash['type']
     $S0 = substr attrname, 0, 1
+    unless null itypeclass goto attrinit_itype
     if $S0 == '@' goto attrinit_array
     if $S0 == '%' goto attrinit_hash
     itypeclass = get_class ['Perl6Scalar']
@@ -299,8 +300,20 @@ the object's type and address.
     .local pmc attr
     attr = new itypeclass
     setattribute candidate, parrotclass, attrname, attr
-    $P0 = attrhash['type']
-    setprop attr, 'type', $P0
+    if null type goto type_done
+    if $S0 == '@' goto pos_type
+    if $S0 == '%' goto ass_type
+    setprop attr, 'type', type
+    goto type_done
+  ass_type:
+    $P0 = get_hll_global 'Associative'
+    goto apply_type
+  pos_type:
+    $P0 = get_hll_global 'Positional'
+  apply_type:
+    $P0 = $P0.'!select'(type)
+    'infix:does'(attr, $P0)
+  type_done:
     .local string keyname
     $I0 = index attrname, '!'
     if $I0 < 0 goto attrinit_loop