sem_names: improve support of external names.

6 files changed, 127 insertions, 75 deletions

diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index 72e871d6b..5ced8f0e5 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -197,6 +197,10 @@ package body Canon is
          when Iir_Kind_Allocator_By_Subtype =>
             null;
 
+         when Iir_Kind_External_Variable_Name
+           | Iir_Kind_External_Constant_Name =>
+            null;
+
          when Iir_Kinds_Monadic_Operator =>
             Canon_Extract_Sensitivity
               (Get_Operand (Expr), Sensitivity_List, False);
@@ -224,7 +228,8 @@ package body Canon is
          when Iir_Kind_Interface_Signal_Declaration
            | Iir_Kind_Signal_Declaration
            | Iir_Kind_Guard_Signal_Declaration
-           | Iir_Kinds_Signal_Attribute =>
+           | Iir_Kinds_Signal_Attribute
+           | Iir_Kind_External_Signal_Name =>
             --  LRM 8.1
             --  A simple name that denotes a signal, add the longuest static
             --  prefix of the name to the sensitivity set;
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 8aa7f442f..c6c53f8e7 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -3681,6 +3681,29 @@ package Iirs is
    --
    --   Get/Set_Name_Staticness (State2)
 
+   -- Iir_Kind_External_Constant_Name (Short)
+   -- Iir_Kind_External_Signal_Name (Short)
+   -- Iir_Kind_External_Variable_Name (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --   Get/Set_Type (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_External_Pathname (Field3)
+   --
+   --   Get/Set_Named_Entity (Field4)
+   --
+   --   Get/Set_Subtype_Indication (Field5)
+   --
+   --  Only for Iir_Kind_External_Variable_Name:
+   --   Get/Set_Shared_Flag (Flag2)
+   --
+   --   Get/Set_Expr_Staticness (State1)
+   --
+   --   Get/Set_Name_Staticness (State2)
+
    -- Iir_Kind_Selected_By_All_Name (Short)
    --
    --   Get/Set_Prefix (Field0)
@@ -3774,27 +3797,6 @@ package Iirs is
    --
    --   Get/Set_Name_Staticness (State2)
 
-   -- Iir_Kind_External_Constant_Name (Short)
-   -- Iir_Kind_External_Signal_Name (Short)
-   -- Iir_Kind_External_Variable_Name (Short)
-   --
-   --   Get/Set_Parent (Field0)
-   --
-   --   Get/Set_Type (Field1)
-   --
-   --   Get/Set_Chain (Field2)
-   --
-   --   Get/Set_External_Pathname (Field3)
-   --
-   --   Get/Set_Subtype_Indication (Field5)
-   --
-   --  Only for Iir_Kind_External_Variable_Name:
-   --   Get/Set_Shared_Flag (Flag2)
-   --
-   --   Get/Set_Expr_Staticness (State1)
-   --
-   --   Get/Set_Name_Staticness (State2)
-
    -- Iir_Kind_Package_Pathname (Short)
    --  This node represents only the library_logical_name. Package and object
    --  simple_names are represented by Selected_Name.
@@ -4293,13 +4295,13 @@ package Iirs is
       Iir_Kind_Operator_Symbol,                --  denoting_name
       Iir_Kind_Reference_Name,                 --  denoting_name
 
-      Iir_Kind_Selected_By_All_Name,
-      Iir_Kind_Parenthesis_Name,
-
       Iir_Kind_External_Constant_Name,
       Iir_Kind_External_Signal_Name,
       Iir_Kind_External_Variable_Name,
 
+      Iir_Kind_Selected_By_All_Name,
+      Iir_Kind_Parenthesis_Name,
+
       Iir_Kind_Package_Pathname,
       Iir_Kind_Absolute_Pathname,
       Iir_Kind_Relative_Pathname,
@@ -5194,6 +5196,16 @@ package Iirs is
    --Iir_Kind_Operator_Symbol
      Iir_Kind_Reference_Name;
 
+   subtype Iir_Kinds_Denoting_And_External_Name is Iir_Kind range
+     Iir_Kind_Character_Literal ..
+   --Iir_Kind_Simple_Name
+   --Iir_Kind_Selected_Name
+   --Iir_Kind_Operator_Symbol
+   --Iir_Kind_Reference_Name
+   --Iir_Kind_External_Constant_Name
+   --Iir_Kind_External_Signal_Name
+     Iir_Kind_External_Variable_Name;
+
    subtype Iir_Kinds_Name is Iir_Kind range
      Iir_Kind_Character_Literal ..
    --Iir_Kind_Simple_Name
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index a477b2c32..2b4c87422 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -436,6 +436,9 @@ package body Iirs_Utils is
             --  GHDL: in particular, names can denote objects.
             return Name_To_Object (Get_Named_Entity (Name));
 
+         when Iir_Kinds_External_Name =>
+            return Name;
+
          when others =>
             return Null_Iir;
       end case;
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 836614625..0200ebc4f 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -4076,6 +4076,7 @@ package body Nodes_Meta is
       Field_Type,
       Field_Chain,
       Field_External_Pathname,
+      Field_Named_Entity,
       Field_Subtype_Indication,
       --  Iir_Kind_External_Signal_Name
       Field_Shared_Flag,
@@ -4085,6 +4086,7 @@ package body Nodes_Meta is
       Field_Type,
       Field_Chain,
       Field_External_Pathname,
+      Field_Named_Entity,
       Field_Subtype_Indication,
       --  Iir_Kind_External_Variable_Name
       Field_Shared_Flag,
@@ -4094,6 +4096,7 @@ package body Nodes_Meta is
       Field_Type,
       Field_Chain,
       Field_External_Pathname,
+      Field_Named_Entity,
       Field_Subtype_Indication,
       --  Iir_Kind_Package_Pathname
       Field_Identifier,
@@ -4606,54 +4609,54 @@ package body Nodes_Meta is
       Iir_Kind_Reference_Name => 1629,
       Iir_Kind_Selected_By_All_Name => 1635,
       Iir_Kind_Parenthesis_Name => 1640,
-      Iir_Kind_External_Constant_Name => 1648,
-      Iir_Kind_External_Signal_Name => 1656,
-      Iir_Kind_External_Variable_Name => 1664,
-      Iir_Kind_Package_Pathname => 1668,
-      Iir_Kind_Absolute_Pathname => 1669,
-      Iir_Kind_Relative_Pathname => 1670,
-      Iir_Kind_Pathname_Element => 1675,
-      Iir_Kind_Base_Attribute => 1677,
-      Iir_Kind_Subtype_Attribute => 1682,
-      Iir_Kind_Element_Attribute => 1687,
-      Iir_Kind_Left_Type_Attribute => 1692,
-      Iir_Kind_Right_Type_Attribute => 1697,
-      Iir_Kind_High_Type_Attribute => 1702,
-      Iir_Kind_Low_Type_Attribute => 1707,
-      Iir_Kind_Ascending_Type_Attribute => 1712,
-      Iir_Kind_Image_Attribute => 1718,
-      Iir_Kind_Value_Attribute => 1724,
-      Iir_Kind_Pos_Attribute => 1730,
-      Iir_Kind_Val_Attribute => 1736,
-      Iir_Kind_Succ_Attribute => 1742,
-      Iir_Kind_Pred_Attribute => 1748,
-      Iir_Kind_Leftof_Attribute => 1754,
-      Iir_Kind_Rightof_Attribute => 1760,
-      Iir_Kind_Delayed_Attribute => 1769,
-      Iir_Kind_Stable_Attribute => 1778,
-      Iir_Kind_Quiet_Attribute => 1787,
-      Iir_Kind_Transaction_Attribute => 1796,
-      Iir_Kind_Event_Attribute => 1800,
-      Iir_Kind_Active_Attribute => 1804,
-      Iir_Kind_Last_Event_Attribute => 1808,
-      Iir_Kind_Last_Active_Attribute => 1812,
-      Iir_Kind_Last_Value_Attribute => 1816,
-      Iir_Kind_Driving_Attribute => 1820,
-      Iir_Kind_Driving_Value_Attribute => 1824,
-      Iir_Kind_Behavior_Attribute => 1824,
-      Iir_Kind_Structure_Attribute => 1824,
-      Iir_Kind_Simple_Name_Attribute => 1831,
-      Iir_Kind_Instance_Name_Attribute => 1836,
-      Iir_Kind_Path_Name_Attribute => 1841,
-      Iir_Kind_Left_Array_Attribute => 1848,
-      Iir_Kind_Right_Array_Attribute => 1855,
-      Iir_Kind_High_Array_Attribute => 1862,
-      Iir_Kind_Low_Array_Attribute => 1869,
-      Iir_Kind_Length_Array_Attribute => 1876,
-      Iir_Kind_Ascending_Array_Attribute => 1883,
-      Iir_Kind_Range_Array_Attribute => 1890,
-      Iir_Kind_Reverse_Range_Array_Attribute => 1897,
-      Iir_Kind_Attribute_Name => 1906
+      Iir_Kind_External_Constant_Name => 1649,
+      Iir_Kind_External_Signal_Name => 1658,
+      Iir_Kind_External_Variable_Name => 1667,
+      Iir_Kind_Package_Pathname => 1671,
+      Iir_Kind_Absolute_Pathname => 1672,
+      Iir_Kind_Relative_Pathname => 1673,
+      Iir_Kind_Pathname_Element => 1678,
+      Iir_Kind_Base_Attribute => 1680,
+      Iir_Kind_Subtype_Attribute => 1685,
+      Iir_Kind_Element_Attribute => 1690,
+      Iir_Kind_Left_Type_Attribute => 1695,
+      Iir_Kind_Right_Type_Attribute => 1700,
+      Iir_Kind_High_Type_Attribute => 1705,
+      Iir_Kind_Low_Type_Attribute => 1710,
+      Iir_Kind_Ascending_Type_Attribute => 1715,
+      Iir_Kind_Image_Attribute => 1721,
+      Iir_Kind_Value_Attribute => 1727,
+      Iir_Kind_Pos_Attribute => 1733,
+      Iir_Kind_Val_Attribute => 1739,
+      Iir_Kind_Succ_Attribute => 1745,
+      Iir_Kind_Pred_Attribute => 1751,
+      Iir_Kind_Leftof_Attribute => 1757,
+      Iir_Kind_Rightof_Attribute => 1763,
+      Iir_Kind_Delayed_Attribute => 1772,
+      Iir_Kind_Stable_Attribute => 1781,
+      Iir_Kind_Quiet_Attribute => 1790,
+      Iir_Kind_Transaction_Attribute => 1799,
+      Iir_Kind_Event_Attribute => 1803,
+      Iir_Kind_Active_Attribute => 1807,
+      Iir_Kind_Last_Event_Attribute => 1811,
+      Iir_Kind_Last_Active_Attribute => 1815,
+      Iir_Kind_Last_Value_Attribute => 1819,
+      Iir_Kind_Driving_Attribute => 1823,
+      Iir_Kind_Driving_Value_Attribute => 1827,
+      Iir_Kind_Behavior_Attribute => 1827,
+      Iir_Kind_Structure_Attribute => 1827,
+      Iir_Kind_Simple_Name_Attribute => 1834,
+      Iir_Kind_Instance_Name_Attribute => 1839,
+      Iir_Kind_Path_Name_Attribute => 1844,
+      Iir_Kind_Left_Array_Attribute => 1851,
+      Iir_Kind_Right_Array_Attribute => 1858,
+      Iir_Kind_High_Array_Attribute => 1865,
+      Iir_Kind_Low_Array_Attribute => 1872,
+      Iir_Kind_Length_Array_Attribute => 1879,
+      Iir_Kind_Ascending_Array_Attribute => 1886,
+      Iir_Kind_Range_Array_Attribute => 1893,
+      Iir_Kind_Reverse_Range_Array_Attribute => 1900,
+      Iir_Kind_Attribute_Name => 1909
      );
 
    function Get_Fields_First (K : Iir_Kind) return Fields_Index is
@@ -9370,6 +9373,9 @@ package body Nodes_Meta is
            | Iir_Kind_Reference_Name
            | Iir_Kind_Selected_By_All_Name
            | Iir_Kind_Parenthesis_Name
+           | Iir_Kind_External_Constant_Name
+           | Iir_Kind_External_Signal_Name
+           | Iir_Kind_External_Variable_Name
            | Iir_Kind_Package_Pathname
            | Iir_Kind_Pathname_Element
            | Iir_Kind_Attribute_Name =>
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 56d2a796d..0e0240809 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -2216,6 +2216,16 @@ package body Sem_Decls is
                  (+Alias, "base type of aliased name and name mismatch");
             end if;
          end if;
+
+         --  LRM08 6.6.2 Object aliases
+         --  The following rules apply yo object aliases:
+         --  b) If the name is an external name, a subtype indication shall not
+         --     appear in the alias declaration.
+         if Get_Kind (N_Name) in Iir_Kinds_External_Name then
+            Error_Msg_Sem
+              (+Alias,
+               "subtype indication not allowed in alias of external name");
+         end if;
       end if;
 
       --  LRM93 4.3.3.1
@@ -2699,11 +2709,11 @@ package body Sem_Decls is
 
          Free_Iir (Alias);
 
-         if Get_Kind (Name) in Iir_Kinds_Denoting_Name then
+         if Get_Kind (Name) in Iir_Kinds_Denoting_And_External_Name then
             Sem_Non_Object_Alias_Declaration (Res);
          else
             Error_Msg_Sem
-              (+Name, "name of nonobject alias is not a declaration");
+              (+Name, "name of nonobject alias is not a name");
 
             --  Create a simple name to an error node.
             N_Entity := Create_Error (Name);
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index dd2851899..6ec51ed3a 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -1736,6 +1736,9 @@ package body Sem_Names is
            | Iir_Kind_Instance_Name_Attribute =>
             Free_Iir (Name);
             return Res;
+         when Iir_Kinds_External_Name =>
+            pragma Assert (Name = Res);
+            return Res;
          when Iir_Kind_Psl_Expression =>
             return Res;
          when Iir_Kind_Psl_Declaration =>
@@ -3776,6 +3779,8 @@ package body Sem_Names is
             Sem_Selected_By_All_Name (Name);
          when Iir_Kind_Attribute_Name =>
             Sem_Attribute_Name (Name);
+         when Iir_Kinds_External_Name =>
+            Sem_External_Name (Name);
          when others =>
             Error_Kind ("sem_name", Name);
       end case;
@@ -4235,6 +4240,17 @@ package body Sem_Names is
       end if;
 
       Set_Type (Name, Atype);
+
+      --  LRM08 8.1 Names
+      --  A name is said to be a static name if and only if one of the
+      --  following condition holds:
+      --  - The name is an external name.
+      Set_Name_Staticness (Name, Globally);
+
+      Set_Expr_Staticness (Name, None);
+
+      --  Consider the node as analyzed.
+      Set_Named_Entity (Name, Name);
    end Sem_External_Name;
 
    function Sem_Terminal_Name (Name : Iir) return Iir