[multiple changes]

2012-03-07  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Apply_Predicate_Check): Do not generate a predicate
	check is the context is an internally generated type-specific
	function.
	* sem_ch6.adb (Process_PPCs); the formals of internally generated
	type-specific functions do not get assertion checks.

2012-03-07  Yannick Moy  <moy@adacore.com>

	* gnat_rm.texi: Minor renaming of title.
	* gnat_ugn.texi: Minor correction.

2012-03-07  Vincent Pucci  <pucci@adacore.com>

	* exp_ch4.adb (Expand_N_Quantified_Expression): Minor
	reformating.
	* sem_ch4.adb (Analyze_Quantified_Expression): Creation and
	analysis of the iteration scheme added in all cases.
	* sem_ch5.adb (Analyze_Iteration_Scheme): Minor reformating.
	(Analyze_Iterator_Specification): Minor reformating.
	* sem_res.adb (Resolve_Quantified_Expression): Resolution of
	the condition added in all cases.

From-SVN: r185050

9 files changed, 86 insertions, 50 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a864c02..c5b2dbd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2012-03-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* checks.adb (Apply_Predicate_Check): Do not generate a predicate
+	check is the context is an internally generated type-specific
+	function.
+	* sem_ch6.adb (Process_PPCs); the formals of internally generated
+	type-specific functions do not get assertion checks.
+
+2012-03-07  Yannick Moy  <moy@adacore.com>
+
+	* gnat_rm.texi: Minor renaming of title.
+	* gnat_ugn.texi: Minor correction.
+
+2012-03-07  Vincent Pucci  <pucci@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Quantified_Expression): Minor
+	reformating.
+	* sem_ch4.adb (Analyze_Quantified_Expression): Creation and
+	analysis of the iteration scheme added in all cases.
+	* sem_ch5.adb (Analyze_Iteration_Scheme): Minor reformating.
+	(Analyze_Iterator_Specification): Minor reformating.
+	* sem_res.adb (Resolve_Quantified_Expression): Resolution of
+	the condition added in all cases.
+
 2012-03-07  Thomas Quinot  <quinot@adacore.com>
 
 	* einfo.adb, einfo.ads: Add flag Reverse_Storage_Order.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 059253f..ab628b3 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -31,6 +31,7 @@ with Exp_Ch2;  use Exp_Ch2;
 with Exp_Ch4;  use Exp_Ch4;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Pakd; use Exp_Pakd;
+with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Elists;   use Elists;
 with Eval_Fat; use Eval_Fat;
@@ -1778,10 +1779,29 @@ package body Checks is
    ---------------------------
 
    procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id) is
+      S : Entity_Id;
    begin
       if Present (Predicate_Function (Typ)) then
-         Insert_Action (N,
-           Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
+
+         --  A predicate check does not apply within internally generated
+         --  subprograms, such as TSS functions.
+
+         S := Current_Scope;
+         while Present (S)
+           and then not Is_Subprogram (S)
+         loop
+            S := Scope (S);
+         end loop;
+
+         if Present (S)
+           and then Get_TSS_Name (S) /= TSS_Null
+         then
+            return;
+
+         else
+            Insert_Action (N,
+              Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
+         end if;
       end if;
    end Apply_Predicate_Check;
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d90b54c..416dd98 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7916,14 +7916,9 @@ package body Exp_Ch4 is
             Make_Exit_Statement (Loc)));
 
       if Present (Loop_Parameter_Specification (N)) then
-         I_Scheme :=
-           Make_Iteration_Scheme (Loc,
-              Loop_Parameter_Specification =>
-                Loop_Parameter_Specification (N));
+         I_Scheme := Relocate_Node (Parent (Loop_Parameter_Specification (N)));
       else
-         I_Scheme :=
-           Make_Iteration_Scheme (Loc,
-             Iterator_Specification => Iterator_Specification (N));
+         I_Scheme := Relocate_Node (Parent (Iterator_Specification (N)));
       end if;
 
       Append_To (Actions,
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index f652151..4fccee3 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -71,7 +71,7 @@ AdaCore
 * About This Guide::
 * Implementation Defined Pragmas::
 * Implementation Defined Attributes::
-* Implementation Defined Restrictions::
+* Standard and Implementation Defined Restrictions::
 * Implementation Advice::
 * Implementation Defined Characteristics::
 * Intrinsic Subprograms::
@@ -289,7 +289,7 @@ Implementation Defined Attributes
 * Wchar_T_Size::
 * Word_Size::
 
-Implementation Defined Restrictions
+Standard and Implementation Defined Restrictions
 
 * Partition-Wide Restrictions::
 * Program Unit Level Restrictions::
@@ -650,7 +650,7 @@ implementation-dependent attributes, which can be used to extend and
 enhance the functionality of the compiler.
 
 @item
-@ref{Implementation Defined Restrictions}, lists GNAT
+@ref{Standard and Implementation Defined Restrictions}, lists GNAT
 implementation-dependent restrictions, which can be used to extend and
 enhance the functionality of the compiler.
 
@@ -6919,8 +6919,8 @@ package @code{Interfaces.C}.
 @code{Standard'Word_Size} (@code{Standard} is the only permissible
 prefix) provides the value @code{System.Word_Size}.
 
-@node Implementation Defined Restrictions
-@chapter Implementation Defined Restrictions
+@node Standard and Implementation Defined Restrictions
+@chapter Standard and Implementation Defined Restrictions
 
 @noindent
 All RM defined Restriction identifiers are implemented:
@@ -9935,7 +9935,7 @@ See documentation in the sources of the run time mentioned in paragraph
 @code{Restrictions}.  See 13.12(7).
 @end cartouche
 @noindent
-@xref{Implementation Defined Restrictions}.
+@xref{Standard and Implementation Defined Restrictions}.
 
 @sp 1
 @cartouche
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index f9f09fa..4bd7bba 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -5953,6 +5953,7 @@ When no switch @option{^-gnatw^/WARNINGS^} is used, this is equivalent to:
 
 @table @option
 @c !sort!
+@item -gnatw.a
 @item -gnatwB
 @item -gnatw.b
 @item -gnatwC
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 0a9cb78..3570533 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3398,22 +3398,12 @@ package body Sem_Ch4 is
       Iterator : Node_Id;
 
    begin
-      Set_Etype  (Ent,  Standard_Void_Type);
+      Set_Etype  (Ent, Standard_Void_Type);
       Set_Scope  (Ent, Current_Scope);
       Set_Parent (Ent, N);
 
       Check_SPARK_Restriction ("quantified expression is not allowed", N);
 
-      --  If expansion is enabled (and not in Alfa mode), the condition is
-      --  analyzed after rewritten as a loop. So we only need to set the type.
-
-      if Operating_Mode /= Check_Semantics
-        and then not Alfa_Mode
-      then
-         Set_Etype (N, Standard_Boolean);
-         return;
-      end if;
-
       if Present (Loop_Parameter_Specification (N)) then
          Iterator :=
            Make_Iteration_Scheme (Loc,
@@ -3438,6 +3428,7 @@ package body Sem_Ch4 is
          Set_Iterator_Specification
            (N, Iterator_Specification (Iterator));
          Set_Loop_Parameter_Specification (N, Empty);
+         Set_Parent (Iterator_Specification (Iterator), Iterator);
       end if;
 
       Analyze (Condition (N));
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index f3188b0..fadfd6d 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2102,7 +2102,14 @@ package body Sem_Ch5 is
                --  because the second one may be created in a different scope,
                --  e.g. a precondition procedure, leading to a crash in GIGI.
 
-               if No (Etype (Id)) or else Etype (Id) = Any_Type then
+               --  Note that if the parent node is a quantified expression,
+               --  this preservation is delayed until the expansion of the
+               --  quantified expression where the node is rewritten as an
+               --  expression with actions.
+
+               if (No (Etype (Id)) or else Etype (Id) = Any_Type)
+                 and then Nkind (Parent (N)) /= N_Quantified_Expression
+               then
                   Set_Etype (Id, Etype (DS));
                end if;
 
@@ -2214,9 +2221,9 @@ package body Sem_Ch5 is
       end;
    end Analyze_Iteration_Scheme;
 
-   -------------------------------------
-   --  Analyze_Iterator_Specification --
-   -------------------------------------
+   ------------------------------------
+   -- Analyze_Iterator_Specification --
+   ------------------------------------
 
    procedure Analyze_Iterator_Specification (N : Node_Id) is
       Loc       : constant Source_Ptr := Sloc (N);
@@ -2228,15 +2235,7 @@ package body Sem_Ch5 is
       Typ : Entity_Id;
 
    begin
-      --  In semantics/Alfa modes, we won't be further expanding the loop, so
-      --  introduce loop variable so that loop body can be properly analyzed.
-      --  Otherwise this happens after expansion.
-
-      if Operating_Mode = Check_Semantics
-        or else Alfa_Mode
-      then
-         Enter_Name (Def_Id);
-      end if;
+      Enter_Name (Def_Id);
 
       Set_Ekind (Def_Id, E_Variable);
 
@@ -2249,7 +2248,13 @@ package body Sem_Ch5 is
       --  The declaration must be a renaming because the body of the loop may
       --  assign to elements.
 
-      if not Is_Entity_Name (Iter_Name) then
+      --  Note that if the parent node is a quantified expression, this
+      --  declaration is created during the expansion of the quantified
+      --  expression where the node is rewritten as an expression with actions.
+
+      if not Is_Entity_Name (Iter_Name)
+        and then Nkind (Parent (Parent (N))) /= N_Quantified_Expression
+      then
          declare
             Id   : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name);
             Decl : Node_Id;
@@ -2281,7 +2286,7 @@ package body Sem_Ch5 is
       --  Iterate is not a reserved name. What matter is that the return type
       --  of the function is an iterator type.
 
-      else
+      elsif Is_Entity_Name (Iter_Name) then
          Analyze (Iter_Name);
 
          if Nkind (Iter_Name) = N_Function_Call then
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index fecf5f0..1e4ed0b 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -9892,6 +9892,13 @@ package body Sem_Ch6 is
          Designator := Body_Id;
       end if;
 
+      --  Internally generated subprograms, such as type-specific functions,
+      --  don't get assertions checks.
+
+      if Get_TSS_Name (Designator) /= TSS_Null then
+         return;
+      end if;
+
       --  Grab preconditions from spec
 
       if Present (Spec_Id) then
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 01fabab..4615bca 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8278,13 +8278,6 @@ package body Sem_Res is
    begin
       if not Alfa_Mode then
 
-         --  If expansion is enabled, analysis is delayed until the expresssion
-         --  is rewritten as a loop.
-
-         if Operating_Mode /= Check_Semantics then
-            return;
-         end if;
-
          --  The loop structure is already resolved during its analysis, only
          --  the resolution of the condition needs to be done. Expansion is
          --  disabled so that checks and other generated code are inserted in