aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2013-12-29 03:38:51 +0100
committerTristan Gingold <tgingold@free.fr>2013-12-29 03:38:51 +0100
commitefd7628a8a7bfd079d2fd2ebd61c754dffb26178 (patch)
treee29024f624a26ae067e5cfcae4c545de3582a204
parent1bc2216d457b894545c08d995f43214af6e497f4 (diff)
downloadghdl-efd7628a8a7bfd079d2fd2ebd61c754dffb26178.tar.gz
ghdl-efd7628a8a7bfd079d2fd2ebd61c754dffb26178.tar.bz2
ghdl-efd7628a8a7bfd079d2fd2ebd61c754dffb26178.zip
Fix multidimensional array individual association.
Fix missing check in discrete range.
-rw-r--r--sem_assocs.adb32
-rw-r--r--sem_expr.adb3
-rw-r--r--sem_types.adb4
-rw-r--r--types.ads5
4 files changed, 26 insertions, 18 deletions
diff --git a/sem_assocs.adb b/sem_assocs.adb
index 3ee7126fc..87081f4cf 100644
--- a/sem_assocs.adb
+++ b/sem_assocs.adb
@@ -540,22 +540,30 @@ package body Sem_Assocs is
end if;
end Add_Individual_Association;
- procedure Finish_Individual_Assoc_Array_Subtype (Assoc : Iir; Atype : Iir)
+ procedure Finish_Individual_Assoc_Array_Subtype
+ (Assoc : Iir; Atype : Iir; Dim : Positive)
is
- Index_Tlist : Iir_List;
+ Index_Tlist : constant Iir_List := Get_Index_Subtype_List (Atype);
+ Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist);
Index_Type : Iir;
Low, High : Iir;
Chain : Iir;
+ El : Iir;
begin
- Index_Tlist := Get_Index_Subtype_List (Atype);
- for I in Natural loop
- Index_Type := Get_Nth_Element (Index_Tlist, I);
- exit when Index_Type = Null_Iir;
- Chain := Get_Individual_Association_Chain (Assoc);
- Sem_Choices_Range
- (Chain, Index_Type, False, False, Get_Location (Assoc), Low, High);
- Set_Individual_Association_Chain (Assoc, Chain);
- end loop;
+ Index_Type := Get_Nth_Element (Index_Tlist, Dim - 1);
+ Chain := Get_Individual_Association_Chain (Assoc);
+ Sem_Choices_Range
+ (Chain, Index_Type, False, False, Get_Location (Assoc), Low, High);
+ Set_Individual_Association_Chain (Assoc, Chain);
+ if Dim < Nbr_Dims then
+ El := Chain;
+ while El /= Null_Iir loop
+ pragma Assert (Get_Kind (El) = Iir_Kind_Choice_By_Expression);
+ Finish_Individual_Assoc_Array_Subtype
+ (Get_Associated (El), Atype, Dim + 1);
+ El := Get_Chain (El);
+ end loop;
+ end if;
end Finish_Individual_Assoc_Array_Subtype;
procedure Finish_Individual_Assoc_Array
@@ -687,7 +695,7 @@ package body Sem_Assocs is
case Get_Kind (Atype) is
when Iir_Kind_Array_Subtype_Definition =>
- Finish_Individual_Assoc_Array_Subtype (Assoc, Atype);
+ Finish_Individual_Assoc_Array_Subtype (Assoc, Atype, 1);
when Iir_Kind_Array_Type_Definition =>
Atype := Create_Array_Subtype (Atype, Get_Location (Assoc));
Set_Index_Constraint_Flag (Atype, True);
diff --git a/sem_expr.adb b/sem_expr.adb
index 21a05c487..4ee643665 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -651,6 +651,9 @@ package body Sem_Expr is
-- FIXME: catch phys/phys.
Set_Type (Expr, Integer_Type_Definition);
+ if Get_Expr_Staticness (Expr) = Locally then
+ Eval_Check_Range (Expr, Integer_Subtype_Definition, True);
+ end if;
elsif Range_Type = Universal_Integer_Type_Definition then
if Vhdl_Std >= Vhdl_08 then
-- LRM08 5.3.2.2
diff --git a/sem_types.adb b/sem_types.adb
index c57c151c5..591fa4875 100644
--- a/sem_types.adb
+++ b/sem_types.adb
@@ -99,7 +99,9 @@ package body Sem_Types is
end case;
end Set_Type_Has_Signal;
- -- Sem a range expression.
+ -- Sem a range expression that appears in an integer, real or physical
+ -- type definition.
+ --
-- Both left and right bounds must be of the same type kind, ie
-- integer types, or if INT_ONLY is false, real types.
-- However, the two bounds need not have the same type.
diff --git a/types.ads b/types.ads
index 9c2ce28b6..4775484ff 100644
--- a/types.ads
+++ b/types.ads
@@ -57,11 +57,6 @@ package Types is
type String_Fat is array (Pos32) of Character;
type String_Fat_Acc is access String_Fat;
- -- Array of iir_int32.
- -- Used by recording feature of scan.
- type Iir_Int32_Array is array (Natural range <>) of Iir_Int32;
- type Iir_Int32_Array_Acc is access Iir_Int32_Array;
-
-- Type of a name table element.
-- The name table is defined in the name_table package.
type Name_Id is new Nat32;