OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2011-08-04  Vincent Celier  <celier@adacore.com>

	* gnat_ugn.texi: Improve documentation of gnatmake switch
	--source-info-file=.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Make_Final_Call): Add local variable Atyp (assertion
	type). Initialize Atyp to the appropriate type which is later checked
	for completion. Rewrite the assertion associated with private type
	completion.

2011-08-04  Ed Falis  <falis@adacore.com>

	* adaint.c: Add call to vxCpuConfiguredGet for VxWorks SMP to
	initialize the number of CPUs.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb (Disambiguate): New subsidiary routine
	In_Same_Declaration_List, to implement AI05-0020: a user-defined
	equality on an anonymous access type whose designated type is private
	does not lead to an ambiguity with the universal access equality
	operator in the body or child units of the defining package. The same
	is true for a multiplication operator on a private type completed with
	a fixed-point-type.

2011-08-04  Javier Miranda  <miranda@adacore.com>

	* opt.ads (Init_Or_Norm_Scalars_Config): Removed.
	(Normalize_Scalars_Config): Removed.
	* opt.adb
	(Register_Opt_Config_Switches): Remove registering config values of
	Init_Or_Norm_Scalars_Config and Normalize_Scalars_Config.
	(Restore_Opt_Config_Switches): Remove code which restores the values of
	Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of
	Init_Or_Norm_Scalars.
	(Save_Opt_Config_Switches): Remove code which saves values of
	Init_Or_Norm_Scalars and Normalize_Scalars.
	(Set_Opt_Config_Switches): Remove code which restores config values of
	Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of
	Init_Or_Norm_Scalars.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* frontend.adb (Frontend): remove previous patch to avoid full
	qualification in ALFA mode.
	* lib-xref-alfa.adb (Add_ALFA_Xrefs): use unique name for variables.
	* sem_util.adb, sem_util.ads (Unique_Name): new function to define a
	unique name for an entity, which could be used to identify the entity
	across compilation units.

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* prj-env.adb
	(Initialize_Default_Project_Path): Add target specific directory
	($prefix/$target/lib/gnat) in front of project path in all cases
	(making gnatmake's behaviour consistent with gprbuild).
	* gnatcmd.adb, make.adb, prj-makr.adb, clean.adb:
	Pass target name from Sdefault to project subsystem.
	* gnatls.adb: Show new target specific default project directory.

2011-08-04  Johannes Kanig  <kanig@adacore.com>

	* cstand.adb: Add Information to Identifier in Standard
	(Identifer_For): Set Entity to the corresponding entity

From-SVN: r177383
This commit is contained in:
Arnaud Charlet 2011-08-04 15:31:14 +02:00
parent 483361a681
commit 6a2e5d0f3d
18 changed files with 239 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
gcc/ada/ChangeLog
View File

@ -1,3 +1,70 @@
2011-08-04 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Improve documentation of gnatmake switch
--source-info-file=.
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Make_Final_Call): Add local variable Atyp (assertion
type). Initialize Atyp to the appropriate type which is later checked
for completion. Rewrite the assertion associated with private type
completion.
2011-08-04 Ed Falis <falis@adacore.com>
* adaint.c: Add call to vxCpuConfiguredGet for VxWorks SMP to
initialize the number of CPUs.
2011-08-04 Ed Schonberg <schonberg@adacore.com>
* sem_type.adb (Disambiguate): New subsidiary routine
In_Same_Declaration_List, to implement AI05-0020: a user-defined
equality on an anonymous access type whose designated type is private
does not lead to an ambiguity with the universal access equality
operator in the body or child units of the defining package. The same
is true for a multiplication operator on a private type completed with
a fixed-point-type.
2011-08-04 Javier Miranda <miranda@adacore.com>
* opt.ads (Init_Or_Norm_Scalars_Config): Removed.
(Normalize_Scalars_Config): Removed.
* opt.adb
(Register_Opt_Config_Switches): Remove registering config values of
Init_Or_Norm_Scalars_Config and Normalize_Scalars_Config.
(Restore_Opt_Config_Switches): Remove code which restores the values of
Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of
Init_Or_Norm_Scalars.
(Save_Opt_Config_Switches): Remove code which saves values of
Init_Or_Norm_Scalars and Normalize_Scalars.
(Set_Opt_Config_Switches): Remove code which restores config values of
Init_Or_Norm_Scalars and Normalize_Scalars. Recalculate value of
Init_Or_Norm_Scalars.
2011-08-04 Yannick Moy <moy@adacore.com>
* frontend.adb (Frontend): remove previous patch to avoid full
qualification in ALFA mode.
* lib-xref-alfa.adb (Add_ALFA_Xrefs): use unique name for variables.
* sem_util.adb, sem_util.ads (Unique_Name): new function to define a
unique name for an entity, which could be used to identify the entity
across compilation units.
2011-08-04 Thomas Quinot <quinot@adacore.com>
* prj-env.adb
(Initialize_Default_Project_Path): Add target specific directory
($prefix/$target/lib/gnat) in front of project path in all cases
(making gnatmake's behaviour consistent with gprbuild).
* gnatcmd.adb, make.adb, prj-makr.adb, clean.adb:
Pass target name from Sdefault to project subsystem.
* gnatls.adb: Show new target specific default project directory.
2011-08-04 Johannes Kanig <kanig@adacore.com>
* cstand.adb: Add Information to Identifier in Standard
(Identifer_For): Set Entity to the corresponding entity
2011-08-04 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Update doc on gnatcheck.

11
gcc/ada/adaint.c
View File

@ -51,6 +51,11 @@ extern "C" {
#include "cacheLib.h"
#endif /* __mips_vxworks */
/* If SMP, access vxCpuConfiguredGet */
#ifdef _WRS_CONFIG_SMP
#include <vxCpuLib.h>
#endif /* _WRS_CONFIG_SMP */
#endif /* VxWorks */
#if (defined (__mips) && defined (__sgi)) || defined (__APPLE__)
@ -2442,6 +2447,12 @@ __gnat_number_of_cpus (void)
status = LIB$GETSYI (&code, &res);
if ((status & 1) != 0)
cores = res;
#elif defined (__WRS_CONFIG_SMP)
unsigned int vxCpuConfiguredGet (void);
cores = vxCpuConfiguredGet ();
#endif
return cores;

4
gcc/ada/clean.adb
View File

@ -37,6 +37,7 @@ with Prj.Ext;
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
with Sdefault;
with Snames;
with Switch; use Switch;
with Table;
@ -1528,7 +1529,8 @@ package body Clean is
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path, Target_Name => "");
(Root_Environment.Project_Path,
Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);

1
gcc/ada/cstand.adb
View File

@ -1651,6 +1651,7 @@ package body CStand is
begin
Ident_Node := New_Node (N_Identifier, Stloc);
Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
Set_Entity (Ident_Node, Standard_Entity (S));
return Ident_Node;
end Identifier_For;

7
gcc/ada/exp_ch7.adb
View File

@ -6734,6 +6734,7 @@ package body Exp_Ch7 is
For_Parent : Boolean := False) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Obj_Ref);
Atyp : Entity_Id;
Fin_Id : Entity_Id := Empty;
Ref : Node_Id;
Utyp : Entity_Id;
@ -6743,10 +6744,12 @@ package body Exp_Ch7 is
if Is_Class_Wide_Type (Typ) then
Utyp := Root_Type (Typ);
Atyp := Utyp;
Ref := Obj_Ref;
elsif Is_Concurrent_Type (Typ) then
Utyp := Corresponding_Record_Type (Typ);
Atyp := Empty;
Ref := Convert_Concurrent (Obj_Ref, Typ);
elsif Is_Private_Type (Typ)
@ -6754,10 +6757,12 @@ package body Exp_Ch7 is
and then Is_Concurrent_Type (Full_View (Typ))
then
Utyp := Corresponding_Record_Type (Full_View (Typ));
Atyp := Typ;
Ref := Convert_Concurrent (Obj_Ref, Full_View (Typ));
else
Utyp := Typ;
Atyp := Typ;
Ref := Obj_Ref;
end if;
@ -6802,7 +6807,7 @@ package body Exp_Ch7 is
-- instead.
if Utyp /= Base_Type (Utyp) then
pragma Assert (Is_Private_Type (Typ));
pragma Assert (Present (Atyp) and then Is_Private_Type (Atyp));
Utyp := Base_Type (Utyp);
Ref := Unchecked_Convert_To (Utyp, Ref);

6
gcc/ada/frontend.adb
View File

@ -372,11 +372,9 @@ begin
-- Qualify all entity names in inner packages, package bodies, etc.,
-- except when compiling for the VM back-ends, which depend on having
-- unqualified names in certain cases and handles the generation of
-- qualified names when needed, and when compiling for formal verification,
-- in which the back-end calls directly Qualify_All_Entity_Names after some
-- preprocessing which uses the non-qualified names.
-- qualified names when needed.
if VM_Target = No_VM and then not ALFA_Mode then
if VM_Target = No_VM then
Exp_Dbug.Qualify_All_Entity_Names;
end if;

4
gcc/ada/gnat_ugn.texi
View File

@ -9389,7 +9389,9 @@ to process the project files, especially when looking for sources that take a
long time. If the source info file exists but cannot be parsed successfully,
the Project Manager will attempt to recreate it. If the Project Manager fails
to create the source info file, a message is issued, but gnatmake does not
fail.
fail. @command{gnatmake} "trusts" the source info file. This means that
if the source files have changed (addition, deletion, moving to a different
source directory), then the source info file need to be deleted and recreated.
@ifclear vms
@item --create-map-file

4
gcc/ada/gnatcmd.adb
View File

@ -41,6 +41,7 @@ with Prj.Ext; use Prj.Ext;
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
with Sdefault;
with Sinput.P;
with Snames; use Snames;
with Table;
@ -1360,7 +1361,8 @@ begin
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path, Target_Name => "");
(Root_Environment.Project_Path,
Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);

28
gcc/ada/gnatls.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -1614,6 +1614,9 @@ begin
Write_Str (" <Current_Directory>");
Write_Eol;
-- The code below reproduces Prj.Env.Initialize_Default_Project_Path,
-- shouldn't we reuse that instead???
declare
Project_Path : String_Access := Getenv (Gpr_Project_Path);
@ -1624,6 +1627,7 @@ begin
Last : Natural;
Add_Default_Dir : Boolean := True;
Prefix_Name_Len : Integer;
begin
-- If there is a project path, display each directory in the path
@ -1699,12 +1703,26 @@ begin
end loop;
-- If the sequence "/lib"/ was found, display the default
-- directory <prefix>/lib/gnat/.
-- directories <prefix>/<target>/lib/gnat and <prefix>/lib/gnat/.
if Name_Len >= 5 then
Name_Buffer (Name_Len + 1 .. Name_Len + 4) := "gnat";
Name_Buffer (Name_Len + 5) := Directory_Separator;
Name_Len := Name_Len + 5;
Prefix_Name_Len := Name_Len - 4;
Name_Len := Prefix_Name_Len;
Name_Len := Prefix_Name_Len;
Add_Str_To_Name_Buffer (Sdefault.Target_Name.all);
Name_Len := Name_Len - 1;
Add_Str_To_Name_Buffer (Directory_Separator
& "lib" & Directory_Separator
& "gnat" & Directory_Separator);
Write_Str (" ");
Write_Line
(To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
Name_Len := Prefix_Name_Len;
Add_Str_To_Name_Buffer ("lib" & Directory_Separator
& "gnat" & Directory_Separator);
Write_Str (" ");
Write_Line
(To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);

2
gcc/ada/lib-xref-alfa.adb
View File

@ -738,7 +738,7 @@ package body ALFA is
if XE.Ent /= Cur_Entity then
Cur_Entity_Name :=
new String'(Exact_Source_Name (Sloc (XE.Ent)));
new String'(Unique_Name (XE.Ent));
end if;
ALFA_Xref_Table.Append (

3
gcc/ada/make.adb
View File

@ -51,6 +51,7 @@ with Prj.Env;
with Prj.Pars;
with Prj.Tree; use Prj.Tree;
with Prj.Util;
with Sdefault;
with SFN_Scan;
with Sinput.P;
with Snames; use Snames;
@ -6370,7 +6371,7 @@ package body Make is
Prj.Tree.Initialize (Env, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Env.Project_Path, Target_Name => "");
(Env.Project_Path, Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);

23
gcc/ada/opt.adb
View File

@ -57,9 +57,7 @@ package body Opt is
External_Name_Exp_Casing_Config := External_Name_Exp_Casing;
External_Name_Imp_Casing_Config := External_Name_Imp_Casing;
Fast_Math_Config := Fast_Math;
Init_Or_Norm_Scalars_Config := Init_Or_Norm_Scalars;
Initialize_Scalars_Config := Initialize_Scalars;
Normalize_Scalars_Config := Normalize_Scalars;
Optimize_Alignment_Config := Optimize_Alignment;
Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
Polling_Required_Config := Polling_Required;
@ -92,15 +90,20 @@ package body Opt is
External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
Fast_Math := Save.Fast_Math;
Init_Or_Norm_Scalars := Save.Init_Or_Norm_Scalars;
Initialize_Scalars := Save.Initialize_Scalars;
Normalize_Scalars := Save.Normalize_Scalars;
Optimize_Alignment := Save.Optimize_Alignment;
Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
Polling_Required := Save.Polling_Required;
Short_Descriptors := Save.Short_Descriptors;
Use_VADS_Size := Save.Use_VADS_Size;
-- Update consistently the value of Init_Or_Norm_Scalars. The value of
-- Normalize_Scalars is not saved/restored because after set to True its
-- value is never changed. That is, if a compilation unit has pragma
-- Normalize_Scalars then it forces that value for all with'ed units.
Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
end Restore_Opt_Config_Switches;
------------------------------
@ -122,9 +125,7 @@ package body Opt is
Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
Save.Fast_Math := Fast_Math;
Save.Init_Or_Norm_Scalars := Init_Or_Norm_Scalars;
Save.Initialize_Scalars := Initialize_Scalars;
Save.Normalize_Scalars := Normalize_Scalars;
Save.Optimize_Alignment := Optimize_Alignment;
Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
@ -190,13 +191,19 @@ package body Opt is
External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
Fast_Math := Fast_Math_Config;
Init_Or_Norm_Scalars := Init_Or_Norm_Scalars_Config;
Initialize_Scalars := Initialize_Scalars_Config;
Normalize_Scalars := Normalize_Scalars_Config;
Optimize_Alignment := Optimize_Alignment_Config;
Optimize_Alignment_Local := False;
Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
Use_VADS_Size := Use_VADS_Size_Config;
-- Update consistently the value of Init_Or_Norm_Scalars. The value
-- of Normalize_Scalars is not saved/restored because once set to
-- True its value is never changed. That is, if a compilation unit
-- has pragma Normalize_Scalars then it forces that value for all
-- with'ed units.
Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
end if;
Default_Pool := Default_Pool_Config;

13
gcc/ada/opt.ads
View File

@ -1718,11 +1718,6 @@ package Opt is
-- used to set the initial value of Fast_Math at the start of each new
-- compilation unit.
Init_Or_Norm_Scalars_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that is set by one
-- of the pragmas Initialize_Scalars or Normalize_Scalars.
Initialize_Scalars_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that is set by the
@ -1730,13 +1725,6 @@ package Opt is
-- This switch is not set when the pragma appears ahead of a given
-- unit, so it does not affect the compilation of other units.
Normalize_Scalars_Config : Boolean;
-- GNAT
-- This is the value of the configuration switch that is set by the
-- pragma Normalize_Scalars when it appears in the gnat.adc file.
-- This switch is not set when the pragma appears ahead of a given
-- unit, so it does not affect the compilation of other units.
Optimize_Alignment_Config : Character;
-- GNAT
-- This is the value of the configuration switch that controls the
@ -1916,7 +1904,6 @@ private
External_Name_Exp_Casing : External_Casing_Type;
External_Name_Imp_Casing : External_Casing_Type;
Fast_Math : Boolean;
Init_Or_Norm_Scalars : Boolean;
Initialize_Scalars : Boolean;
Normalize_Scalars : Boolean;
Optimize_Alignment : Character;

67
gcc/ada/prj-env.adb
View File

@ -1981,44 +1981,67 @@ package body Prj.Env is
if Add_Default_Dir then
declare
Prefix : String_Ptr := Sdefault.Search_Dir_Prefix;
Prefix : String_Ptr;
Add_Prefix_Share_Gpr : Boolean;
begin
if Prefix = null then
Prefix := new String'(Executable_Prefix_Path);
if Sdefault.Search_Dir_Prefix = null then
if Prefix.all /= "" then
if Target_Name /= "" then
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
Target_Name & Directory_Separator &
"lib" & Directory_Separator & "gnat");
-- gprbuild case
Prefix := new String'(Executable_Prefix_Path);
Add_Prefix_Share_Gpr := True;
else
Prefix := new String'(Sdefault.Search_Dir_Prefix.all
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator);
Add_Prefix_Share_Gpr := False;
end if;
if Prefix.all /= "" then
if Target_Name /= "" then
-- $prefix/$target/lib/gnat
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
Target_Name);
-- Note: Target_Name has a trailing / when it comes from
-- Sdefault.
if Name_Buffer (Name_Len) /= '/' then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Add_Str_To_Name_Buffer
("lib" & Directory_Separator & "gnat");
end if;
if Add_Prefix_Share_Gpr then
-- $prefix/share/gpr
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"share" & Directory_Separator & "gpr");
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"lib" & Directory_Separator & "gnat");
end if;
else
Self.Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all &
".." & Directory_Separator &
".." & Directory_Separator &
".." & Directory_Separator & "gnat");
-- $prefix/lib/gnat
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"lib" & Directory_Separator & "gnat");
end if;
Free (Prefix);
end;
end if;
if Self.Path = null then
Self.Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
Self.Path := new String'(Name_Buffer (1 .. Name_Len));
end Initialize_Default_Project_Path;
--------------

4
gcc/ada/prj-makr.adb
View File

@ -34,6 +34,7 @@ with Prj.Part;
with Prj.PP;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
with Sdefault;
with Snames; use Snames;
with Table; use Table;
@ -802,7 +803,8 @@ package body Prj.Makr is
Prj.Tree.Initialize (Root_Environment, Flags);
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path, Target_Name => "");
(Root_Environment.Project_Path,
Target_Name => Sdefault.Target_Name.all);
Prj.Tree.Initialize (Tree);

36
gcc/ada/sem_type.adb
View File

@ -1196,6 +1196,17 @@ package body Sem_Type is
-- Determine whether one of the candidates is an operation inherited by
-- a type that is derived from an actual in an instantiation.
function In_Same_Declaration_List
(Typ : Entity_Id;
Op_Decl : Entity_Id) return Boolean;
-- AI05-0020: a spurious ambiguity may arise when equality on anonymous
-- access types is declared on the partial view of a designated type, so
-- that the type declaration and equality are not in the same list of
-- declarations. This AI gives a preference rule for the user-defined
-- operation. Same rule applies for arithmetic operations on private
-- types completed with fixed-point types: the predefined operation is
-- hidden; this is already handled properly in GNAT.
function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
-- Determine whether a subprogram is an actual in an enclosing instance.
-- An overloading between such a subprogram and one declared outside the
@ -1255,6 +1266,26 @@ package body Sem_Type is
end if;
end Inherited_From_Actual;
------------------------------
-- In_Same_Declaration_List --
------------------------------
function In_Same_Declaration_List
(Typ : Entity_Id;
Op_Decl : Entity_Id) return Boolean
is
Scop : constant Entity_Id := Scope (Typ);
begin
return In_Same_List (Parent (Typ), Op_Decl)
or else
(Ekind_In (Scop, E_Package, E_Generic_Package)
and then List_Containing (Op_Decl) =
Visible_Declarations (Parent (Scop))
and then List_Containing (Parent (Typ)) =
Private_Declarations (Parent (Scop)));
end In_Same_Declaration_List;
--------------------------
-- Is_Actual_Subprogram --
--------------------------
@ -1934,8 +1965,9 @@ package body Sem_Type is
and then Etype (User_Subp) = Standard_Boolean
and then Ekind (Operand_Type) = E_Anonymous_Access_Type
and then
In_Same_List (Parent (Designated_Type (Operand_Type)),
Unit_Declaration_Node (User_Subp))
In_Same_Declaration_List
(Designated_Type (Operand_Type),
Unit_Declaration_Node (User_Subp))
then
if It2.Nam = Predef_Subp then
return It1;

16
gcc/ada/sem_util.adb
View File

@ -12201,6 +12201,22 @@ package body Sem_Util is
end case;
end Unique_Defining_Entity;
-----------------
-- Unique_Name --
-----------------
function Unique_Name (E : Entity_Id) return String is
Name : constant String := Get_Name_String (Chars (E));
begin
if Has_Fully_Qualified_Name (E)
or else E = Standard_Standard
then
return Name;
else
return Unique_Name (Scope (E)) & "__" & Name;
end if;
end Unique_Name;
--------------------------
-- Unit_Declaration_Node --
--------------------------

4
gcc/ada/sem_util.ads
View File

@ -1372,6 +1372,10 @@ package Sem_Util is
-- Return the entity which represents declaration N, so that matching
-- declaration and body have the same entity.
function Unique_Name (E : Entity_Id) return String;
-- Return a unique name for entity E, which could be used to identify E
-- across compilation units.
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