aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2013-04-25 10:13:14 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2013-04-25 12:13:14 +0200
commit42fdc85bfbf3b7eab8b860c2fcfdc3b7696acb2e (patch)
tree3977c15587116896b00f1879f3e75814b6a198d3 /gcc/ada
parent99a71c65ab06b6f960b80fd02879c003701eab41 (diff)
downloadgcc-42fdc85bfbf3b7eab8b860c2fcfdc3b7696acb2e.zip
gcc-42fdc85bfbf3b7eab8b860c2fcfdc3b7696acb2e.tar.gz
gcc-42fdc85bfbf3b7eab8b860c2fcfdc3b7696acb2e.tar.bz2
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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog16
-rw-r--r--gcc/ada/einfo.adb21
-rw-r--r--gcc/ada/einfo.ads6
-rw-r--r--gcc/ada/sem_ch13.adb55
-rw-r--r--gcc/ada/sem_util.adb20
-rw-r--r--gcc/ada/sem_util.ads5
6 files changed, 62 insertions, 61 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3d60a92..71295d8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,21 @@
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>
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 7092ee7..81b35f7 100644
--- a/gcc/ada/einfo.adb
+++ b/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 --
---------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index fd38a1f..38d4f22 100644
--- a/gcc/ada/einfo.ads
+++ b/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;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 709947b..e6f39f5 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/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&",
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f55f594..095510e 100644
--- a/gcc/ada/sem_util.adb
+++ b/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 --
-----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 11b7a91..fa5b6e3 100644
--- a/gcc/ada/sem_util.ads
+++ b/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