Skip to content

R
riscv-gcc-1
Commit ff1bedac by Yannick Moy Committed by Arnaud Charlet
Options

sem_aux.adb, [...] (Get_Low_Bound): Use Type_Low_Bound. 

2015-05-26  Yannick Moy  <moy@adacore.com>

	* sem_aux.adb, sem_aux.ads (Get_Low_Bound): Use Type_Low_Bound.
	(Package_Body, Package_Spec): New queries moved
	here from GNATprove.
	(Package_Specification): Simplify query to remove use of loop.
	* sem_util.adb, sem_util.ads (Enclosing_Declaration,
	Enclosing_Package_Or_Subprogram, Is_Attribute_Update): New
	queries moved here from GNATprove.

From-SVN: r223681
parent a7b37927
Showing with 174 additions and 47 deletions
gcc/ada/ChangeLog
2015-05-26 Yannick Moy <moy@adacore.com>
* sem_aux.adb, sem_aux.ads (Get_Low_Bound): Use Type_Low_Bound.
(Package_Body, Package_Spec): New queries moved
here from GNATprove.
(Package_Specification): Simplify query to remove use of loop.
* sem_util.adb, sem_util.ads (Enclosing_Declaration,
Enclosing_Package_Or_Subprogram, Is_Attribute_Update): New
queries moved here from GNATprove.
2015-05-26 Bob Duff <duff@adacore.com>
* einfo.adb, einfo.ads, sprint.adb, lib-xref.ads: Minor cleanup: Remove
......
gcc/ada/sem_aux.adb
......@@ -481,8 +481,7 @@ package body Sem_Aux is
if Ekind (E) = E_String_Literal_Subtype then
return String_Literal_Low_Bound (E);
else
-- Why is this not Type_Low_Bound (E)???
return Low_Bound (Scalar_Range (E));
return Type_Low_Bound (E);
end if;
end Get_Low_Bound;
......@@ -964,9 +963,9 @@ package body Sem_Aux is
end if;
end Is_By_Reference_Type;
---------------------------
-------------------------
-- Is_Definite_Subtype --
---------------------------
-------------------------
function Is_Definite_Subtype (T : Entity_Id) return Boolean is
pragma Assert (Is_Type (T));
......@@ -1440,22 +1439,60 @@ package body Sem_Aux is
and then Has_Discriminants (Typ));
end Object_Type_Has_Constrained_Partial_View;
------------------
-- Package_Body --
------------------
function Package_Body (E : Entity_Id) return Node_Id is
N : Node_Id;
begin
if Ekind (E) = E_Package_Body then
N := Parent (E);
if Nkind (N) = N_Defining_Program_Unit_Name then
N := Parent (N);
end if;
else
N := Package_Spec (E);
if Present (Corresponding_Body (N)) then
N := Parent (Corresponding_Body (N));
if Nkind (N) = N_Defining_Program_Unit_Name then
N := Parent (N);
end if;
else
N := Empty;
end if;
end if;
return N;
end Package_Body;
------------------
-- Package_Spec --
------------------
function Package_Spec (E : Entity_Id) return Node_Id is
begin
return Parent (Package_Specification (E));
end Package_Spec;
---------------------------
-- Package_Specification --
---------------------------
function Package_Specification (Pack_Id : Entity_Id) return Node_Id is
function Package_Specification (E : Entity_Id) return Node_Id is
N : Node_Id;
begin
N := Parent (Pack_Id);
while Nkind (N) /= N_Package_Specification loop
N := Parent (N);
N := Parent (E);
if No (N) then
raise Program_Error;
end if;
end loop;
if Nkind (N) = N_Defining_Program_Unit_Name then
N := Parent (N);
end if;
return N;
end Package_Specification;
......@@ -1489,13 +1526,19 @@ package body Sem_Aux is
-- If this declaration is not a subprogram body, then it must be a
-- subprogram declaration, from which we can retrieve the entity for
-- the corresponding subprogram body if any.
-- the corresponding subprogram body if any, or an abstract subprogram
-- declaration, for which we return Empty.
if Nkind (N) = N_Subprogram_Body then
return E;
else
return Corresponding_Body (N);
end if;
case Nkind (N) is
when N_Subprogram_Body =>
return E;
when N_Subprogram_Declaration =>
return Corresponding_Body (N);
when others =>
return Empty;
end case;
end Subprogram_Body_Entity;
---------------------
......
gcc/ada/sem_aux.ads
......@@ -390,10 +390,17 @@ package Sem_Aux is
-- derived type, and the subtype is not an unconstrained array subtype
-- (RM 3.3(23.10/3)).
function Package_Specification (Pack_Id : Entity_Id) return Node_Id;
-- Given an entity for a package or generic package, return corresponding
-- package specification. Simplifies handling of child units, and better
-- than the old idiom: Specification (Unit_Declaration_Node (Pack_Id)).
function Package_Body (E : Entity_Id) return Node_Id;
-- Given an entity for a package (spec or body), return the corresponding
-- package body if any, or else Empty.
function Package_Spec (E : Entity_Id) return Node_Id;
-- Given an entity for a package spec, return the corresponding package
-- spec if any, or else Empty.
function Package_Specification (E : Entity_Id) return Node_Id;
-- Given an entity for a package, return the corresponding package
-- specification.
function Subprogram_Body (E : Entity_Id) return Node_Id;
-- Given an entity for a subprogram (spec or body), return the
......
gcc/ada/sem_util.adb
......@@ -5674,24 +5674,6 @@ package body Sem_Util is
end if;
end Enclosing_Comp_Unit_Node;
-----------------------------
-- Enclosing_Lib_Unit_Node --
-----------------------------
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id is
Encl_Unit : Node_Id;
begin
Encl_Unit := Enclosing_Comp_Unit_Node (N);
while Present (Encl_Unit)
and then Nkind (Unit (Encl_Unit)) = N_Subunit
loop
Encl_Unit := Library_Unit (Encl_Unit);
end loop;
return Encl_Unit;
end Enclosing_Lib_Unit_Node;
--------------------------
-- Enclosing_CPP_Parent --
--------------------------
......@@ -5714,6 +5696,25 @@ package body Sem_Util is
return Parent_Typ;
end Enclosing_CPP_Parent;
---------------------------
-- Enclosing_Declaration --
---------------------------
function Enclosing_Declaration (N : Node_Id) return Node_Id is
Decl : Node_Id := N;
begin
while Present (Decl)
and then not (Nkind (Decl) in N_Declaration
or else
Nkind (Decl) in N_Later_Decl_Item)
loop
Decl := Parent (Decl);
end loop;
return Decl;
end Enclosing_Declaration;
----------------------------
-- Enclosing_Generic_Body --
----------------------------
......@@ -5815,6 +5816,24 @@ package body Sem_Util is
return Unit_Entity;
end Enclosing_Lib_Unit_Entity;
-----------------------------
-- Enclosing_Lib_Unit_Node --
-----------------------------
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id is
Encl_Unit : Node_Id;
begin
Encl_Unit := Enclosing_Comp_Unit_Node (N);
while Present (Encl_Unit)
and then Nkind (Unit (Encl_Unit)) = N_Subunit
loop
Encl_Unit := Library_Unit (Encl_Unit);
end loop;
return Encl_Unit;
end Enclosing_Lib_Unit_Node;
-----------------------
-- Enclosing_Package --
-----------------------
......@@ -5839,6 +5858,34 @@ package body Sem_Util is
end if;
end Enclosing_Package;
-------------------------------------
-- Enclosing_Package_Or_Subprogram --
-------------------------------------
function Enclosing_Package_Or_Subprogram (E : Entity_Id) return Entity_Id is
S : Entity_Id;
begin
S := Scope (E);
while Present (S) loop
if Is_Package_Or_Generic_Package (S)
or else Ekind (S) = E_Package_Body
then
return S;
elsif Is_Subprogram_Or_Generic_Subprogram (S)
or else Ekind (S) = E_Subprogram_Body
then
return S;
else
S := Scope (S);
end if;
end loop;
return Empty;
end Enclosing_Package_Or_Subprogram;
--------------------------
-- Enclosing_Subprogram --
--------------------------
......@@ -10484,6 +10531,16 @@ package body Sem_Util is
and then Attribute_Name (N) = Name_Result;
end Is_Attribute_Result;
-------------------------
-- Is_Attribute_Update --
-------------------------
function Is_Attribute_Update (N : Node_Id) return Boolean is
begin
return Nkind (N) = N_Attribute_Reference
and then Attribute_Name (N) = Name_Update;
end Is_Attribute_Update;
------------------------------------
-- Is_Body_Or_Package_Declaration --
------------------------------------
......
gcc/ada/sem_util.ads
......@@ -532,16 +532,12 @@ package Sem_Util is
-- Returns the enclosing N_Compilation_Unit node that is the root of a
-- subtree containing N.
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id;
-- Returns the N_Compilation_Unit node of the library unit that is directly
-- or indirectly (through a subunit) at the root of a subtree containing
-- N. This may be either the same as Enclosing_Comp_Unit_Node, or if
-- Enclosing_Comp_Unit_Node returns a subunit, then the corresponding
-- library unit. If no such item is found, returns Empty???
function Enclosing_CPP_Parent (Typ : Entity_Id) return Entity_Id;
-- Returns the closest ancestor of Typ that is a CPP type.
function Enclosing_Declaration (N : Node_Id) return Node_Id;
-- Returns the declaration node enclosing N, if any, or Empty otherwise
function Enclosing_Generic_Body
(N : Node_Id) return Node_Id;
-- Returns the Node_Id associated with the innermost enclosing generic
......@@ -559,10 +555,21 @@ package Sem_Util is
-- caller is responsible for ensuring this condition) or other specified
-- entity.
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id;
-- Returns the N_Compilation_Unit node of the library unit that is directly
-- or indirectly (through a subunit) at the root of a subtree containing
-- N. This may be either the same as Enclosing_Comp_Unit_Node, or if
-- Enclosing_Comp_Unit_Node returns a subunit, then the corresponding
-- library unit. If no such item is found, returns Empty.
function Enclosing_Package (E : Entity_Id) return Entity_Id;
-- Utility function to return the Ada entity of the package enclosing
-- the entity E, if any. Returns Empty if no enclosing package.
function Enclosing_Package_Or_Subprogram (E : Entity_Id) return Entity_Id;
-- Returns the entity of the package or subprogram enclosing E, if any.
-- Returns Empty if no enclosing package or subprogram.
function Enclosing_Subprogram (E : Entity_Id) return Entity_Id;
-- Utility function to return the Ada entity of the subprogram enclosing
-- the entity E, if any. Returns Empty if no enclosing subprogram.
......@@ -1190,6 +1197,9 @@ package Sem_Util is
function Is_Attribute_Result (N : Node_Id) return Boolean;
-- Determine whether node N denotes attribute 'Result
function Is_Attribute_Update (N : Node_Id) return Boolean;
-- Determine whether node N denotes attribute 'Update
function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean;
-- Determine whether node N denotes a body or a package declaration
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment