Commit 42fdc85b by Hristian Kirtchev Committed by Arnaud Charlet

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
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> 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. * einfo.adb (Is_Ghost_Subprogram): Remove useless code.
2013-04-25 Robert Dewar <dewar@adacore.com> 2013-04-25 Robert Dewar <dewar@adacore.com>
......
...@@ -33,7 +33,6 @@ pragma Style_Checks (All_Checks); ...@@ -33,7 +33,6 @@ pragma Style_Checks (All_Checks);
-- Turn off subprogram ordering, not used for this unit -- Turn off subprogram ordering, not used for this unit
with Atree; use Atree; with Atree; use Atree;
with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Output; use Output; with Output; use Output;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
...@@ -6102,6 +6101,26 @@ package body Einfo is ...@@ -6102,6 +6101,26 @@ package body Einfo is
return Etype (Discrete_Subtype_Definition (Parent (Id))); return Etype (Discrete_Subtype_Definition (Parent (Id)));
end Entry_Index_Type; 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 -- -- First_Component --
--------------------- ---------------------
......
...@@ -29,6 +29,7 @@ ...@@ -29,6 +29,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Namet; use Namet;
with Snames; use Snames; with Snames; use Snames;
with Types; use Types; with Types; use Types;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -7351,6 +7352,11 @@ package Einfo is ...@@ -7351,6 +7352,11 @@ package Einfo is
-- expression is deferred to the freeze point. For further details see -- expression is deferred to the freeze point. For further details see
-- Sem_Ch13.Analyze_Aspect_Specifications. -- 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 function Get_Attribute_Definition_Clause
(E : Entity_Id; (E : Entity_Id;
Id : Attribute_Id) return Node_Id; Id : Attribute_Id) return Node_Id;
......
...@@ -5741,6 +5741,9 @@ package body Sem_Ch13 is ...@@ -5741,6 +5741,9 @@ package body Sem_Ch13 is
Raise_Expression_Present : Boolean := False; Raise_Expression_Present : Boolean := False;
-- Set True if Expr has at least one Raise_Expression -- 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); procedure Add_Call (T : Entity_Id);
-- Includes a call to the predicate function for type T in Expr if T -- Includes a call to the predicate function for type T in Expr if T
-- has predicates and Predicate_Function (T) is non-empty. -- has predicates and Predicate_Function (T) is non-empty.
...@@ -5765,13 +5768,6 @@ package body Sem_Ch13 is ...@@ -5765,13 +5768,6 @@ package body Sem_Ch13 is
procedure Process_REs is new Traverse_Proc (Process_RE); procedure Process_REs is new Traverse_Proc (Process_RE);
-- Marks any raise expressions in Expr_M to return False -- 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 -- -- Add_Call --
-------------- --------------
...@@ -5783,12 +5779,6 @@ package body Sem_Ch13 is ...@@ -5783,12 +5779,6 @@ package body Sem_Ch13 is
if Present (T) and then Present (Predicate_Function (T)) then if Present (T) and then Present (Predicate_Function (T)) then
Set_Has_Predicates (Typ); 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 -- Build the call to the predicate function of T
Exp := Exp :=
...@@ -5872,17 +5862,14 @@ package body Sem_Ch13 is ...@@ -5872,17 +5862,14 @@ package body Sem_Ch13 is
if Nkind (Ritem) = N_Pragma if Nkind (Ritem) = N_Pragma
and then Pragma_Name (Ritem) = Name_Predicate and then Pragma_Name (Ritem) = Name_Predicate
then then
-- Capture the nature of the predicate -- Save the static predicate of the type for diagnostics and
-- error reporting purposes.
if Present (Corresponding_Aspect (Ritem)) then
case Chars (Identifier (Corresponding_Aspect (Ritem))) is if Present (Corresponding_Aspect (Ritem))
when Name_Dynamic_Predicate => and then Chars (Identifier (Corresponding_Aspect (Ritem))) =
Dynamic_Predicate_Present := True; Name_Static_Predicate
when Name_Static_Predicate => then
Static_Predicate_Present := Ritem; Static_Predic := Ritem;
when others =>
null;
end case;
end if; end if;
-- Acquire arguments -- Acquire arguments
...@@ -6211,7 +6198,9 @@ package body Sem_Ch13 is ...@@ -6211,7 +6198,9 @@ package body Sem_Ch13 is
-- Attempt to build a static predicate for a discrete or a real -- Attempt to build a static predicate for a discrete or a real
-- subtype. This action may fail because the actual expression may -- 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, if Ekind_In (Typ, E_Decimal_Fixed_Point_Subtype,
E_Enumeration_Subtype, E_Enumeration_Subtype,
...@@ -6222,30 +6211,26 @@ package body Sem_Ch13 is ...@@ -6222,30 +6211,26 @@ package body Sem_Ch13 is
then then
Build_Static_Predicate (Typ, Expr, Object_Name); Build_Static_Predicate (Typ, Expr, Object_Name);
-- The predicate is categorized as static but its expression is -- Emit an error when the predicate is categorized as static
-- dynamic. Note that the predicate may become non-static when -- but its expression is dynamic.
-- inherited dynamic predicates are involved.
if Present (Static_Predicate_Present) if Present (Static_Predic)
and then No (Static_Predicate (Typ)) and then No (Static_Predicate (Typ))
and then not Dynamic_Predicate_Present
then then
Error_Msg_F Error_Msg_F
("expression does not have required form for " ("expression does not have required form for "
& "static predicate", & "static predicate",
Next (First (Pragma_Argument_Associations Next (First (Pragma_Argument_Associations
(Static_Predicate_Present)))); (Static_Predic))));
end if; end if;
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 -- 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 -- scalar type. We do not issue an error on generated types, as
-- these may be duplicates of the same error on a source type. -- these may be duplicates of the same error on a source type.
elsif Present (Static_Predicate_Present) elsif Present (Static_Predic) and then Comes_From_Source (Typ) then
and then Comes_From_Source (Typ)
then
if Is_Scalar_Type (Typ) then if Is_Scalar_Type (Typ) then
Error_Msg_FE Error_Msg_FE
("static predicate not allowed for non-static type&", ("static predicate not allowed for non-static type&",
......
...@@ -4882,26 +4882,6 @@ package body Sem_Util is ...@@ -4882,26 +4882,6 @@ package body Sem_Util is
end if; end if;
end Find_Parameter_Type; 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 -- -- Find_Static_Alternative --
----------------------------- -----------------------------
......
...@@ -494,11 +494,6 @@ package Sem_Util is ...@@ -494,11 +494,6 @@ package Sem_Util is
-- Return the type of formal parameter Param as determined by its -- Return the type of formal parameter Param as determined by its
-- specification. -- 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; function Find_Static_Alternative (N : Node_Id) return Node_Id;
-- N is a case statement whose expression is a compile-time value. -- N is a case statement whose expression is a compile-time value.
-- Determine the alternative chosen, so that the code of non-selected -- 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