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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3d60a92b44e394a71306f9d2c784000d98defe65..71295d84178eb4eb423a8ac04aeecf4ebe14a8fd 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+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.

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 7092ee7adf94622cd3c7698101c6993be666f6ed..81b35f7754ce4c91f9d58b3e325190efc461aacb 100644 (file)
--- 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 fd38a1fdea1fbe16634cf192e5de68b755671f2d..38d4f22c6a5cee5cb01d06149b88b0ee5499849f 100644 (file)
--- 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 709947b7cf31b939d5b0b7e3dcc234a2ceb46050..e6f39f5b84409c45c1910725d87abd818e28d1f6 100644 (file)
--- 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 f55f594a50ac89524e1ca22567b3fc97d93525fc..095510e1eb0cdede2f1c23e0a6526fd8593c2c01 100644 (file)
--- 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 11b7a913a695cef07adaf25b14f1da442a4c7c8a..fa5b6e392b0eb44bc3646f15235dca64d795e3be 100644 (file)
--- 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