2012-11-06 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_prag.adb (Expand_Pragma_Loop_Assertion): Update the comment
	on intended expansion.	Reimplement the logic which expands the
	termination variants.
	(Process_Increase_Decrease): Update the parameter profile and the
	comment related to it. Accommodate the new aggregate-like appearance of
	the termination variants.
	* sem_prag.adb (Analyze_Pragma): Update the syntax of pragma
	Loop_Assertion. Reimplement the semantic analysis of the pragma
	to accommodate the new aggregate-like variant.
	(Check_Variant): New routine.
	* snames.ads-tmpl: Change names Name_Decreases and Name_Increases
	to Name_Decreasing and Name_Increasing respectively. Add name
	Variant.

2012-11-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_eval.adb: Static evaluation of case expressions.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@193216 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 256 insertions, 100 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e2b1c7e6d1b..632b6030c20 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2012-11-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_prag.adb (Expand_Pragma_Loop_Assertion): Update the comment
+	on intended expansion.	Reimplement the logic which expands the
+	termination variants.
+	(Process_Increase_Decrease): Update the parameter profile and the
+	comment related to it. Accommodate the new aggregate-like appearance of
+	the termination variants.
+	* sem_prag.adb (Analyze_Pragma): Update the syntax of pragma
+	Loop_Assertion. Reimplement the semantic analysis of the pragma
+	to accommodate the new aggregate-like variant.
+	(Check_Variant): New routine.
+	* snames.ads-tmpl: Change names Name_Decreases and Name_Increases
+	to Name_Decreasing and Name_Increasing respectively. Add name
+	Variant.
+
+2012-11-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_eval.adb: Static evaluation of case expressions.
+
 2012-11-06  Robert Dewar  <dewar@adacore.com>
 
 	* exp_prag.adb, impunit.adb, exp_ch9.adb, par-ch4.adb,
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 5ce2aa1b985..5ce90974768 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -807,8 +807,8 @@ package body Exp_Prag is
    --        <preceding source statements>
    --        pragma Loop_Assertion
    --           (Invariant => Invar_Expr,
-   --            Increases => Incr_Expr,
-   --            Decreases => Decr_Expr);
+   --            Variant   => (Increasing => Incr_Expr,
+   --                          Decreasing => Decr_Expr));
    --        <succeeding source statements>
    --     end loop;
 
@@ -855,15 +855,20 @@ package body Exp_Prag is
       Loop_Stmt   : Node_Id;
       Old_Assign  : List_Id   := No_List;
 
-      procedure Process_Increase_Decrease (Arg : Node_Id; Is_Last : Boolean);
-      --  Process a single increases/decreases expression. Flag Is_Last should
-      --  be set when the expression is the last argument to be processed.
+      procedure Process_Increase_Decrease
+        (Variant : Node_Id;
+         Is_Last : Boolean);
+      --  Process a single increasing / decreasing termination variant. Flag
+      --  Is_Last should be set when processing the last variant.
 
       -------------------------------
       -- Process_Increase_Decrease --
       -------------------------------
 
-      procedure Process_Increase_Decrease (Arg : Node_Id; Is_Last : Boolean) is
+      procedure Process_Increase_Decrease
+        (Variant : Node_Id;
+         Is_Last : Boolean)
+      is
          function Make_Op
            (Loc      : Source_Ptr;
             Curr_Val : Node_Id;
@@ -880,26 +885,21 @@ package body Exp_Prag is
             Curr_Val : Node_Id;
             Old_Val  : Node_Id) return Node_Id
          is
+            Modif : constant Node_Id := First (Choices (Variant));
          begin
-            if Chars (Arg) = Name_Increases then
-               return
-                 Make_Op_Gt (Loc,
-                   Left_Opnd  => Curr_Val,
-                   Right_Opnd => Old_Val);
-
-            else pragma Assert (Chars (Arg) = Name_Decreases);
-               return
-                 Make_Op_Lt (Loc,
-                   Left_Opnd  => Curr_Val,
-                   Right_Opnd => Old_Val);
+            if Chars (Modif) = Name_Increasing then
+               return Make_Op_Gt (Loc, Curr_Val, Old_Val);
+
+            else pragma Assert (Chars (Modif) = Name_Decreasing);
+               return Make_Op_Lt (Loc, Curr_Val, Old_Val);
             end if;
          end Make_Op;
 
          --  Local variables
 
-         Expr     : constant Node_Id := Expression (Arg);
+         Expr     : constant Node_Id := Expression (Variant);
+         Loc      : constant Source_Ptr := Sloc (Expr);
          Loop_Loc : constant Source_Ptr := Sloc (Loop_Stmt);
-         Cond     : Node_Id;
          Curr_Id  : Entity_Id;
          Old_Id   : Entity_Id;
          Prag     : Node_Id;
@@ -909,7 +909,8 @@ package body Exp_Prag is
       begin
          --  All temporaries generated in this routine must be inserted before
          --  the related loop statement. Ensure that the proper scope is on the
-         --  stack when analyzing the temporaries.
+         --  stack when analyzing the temporaries. Note that we also use the
+         --  Sloc of the related loop.
 
          Push_Scope (Scope (Loop_Scop));
 
@@ -930,6 +931,21 @@ package body Exp_Prag is
                   New_Reference_To (Standard_Boolean, Loop_Loc),
                 Expression          =>
                   New_Reference_To (Standard_False, Loop_Loc)));
+
+            --  Prevent an unwanted optimization where the Current_Value of
+            --  the flag eliminates the if statement which stores the variant
+            --  values coming from the previous iteration.
+
+            --     Flag : Boolean := False;
+            --     loop
+            --        if Flag then         --  condition rewritten to False
+            --           Old_N := Curr_N;  --  and if statement eliminated
+            --        end if;
+            --        . . .
+            --        Flag := True;
+            --     end loop;
+
+            Set_Current_Value (Flag_Id, Empty);
          end if;
 
          --  Step 2: Create the temporaries which store the old and current
@@ -1008,16 +1024,22 @@ package body Exp_Prag is
          --    if Curr /= Old then
          --       <Prag>;
 
-         Cond :=
-           Make_Op_Ne (Loc,
-             Left_Opnd  => New_Reference_To (Curr_Id, Loc),
-             Right_Opnd => New_Reference_To (Old_Id, Loc));
-
          if No (If_Stmt) then
-            If_Stmt :=
-              Make_If_Statement (Loc,
-                Condition       => Cond,
-                Then_Statements => New_List (Prag));
+
+            --  When there is just one termination variant, do not compare the
+            --  old and current value for equality, just check the pragma.
+
+            if Is_Last then
+               If_Stmt := Prag;
+            else
+               If_Stmt :=
+                 Make_If_Statement (Loc,
+                   Condition       =>
+                     Make_Op_Ne (Loc,
+                       Left_Opnd  => New_Reference_To (Curr_Id, Loc),
+                       Right_Opnd => New_Reference_To (Old_Id, Loc)),
+                   Then_Statements => New_List (Prag));
+            end if;
 
          --  Generate:
          --    else
@@ -1038,31 +1060,24 @@ package body Exp_Prag is
 
             Append_To (Elsif_Parts (If_Stmt),
               Make_Elsif_Part (Loc,
-                Condition       => Cond,
+                Condition       =>
+                  Make_Op_Ne (Loc,
+                    Left_Opnd  => New_Reference_To (Curr_Id, Loc),
+                    Right_Opnd => New_Reference_To (Old_Id, Loc)),
                 Then_Statements => New_List (Prag)));
          end if;
       end Process_Increase_Decrease;
 
       --  Local variables
 
-      Args     : constant List_Id := Pragma_Argument_Associations (N);
-      Last_Arg : constant Node_Id := Last (Args);
-      Arg      : Node_Id;
-      Invar    : Node_Id := Empty;
+      Arg   : Node_Id;
+      Invar : Node_Id := Empty;
 
    --  Start of processing for Expand_Pragma_Loop_Assertion
 
    begin
       --  Locate the enclosing loop for which this assertion applies
 
-      Loop_Scop := Current_Scope;
-      while Present (Loop_Scop)
-        and then Loop_Scop /= Standard_Standard
-        and then Ekind (Loop_Scop) /= E_Loop
-      loop
-         Loop_Scop := Scope (Loop_Scop);
-      end loop;
-
       Loop_Stmt := N;
       while Present (Loop_Stmt)
         and then Nkind (Loop_Stmt) /= N_Loop_Statement
@@ -1070,14 +1085,35 @@ package body Exp_Prag is
          Loop_Stmt := Parent (Loop_Stmt);
       end loop;
 
+      Loop_Scop := Entity (Identifier (Loop_Stmt));
+
       --  Process all pragma arguments
 
-      Arg := First (Args);
+      Arg := First (Pragma_Argument_Associations (N));
       while Present (Arg) loop
-         if Chars (Arg) = Name_Increases
-           or else Chars (Arg) = Name_Decreases
-         then
-            Process_Increase_Decrease (Arg, Is_Last => Arg = Last_Arg);
+
+         --  Termination variants appear as components in an aggregate
+
+         if Chars (Arg) = Name_Variant then
+            declare
+               Variants : constant Node_Id := Expression (Arg);
+               Last_Var : constant Node_Id :=
+                            Last (Component_Associations (Variants));
+               Variant  : Node_Id;
+
+            begin
+               Variant := First (Component_Associations (Variants));
+               while Present (Variant) loop
+                  Process_Increase_Decrease
+                    (Variant => Variant,
+                     Is_Last => Variant = Last_Var);
+
+                  Next (Variant);
+               end loop;
+            end;
+
+         --  Invariant
+
          else
             Invar := Expression (Arg);
          end if;
@@ -1088,13 +1124,19 @@ package body Exp_Prag is
       --  Verify the invariant expression, generate:
       --    pragma Assert (<Invar>);
 
+      --  Use the Sloc of the invariant for better error reporting
+
       if Present (Invar) then
-         Insert_Action (N,
-           Make_Pragma (Loc,
-             Chars                        => Name_Assert,
-             Pragma_Argument_Associations => New_List (
-               Make_Pragma_Argument_Association (Loc,
-                 Expression => Relocate_Node (Invar)))));
+         declare
+            Invar_Loc : constant Source_Ptr := Sloc (Invar);
+         begin
+            Insert_Action (N,
+              Make_Pragma (Invar_Loc,
+                Chars                        => Name_Assert,
+                Pragma_Argument_Associations => New_List (
+                  Make_Pragma_Argument_Association (Invar_Loc,
+                    Expression => Relocate_Node (Invar)))));
+         end;
       end if;
 
       --  Construct the segment which stores the old values of all expressions.
@@ -1135,7 +1177,8 @@ package body Exp_Prag is
                  Expression => New_Reference_To (Standard_True, Loc)))));
       end if;
 
-      --  Need a comment on this final rewrite ???
+      --  The original pragma has been transformed into a complex sequence of
+      --  statements and does not need to remain in the tree.
 
       Rewrite (N, Make_Null_Statement (Loc));
       Analyze (N);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index f7e774308fb..42174631ba8 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1759,21 +1759,63 @@ package body Sem_Eval is
    -- Eval_Case_Expression --
    --------------------------
 
-   --  Right now we do not attempt folding of any case expressions, and the
-   --  language does not require it, so the only required processing is to
-   --  do the check for all expressions appearing in the case expression.
+   --  A conditional expression is static if all its conditions and dependent
+   --  expressions are static.
 
    procedure Eval_Case_Expression (N : Node_Id) is
-      Alt : Node_Id;
+      Alt       : Node_Id;
+      Choice    : Node_Id;
+      Is_Static : Boolean;
+      Result    : Node_Id;
+      Val       : Uint;
 
    begin
-      Check_Non_Static_Context (Expression (N));
+      Result := Empty;
+      Is_Static := True;
+
+      if Is_Static_Expression (Expression (N)) then
+         Val := Expr_Value (Expression (N));
+
+      else
+         Check_Non_Static_Context (Expression (N));
+         Is_Static := False;
+      end if;
 
       Alt := First (Alternatives (N));
-      while Present (Alt) loop
-         Check_Non_Static_Context (Expression (Alt));
+
+      Search : while Present (Alt) loop
+         if not Is_Static
+           or else not Is_Static_Expression (Expression (Alt))
+         then
+            Check_Non_Static_Context (Expression (Alt));
+            Is_Static := False;
+
+         else
+            Choice := First (Discrete_Choices (Alt));
+            while Present (Choice) loop
+               if Nkind (Choice) = N_Others_Choice then
+                  Result := Expression (Alt);
+                  exit Search;
+
+               elsif Expr_Value (Choice) = Val then
+                  Result := Expression (Alt);
+                  exit Search;
+
+               else
+                  Next (Choice);
+               end if;
+            end loop;
+         end if;
+
          Next (Alt);
-      end loop;
+      end loop Search;
+
+      if Is_Static then
+         Rewrite (N, Relocate_Node (Result));
+
+      else
+         Set_Is_Static_Expression (N, False);
+      end if;
    end Eval_Case_Expression;
 
    ------------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c2392cb0cbc..325ca0c3bc3 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11288,18 +11288,71 @@ package body Sem_Prag is
          -- Loop_Assertion --
          --------------------
 
-         --  pragma Loop_Assertion (
-         --     [[Invariant   =>] boolean_EXPRESSION],
-         --      {CHANGE_MODE =>  discrete_EXPRESSION} );
+         --  pragma Loop_Assertion
+         --    (   [Invariant =>] boolean_Expression
+         --      | [Invariant =>] boolean_Expression ,
+         --         Variant => TERMINATION_VARIANTS
+         --      |  Variant => TERMINATION_VARIANTS );
          --
-         --  CHANGE_MODE ::= Increases | Decreases
+         --  TERMINATION_VARIANTS ::=
+         --    ( TERMINATION_VARIANT {, TERMINATION_VARIANT} )
+         --
+         --  TERMINATION_VARIANT ::= CHANGE_MODIFIER => discrete_EXPRESSION
+         --
+         --  CHANGE_MODIFIER ::= Increasing | Decreasing
 
          when Pragma_Loop_Assertion => Loop_Assertion : declare
-            Arg  : Node_Id;
-            Expr : Node_Id;
-            Seen : Boolean := False;
+            procedure Check_Variant (Arg : Node_Id);
+            --  Verify the legality of a variant
+
+            -------------------
+            -- Check_Variant --
+            -------------------
+
+            procedure Check_Variant (Arg : Node_Id) is
+               Expr : constant Node_Id := Expression (Arg);
+
+            begin
+               --  Variants appear in aggregate form
+
+               if Nkind (Expr) = N_Aggregate then
+                  declare
+                     Comp  : Node_Id;
+                     Extra : Node_Id;
+                     Modif : Node_Id;
+
+                  begin
+                     Comp := First (Component_Associations (Expr));
+                     while Present (Comp) loop
+                        Modif := First (Choices (Comp));
+                        Extra := Next (Modif);
+
+                        Check_Arg_Is_One_Of
+                          (Modif, Name_Decreasing, Name_Increasing);
+
+                        if Present (Extra) then
+                           Error_Pragma_Arg
+                             ("only one modifier allowed in argument", Expr);
+                        end if;
+
+                        Preanalyze_And_Resolve
+                          (Expression (Comp), Any_Discrete);
+
+                        Next (Comp);
+                     end loop;
+                  end;
+               else
+                  Error_Pragma_Arg
+                    ("expression on variant must be an aggregate", Expr);
+               end if;
+            end Check_Variant;
+
+            --  Local variables
+
             Stmt : Node_Id;
 
+         --  Start of processing for Loop_Assertion
+
          begin
             GNAT_Pragma;
             S14_Pragma;
@@ -11324,46 +11377,43 @@ package body Sem_Prag is
             end if;
 
             Check_At_Least_N_Arguments (1);
+            Check_At_Most_N_Arguments  (2);
 
-            --  Process the arguments
+            --  Process the first argument
 
-            Arg := Arg1;
-            while Present (Arg) loop
-               Expr := Expression (Arg);
+            if Chars (Arg1) = Name_Variant then
+               Check_Variant (Arg1);
 
-               --  All expressions are preanalyzed because they will be
-               --  relocated during expansion and analyzed in their new
-               --  context.
+            elsif Chars (Arg1) = No_Name
+              or else Chars (Arg1) = Name_Invariant
+            then
+               Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean);
 
-               if Chars (Arg) = Name_Invariant
-                 or else
-                   (Arg_Count = 1
-                      and then Chars (Arg) /= Name_Increases
-                      and then Chars (Arg) /= Name_Decreases)
-               then
-                  --  Only one invariant is allowed in the pragma
+            else
+               Error_Pragma_Arg ("argument not allowed in pragma %", Arg1);
+            end if;
 
-                  if Seen then
-                     Error_Pragma_Arg
-                       ("only one invariant allowed in pragma %", Arg);
+            --  Process the second argument
+
+            if Present (Arg2) then
+               if Chars (Arg2) = Name_Variant then
+                  if Chars (Arg1) = Name_Variant then
+                     Error_Pragma ("only one variant allowed in pragma %");
                   else
-                     Seen := True;
-                     Preanalyze_And_Resolve (Expr, Any_Boolean);
+                     Check_Variant (Arg2);
                   end if;
 
-               elsif Chars (Arg) = Name_Increases
-                 or else Chars (Arg) = Name_Decreases
-               then
-                  Preanalyze_And_Resolve (Expr, Any_Discrete);
-
-               --  Illegal argument
+               elsif Chars (Arg2) = Name_Invariant then
+                  if Chars (Arg1) = Name_Variant then
+                     Error_Pragma_Arg ("invariant must precede variant", Arg2);
+                  else
+                     Error_Pragma ("only one invariant allowed in pragma %");
+                  end if;
 
                else
-                  Error_Pragma_Arg ("argument not allowed in pragma %", Arg);
+                  Error_Pragma_Arg ("argument not allowed in pragma %", Arg2);
                end if;
-
-               Next (Arg);
-            end loop;
+            end if;
          end Loop_Assertion;
 
          -----------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index f44c6898fa4..be0b7ff7e37 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -671,7 +671,7 @@ package Snames is
    Name_Component_Size_4               : constant Name_Id := N + $;
    Name_Copy                           : constant Name_Id := N + $;
    Name_D_Float                        : constant Name_Id := N + $;
-   Name_Decreases                      : constant Name_Id := N + $;
+   Name_Decreasing                     : constant Name_Id := N + $;
    Name_Descriptor                     : constant Name_Id := N + $;
    Name_Disable                        : constant Name_Id := N + $;
    Name_Dot_Replacement                : constant Name_Id := N + $;
@@ -691,7 +691,7 @@ package Snames is
    Name_GPL                            : constant Name_Id := N + $;
    Name_IEEE_Float                     : constant Name_Id := N + $;
    Name_Ignore                         : constant Name_Id := N + $;
-   Name_Increases                      : constant Name_Id := N + $;
+   Name_Increasing                     : constant Name_Id := N + $;
    Name_Info                           : constant Name_Id := N + $;
    Name_Internal                       : constant Name_Id := N + $;
    Name_Link_Name                      : constant Name_Id := N + $;
@@ -753,6 +753,7 @@ package Snames is
    Name_Unrestricted                   : constant Name_Id := N + $;
    Name_Uppercase                      : constant Name_Id := N + $;
    Name_User                           : constant Name_Id := N + $;
+   Name_Variant                        : constant Name_Id := N + $;
    Name_VAX_Float                      : constant Name_Id := N + $;
    Name_VMS                            : constant Name_Id := N + $;
    Name_Vtable_Ptr                     : constant Name_Id := N + $;