mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 22:11:30 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-06-22  Robert Dewar  <dewar@adacore.com>

	* s-rannum.adb: Minor reformatting.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* sem_aux.adb, sem_aux.ads, sem_util.adb, sem_util.ads, sem_elim.adb,
	exp_cg.adb: Minor code reorganization: Move routine Ultimate_Alias from
	package Sem_Util to package Sem_Aux.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_Secondary_DT, Make_DT): Minor code cleanup:
	remove useless restriction on imported routines when building the
	dispatch tables.

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* cstand.adb (Create_Standard): Set Has_Pragma_Pack for standard string
	types.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* sem_ch4.adb (Collect_Generic_Type_Ops): Protect code that handles
	generic subprogram declarations to ensure proper context. Add missing
	support for generic actuals.
	(Try_Primitive_Operation): Add missing support for concurrent types that
	have no Corresponding_Record_Type. Required to diagnose errors compiling
	generics or when compiling with no code generation (-gnatc).
	* sem_ch9.adb (Analyze_Protected_Type, Analyze_Task_Type): Do not build
	the corresponding record type.
	* sem_disp.ads, sem_disp.adb (Check_Dispatching_Operation): Complete
	documentation. Do minimum decoration when processing a primitive of a
	concurrent tagged type that covers interfaces. Required to diagnose
	errors in the Object.Operation notation compiling generics or under
	-gnatc.
	* exp_ch9.ads, exp_ch9.adb (Build_Corresponding_Record): Add missing
	propagation of attribute Interface_List to the corresponding record.
	(Expand_N_Task_Type_Declaration): Code cleanup.
	(Expand_N_Protected_Type_Declaration): Code cleanup.

From-SVN: r161203
This commit is contained in:
Arnaud Charlet 2010-06-22 18:47:55 +02:00
parent 5bec9717c3
commit bb10b89181
16 changed files with 190 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/ChangeLog
View File

@ -1,3 +1,44 @@
2010-06-22 Robert Dewar <dewar@adacore.com>
* s-rannum.adb: Minor reformatting.
2010-06-22 Javier Miranda <miranda@adacore.com>
* sem_aux.adb, sem_aux.ads, sem_util.adb, sem_util.ads, sem_elim.adb,
exp_cg.adb: Minor code reorganization: Move routine Ultimate_Alias from
package Sem_Util to package Sem_Aux.
2010-06-22 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Make_Secondary_DT, Make_DT): Minor code cleanup:
remove useless restriction on imported routines when building the
dispatch tables.
2010-06-22 Robert Dewar <dewar@adacore.com>
* cstand.adb (Create_Standard): Set Has_Pragma_Pack for standard string
types.
2010-06-22 Javier Miranda <miranda@adacore.com>
* sem_ch4.adb (Collect_Generic_Type_Ops): Protect code that handles
generic subprogram declarations to ensure proper context. Add missing
support for generic actuals.
(Try_Primitive_Operation): Add missing support for concurrent types that
have no Corresponding_Record_Type. Required to diagnose errors compiling
generics or when compiling with no code generation (-gnatc).
* sem_ch9.adb (Analyze_Protected_Type, Analyze_Task_Type): Do not build
the corresponding record type.
* sem_disp.ads, sem_disp.adb (Check_Dispatching_Operation): Complete
documentation. Do minimum decoration when processing a primitive of a
concurrent tagged type that covers interfaces. Required to diagnose
errors in the Object.Operation notation compiling generics or under
-gnatc.
* exp_ch9.ads, exp_ch9.adb (Build_Corresponding_Record): Add missing
propagation of attribute Interface_List to the corresponding record.
(Expand_N_Task_Type_Declaration): Code cleanup.
(Expand_N_Protected_Type_Declaration): Code cleanup.
2010-06-22 Matthew Heaney <heaney@adacore.com>
* a-convec.adb, a-coinve.adb: Removed 64-bit types Int and UInt.

27
gcc/ada/cstand.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -688,12 +688,13 @@ package body CStand is
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);
Set_Ekind (Standard_String, E_String_Type);
Set_Etype (Standard_String, Standard_String);
Set_Component_Type (Standard_String, Standard_Character);
Set_Component_Size (Standard_String, Uint_8);
Init_Size_Align (Standard_String);
Set_Alignment (Standard_String, Uint_1);
Set_Ekind (Standard_String, E_String_Type);
Set_Etype (Standard_String, Standard_String);
Set_Component_Type (Standard_String, Standard_Character);
Set_Component_Size (Standard_String, Uint_8);
Init_Size_Align (Standard_String);
Set_Alignment (Standard_String, Uint_1);
Set_Has_Pragma_Pack (Standard_String, True);
-- On targets where a storage unit is larger than a byte (such as AAMP),
-- pragma Pack has a real effect on the representation of type String,
@ -731,11 +732,12 @@ package body CStand is
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
Set_Ekind (Standard_Wide_String, E_String_Type);
Set_Etype (Standard_Wide_String, Standard_Wide_String);
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
Set_Component_Size (Standard_Wide_String, Uint_16);
Init_Size_Align (Standard_Wide_String);
Set_Ekind (Standard_Wide_String, E_String_Type);
Set_Etype (Standard_Wide_String, Standard_Wide_String);
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
Set_Component_Size (Standard_Wide_String, Uint_16);
Init_Size_Align (Standard_Wide_String);
Set_Has_Pragma_Pack (Standard_Wide_String, True);
-- Set index type of Wide_String
@ -772,6 +774,7 @@ package body CStand is
Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
Init_Size_Align (Standard_Wide_Wide_String);
Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
Set_Has_Pragma_Pack (Standard_Wide_Wide_String, True);
-- Set index type of Wide_Wide_String

1
gcc/ada/exp_cg.adb
View File

@ -34,6 +34,7 @@ with Lib; use Lib;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Sem_Aux; use Sem_Aux;
with Sem_Disp; use Sem_Disp;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;

26
gcc/ada/exp_ch9.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -128,6 +128,14 @@ package body Exp_Ch9 is
-- Build a specification for a function implementing the protected entry
-- barrier of the specified entry body.
function Build_Corresponding_Record
(N : Node_Id;
Ctyp : Node_Id;
Loc : Source_Ptr) return Node_Id;
-- Common to tasks and protected types. Copy discriminant specifications,
-- build record declaration. N is the type declaration, Ctyp is the
-- concurrent entity (task type or protected type).
function Build_Entry_Count_Expression
(Concurrent_Type : Node_Id;
Component_List : List_Id;
@ -1037,8 +1045,9 @@ package body Exp_Ch9 is
-- record is "limited tagged". It is "limited" to reflect the underlying
-- limitedness of the task or protected object that it represents, and
-- ensuring for example that it is properly passed by reference. It is
-- "tagged" to give support to dispatching calls through interfaces (Ada
-- 2005: AI-345)
-- "tagged" to give support to dispatching calls through interfaces. We
-- propagate here the list of interfaces covered by the concurrent type
-- (Ada 2005: AI-345).
return
Make_Full_Type_Declaration (Loc,
@ -1051,6 +1060,7 @@ package body Exp_Ch9 is
Component_Items => Cdecls),
Tagged_Present =>
Ada_Version >= Ada_05 and then Is_Tagged_Type (Ctyp),
Interface_List => Interface_List (N),
Limited_Present => True));
end Build_Corresponding_Record;
@ -7682,11 +7692,6 @@ package body Exp_Ch9 is
Cdecls := Component_Items (Component_List (Type_Definition (Rec_Decl)));
-- Ada 2005 (AI-345): Propagate the attribute that contains the list
-- of implemented interfaces.
Set_Interface_List (Type_Definition (Rec_Decl), Interface_List (N));
Qualify_Entity_Names (N);
-- If the type has discriminants, their occurrences in the declaration
@ -9946,11 +9951,6 @@ package body Exp_Ch9 is
Rec_Decl := Build_Corresponding_Record (N, Tasktyp, Loc);
-- Ada 2005 (AI-345): Propagate the attribute that contains the list
-- of implemented interfaces.
Set_Interface_List (Type_Definition (Rec_Decl), Interface_List (N));
Rec_Ent := Defining_Identifier (Rec_Decl);
Cdecls := Component_Items (Component_List
(Type_Definition (Rec_Decl)));

10
gcc/ada/exp_ch9.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -50,14 +50,6 @@ package Exp_Ch9 is
-- Task_Id of the associated task as the parameter. The caller is
-- responsible for analyzing and resolving the resulting tree.
function Build_Corresponding_Record
(N : Node_Id;
Ctyp : Node_Id;
Loc : Source_Ptr) return Node_Id;
-- Common to tasks and protected types. Copy discriminant specifications,
-- build record declaration. N is the type declaration, Ctyp is the
-- concurrent entity (task type or protected type).
function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id;
-- Create the statements which populate the entry names array of a task or
-- protected type. The statements are wrapped inside a block due to a local

6
gcc/ada/exp_disp.adb
View File

@ -3968,12 +3968,9 @@ package body Exp_Disp is
-- are located in a separate dispatch table; skip also
-- abstract and eliminated primitives.
-- Why do we skip imported primitives???
if not Is_Predefined_Dispatching_Operation (Prim)
and then Present (Interface_Alias (Prim))
and then not Is_Abstract_Subprogram (Alias (Prim))
and then not Is_Imported (Alias (Prim))
and then not Is_Eliminated (Alias (Prim))
and then Find_Dispatching_Type
(Interface_Alias (Prim)) = Iface
@ -5518,13 +5515,10 @@ package body Exp_Disp is
-- to build secondary dispatch tables; skip also abstract
-- and eliminated primitives.
-- Why do we skip imported primitives???
if not Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Predefined_Dispatching_Operation (E)
and then not Present (Interface_Alias (Prim))
and then not Is_Abstract_Subprogram (E)
and then not Is_Imported (E)
and then not Is_Eliminated (E)
then
pragma Assert

60
gcc/ada/s-rannum.adb
View File

@ -86,9 +86,10 @@
-- --
------------------------------------------------------------------------------
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar; use Ada.Calendar;
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
with Interfaces; use Interfaces;
use Ada;
@ -122,7 +123,9 @@ package body System.Random_Numbers is
Image_Numeral_Length : constant := Max_Image_Width / N;
subtype Image_String is String (1 .. Max_Image_Width);
-- Utility functions
-----------------------
-- Local Subprograms --
-----------------------
procedure Init (Gen : out Generator; Initiator : Unsigned_32);
-- Perform a default initialization of the state of Gen. The resulting
@ -199,6 +202,10 @@ package body System.Random_Numbers is
-- assuming that Unsigned is large enough to hold the bits of a mantissa
-- for type Real.
---------------------------
-- Random_Float_Template --
---------------------------
function Random_Float_Template (Gen : Generator) return Real is
pragma Compile_Time_Error
@ -232,6 +239,7 @@ package body System.Random_Numbers is
if Real'Machine_Radix /= 2 then
return Real'Machine
(Real (Unsigned'(Random (Gen))) * 2.0**(-Unsigned'Size));
else
declare
type Bit_Count is range 0 .. 4;
@ -239,8 +247,8 @@ package body System.Random_Numbers is
subtype T is Real'Base;
Trailing_Ones : constant array (Unsigned_32 range 0 .. 15)
of Bit_Count
:= (2#00000# => 0, 2#00001# => 1, 2#00010# => 0, 2#00011# => 2,
of Bit_Count :=
(2#00000# => 0, 2#00001# => 1, 2#00010# => 0, 2#00011# => 2,
2#00100# => 0, 2#00101# => 1, 2#00110# => 0, 2#00111# => 3,
2#01000# => 0, 2#01001# => 1, 2#01010# => 0, 2#01011# => 2,
2#01100# => 0, 2#01101# => 1, 2#01110# => 0, 2#01111# => 4);
@ -255,21 +263,30 @@ package body System.Random_Numbers is
(Unsigned'Size - T'Machine_Mantissa + 1);
-- Random bits left over after selecting mantissa
Mantissa : Unsigned;
X : Real; -- Scaled mantissa
R : Unsigned_32; -- Supply of random bits
R_Bits : Natural; -- Number of bits left in R
Mantissa : Unsigned;
X : Real;
-- Scaled mantissa
R : Unsigned_32;
-- Supply of random bits
R_Bits : Natural;
-- Number of bits left in R
K : Bit_Count;
-- Next decrement to exponent
K : Bit_Count; -- Next decrement to exponent
begin
Mantissa := Random (Gen) / 2**Extra_Bits;
R := Unsigned_32 (Mantissa mod 2**Extra_Bits);
R_Bits := Extra_Bits;
X := Real (2**(T'Machine_Mantissa - 1) + Mantissa); -- Exact
if Extra_Bits < 4 and then R < 2**Extra_Bits - 1 then
if Extra_Bits < 4 and then R < 2 ** Extra_Bits - 1 then
-- We got lucky and got a zero in our few extra bits
K := Trailing_Ones (R);
else
@ -305,12 +322,11 @@ package body System.Random_Numbers is
end loop Find_Zero;
end if;
-- K has the count of trailing ones not reflected yet in X.
-- The following multiplication takes care of that, as well
-- as the correction to move the radix point to the left of
-- the mantissa. Doing it at the end avoids repeated rounding
-- errors in the exceedingly unlikely case of ever having
-- a subnormal result.
-- K has the count of trailing ones not reflected yet in X. The
-- following multiplication takes care of that, as well as the
-- correction to move the radix point to the left of the mantissa.
-- Doing it at the end avoids repeated rounding errors in the
-- exceedingly unlikely case of ever having a subnormal result.
X := X * Pow_Tab (K);
@ -330,6 +346,10 @@ package body System.Random_Numbers is
end if;
end Random_Float_Template;
------------
-- Random --
------------
function Random (Gen : Generator) return Float is
function F is new Random_Float_Template (Unsigned_32, Float);
begin
@ -371,7 +391,7 @@ package body System.Random_Numbers is
-- Ignore different-size warnings here; since GNAT's handling
-- is correct.
pragma Warnings ("Z");
pragma Warnings ("Z"); -- better to use msg string! ???
function Conv_To_Unsigned is
new Unchecked_Conversion (Result_Subtype'Base, Unsigned_64);
function Conv_To_Result is
@ -489,7 +509,7 @@ package body System.Random_Numbers is
I, J : Integer;
begin
Init (Gen, 19650218);
Init (Gen, 19650218); -- please give this constant a name ???
I := 1;
J := 0;

16
gcc/ada/sem_aux.adb
View File

@ -799,4 +799,20 @@ package body Sem_Aux is
Obsolescent_Warnings.Tree_Write;
end Tree_Write;
--------------------
-- Ultimate_Alias --
--------------------
function Ultimate_Alias (Prim : Entity_Id) return Entity_Id is
E : Entity_Id := Prim;
begin
while Present (Alias (E)) loop
pragma Assert (Alias (E) /= E);
E := Alias (E);
end loop;
return E;
end Ultimate_Alias;
end Sem_Aux;

7
gcc/ada/sem_aux.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -193,4 +193,9 @@ package Sem_Aux is
function Number_Discriminants (Typ : Entity_Id) return Pos;
-- Typ is a type with discriminants, yields number of discriminants in type
function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
pragma Inline (Ultimate_Alias);
-- Return the last entity in the chain of aliased entities of Prim. If Prim
-- has no alias return Prim.
end Sem_Aux;

54
gcc/ada/sem_ch4.adb
View File

@ -6880,23 +6880,26 @@ package body Sem_Ch4 is
-- Scan the list of generic formals to find subprograms
-- that may have a first controlling formal of the type.
declare
Decl : Node_Id;
if Nkind (Unit_Declaration_Node (Scope (T)))
= N_Generic_Subprogram_Declaration
then
declare
Decl : Node_Id;
begin
Decl :=
First (Generic_Formal_Declarations
(Unit_Declaration_Node (Scope (T))));
while Present (Decl) loop
if Nkind (Decl) in N_Formal_Subprogram_Declaration then
Subp := Defining_Entity (Decl);
Check_Candidate;
end if;
Next (Decl);
end loop;
end;
begin
Decl :=
First (Generic_Formal_Declarations
(Unit_Declaration_Node (Scope (T))));
while Present (Decl) loop
if Nkind (Decl) in N_Formal_Subprogram_Declaration then
Subp := Defining_Entity (Decl);
Check_Candidate;
end if;
Next (Decl);
end loop;
end;
end if;
return Candidates;
else
@ -6906,7 +6909,15 @@ package body Sem_Ch4 is
-- declaration or body (either the one that declares T, or a
-- child unit).
Subp := First_Entity (Scope (T));
-- For a subtype representing a generic actual type, go to the
-- base type.
if Is_Generic_Actual_Type (T) then
Subp := First_Entity (Scope (Base_Type (T)));
else
Subp := First_Entity (Scope (T));
end if;
while Present (Subp) loop
if Is_Overloadable (Subp) then
Check_Candidate;
@ -6979,13 +6990,14 @@ package body Sem_Ch4 is
-- corresponding record (base) type.
if Is_Concurrent_Type (Obj_Type) then
if not Present (Corresponding_Record_Type (Obj_Type)) then
return False;
if Present (Corresponding_Record_Type (Obj_Type)) then
Corr_Type := Base_Type (Corresponding_Record_Type (Obj_Type));
Elmt := First_Elmt (Primitive_Operations (Corr_Type));
else
Corr_Type := Obj_Type;
Elmt := First_Elmt (Collect_Generic_Type_Ops (Obj_Type));
end if;
Corr_Type := Base_Type (Corresponding_Record_Type (Obj_Type));
Elmt := First_Elmt (Primitive_Operations (Corr_Type));
elsif not Is_Generic_Type (Obj_Type) then
Corr_Type := Obj_Type;
Elmt := First_Elmt (Primitive_Operations (Obj_Type));

19
gcc/ada/sem_ch9.adb
View File

@ -1176,16 +1176,6 @@ package body Sem_Ch9 is
Set_Is_Constrained (T, not Has_Discriminants (T));
-- Perform minimal expansion of protected type while inside a generic.
-- The corresponding record is needed for various semantic checks.
if Ada_Version >= Ada_05
and then Inside_A_Generic
then
Insert_After_And_Analyze (N,
Build_Corresponding_Record (N, T, Sloc (T)));
end if;
Analyze (Protected_Definition (N));
-- Protected types with entries are controlled (because of the
@ -1976,15 +1966,6 @@ package body Sem_Ch9 is
Set_Is_Constrained (T, not Has_Discriminants (T));
-- Perform minimal expansion of the task type while inside a generic
-- context. The corresponding record is needed for various semantic
-- checks.
if Inside_A_Generic then
Insert_After_And_Analyze (N,
Build_Corresponding_Record (N, T, Sloc (T)));
end if;
if Present (Task_Definition (N)) then
Analyze_Task_Definition (Task_Definition (N));
end if;

23
gcc/ada/sem_disp.adb
View File

@ -677,18 +677,15 @@ package body Sem_Disp is
Set_Is_Dispatching_Operation (Subp, False);
Tagged_Type := Find_Dispatching_Type (Subp);
-- Ada 2005 (AI-345)
-- Ada 2005 (AI-345): Use the corresponding record (if available).
-- Required because primitives of concurrent types are be attached
-- to the corresponding record (not to the concurrent type).
if Ada_Version >= Ada_05
and then Present (Tagged_Type)
and then Is_Concurrent_Type (Tagged_Type)
and then Present (Corresponding_Record_Type (Tagged_Type))
then
-- Protect the frontend against previously detected errors
if No (Corresponding_Record_Type (Tagged_Type)) then
return;
end if;
Tagged_Type := Corresponding_Record_Type (Tagged_Type);
end if;
@ -1068,6 +1065,18 @@ package body Sem_Disp is
end if;
end if;
-- If the tagged type is a concurrent type then we must be compiling
-- with no code generation (we are either compiling a generic unit or
-- compiling under -gnatc mode) because we have previously tested that
-- no serious errors has been reported. In this case we do not add the
-- primitive to the list of primitives of Tagged_Type but we leave the
-- primitive decorated as a dispatching operation to be able to analyze
-- and report errors associated with the Object.Operation notation.
elsif Is_Concurrent_Type (Tagged_Type) then
pragma Assert (not Expander_Active);
null;
-- If no old subprogram, then we add this as a dispatching operation,
-- but we avoid doing this if an error was posted, to prevent annoying
-- cascaded errors.

9
gcc/ada/sem_disp.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -46,7 +46,12 @@ package Sem_Disp is
-- if it has a parameter of this type and is defined at a proper place for
-- primitive operations (new primitives are only defined in package spec,
-- overridden operation can be defined in any scope). If Old_Subp is not
-- Empty we are in the overriding case.
-- Empty we are in the overriding case. If the tagged type associated with
-- Subp is a concurrent type (case that occurs when the type is declared in
-- a generic because the analysis of generics disables generation of the
-- corresponding record) then this routine does does not add "Subp" to the
-- list of primitive operations but leaves Subp decorated as dispatching
-- operation to enable checks associated with the Object.Operation notation
procedure Check_Operation_From_Incomplete_Type
(Subp : Entity_Id;

1
gcc/ada/sem_elim.adb
View File

@ -31,6 +31,7 @@ with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
with Sinput; use Sinput;

16
gcc/ada/sem_util.adb
View File

@ -11125,22 +11125,6 @@ package body Sem_Util is
return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
end Type_Access_Level;
--------------------
-- Ultimate_Alias --
--------------------
function Ultimate_Alias (Prim : Entity_Id) return Entity_Id is
E : Entity_Id := Prim;
begin
while Present (Alias (E)) loop
pragma Assert (Alias (E) /= E);
E := Alias (E);
end loop;
return E;
end Ultimate_Alias;
--------------------------
-- Unit_Declaration_Node --
--------------------------

5
gcc/ada/sem_util.ads
View File

@ -1260,11 +1260,6 @@ package Sem_Util is
function Type_Access_Level (Typ : Entity_Id) return Uint;
-- Return the accessibility level of Typ
function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
pragma Inline (Ultimate_Alias);
-- Return the last entity in the chain of aliased entities of Prim. If Prim
-- has no alias return Prim.
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