Refine error message for issue #148.

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);