From d4e80643bc015d6404d9ac23a32cf9c5ff084976 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sat, 13 Nov 2021 22:14:46 +0100
Subject: synth: add exec_name_subtype.  Fix #1911

---
 src/synth/elab-vhdl_expr.adb | 48 +++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 47 insertions(+), 1 deletion(-)

(limited to 'src/synth/elab-vhdl_expr.adb')

diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb
index 35a92c39d..ff2ef3c9d 100644
--- a/src/synth/elab-vhdl_expr.adb
+++ b/src/synth/elab-vhdl_expr.adb
@@ -709,10 +709,56 @@ package body Elab.Vhdl_Expr is
                return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val));
             end;
          when others =>
-            Error_Kind ("synth_name", Name);
+            Error_Kind ("exec_name", Name);
       end case;
    end Exec_Name;
 
+   function Exec_Name_Subtype (Syn_Inst : Synth_Instance_Acc; Name : Node)
+                              return Type_Acc is
+   begin
+      case Get_Kind (Name) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            return Exec_Name_Subtype (Syn_Inst, Get_Named_Entity (Name));
+         when Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Constant_Declaration
+           | Iir_Kind_Iterator_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_File_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            return Get_Value (Syn_Inst, Name).Typ;
+         when Iir_Kind_Selected_Element =>
+            declare
+               Idx : constant Iir_Index32 :=
+                 Get_Element_Position (Get_Named_Entity (Name));
+               Pfx : constant Node := Get_Prefix (Name);
+               Res : Type_Acc;
+            begin
+               Res := Exec_Name_Subtype (Syn_Inst, Pfx);
+               Res := Res.Rec.E (Idx + 1).Typ;
+               return Res;
+            end;
+         when Iir_Kind_Enumeration_Literal
+            | Iir_Kind_Unit_Declaration =>
+            return Get_Subtype_Object (Syn_Inst, Get_Type (Name));
+         when Iir_Kind_Implicit_Dereference
+           | Iir_Kind_Dereference =>
+            declare
+               Val : Valtyp;
+            begin
+               Val := Exec_Expression (Syn_Inst, Get_Prefix (Name));
+               Val := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val));
+               return Val.Typ;
+            end;
+         when others =>
+            Error_Kind ("exec_name_subtype", Name);
+      end case;
+   end Exec_Name_Subtype;
+
    procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc;
                                      Pfx : Node;
                                      Dest_Base : out Valtyp;
-- 
cgit v1.2.3