Use specific error message for direction mismatch.

Fix #559

3 files changed, 45 insertions, 15 deletions

diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index cb31da86b..6cad50223 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -54,11 +54,24 @@ package body Trans.Chap6 is
    begin
       Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col);
 
-      Start_Association (Constr, Ghdl_Bound_Check_Failed_L1);
+      Start_Association (Constr, Ghdl_Bound_Check_Failed);
       Assoc_Filename_Line (Constr, Line);
       New_Procedure_Call (Constr);
    end Gen_Bound_Error;
 
+   procedure Gen_Direction_Error (Loc : Iir)
+   is
+      Constr    : O_Assoc_List;
+      Name      : Name_Id;
+      Line, Col : Natural;
+   begin
+      Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col);
+
+      Start_Association (Constr, Ghdl_Direction_Check_Failed);
+      Assoc_Filename_Line (Constr, Line);
+      New_Procedure_Call (Constr);
+   end Gen_Direction_Error;
+
    procedure Gen_Program_Error (Loc : Iir; Code : Natural)
    is
       Assoc : O_Assoc_List;
@@ -92,6 +105,15 @@ package body Trans.Chap6 is
       Finish_If_Stmt (If_Blk);
    end Check_Bound_Error;
 
+   procedure Check_Direction_Error (Cond : O_Enode; Loc : Iir)
+   is
+      If_Blk : O_If_Block;
+   begin
+      Start_If_Stmt (If_Blk, Cond);
+      Gen_Direction_Error (Loc);
+      Finish_If_Stmt (If_Blk);
+   end Check_Direction_Error;
+
    --  Return TRUE if an array whose index type is RNG_TYPE indexed by
    --  an expression of type EXPR_TYPE needs a bound check.
    function Need_Index_Check (Expr_Type : Iir; Rng_Type : Iir)
@@ -586,12 +608,12 @@ package body Trans.Chap6 is
         or else Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition
       then
          --  Check same direction.
-         Check_Bound_Error
+         Check_Direction_Error
            (New_Compare_Op (ON_Neq,
-            M2E (Chap3.Range_To_Dir (Prefix_Range)),
-            M2E (Chap3.Range_To_Dir (Slice_Range)),
-            Ghdl_Bool_Type),
-            Expr, 1);
+                            M2E (Chap3.Range_To_Dir (Prefix_Range)),
+                            M2E (Chap3.Range_To_Dir (Slice_Range)),
+                            Ghdl_Bool_Type),
+            Expr);
       end if;
 
       Unsigned_Diff := Create_Temp (Ghdl_Index_Type);
diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads
index 0a2d5e69f..d0011e653 100644
--- a/src/vhdl/translate/trans_decls.ads
+++ b/src/vhdl/translate/trans_decls.ads
@@ -168,7 +168,8 @@ package Trans_Decls is
 
    --  Procedure called in case of check failed.
    Ghdl_Program_Error : O_Dnode;
-   Ghdl_Bound_Check_Failed_L1 : O_Dnode;
+   Ghdl_Bound_Check_Failed : O_Dnode;
+   Ghdl_Direction_Check_Failed : O_Dnode;
 
    --  Stack 2.
    Ghdl_Stack2_Allocate : O_Dnode;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 7c7e1904e..6baaaa995 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -601,22 +601,29 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_program_error"),
          O_Storage_External);
-      New_Interface_Decl
-        (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
-      New_Interface_Decl
-        (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
       New_Interface_Decl
         (Interfaces, Param, Get_Identifier ("code"), Ghdl_Index_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Program_Error);
 
-      --  procedure __ghdl_bound_check_failed_l1 (filename : char_ptr_type;
-      --                                          line : ghdl_i32);
+      --  procedure __ghdl_bound_check_failed (filename : char_ptr_type;
+      --                                       line : ghdl_i32);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_bound_check_failed"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed);
+
+      --  procedure __ghdl_direction_check_failed (filename : char_ptr_type;
+      --                                           line : ghdl_i32);
       Start_Procedure_Decl
-        (Interfaces, Get_Identifier ("__ghdl_bound_check_failed_l1"),
+        (Interfaces, Get_Identifier ("__ghdl_direction_check_failed"),
          O_Storage_External);
       New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
       New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
-      Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed_L1);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Direction_Check_Failed);
 
       --  Secondary stack subprograms.
       --  function __ghdl_stack2_allocate (size : ghdl_index_type)