[multiple changes]

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

	* sem_ch4.adb (Analyze_Quantified_Expression):
	Preanalyze the condition when the quantified expression will be
	further expanded.

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

	* sem_prag.adb, sem_util.adb, sem_util.ads, sem_attr.adb, sem_ch6.adb,
	sem_warn.adb: Minor refactoring, renaming Case_Pragma in CTC_Pragma,
	to refer to both Test_Case pragma and Contract_Case pragma (same
	acronym as in Spec_CTC_List).

From-SVN: r185419

8 files changed, 54 insertions, 29 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c9063a6..45a53bb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2012-03-15  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_ch4.adb (Analyze_Quantified_Expression):
+	Preanalyze the condition when the quantified expression will be
+	further expanded.
+
+2012-03-15  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb, sem_util.adb, sem_util.ads, sem_attr.adb, sem_ch6.adb,
+	sem_warn.adb: Minor refactoring, renaming Case_Pragma in CTC_Pragma,
+	to refer to both Test_Case pragma and Contract_Case pragma (same
+	acronym as in Spec_CTC_List).
+
 2012-03-15  Robert Dewar  <dewar@adacore.com>
 
 	* sem_prag.adb, sem_prag.ads, sem_util.ads, sem_attr.adb, sem_ch6.adb,
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index d516486..50c7d12 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4260,7 +4260,7 @@ package body Sem_Attr is
             then
                declare
                   Arg_Ens : constant Node_Id :=
-                              Get_Ensures_From_Case_Pragma (Prag);
+                              Get_Ensures_From_CTC_Pragma (Prag);
                   Arg     : Node_Id;
 
                begin
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index c6f8c0c..5567485 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -29,6 +29,7 @@ with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
+with Expander; use Expander;
 with Exp_Util; use Exp_Util;
 with Fname;    use Fname;
 with Itypes;   use Itypes;
@@ -3442,7 +3443,19 @@ package body Sem_Ch4 is
          Set_Parent (Iterator_Specification (Iterator), Iterator);
       end if;
 
-      Analyze (Condition (N));
+      if Needs_Expansion then
+
+         --  The full analysis will be performed during the expansion of the
+         --  quantified expression, only a preanalysis of the condition needs
+         --  to be done.
+
+         Expander_Mode_Save_And_Set (False);
+         Analyze (Condition (N));
+         Expander_Mode_Restore;
+      else
+         Analyze (Condition (N));
+      end if;
+
       End_Scope;
 
       Set_Etype (N, Standard_Boolean);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 391ac80..a63cb79 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7079,7 +7079,7 @@ package body Sem_Ch6 is
          loop
             --  Retrieve the Ensures component of the contract-case, if any
 
-            Arg := Get_Ensures_From_Case_Pragma (Prag);
+            Arg := Get_Ensures_From_CTC_Pragma (Prag);
 
             if Pragma_Name (Prag) = Name_Contract_Case then
 
@@ -11058,11 +11058,11 @@ package body Sem_Ch6 is
          --  Copy the Requires and Ensures expressions
 
          Req  := New_Copy_Tree
-                   (Expression (Get_Requires_From_Case_Pragma (Prag)),
+                   (Expression (Get_Requires_From_CTC_Pragma (Prag)),
                     New_Scope => Current_Scope);
 
          Ens  := New_Copy_Tree
-                   (Expression (Get_Ensures_From_Case_Pragma (Prag)),
+                   (Expression (Get_Ensures_From_CTC_Pragma (Prag)),
                     New_Scope => Current_Scope);
 
          --  Build the postcondition (not Requires'Old or else Ensures)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 51ca907..38a2c8c 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -260,8 +260,8 @@ package body Sem_Prag is
 
       Preanalyze_CTC_Args
         (N,
-         Get_Requires_From_Case_Pragma (N),
-         Get_Ensures_From_Case_Pragma (N));
+         Get_Requires_From_CTC_Pragma (N),
+         Get_Ensures_From_CTC_Pragma (N));
 
       --  Remove the subprogram from the scope stack now that the pre-analysis
       --  of the expressions in the contract case or test case is done.
@@ -1465,13 +1465,13 @@ package body Sem_Prag is
             --  same name associated to this subprogram.
 
             declare
-               Name : constant String_Id := Get_Name_From_Case_Pragma (N);
+               Name : constant String_Id := Get_Name_From_CTC_Pragma (N);
                CTC  : Node_Id;
 
             begin
                CTC := Spec_CTC_List (Contract (S));
                while Present (CTC) loop
-                  if String_Equal (Name, Get_Name_From_Case_Pragma (CTC)) then
+                  if String_Equal (Name, Get_Name_From_CTC_Pragma (CTC)) then
                      Error_Msg_Sloc := Sloc (CTC);
                      Error_Pragma ("name for pragma% is already used#");
                   end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 1d60030..6519221 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4490,11 +4490,11 @@ package body Sem_Util is
       end if;
    end Get_Enum_Lit_From_Pos;
 
-   ----------------------------------
-   -- Get_Ensures_From_Case_Pragma --
-   ----------------------------------
+   ---------------------------------
+   -- Get_Ensures_From_CTC_Pragma --
+   ---------------------------------
 
-   function Get_Ensures_From_Case_Pragma (N : Node_Id) return Node_Id is
+   function Get_Ensures_From_CTC_Pragma (N : Node_Id) return Node_Id is
       Args : constant List_Id := Pragma_Argument_Associations (N);
       Res  : Node_Id;
 
@@ -4514,7 +4514,7 @@ package body Sem_Util is
       end if;
 
       return Res;
-   end Get_Ensures_From_Case_Pragma;
+   end Get_Ensures_From_CTC_Pragma;
 
    ------------------------
    -- Get_Generic_Entity --
@@ -4602,16 +4602,16 @@ package body Sem_Util is
       return Entity_Id (Get_Name_Table_Info (Id));
    end Get_Name_Entity_Id;
 
-   -------------------------------
-   -- Get_Name_From_Case_Pragma --
-   -------------------------------
+   ------------------------------
+   -- Get_Name_From_CTC_Pragma --
+   ------------------------------
 
-   function Get_Name_From_Case_Pragma (N : Node_Id) return String_Id is
+   function Get_Name_From_CTC_Pragma (N : Node_Id) return String_Id is
       Arg : constant Node_Id :=
               Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
    begin
       return Strval (Expr_Value_S (Arg));
-   end Get_Name_From_Case_Pragma;
+   end Get_Name_From_CTC_Pragma;
 
    -------------------
    -- Get_Pragma_Id --
@@ -4656,11 +4656,11 @@ package body Sem_Util is
       return R;
    end Get_Renamed_Entity;
 
-   -----------------------------------
-   -- Get_Requires_From_Case_Pragma --
-   -----------------------------------
+   ----------------------------------
+   -- Get_Requires_From_CTC_Pragma --
+   ----------------------------------
 
-   function Get_Requires_From_Case_Pragma (N : Node_Id) return Node_Id is
+   function Get_Requires_From_CTC_Pragma (N : Node_Id) return Node_Id is
       Args : constant List_Id := Pragma_Argument_Associations (N);
       Res  : Node_Id;
 
@@ -4677,7 +4677,7 @@ package body Sem_Util is
       end if;
 
       return Res;
-   end Get_Requires_From_Case_Pragma;
+   end Get_Requires_From_CTC_Pragma;
 
    -------------------------
    -- Get_Subprogram_Body --
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 8982228..34d2fc0 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -538,7 +538,7 @@ package Sem_Util is
    --  If expression N references a part of an object, return this object.
    --  Otherwise return Empty. Expression N should have been resolved already.
 
-   function Get_Ensures_From_Case_Pragma (N : Node_Id) return Node_Id;
+   function Get_Ensures_From_CTC_Pragma (N : Node_Id) return Node_Id;
    --  Return the Ensures component of Contract_Case or Test_Case pragma N, or
    --  Empty otherwise.
 
@@ -573,9 +573,8 @@ package Sem_Util is
    --  is the innermost visible entity with the given name. See the body of
    --  Sem_Ch8 for further details on handling of entity visibility.
 
-   function Get_Name_From_Case_Pragma (N : Node_Id) return String_Id;
+   function Get_Name_From_CTC_Pragma (N : Node_Id) return String_Id;
    --  Return the Name component of Contract_Case or Test_Case pragma N
-   --  Bad name, Case_Pragma is meaningless to me ???
 
    function Get_Pragma_Id (N : Node_Id) return Pragma_Id;
    pragma Inline (Get_Pragma_Id);
@@ -592,7 +591,7 @@ package Sem_Util is
    --  not a renamed entity, returns its argument. It is an error to call this
    --  with any other kind of entity.
 
-   function Get_Requires_From_Case_Pragma (N : Node_Id) return Node_Id;
+   function Get_Requires_From_CTC_Pragma (N : Node_Id) return Node_Id;
    --  Return the Requires component of Contract_Case or Test_Case pragma N, or
    --  Empty otherwise.
 
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 129eb35..3ba8b91 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1775,7 +1775,7 @@ package body Sem_Warn is
                                      or else
                                    Pragma_Name (P) = Name_Test_Case)
                                 and then
-                                  Nod = Get_Ensures_From_Case_Pragma (P)
+                                  Nod = Get_Ensures_From_CTC_Pragma (P)
                               then
                                  return True;
                               end if;