Fix bug14953: improve error message for direct signal assignment.

7 files changed, 55 insertions, 13 deletions

diff --git a/testsuite/gna/bug14953/bug.vhdl b/testsuite/gna/bug14953/bug.vhdl
new file mode 100644
index 000000000..228e7e60d
--- /dev/null
+++ b/testsuite/gna/bug14953/bug.vhdl
@@ -0,0 +1,11 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+entity bug is
+end entity;
+
+architecture a of bug is
+    signal irunning :natural range 0 to 1 := 2;  -- reports no error
+begin
+    irunning <= 2;  -- reports error, but no information
+end architecture;
diff --git a/testsuite/gna/bug14953/bug2.vhdl b/testsuite/gna/bug14953/bug2.vhdl
new file mode 100644
index 000000000..a84c39669
--- /dev/null
+++ b/testsuite/gna/bug14953/bug2.vhdl
@@ -0,0 +1,11 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+entity bug is
+end entity;
+
+architecture a of bug is
+    signal irunning :natural range 0 to 1;
+begin
+    irunning <= 2;  -- reports error, but no information
+end architecture;
diff --git a/testsuite/gna/bug14953/testsuite.sh b/testsuite/gna/bug14953/testsuite.sh
new file mode 100755
index 000000000..1e8b4b9ee
--- /dev/null
+++ b/testsuite/gna/bug14953/testsuite.sh
@@ -0,0 +1,12 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze_failure bug.vhdl
+
+analyze bug2.vhdl
+elab_simulate_failure bug
+
+clean
+
+echo "Test successful"
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index cc3d5ffaa..8a5405f95 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -1001,7 +1001,7 @@ package body Grt.Disp_Rti is
       Put ("DISP_RTI.Disp_All: ");
       Disp_Kind (Ghdl_Rti_Top.Common.Kind);
       New_Line;
-      Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
+      Ctxt := (Base => Ghdl_Rti_Top_Instance,
                Block => Ghdl_Rti_Top.Parent);
       Disp_Rti_Arr (Ghdl_Rti_Top.Nbr_Child,
                     Ghdl_Rti_Top.Children,
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index 6caba1539..2276adf47 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -335,7 +335,7 @@ package Grt.Rtis is
       Children => null);
 
    --  Address of the top instance.
-   Ghdl_Rti_Top_Instance : Ghdl_Rti_Access;
+   Ghdl_Rti_Top_Instance : Address;
 
    --  Instances have a pointer to their RTI at offset 0.
    type Ghdl_Rti_Acc_Acc is access Ghdl_Rti_Access;
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
index 0c64d0cec..784698d35 100644
--- a/translate/grt/grt-rtis_addr.adb
+++ b/translate/grt/grt-rtis_addr.adb
@@ -264,7 +264,7 @@ package body Grt.Rtis_Addr is
    is
       Ctxt : Rti_Context;
    begin
-      Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
+      Ctxt := (Base => Ghdl_Rti_Top_Instance,
                Block => Ghdl_Rti_Top.Parent);
       return Ctxt;
    end Get_Top_Context;
diff --git a/translate/translation.adb b/translate/translation.adb
index 0f2835fa2..7b8351f47 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -20877,8 +20877,14 @@ package body Translation is
       end Translate_Signal_Target_Aggr;
 
       type Signal_Direct_Assign_Data is record
+         --  The driver
          Drv : Mnode;
+
+         --  The value
          Expr : Mnode;
+
+         --  The node for the expression (used to locate errors).
+         Expr_Node : Iir;
       end record;
 
       procedure Gen_Signal_Direct_Assign_Non_Composite
@@ -20896,7 +20902,7 @@ package body Translation is
 
          --  Set driver.
          Chap7.Translate_Assign
-           (Drv, M2E (Data.Expr), Null_Iir, Targ_Type);
+           (Drv, M2E (Data.Expr), Data.Expr_Node, Targ_Type);
 
          --  Test if the signal is active.
          Start_If_Stmt
@@ -20956,7 +20962,8 @@ package body Translation is
       begin
          return Signal_Direct_Assign_Data'
            (Drv => Stabilize (Val.Drv),
-            Expr => Stabilize (Val.Expr));
+            Expr => Stabilize (Val.Expr),
+            Expr_Node => Val.Expr_Node);
       end Gen_Signal_Direct_Prepare_Data_Record;
 
       function Gen_Signal_Direct_Update_Data_Array
@@ -20970,7 +20977,8 @@ package body Translation is
            (Drv => Chap3.Index_Base (Chap3.Get_Array_Base (Val.Drv),
                                      Targ_Type, New_Obj_Value (Index)),
             Expr => Chap3.Index_Base (Chap3.Get_Array_Base (Val.Expr),
-                                      Targ_Type, New_Obj_Value (Index)));
+                                      Targ_Type, New_Obj_Value (Index)),
+            Expr_Node => Val.Expr_Node);
       end Gen_Signal_Direct_Update_Data_Array;
 
       function Gen_Signal_Direct_Update_Data_Record
@@ -20983,7 +20991,8 @@ package body Translation is
       begin
          return Signal_Direct_Assign_Data'
            (Drv => Chap6.Translate_Selected_Element (Val.Drv, El),
-            Expr => Chap6.Translate_Selected_Element (Val.Expr, El));
+            Expr => Chap6.Translate_Selected_Element (Val.Expr, El),
+            Expr_Node => Val.Expr_Node);
       end Gen_Signal_Direct_Update_Data_Record;
 
       procedure Gen_Signal_Direct_Finish_Data_Composite
@@ -21018,6 +21027,7 @@ package body Translation is
 
          Arg.Expr := E2M (Chap7.Translate_Expression (We, Target_Type),
                           Get_Info (Target_Type), Mode_Value);
+         Arg.Expr_Node := We;
          Gen_Signal_Direct_Assign (Targ_Sig, Target_Type, Arg);
          return;
       end Translate_Direct_Signal_Assignment;
@@ -29436,17 +29446,15 @@ package body Translation is
          --  We need to create code.
          Set_Global_Storage (O_Storage_Private);
 
-         --  Create the array of packages (as a variable, dynamically
-         --  initialized).
+         --  Create the array of RTIs for packages (as a variable, initialized
+         --  during elaboration).
          Arr_Type := New_Constrained_Array_Type
            (Rtis.Ghdl_Rti_Array,
             New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Pkgs)));
          New_Var_Decl (Arr, Get_Identifier ("__ghdl_top_RTIARRAY"),
                        O_Storage_Private, Arr_Type);
 
-         --  Declare (but do not define):
-         --  Variable for the hierarchy top instance.
-
+         --  The elaboration entry point.
          Start_Procedure_Decl (Inter_List, Get_Identifier ("__ghdl_ELABORATE"),
                                O_Storage_Public);
          Finish_Subprogram_Decl (Inter_List, Ghdl_Elaborate);
@@ -29458,7 +29466,7 @@ package body Translation is
          New_Var_Decl (Instance, Wki_Instance, O_Storage_Local,
                        Entity_Info.Block_Decls_Ptr_Type);
 
-         --  create instance for the architecture
+         --  Create instance for the architecture.
          New_Assign_Stmt
            (New_Obj (Arch_Instance),
             Gen_Alloc (Alloc_System,