aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2022-05-06 18:38:50 +0200
committerTristan Gingold <tgingold@free.fr>2022-05-07 14:54:18 +0200
commit40acfa4b8258fda8d0bac3cd82a990eef468575f (patch)
tree5997cfdf5858cb5fd825b3a22ef292cf74aa9abd /src
parent2886f0582984bc4948f716d82762c50fc3302064 (diff)
downloadghdl-40acfa4b8258fda8d0bac3cd82a990eef468575f.tar.gz
ghdl-40acfa4b8258fda8d0bac3cd82a990eef468575f.tar.bz2
ghdl-40acfa4b8258fda8d0bac3cd82a990eef468575f.zip
vhdl: consider fully static record aggregates. Fix #2051
Diffstat (limited to 'src')
-rw-r--r--src/vhdl/translate/trans-chap3.adb3
-rw-r--r--src/vhdl/translate/trans-chap3.ads3
-rw-r--r--src/vhdl/translate/trans-chap7.adb92
-rw-r--r--src/vhdl/vhdl-sem_expr.adb11
4 files changed, 83 insertions, 26 deletions
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index e1bb61af6..adb1f9d01 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -3574,9 +3574,6 @@ package body Trans.Chap3 is
end if;
end Maybe_Insert_Scalar_Check;
- function Locally_Types_Match (L_Type : Iir; R_Type : Iir)
- return Tri_State_Type;
-
function Locally_Array_Match (L_Type, R_Type : Iir) return Tri_State_Type
is
L_Indexes : constant Iir_Flist := Get_Index_Subtype_List (L_Type);
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index 78e7a324f..53f9450f1 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -345,7 +345,8 @@ package Trans.Chap3 is
-- Return True iff all indexes of L_TYPE and R_TYPE have the same
-- length. They must be constrained.
- function Locally_Array_Match (L_Type, R_Type : Iir) return Tri_State_Type;
+ function Locally_Types_Match (L_Type : Iir; R_Type : Iir)
+ return Tri_State_Type;
-- Check bounds of L match bounds of R.
-- If L_TYPE (resp. R_TYPE) is not a thin composite type, then L_NODE
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 33f3f974d..bd80b1050 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -71,12 +71,10 @@ package body Trans.Chap7 is
end if;
-- EXPR must be already constrained.
- pragma Assert (Get_Kind (Expr_Type) = Iir_Kind_Array_Subtype_Definition);
- if Get_Kind (Res_Type) = Iir_Kind_Array_Subtype_Definition
- and then Get_Constraint_State (Res_Type) = Fully_Constrained
- then
+ pragma Assert (Get_Constraint_State (Expr_Type) = Fully_Constrained);
+ if Get_Constraint_State (Res_Type) = Fully_Constrained then
-- constrained to constrained.
- if Chap3.Locally_Array_Match (Expr_Type, Res_Type) /= True then
+ if Chap3.Locally_Types_Match (Expr_Type, Res_Type) /= True then
-- Sem should have replaced the expression by an overflow.
raise Internal_Error;
-- Chap6.Gen_Bound_Error (Loc);
@@ -260,16 +258,58 @@ package body Trans.Chap7 is
function Translate_Static_Aggregate (Aggr : Iir) return O_Cnode
is
Aggr_Type : constant Iir := Get_Type (Aggr);
- List : O_Array_Aggr_List;
Res : O_Cnode;
begin
Chap3.Translate_Anonymous_Subtype_Definition (Aggr_Type, False);
- Start_Array_Aggr
- (List, Get_Ortho_Type (Aggr_Type, Mode_Value),
- Unsigned_32 (Chap3.Get_Static_Array_Length (Aggr_Type)));
+ case Get_Kind (Aggr_Type) is
+ when Iir_Kind_Array_Subtype_Definition =>
+ declare
+ List : O_Array_Aggr_List;
+ begin
+ Start_Array_Aggr
+ (List, Get_Ortho_Type (Aggr_Type, Mode_Value),
+ Unsigned_32 (Chap3.Get_Static_Array_Length (Aggr_Type)));
- Translate_Static_Array_Aggregate_1 (List, Aggr, Aggr_Type, 1);
- Finish_Array_Aggr (List, Res);
+ Translate_Static_Array_Aggregate_1 (List, Aggr, Aggr_Type, 1);
+ Finish_Array_Aggr (List, Res);
+ end;
+ when Iir_Kind_Record_Type_Definition
+ | Iir_Kind_Record_Subtype_Definition =>
+ declare
+ Btype : constant Iir := Get_Base_Type (Aggr_Type);
+ Bels : constant Iir_Flist :=
+ Get_Elements_Declaration_List (Btype);
+ Assocs : constant Iir := Get_Association_Choices_Chain (Aggr);
+ List : O_Record_Aggr_List;
+ Assoc : Iir;
+ El : Iir;
+ Bel : Iir;
+ begin
+ Start_Record_Aggr
+ (List, Get_Ortho_Type (Aggr_Type, Mode_Value));
+ -- First elements declared with a fully-bounded subtype,
+ -- then unbounded elements.
+ for Static in reverse Boolean loop
+ Assoc := Assocs;
+ for I in Flist_First .. Flist_Last (Bels) loop
+ pragma Assert
+ (Get_Kind (Assoc) = Iir_Kind_Choice_By_None);
+ Bel := Get_Nth_Element (Bels, I);
+ if Is_Static_Type (Get_Info (Get_Type (Bel))) = Static
+ then
+ El := Get_Associated_Expr (Assoc);
+ New_Record_Aggr_El
+ (List,
+ Translate_Static_Expression (El, Get_Type (El)));
+ end if;
+ Assoc := Get_Chain (Assoc);
+ end loop;
+ end loop;
+ Finish_Record_Aggr (List, Res);
+ end;
+ when others =>
+ raise Internal_Error;
+ end case;
return Res;
end Translate_Static_Aggregate;
@@ -467,6 +507,8 @@ package body Trans.Chap7 is
return O_Enode
is
Str_Type : constant Iir := Get_Type (Str);
+ Is_Array : constant Boolean :=
+ Get_Kind (Str_Type) = Iir_Kind_Array_Subtype_Definition;
Is_Static : Boolean;
Vtype : Iir;
Var : Var_Type;
@@ -475,7 +517,8 @@ package body Trans.Chap7 is
R : O_Enode;
begin
if Get_Constraint_State (Str_Type) = Fully_Constrained
- and then Are_Array_Indexes_Locally_Static (Str_Type)
+ and then (not Is_Array
+ or else Are_Array_Indexes_Locally_Static (Str_Type))
then
Chap3.Create_Composite_Subtype (Str_Type);
case Get_Kind (Str) is
@@ -491,7 +534,8 @@ package body Trans.Chap7 is
when others =>
raise Internal_Error;
end case;
- Is_Static := Are_Array_Indexes_Locally_Static (Res_Type);
+ Is_Static := not Is_Array
+ or else Are_Array_Indexes_Locally_Static (Res_Type);
if Is_Static then
Res := Translate_Static_Implicit_Conv (Res, Str_Type, Res_Type);
@@ -580,12 +624,25 @@ package body Trans.Chap7 is
return Translate_Numeric_Literal (Expr, Expr_Otype);
end Translate_Numeric_Literal;
+ function Translate_Null_Literal (Expr : Iir; Res_Type : Iir)
+ return O_Cnode
+ is
+ pragma Unreferenced (Expr);
+ Tinfo : constant Type_Info_Acc := Get_Info (Res_Type);
+ Otype : constant O_Tnode := Tinfo.Ortho_Type (Mode_Value);
+ begin
+ return New_Null_Access (Otype);
+ end Translate_Null_Literal;
+
function Translate_Static_Expression (Expr : Iir; Res_Type : Iir)
return O_Cnode
is
Expr_Type : constant Iir := Get_Type (Expr);
begin
case Get_Kind (Expr) is
+ when Iir_Kind_Null_Literal =>
+ return Translate_Null_Literal (Expr, Res_Type);
+
when Iir_Kind_Integer_Literal
| Iir_Kind_Enumeration_Literal
| Iir_Kind_Floating_Point_Literal
@@ -958,7 +1015,7 @@ package body Trans.Chap7 is
if Einfo.Type_Mode = Type_Mode_Static_Array then
-- FIXME: optimize static vs non-static
-- constrained to constrained.
- if Chap3.Locally_Array_Match (Expr_Type, Res_Type) /= True then
+ if Chap3.Locally_Types_Match (Expr_Type, Res_Type) /= True then
-- FIXME: generate a bound error ?
-- Even if this is caught at compile-time,
-- the code is not required to run.
@@ -4499,12 +4556,7 @@ package body Trans.Chap7 is
end if;
when Iir_Kind_Null_Literal =>
- declare
- Tinfo : constant Type_Info_Acc := Get_Info (Expr_Type);
- Otype : constant O_Tnode := Tinfo.Ortho_Type (Mode_Value);
- begin
- return New_Lit (New_Null_Access (Otype));
- end;
+ return New_Lit (Translate_Null_Literal (Expr, Res_Type));
when Iir_Kind_Overflow_Literal =>
return Translate_Overflow_Literal (Expr);
diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb
index 425d2bf80..ceb7af3b3 100644
--- a/src/vhdl/vhdl-sem_expr.adb
+++ b/src/vhdl/vhdl-sem_expr.adb
@@ -3219,8 +3219,7 @@ package body Vhdl.Sem_Expr is
-- records.
Add_Constraints : Boolean;
begin
- -- Not yet handled.
- Set_Aggregate_Expand_Flag (Aggr, False);
+ Set_Aggregate_Expand_Flag (Aggr, True);
Ok := True;
Assoc_Chain := Get_Association_Choices_Chain (Aggr);
@@ -3312,6 +3311,9 @@ package body Vhdl.Sem_Expr is
then
Add_Constraints := True;
end if;
+ if not Is_Static_Construct (Expr) then
+ Set_Aggregate_Expand_Flag (Aggr, False);
+ end if;
else
Ok := False;
end if;
@@ -3326,6 +3328,11 @@ package body Vhdl.Sem_Expr is
El := Get_Chain (El);
end loop;
+ if Has_Named then
+ -- TODO: support named element on expanded aggregate
+ Set_Aggregate_Expand_Flag (Aggr, False);
+ end if;
+
-- Check for missing associations.
for I in Matches'Range loop
if Matches (I) = Null_Iir then