ada: Add Unique_Component_Name function for use by CCG.

Define a new function which, initially, is never called.
It is intended to be called from CCG. If an Ada tagged record type
has a component named Foo, then the generated corresponding C struct
might have a component with the same name. This approach almost works,
but breaks down in the (rare) case of an Ada record type where two or more
components have the same name (this is normally illegal, but is possible in
the case of an extension where some component of the parent type is not
visible at the point of the extension). This new function is intended for
use in coping with this case.

gcc/ada/ChangeLog:

	* sem_aux.ads: Declare new function Unique_Component_Name.

	* sem_aux.adb: Implement new function Unique_Component_Name.

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index bb1624da5b74b8058a1c08e1b44ab77657092a37..08ff0b11268b803b6e1841c4bd3e1f65fdc2913c 100644 (file)
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -25,7 +25,6 @@
 
 with Atree;          use Atree;
 with Einfo;          use Einfo;
-with Einfo.Entities; use Einfo.Entities;
 with Einfo.Utils;    use Einfo.Utils;
 with Nlists;         use Nlists;
 with Sinfo;          use Sinfo;
@@ -1546,6 +1545,81 @@ package body Sem_Aux is
       return E;
    end Ultimate_Alias;
 
+   ---------------------------
+   -- Unique_Component_Name --
+   ---------------------------
+
+   function Unique_Component_Name
+     (Component : Record_Field_Kind_Id) return Name_Id
+   is
+      Homographic_Component_Count : Pos := 1;
+      Hcc                         : Pos renames Homographic_Component_Count;
+      Enclosing_Type              : Entity_Id :=
+        Underlying_Type (Base_Type (Scope (Component)));
+   begin
+      if Ekind (Enclosing_Type) = E_Record_Type
+        and then Is_Tagged_Type (Enclosing_Type)
+        and then Has_Private_Ancestor (Enclosing_Type)
+      then
+         --  traverse ancestors to determine Hcc value
+         loop
+            declare
+               Type_Decl : constant Node_Id :=
+                 Parent (Underlying_Type (Base_Type (Enclosing_Type)));
+               Type_Def : constant Node_Id := Type_Definition (Type_Decl);
+            begin
+               exit when Nkind (Type_Def) /= N_Derived_Type_Definition;
+               Enclosing_Type :=
+                 Underlying_Type (Base_Type (Etype (Enclosing_Type)));
+
+               declare
+                  Ancestor_Comp : Opt_Record_Field_Kind_Id :=
+                    First_Component_Or_Discriminant (Enclosing_Type);
+               begin
+                  while Present (Ancestor_Comp) loop
+                     if Chars (Ancestor_Comp) = Chars (Component) then
+                        Hcc := Hcc + 1;
+                        exit; -- exit not required, but might as well
+                     end if;
+                     Next_Component_Or_Discriminant (Ancestor_Comp);
+                  end loop;
+               end;
+            end;
+         end loop;
+      end if;
+
+      if Hcc = 1 then
+         --  the usual case
+         return Chars (Component);
+      else
+         declare
+            Buff : Bounded_String;
+         begin
+            Append (Buff, Chars (Component));
+
+            Append (Buff, "__");
+            --  A double underscore in an identifier is legal in C, not in Ada.
+            --  Returning a result that is not a legal Ada identifier
+            --  ensures that we won't have problems with collisions.
+            --  If we have a component named Foo and we just append a
+            --  number (without any underscores), that new name might match
+            --  the name of another component (which would be bad).
+            --  The result of this function is intended for use as an
+            --  identifier in generated C code, so it needs to be a
+            --  legal C identifer.
+
+            Append (Buff, Hcc);
+            --  Should we instead append Hcc - 1 here? This is a human
+            --  readability question. If parent type and extension each
+            --  have a Foo component, do we want the name returned for the
+            --  second Foo to be "foo__2" or "foo__1" ? Does it matter?
+            --  Either way, the name returned for the first Foo will be "foo".
+
+            return Name_Find (Buff);
+         end;
+      end if;
+   end Unique_Component_Name;
+
    --------------------------
    -- Unit_Declaration_Node --
    --------------------------

diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index aad5d324efece7f8020d2bd2d25e0efb06e25e9d..1a298a9a33fba3a472f3f6dd7649aabff03e3e41 100644 (file)
--- a/gcc/ada/sem_aux.ads
+++ b/gcc/ada/sem_aux.ads
@@ -31,6 +31,7 @@
 --  require more than minimal semantic knowledge.
 
 with Alloc;
+with Einfo.Entities; use Einfo.Entities;
 with Namet; use Namet;
 with Table;
 with Types; use Types;
@@ -405,6 +406,19 @@ package Sem_Aux is
    --  Return the last entity in the chain of aliased entities of Prim. If Prim
    --  has no alias return Prim.
 
+   function Unique_Component_Name
+     (Component : Record_Field_Kind_Id) return Name_Id;
+   --  Usually, a record type cannot have two components with the same name.
+   --  But in the case of a component declared in an extension of a tagged
+   --  private (or private extension) parent type, it is possible that some
+   --  ancestor type also has a (non-visible) component with the same name.
+   --  In the common case, this function simply returns the Chars attribute
+   --  of its argument.
+   --  But in the multiple-components-with-the-same-name case, it appends
+   --  a uniquifying suffix. The result in this case will not be a
+   --  syntactically valid Ada identifier, but it will be a syntactically
+   --  valid C identifier.
+
    function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
    --  Unit_Id is the simple name of a program unit, this function returns the
    --  corresponding xxx_Declaration node for the entity. Also applies to the