diff options
| -rw-r--r-- | src/vhdl/iirs.ads | 11 | ||||
| -rw-r--r-- | src/vhdl/sem_assocs.adb | 41 | ||||
| -rw-r--r-- | src/vhdl/sem_specs.adb | 6 |
3 files changed, 37 insertions, 21 deletions
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 8f2d21c29..50255d267 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -2935,6 +2935,17 @@ package Iirs is -- Iir_Kind_If_Statement (Short) -- Iir_Kind_Elsif (Short) -- + -- LRM08 10.8 + -- if_statement ::= + -- [ /if/_label : ] + -- IF condition THEN + -- sequence_of_statements + -- { ELSIF condition THEN + -- sequence_of_statements } + -- [ ELSE + -- sequence_of_satements ] + -- END IF [ /if/_label ] ; + -- -- Get/Set_Parent (Field0) -- -- May be NULL only for an iir_kind_elsif node, and then means the else diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index f1cb1fe85..a2c45eeac 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -434,6 +434,8 @@ package body Sem_Assocs is procedure Check_Port_Association_Bounds_Restrictions (Formal : Iir; Actual : Iir; Assoc : Iir) is + Inter : constant Iir := Get_Object_Prefix (Formal, False); + function Is_Scalar_Type_Compatible (Src : Iir; Dest : Iir) return Boolean is @@ -477,7 +479,24 @@ package body Sem_Assocs is return True; end Is_Scalar_Type_Compatible; - Inter : constant Iir := Get_Object_Prefix (Formal, False); + procedure Error_Msg + is + Id : Msgid_Type; + Orig : Report_Origin; + begin + if Flag_Elaborate then + Id := Msgid_Error; + Orig := Elaboration; + else + Id := Warnid_Port_Bounds; + Orig := Semantic; + end if; + Report_Msg + (Id, Orig, +Assoc, + "bounds or direction of actual don't match with %n", + (1 => +Inter)); + end Error_Msg; + Ftype : constant Iir := Get_Type (Formal); Atype : constant Iir := Get_Type (Actual); F_Conv : constant Iir := Get_Out_Conversion (Assoc); @@ -519,28 +538,12 @@ package body Sem_Assocs is 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; + Error_Msg; 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; + Error_Msg; end if; end Check_Port_Association_Bounds_Restrictions; diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb index 03a95ccad..7e0c608a1 100644 --- a/src/vhdl/sem_specs.adb +++ b/src/vhdl/sem_specs.adb @@ -1627,8 +1627,10 @@ 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); + if Kind = Map_Port then + Check_Port_Association_Bounds_Restrictions + (Ent_El, Comp_El, Assoc); + end if; Found := Found + 1; end if; Set_Whole_Association_Flag (Assoc, True); |