[multiple changes]

2014-08-04  Vincent Celier  <celier@adacore.com>

	* prj-dect.adb (Parse_Case_Construction): It is no longer
	an error if the variable for a case construction is not
	typed, only if the variable value is not a single string. Call
	Parse_Choice_List and End_Case_Construction with the new parameter
	to indicate that the variable is typed.
	* prj-strt.adb (End_Case_Construction): Only check the labels
	if the variable is typed.  If the variable is not typed,
	issue a warning when there is no "when others" allternative.
	(Parse_Choice_List): Manage the labels only if the variable
	is typed.
	* prj-strt.ads (End_Case_Construction): New Boolean parameter
	String_Type.
	(Parse_Choice_List): Ditto.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb: Additional fix to Check_Predicate_Use.

2014-08-04  Vincent Celier  <celier@adacore.com>

	* projects.texi: Update documentation of case constructions with
	variables that are not typed.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Build_Class_Wide_Wrapper): If the operator carries
	an Eliminated pragma, indicate that the wrapper is also to be
	eliminated, to prevent spurious errors when using gnatelim on
	programs that include box-initialization of equality operators
	(consequence of AI05-071)..

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Activate_Overflow_Check): Handle floating-point
	case correctly.
	* checks.ads (Activate_Overflow_Check): Clarify handling of
	floating-point cases.
	* exp_util.adb (Check_Float_Op_Overflow): Reset Do_Overflow_Check
	flag if we generate an explicit overflow check (for
	Check_Float_Overflow mode).

From-SVN: r213550

10 files changed, 195 insertions, 90 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 61ccf82..91804ed 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,46 @@
+2014-08-04  Vincent Celier  <celier@adacore.com>
+
+	* prj-dect.adb (Parse_Case_Construction): It is no longer
+	an error if the variable for a case construction is not
+	typed, only if the variable value is not a single string. Call
+	Parse_Choice_List and End_Case_Construction with the new parameter
+	to indicate that the variable is typed.
+	* prj-strt.adb (End_Case_Construction): Only check the labels
+	if the variable is typed.  If the variable is not typed,
+	issue a warning when there is no "when others" allternative.
+	(Parse_Choice_List): Manage the labels only if the variable
+	is typed.
+	* prj-strt.ads (End_Case_Construction): New Boolean parameter
+	String_Type.
+	(Parse_Choice_List): Ditto.
+
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch5.adb: Additional fix to Check_Predicate_Use.
+
+2014-08-04  Vincent Celier  <celier@adacore.com>
+
+	* projects.texi: Update documentation of case constructions with
+	variables that are not typed.
+
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Build_Class_Wide_Wrapper): If the operator carries
+	an Eliminated pragma, indicate that the wrapper is also to be
+	eliminated, to prevent spurious errors when using gnatelim on
+	programs that include box-initialization of equality operators
+	(consequence of AI05-071)..
+
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Activate_Overflow_Check): Handle floating-point
+	case correctly.
+	* checks.ads (Activate_Overflow_Check): Clarify handling of
+	floating-point cases.
+	* exp_util.adb (Check_Float_Op_Overflow): Reset Do_Overflow_Check
+	flag if we generate an explicit overflow check (for
+	Check_Float_Overflow mode).
+
 2014-08-04  Robert Dewar  <dewar@adacore.com>
 
 	* prj-proc.adb, prj-part.adb, prj-strt.adb, prj.adb, prj.ads,
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 0b934eb..8072629 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -388,27 +388,46 @@ package body Checks is
    -----------------------------
 
    procedure Activate_Overflow_Check (N : Node_Id) is
+      Typ : constant Entity_Id := Etype (N);
+
    begin
-      --  Nothing to do for unconstrained floating-point types (the test for
-      --  Etype (N) being present seems necessary in some cases, should be
-      --  tracked down, but for now just ignore the check in this case ???),
-      --  except if Check_Float_Overflow is set.
-
-      if Present (Etype (N))
-        and then Is_Floating_Point_Type (Etype (N))
-        and then not Is_Constrained (Etype (N))
-        and then not Check_Float_Overflow
-      then
-         return;
-      end if;
+      --  Floating-point case. If Etype is not set (this can happen when we
+      --  activate a check on a node that has not yet been analyzed), then
+      --  we assume we do not have a floating-point type (as per our spec).
 
-      --  Nothing to do for Rem/Mod/Plus (overflow not possible)
+      if Present (Typ) and then Is_Floating_Point_Type (Typ) then
 
-      if Nkind_In (N, N_Op_Rem, N_Op_Mod, N_Op_Plus) then
-         return;
+         --  Ignore call if we have no automatic overflow checks on the target
+         --  and Check_Float_Overflow mode is not set. These are the cases in
+         --  which we expect to generate infinities and NaN's with no check.
+
+         if not (Machine_Overflows_On_Target or Check_Float_Overflow) then
+            return;
+
+         --  Ignore for unary operations ("+", "-", abs) since these can never
+         --  result in overflow for floating-point cases.
+
+         elsif Nkind (N) in N_Unary_Op then
+            return;
+
+         --  Otherwise we will set the flag
+
+         else
+            null;
+         end if;
+
+      --  Discrete case
+
+      else
+         --  Nothing to do for Rem/Mod/Plus (overflow not possible, the check
+         --  for zero-divide is a divide check, not an overflow check).
+
+         if Nkind_In (N, N_Op_Rem, N_Op_Mod, N_Op_Plus) then
+            return;
+         end if;
       end if;
 
-      --  Otherwise set the flag
+      --  Fall through for cases where we do set the flag
 
       Set_Do_Overflow_Check (N, True);
       Possible_Local_Raise (N, Standard_Constraint_Error);
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 9362550..2dca67e 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -145,10 +145,19 @@ package Checks is
    --  Sets Do_Overflow_Check flag in node N, and handles possible local raise.
    --  Always call this routine rather than calling Set_Do_Overflow_Check to
    --  set an explicit value of True, to ensure handling the local raise case.
-   --  Note that this call has no effect for MOD, REM, and unary "+" for which
-   --  overflow is never possible in any case. In addition, we do not set the
-   --  flag for unconstrained floating-point type operations, since we want to
-   --  allow for the generation of IEEE infinities in such cases.
+   --  Note that for discrete types, this call has no effect for MOD, REM, and
+   --  unary "+" for which overflow is never possible in any case.
+   --
+   --  Note: for the discrete-type case, it is legitimate to call this routine
+   --  on an unanalyzed node where the Etype field is not set. However, for the
+   --  floating-point case, Etype must be set (to a floating-point type).
+   --
+   --  For floating-point, we set the flag if we have automatic overflow checks
+   --  on the target, or if Check_Float_Overflow mode is set. For the floating-
+   --  point case, we ignore all the unary operators ("+", "-", and abs) since
+   --  none of these can result in overflow. If there are no overflow checks on
+   --  the target, and Check_Float_Overflow mode is not set, then the call has
+   --  no effect, since in such cases we want to generate NaN's and infinities.
 
    procedure Activate_Range_Check (N : Node_Id);
    pragma Inline (Activate_Range_Check);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5532d58..9467154 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1641,10 +1641,11 @@ package body Exp_Util is
    begin
       --  Return if no check needed
 
-      if not Check_Float_Overflow
-        or else not Is_Floating_Point_Type (Etype (N))
+      if not Is_Floating_Point_Type (Etype (N))
+        or else not (Do_Overflow_Check (N) and then Check_Float_Overflow)
 
         --  In CodePeer_Mode, rely on the overflow check flag being set instead
+        --  and do not expand the code for float overflow checking.
 
         or else CodePeer_Mode
       then
@@ -1663,9 +1664,12 @@ package body Exp_Util is
          Typ : constant Entity_Id  := Etype (N);
 
       begin
-         --  Prevent recursion
+         --  Turn off the Do_Overflow_Check flag, since we are doing that work
+         --  right here. We also set the node as analyzed to prevent infinite
+         --  recursion from repeating the operation in the expansion.
 
-         Set_Analyzed (N);
+         Set_Do_Overflow_Check (N, False);
+         Set_Analyzed (N, True);
 
          --  Do the rewrite to include the check
 
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 9053cfc..672c454 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -827,11 +827,11 @@ package body Prj.Dect is
       if Present (Case_Variable) then
          String_Type := String_Type_Of (Case_Variable, In_Tree);
 
-         if No (String_Type) then
+         if Expression_Kind_Of (Case_Variable, In_Tree) /= Single then
             Error_Msg (Flags,
                        "variable """ &
                        Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
-                       """ is not typed",
+                       """ is not a single string",
                        Variable_Location);
          end if;
       end if;
@@ -914,7 +914,8 @@ package body Prj.Dect is
             Parse_Choice_List
               (In_Tree      => In_Tree,
                First_Choice => First_Choice,
-               Flags        => Flags);
+               Flags        => Flags,
+               String_Type  => Present (String_Type));
             Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice);
 
             Expect (Tok_Arrow, "`=>`");
@@ -941,7 +942,8 @@ package body Prj.Dect is
       End_Case_Construction
         (Check_All_Labels => not When_Others and not Quiet_Output,
          Case_Location    => Location_Of (Case_Construction, In_Tree),
-         Flags            => Flags);
+         Flags            => Flags,
+         String_Type      => Present (String_Type));
 
       Expect (Tok_End, "`END CASE`");
       Remove_Next_End_Node;
diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb
index c79c199..1224270 100644
--- a/gcc/ada/prj-strt.adb
+++ b/gcc/ada/prj-strt.adb
@@ -297,7 +297,8 @@ package body Prj.Strt is
    procedure End_Case_Construction
      (Check_All_Labels   : Boolean;
       Case_Location      : Source_Ptr;
-      Flags              : Processing_Flags)
+      Flags              : Processing_Flags;
+      String_Type        : Boolean)
    is
       Non_Used : Natural := 0;
       First_Non_Used : Choice_Node_Id := First_Choice_Node_Id;
@@ -306,7 +307,8 @@ package body Prj.Strt is
       --  of the string type have been used.
 
       if Check_All_Labels then
-         for Choice in Choice_First .. Choices.Last loop
+         if String_Type then
+            for Choice in Choice_First .. Choices.Last loop
                if not Choices.Table (Choice).Already_Used then
                   Non_Used := Non_Used + 1;
 
@@ -314,27 +316,35 @@ package body Prj.Strt is
                      First_Non_Used := Choice;
                   end if;
                end if;
-         end loop;
+            end loop;
+
+            --  If only one is not used, report a single warning for this value
 
-         --  If only one is not used, report a single warning for this value
+            if Non_Used = 1 then
+               Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
+               Error_Msg
+                 (Flags, "?value %% is not used as label", Case_Location);
 
-         if Non_Used = 1 then
-            Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
-            Error_Msg (Flags, "?value %% is not used as label", Case_Location);
+               --  If several are not used, report a warning for each one of
+               --  them.
 
-         --  If several are not used, report a warning for each one of them
+            elsif Non_Used > 1 then
+               Error_Msg
+                 (Flags, "?the following values are not used as labels:",
+                  Case_Location);
 
-         elsif Non_Used > 1 then
+               for Choice in First_Non_Used .. Choices.Last loop
+                  if not Choices.Table (Choice).Already_Used then
+                     Error_Msg_Name_1 := Choices.Table (Choice).The_String;
+                     Error_Msg (Flags, "\?%%", Case_Location);
+                  end if;
+               end loop;
+            end if;
+         else
             Error_Msg
-              (Flags, "?the following values are not used as labels:",
+              (Flags,
+               "?no when others for this case construction",
                Case_Location);
-
-            for Choice in First_Non_Used .. Choices.Last loop
-               if not Choices.Table (Choice).Already_Used then
-                  Error_Msg_Name_1 := Choices.Table (Choice).The_String;
-                  Error_Msg (Flags, "\?%%", Case_Location);
-               end if;
-            end loop;
          end if;
       end if;
 
@@ -487,7 +497,8 @@ package body Prj.Strt is
    procedure Parse_Choice_List
      (In_Tree      : Project_Node_Tree_Ref;
       First_Choice : out Project_Node_Id;
-      Flags        : Processing_Flags)
+      Flags        : Processing_Flags;
+      String_Type  : Boolean := True)
    is
       Current_Choice : Project_Node_Id := Empty_Node;
       Next_Choice    : Project_Node_Id := Empty_Node;
@@ -517,38 +528,40 @@ package body Prj.Strt is
 
          Set_String_Value_Of (Current_Choice, In_Tree, To => Choice_String);
 
-         --  Check if the label is part of the string type and if it has not
-         --  been already used.
+         if String_Type then
+            --  Check if the label is part of the string type and if it has not
+            --  been already used.
 
-         Found := False;
-         for Choice in Choice_First .. Choices.Last loop
-            if Choices.Table (Choice).The_String = Choice_String then
+            Found := False;
+            for Choice in Choice_First .. Choices.Last loop
+               if Choices.Table (Choice).The_String = Choice_String then
 
-               --  This label is part of the string type
+                  --  This label is part of the string type
 
-               Found := True;
+                  Found := True;
 
-               if Choices.Table (Choice).Already_Used then
+                  if Choices.Table (Choice).Already_Used then
 
-                  --  But it has already appeared in a choice list for this
-                  --  case construction so report an error.
+                     --  But it has already appeared in a choice list for this
+                     --  case construction so report an error.
 
-                  Error_Msg_Name_1 := Choice_String;
-                  Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
+                     Error_Msg_Name_1 := Choice_String;
+                     Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
 
-               else
-                  Choices.Table (Choice).Already_Used := True;
-               end if;
+                  else
+                     Choices.Table (Choice).Already_Used := True;
+                  end if;
 
-               exit;
-            end if;
-         end loop;
+                  exit;
+               end if;
+            end loop;
 
-         --  If the label is not part of the string list, report an error
+            --  If the label is not part of the string list, report an error
 
-         if not Found then
-            Error_Msg_Name_1 := Choice_String;
-            Error_Msg (Flags, "illegal case label %%", Token_Ptr);
+            if not Found then
+               Error_Msg_Name_1 := Choice_String;
+               Error_Msg (Flags, "illegal case label %%", Token_Ptr);
+            end if;
          end if;
 
          --  Scan past the label
diff --git a/gcc/ada/prj-strt.ads b/gcc/ada/prj-strt.ads
index 7dbe530..66a96d3 100644
--- a/gcc/ada/prj-strt.ads
+++ b/gcc/ada/prj-strt.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2014, 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- --
@@ -59,7 +59,8 @@ private package Prj.Strt is
    procedure End_Case_Construction
      (Check_All_Labels   : Boolean;
       Case_Location      : Source_Ptr;
-      Flags              : Processing_Flags);
+      Flags              : Processing_Flags;
+      String_Type        : Boolean);
    --  This procedure is called at the end of a case construction to remove the
    --  case labels and to restore the previous state. In particular, in the
    --  case of nested case constructions, the case labels of the enclosing case
@@ -70,7 +71,8 @@ private package Prj.Strt is
    procedure Parse_Choice_List
      (In_Tree      : Project_Node_Tree_Ref;
       First_Choice : out Project_Node_Id;
-      Flags        : Processing_Flags);
+      Flags        : Processing_Flags;
+      String_Type  : Boolean := True);
    --  Get the label for a choice list.
    --  Report an error if
    --    - a case label is not a literal string
diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index b61deca..06e3ac6 100644
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -2403,7 +2403,7 @@ The environment variables at the time you launch @command{gprbuild}
 will influence the view these tools have of the project
 (PATH to find the compiler, ADA_PROJECT_PATH or GPR_PROJECT_PATH to find the
 projects, environment variables that are referenced in project files
-through the "external" statement,...). Several command line switches
+through the "external" built-in function, ...). Several command line switches
 can be used to override those (-X or -aP), but on some systems and
 with some projects, this might make the command line too long, and on
 all systems often make it hard to read.
@@ -2427,7 +2427,7 @@ building. The syntax looks like
 @end smallexample
 
 One of the often requested features in projects is to be able to
-reference external variables in @code{with} statements, as in
+reference external variables in @code{with} declarations, as in
 
 @smallexample @c projectfile
   @b{with} @b{external}("SETUP") & "path/prj.gpr";   --@i{  ILLEGAL}
@@ -2566,7 +2566,7 @@ Here are a few valid examples:
 @cindex @code{Project_Path}
 
 This attribute can be used to specify a list of directories in
-which to look for project files in @code{with} statements.
+which to look for project files in @code{with} declarations.
 
 When you specify a project in Project_Files (say @code{x/y/a.gpr}), and
 @code{a.gpr} imports a project @code{b.gpr}, only @code{b.gpr} is searched in
@@ -2637,7 +2637,7 @@ Example:
 @cindex @code{External}
 
 This attribute can be used to set the value of environment
-variables as retrieved through the @code{external} statement
+variables as retrieved through the @code{external} function
 in projects. It does not affect the environment variables
 themselves (so for instance you cannot use it to change the value
 of your PATH as seen from the spawned compiler).
@@ -3403,7 +3403,7 @@ list expression, and can therefore appear in a variable declaration or
 an attribute declaration.
 
 Most of the time, this construct is used to initialize typed variables, which
-are then used in @b{case} statements to control the value assigned to
+are then used in @b{case} constructions to control the value assigned to
 attributes in various scenarios. Thus such variables are often called
 @b{scenario variables}.
 
@@ -3565,8 +3565,8 @@ A @b{context} may be one of the following:
 @c ---------------------------------------------
 
 @noindent
-A @b{case} statement is used in a project file to effect conditional
-behavior. Through this statement, you can set the value of attributes
+A @b{case} construction is used in a project file to effect conditional
+behavior. Through this construction, you can set the value of attributes
 and variables depending on the value previously assigned to a typed
 variable.
 
@@ -3574,30 +3574,30 @@ All choices in a choice list must be distinct. Unlike Ada, the choice
 lists of all alternatives do not need to include all values of the type.
 An @code{others} choice must appear last in the list of alternatives.
 
-The syntax of a @code{case} construction is based on the Ada case statement
-(although the @code{null} statement for empty alternatives is optional).
+The syntax of a @code{case} construction is based on the Ada case construction
+(although the @code{null} declaration for empty alternatives is optional).
 
-The case expression must be a typed string variable, whose value is often
-given by an external reference (@pxref{External Values}).
+The case expression must be a string variable, either typed or not, whose value
+is often given by an external reference (@pxref{External Values}).
 
 Each alternative starts with the reserved word @code{when}, either a list of
 literal strings separated by the @code{"|"} character or the reserved word
 @code{others}, and the @code{"=>"} token.
-Each literal string must belong to the string type that is the type of the
-case variable.
-After each @code{=>}, there are zero or more statements.  The only
-statements allowed in a case construction are other case constructions,
+When the case expression is a typed string variable, each literal string must
+belong to the string type that is the type of the case variable.
+After each @code{=>}, there are zero or more declarations.  The only
+declarations allowed in a case construction are other case constructions,
 attribute declarations and variable declarations. String type declarations and
 package declarations are not allowed. Variable declarations are restricted to
 variables that have already been declared before the case construction.
 
 @smallexample
-case_statement ::=
-  @i{case} @i{<typed_variable_>}name @i{is} @{case_item@} @i{end case} ;
+case_construction ::=
+  @i{case} @i{<variable_>}name @i{is} @{case_item@} @i{end case} ;
 
 case_item ::=
   @i{when} discrete_choice_list =>
-    @{case_statement
+    @{case_declaration
       | attribute_declaration
       | variable_declaration
       | empty_declaration@}
@@ -3606,7 +3606,7 @@ discrete_choice_list ::= string_literal @{| string_literal@} | @i{others}
 @end smallexample
 
 @noindent
-Here is a typical example:
+Here is a typical example, with a typed string variable:
 
 @smallexample @c projectfile
 @group
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 37b62d1..65a000f 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2204,9 +2204,15 @@ package body Sem_Ch5 is
 
       procedure Check_Predicate_Use (T : Entity_Id) is
       begin
+
+         --  A predicated subtype is illegal in loops and related constructs
+         --  if the predicate is not static, or else if it is a non-static
+         --  subtype of a statically predicated subtype.
+
          if Is_Discrete_Type (T)
            and then Has_Predicates (T)
            and then (not Has_Static_Predicate (T)
+                      or else not Is_Static_Subtype (T)
                       or else Has_Dynamic_Predicate_Aspect (T))
          then
             Bad_Predicated_Subtype_Use
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 251fc43..0521efb 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -2321,6 +2321,13 @@ package body Sem_Ch8 is
          Insert_Before_And_Analyze (N, Spec_Decl);
          Wrap_Id := Defining_Entity (Spec_Decl);
 
+         --  If the operator carries an Eliminated pragma, indicate that the
+         --  wrapper is also to be eliminated, to prevent spurious error when
+         --  using gnatelim on programs that include box-initialization of
+         --  equality operators.
+
+         Set_Is_Eliminated (Wrap_Id, Is_Eliminated (Prim_Op));
+
          --  The generated body does not freeze and must be analyzed when the
          --  class-wide wrapper is frozen. The body is only needed if expansion
          --  is enabled.