diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/vhdl/errorout.ads | 4 | ||||
| -rw-r--r-- | src/vhdl/evaluation.adb | 20 | ||||
| -rw-r--r-- | src/vhdl/evaluation.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/sem.adb | 4 | ||||
| -rw-r--r-- | src/vhdl/sem_assocs.adb | 94 | ||||
| -rw-r--r-- | src/vhdl/sem_assocs.ads | 7 | ||||
| -rw-r--r-- | src/vhdl/sem_specs.adb | 4 |
8 files changed, 133 insertions, 6 deletions
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads index bdc67226a..4b1ed23ee 100644 --- a/src/vhdl/errorout.ads +++ b/src/vhdl/errorout.ads @@ -80,6 +80,10 @@ package Errorout is -- Incorrect use of universal value. Warnid_Universal, + -- Mismatch of bounds between actual and formal in a scalar port + -- association + Warnid_Port_Bounds, + -- Runtime error detected at analysis time. Warnid_Runtime_Error, diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index f774208b2..e681ee651 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -2873,6 +2873,26 @@ package body Evaluation is return Get_Left_Limit (Range_Expr); end Eval_Discrete_Range_Left; + function Eval_Is_Eq (L, R : Iir) return Boolean + is + Expr_Type : constant Iir := Get_Type (L); + begin + case Get_Kind (Expr_Type) is + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition => + return Eval_Pos (L) = Eval_Pos (R); + when Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Floating_Type_Definition => + return Get_Fp_Value (L) = Get_Fp_Value (R); + when others => + Error_Kind ("eval_is_eq", Expr_Type); + end case; + end Eval_Is_Eq; + procedure Eval_Operator_Symbol_Name (Id : Name_Id) is begin diff --git a/src/vhdl/evaluation.ads b/src/vhdl/evaluation.ads index 256d687bf..4d2bb218f 100644 --- a/src/vhdl/evaluation.ads +++ b/src/vhdl/evaluation.ads @@ -123,6 +123,9 @@ package Evaluation is -- EXPR must be of a discrete subtype. function Eval_Pos (Expr : Iir) return Iir_Int64; + -- Return True iff L and R (scalar literals) are equal. + function Eval_Is_Eq (L, R : Iir) return Boolean; + -- Replace ORIGIN (an overflow literal) with extreme positive value (if -- IS_POS is true) or extreme negative value. function Build_Extreme_Value (Is_Pos : Boolean; Origin : Iir) return Iir; diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 8b3904e3a..c93fad0c7 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -408,7 +408,7 @@ package Iirs is -- Only for Iir_Kind_Association_Element_By_Individual: -- Get/Set_Individual_Association_Chain (Field4) -- - -- A function call or a type conversion for the association. + -- A function call or a type conversion for the actual. -- FIXME: should be a name ? -- Only for Iir_Kind_Association_Element_By_Expression: -- Get/Set_In_Conversion (Field4) @@ -419,6 +419,7 @@ package Iirs is -- Only for Iir_Kind_Association_Element_By_Individual: -- Get/Set_Actual_Type (Field5) -- + -- A function call or a type conversion for the formal. -- Only for Iir_Kind_Association_Element_By_Expression: -- Get/Set_Out_Conversion (Field5) -- diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 8de3f149c..90cdc3179 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -555,13 +555,15 @@ package body Sem is if Get_Name_Staticness (Object) < Globally then Error_Msg_Sem (+Actual, "actual must be a static name"); end if; + Check_Port_Association_Bounds_Restrictions + (Formal, Actual, El); if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration then declare P : Boolean; pragma Unreferenced (P); begin - P := Check_Port_Association_Restriction + P := Check_Port_Association_Mode_Restrictions (Formal_Base, Prefix, El); end; end if; diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index 3ae609ac1..a56840df0 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -397,7 +397,7 @@ package body Sem_Assocs is -- Check for restrictions in LRM 1.1.1.2 -- Return FALSE in case of error. - function Check_Port_Association_Restriction + function Check_Port_Association_Mode_Restrictions (Formal : Iir_Interface_Signal_Declaration; Actual : Iir_Interface_Signal_Declaration; Assoc : Iir) @@ -426,7 +426,97 @@ package body Sem_Assocs is & Get_Mode_Name (Amode), +Formal); end if; return False; - end Check_Port_Association_Restriction; + end Check_Port_Association_Mode_Restrictions; + + -- Check restrictions of LRM02 12.2.4 + procedure Check_Port_Association_Bounds_Restrictions + (Formal : Iir; Actual : Iir; Assoc : Iir) + is + function Is_Scalar_Type_Compatible (Src : Iir; Dest : Iir) + return Boolean + is + Src_Range : Iir; + Dst_Range : Iir; + begin + if Get_Kind (Src) not in Iir_Kinds_Scalar_Type_Definition then + return True; + end if; + + Src_Range := Get_Range_Constraint (Src); + Dst_Range := Get_Range_Constraint (Dest); + if Get_Expr_Staticness (Src_Range) /= Locally + or else Get_Expr_Staticness (Dst_Range) /= Locally + then + return True; + end if; + + -- FIXME: non-static bounds have to be checked at run-time + -- (during elaboration). + if not Eval_Is_Eq (Get_Left_Limit (Src_Range), + Get_Left_Limit (Dst_Range)) + or else not Eval_Is_Eq (Get_Right_Limit (Src_Range), + Get_Right_Limit (Dst_Range)) + or else Get_Direction (Src_Range) /= Get_Direction (Dst_Range) + then + return False; + end if; + + return True; + end Is_Scalar_Type_Compatible; + + Inter : constant Iir := Get_Object_Prefix (Formal, False); + Ftype : constant Iir := Get_Type (Formal); + Atype : constant Iir := Get_Type (Actual); + F_Conv : constant Iir := Get_Out_Conversion (Assoc); + A_Conv : constant Iir := Get_In_Conversion (Assoc); + F2a_Type : Iir; + A2f_Type : Iir; + begin + -- LRM02 12.2.4 The port map aspect + -- If an actual signal is associated with a port of any mode, and if + -- the type of the formal is a scalar type, then it is an error if + -- (after applying any conversion function or type conversion + -- expression present in the actual part) the bounds and direction of + -- the subtype denoted by the subtype indication of the formal are not + -- identical to the bounds and direction of the subtype denoted by the + -- subtype indication of the actual. + if Is_Valid (F_Conv) then + F2a_Type := Get_Type (F_Conv); + else + F2a_Type := Ftype; + end if; + if Is_Valid (A_Conv) then + A2f_Type := Get_Type (A_Conv); + else + A2f_Type := Atype; + end if; + if Get_Mode (Inter) in Iir_In_Modes + and then not Is_Scalar_Type_Compatible (A2f_Type, Ftype) + then + if Flag_Elaborate then + Error_Msg_Elab + (Assoc, + "bounds or direction of formal and actual mismatch"); + else + Warning_Msg_Sem + (Warnid_Port_Bounds, +Assoc, + "bounds or direction of formal and actual mismatch"); + end if; + end if; + if Get_Mode (Inter) in Iir_Out_Modes + and then not Is_Scalar_Type_Compatible (F2a_Type, Atype) + then + if Flag_Elaborate then + Error_Msg_Elab + (Assoc, + "bounds or direction of formal and actual mismatch"); + else + Warning_Msg_Sem + (Warnid_Port_Bounds, +Assoc, + "bounds or direction of formal and actual mismatch"); + end if; + end if; + end Check_Port_Association_Bounds_Restrictions; -- Handle indexed name -- FORMAL is the formal name to be handled. diff --git a/src/vhdl/sem_assocs.ads b/src/vhdl/sem_assocs.ads index e40258915..9563138ce 100644 --- a/src/vhdl/sem_assocs.ads +++ b/src/vhdl/sem_assocs.ads @@ -55,9 +55,14 @@ package Sem_Assocs is -- Check for restrictions in LRM93 1.1.1.2 -- Return FALSE in case of error. - function Check_Port_Association_Restriction + function Check_Port_Association_Mode_Restrictions (Formal : Iir_Interface_Signal_Declaration; Actual : Iir_Interface_Signal_Declaration; Assoc : Iir) return Boolean; + + -- Check restrictions of LRM02 12.2.4 + procedure Check_Port_Association_Bounds_Restrictions + (Formal : Iir; Actual : Iir; Assoc : Iir); + end Sem_Assocs; diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb index 3cc08d03c..03a95ccad 100644 --- a/src/vhdl/sem_specs.adb +++ b/src/vhdl/sem_specs.adb @@ -1608,7 +1608,7 @@ package body Sem_Specs is (+Ent_El, +Ent_El)); Error := True; elsif Kind = Map_Port - and then not Check_Port_Association_Restriction + and then not Check_Port_Association_Mode_Restrictions (Ent_El, Comp_El, Null_Iir) then if not Error then @@ -1627,6 +1627,8 @@ package body Sem_Specs is Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression); Location_Copy (Assoc, Parent); Set_Actual (Assoc, Comp_El); + Check_Port_Association_Bounds_Restrictions + (Ent_El, Comp_El, Assoc); Found := Found + 1; end if; Set_Whole_Association_Flag (Assoc, True); |