Skip to content

R
riscv-gcc-1
Commit 42fdc85b by Hristian Kirtchev Committed by Arnaud Charlet
Options

einfo.ads, einfo.adb: Remove with and use clauses for Namet. 

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.ads, einfo.adb: Remove with and use clauses for Namet.
	(Find_Pragma): New routine.
	* sem_util.ads, sem_util.adb (Find_Pragma): Moved to einfo.

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch13.adb (Add_Call): Do not capture the nature of the inherited
	predicate.
	(Add_Predicates): Save the static predicate for diagnostics and error
	reporting purposes.
	(Process_PPCs): Remove local variables Dynamic_Predicate_Present and
	Static_Predicate_Present. Add local variable Static_Pred. Ensure that
	the expression of a static predicate is static.

From-SVN: r198283
parent 99a71c65
Showing with 62 additions and 61 deletions
gcc/ada/ChangeLog
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.ads, einfo.adb: Remove with and use clauses for Namet.
(Find_Pragma): New routine.
* sem_util.ads, sem_util.adb (Find_Pragma): Moved to einfo.
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch13.adb (Add_Call): Do not capture the nature of the inherited
predicate.
(Add_Predicates): Save the static predicate for diagnostics and error
reporting purposes.
(Process_PPCs): Remove local variables Dynamic_Predicate_Present and
Static_Predicate_Present. Add local variable Static_Pred. Ensure that
the expression of a static predicate is static.
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb (Is_Ghost_Subprogram): Remove useless code.
2013-04-25 Robert Dewar <dewar@adacore.com>
......
gcc/ada/einfo.adb
......@@ -33,7 +33,6 @@ pragma Style_Checks (All_Checks);
-- Turn off subprogram ordering, not used for this unit
with Atree; use Atree;
with Namet; use Namet;
with Nlists; use Nlists;
with Output; use Output;
with Sinfo; use Sinfo;
......@@ -6102,6 +6101,26 @@ package body Einfo is
return Etype (Discrete_Subtype_Definition (Parent (Id)));
end Entry_Index_Type;
-----------------
-- Find_Pragma --
-----------------
function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id is
Item : Node_Id;
begin
Item := First_Rep_Item (Id);
while Present (Item) loop
if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name then
return Item;
end if;
Item := Next_Rep_Item (Item);
end loop;
return Empty;
end Find_Pragma;
---------------------
-- First_Component --
---------------------
......
gcc/ada/einfo.ads
......@@ -29,6 +29,7 @@
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Snames; use Snames;
with Types; use Types;
with Uintp; use Uintp;
......@@ -7351,6 +7352,11 @@ package Einfo is
-- expression is deferred to the freeze point. For further details see
-- Sem_Ch13.Analyze_Aspect_Specifications.
function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id;
-- Given entity Id and pragma name Name, attempt to find the corresponding
-- pragma in Id's chain of representation items. The function returns Empty
-- if no such pragma has been found.
function Get_Attribute_Definition_Clause
(E : Entity_Id;
Id : Attribute_Id) return Node_Id;
......
gcc/ada/sem_ch13.adb
......@@ -5741,6 +5741,9 @@ package body Sem_Ch13 is
Raise_Expression_Present : Boolean := False;
-- Set True if Expr has at least one Raise_Expression
Static_Predic : Node_Id := Empty;
-- Set to N_Pragma node for a static predicate if one is encountered
procedure Add_Call (T : Entity_Id);
-- Includes a call to the predicate function for type T in Expr if T
-- has predicates and Predicate_Function (T) is non-empty.
......@@ -5765,13 +5768,6 @@ package body Sem_Ch13 is
procedure Process_REs is new Traverse_Proc (Process_RE);
-- Marks any raise expressions in Expr_M to return False
Dynamic_Predicate_Present : Boolean := False;
-- Set True if a dynamic predicate is present, results in the entire
-- predicate being considered dynamic even if it looks static.
Static_Predicate_Present : Node_Id := Empty;
-- Set to N_Pragma node for a static predicate if one is encountered
--------------
-- Add_Call --
--------------
......@@ -5783,12 +5779,6 @@ package body Sem_Ch13 is
if Present (T) and then Present (Predicate_Function (T)) then
Set_Has_Predicates (Typ);
-- Capture the nature of the inherited ancestor predicate
if Has_Dynamic_Predicate_Aspect (T) then
Dynamic_Predicate_Present := True;
end if;
-- Build the call to the predicate function of T
Exp :=
......@@ -5872,17 +5862,14 @@ package body Sem_Ch13 is
if Nkind (Ritem) = N_Pragma
and then Pragma_Name (Ritem) = Name_Predicate
then
-- Capture the nature of the predicate
if Present (Corresponding_Aspect (Ritem)) then
case Chars (Identifier (Corresponding_Aspect (Ritem))) is
when Name_Dynamic_Predicate =>
Dynamic_Predicate_Present := True;
when Name_Static_Predicate =>
Static_Predicate_Present := Ritem;
when others =>
null;
end case;
-- Save the static predicate of the type for diagnostics and
-- error reporting purposes.
if Present (Corresponding_Aspect (Ritem))
and then Chars (Identifier (Corresponding_Aspect (Ritem))) =
Name_Static_Predicate
then
Static_Predic := Ritem;
end if;
-- Acquire arguments
......@@ -6211,7 +6198,9 @@ package body Sem_Ch13 is
-- Attempt to build a static predicate for a discrete or a real
-- subtype. This action may fail because the actual expression may
-- not be static.
-- not be static. Note that the presence of an inherited or
-- explicitly declared dynamic predicate is orthogonal to this
-- check because we are only interested in the static predicate.
if Ekind_In (Typ, E_Decimal_Fixed_Point_Subtype,
E_Enumeration_Subtype,
......@@ -6222,30 +6211,26 @@ package body Sem_Ch13 is
then
Build_Static_Predicate (Typ, Expr, Object_Name);
-- The predicate is categorized as static but its expression is
-- dynamic. Note that the predicate may become non-static when
-- inherited dynamic predicates are involved.
-- Emit an error when the predicate is categorized as static
-- but its expression is dynamic.
if Present (Static_Predicate_Present)
if Present (Static_Predic)
and then No (Static_Predicate (Typ))
and then not Dynamic_Predicate_Present
then
Error_Msg_F
("expression does not have required form for "
& "static predicate",
Next (First (Pragma_Argument_Associations
(Static_Predicate_Present))));
(Static_Predic))));
end if;
end if;
-- If a Static_Predicate applies on other types, that's an error:
-- If a static predicate applies on other types, that's an error:
-- either the type is scalar but non-static, or it's not even a
-- scalar type. We do not issue an error on generated types, as
-- these may be duplicates of the same error on a source type.
elsif Present (Static_Predicate_Present)
and then Comes_From_Source (Typ)
then
elsif Present (Static_Predic) and then Comes_From_Source (Typ) then
if Is_Scalar_Type (Typ) then
Error_Msg_FE
("static predicate not allowed for non-static type&",
......
gcc/ada/sem_util.adb
......@@ -4882,26 +4882,6 @@ package body Sem_Util is
end if;
end Find_Parameter_Type;
-----------------
-- Find_Pragma --
-----------------
function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id is
Item : Node_Id;
begin
Item := First_Rep_Item (Id);
while Present (Item) loop
if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name then
return Item;
end if;
Item := Next_Rep_Item (Item);
end loop;
return Empty;
end Find_Pragma;
-----------------------------
-- Find_Static_Alternative --
-----------------------------
......
gcc/ada/sem_util.ads
......@@ -494,11 +494,6 @@ package Sem_Util is
-- Return the type of formal parameter Param as determined by its
-- specification.
function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id;
-- Given entity Id and pragma name Name, attempt to find the corresponding
-- pragma in Id's chain of representation items. The function returns Empty
-- if no such pragma has been found.
function Find_Static_Alternative (N : Node_Id) return Node_Id;
-- N is a case statement whose expression is a compile-time value.
-- Determine the alternative chosen, so that the code of non-selected
......
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