diff options
Diffstat (limited to 'gcc/ada/sem_aux.adb')
| -rw-r--r-- | gcc/ada/sem_aux.adb | 88 |
1 files changed, 87 insertions, 1 deletions
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index bb1624d..0aa74e3 100644 --- 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; @@ -454,16 +453,28 @@ package body Sem_Aux is Id : Entity_Id; begin + -- Call using access to subprogram with explicit dereference + if Nkind (Nam) = N_Explicit_Dereference then Id := Etype (Nam); pragma Assert (Ekind (Id) = E_Subprogram_Type); + -- Case of call to simple entry, where the Name is a selected component + -- whose prefix is the task or protected record, and whose selector name + -- is the entry name. + elsif Nkind (Nam) = N_Selected_Component then Id := Entity (Selector_Name (Nam)); + -- Case of call to member of entry family, where Name is an indexed + -- component, with the prefix being a selected component giving the + -- task and entry family name, and the index being the entry index. + elsif Nkind (Nam) = N_Indexed_Component then Id := Entity (Selector_Name (Prefix (Nam))); + -- Normal case + else Id := Entity (Nam); end if; @@ -1546,6 +1557,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 -- -------------------------- |