[multiple changes]

2017-05-02  Eric Botcazou  <ebotcazou@adacore.com>

	* opt.ads: Add missing GNAT markers in comments.
	* opt.adb (Set_Opt_Config_Switches): Do not override earlier
	settings of Optimize_Alignment at the end.

2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Apply_Constraint_Check): Do not apply
	a discriminant check when the associated type is a constrained
	subtype created for an unconstrained nominal type.
	* exp_attr.adb: Minor reformatting.

2017-05-02  Bob Duff  <duff@adacore.com>

	* sem_ch3.adb (OK_For_Limited_Init_In_05): Handle correctly
	the N_Raise_Expression case.
	* sem_ch6.adb (Check_Limited_Return): Minor: clarify comment,
	and add assertions.

2017-05-02  Yannick Moy  <moy@adacore.com>

	* exp_ch4.adb (Expand_N_Op_Ne): Do not bump parenthese level and
	optimize length comparison in GNATprove mode.
	* exp_spark.adb (Expand_SPARK_Op_Ne): New function to rewrite
	operator /= into negation of operator = when needed.
	(Expand_SPARK): Call new
	function to expand operator /=.

2017-05-02  Ed Schonberg  <schonberg@adacore.com>

	* exp_fixd.adb (Expand_Divide_Fixed_By_Fixed_Giving_Fixed):
	Simplify the expression for a fixed-fixed division to remove
	divisions by constants whenever possible, as an optimization
	for restricted targets.

From-SVN: r247468

10 files changed, 169 insertions, 59 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 59ee6e5..5eff9e2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,39 @@
+2017-05-02  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* opt.ads: Add missing GNAT markers in comments.
+	* opt.adb (Set_Opt_Config_Switches): Do not override earlier
+	settings of Optimize_Alignment at the end.
+
+2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb (Apply_Constraint_Check): Do not apply
+	a discriminant check when the associated type is a constrained
+	subtype created for an unconstrained nominal type.
+	* exp_attr.adb: Minor reformatting.
+
+2017-05-02  Bob Duff  <duff@adacore.com>
+
+	* sem_ch3.adb (OK_For_Limited_Init_In_05): Handle correctly
+	the N_Raise_Expression case.
+	* sem_ch6.adb (Check_Limited_Return): Minor: clarify comment,
+	and add assertions.
+
+2017-05-02  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Op_Ne): Do not bump parenthese level and
+	optimize length comparison in GNATprove mode.
+	* exp_spark.adb (Expand_SPARK_Op_Ne): New function to rewrite
+	operator /= into negation of operator = when needed.
+	(Expand_SPARK): Call new
+	function to expand operator /=.
+
+2017-05-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_fixd.adb (Expand_Divide_Fixed_By_Fixed_Giving_Fixed):
+	Simplify the expression for a fixed-fixed division to remove
+	divisions by constants whenever possible, as an optimization
+	for restricted targets.
+
 2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* checks.adb, sem_ch3.adb, sem_ch6.adb: Minor reformatting.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 40f4e65..e8f38f9 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1355,8 +1355,13 @@ package body Checks is
 
             Apply_Range_Check (N, Typ);
 
+         --  Do not install a discriminant check for a constrained subtype
+         --  created for an unconstrained nominal type because the subtype
+         --  has the correct constraints by construction.
+
          elsif Has_Discriminants (Base_Type (Desig_Typ))
-            and then Is_Constrained (Desig_Typ)
+           and then Is_Constrained (Desig_Typ)
+           and then not Is_Constr_Subt_For_U_Nominal (Desig_Typ)
          then
             Apply_Discriminant_Check (N, Typ);
          end if;
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 4d8417a..79560ae 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -83,6 +83,9 @@ package body Exp_Attr is
    --  value returned is the entity of the constructed function body. We do not
    --  bother to generate a separate spec for this subprogram.
 
+   function Build_Disp_Get_Task_Id_Call (Actual : Node_Id) return Node_Id;
+   --  Build a call to Disp_Get_Task_Id, passing Actual as actual parameter
+
    function Build_Record_VS_Func
      (R_Type : Entity_Id;
       Nod    : Node_Id) return Entity_Id;
@@ -354,6 +357,23 @@ package body Exp_Attr is
       return Func_Id;
    end Build_Array_VS_Func;
 
+   ---------------------------------
+   -- Build_Disp_Get_Task_Id_Call --
+   ---------------------------------
+
+   function Build_Disp_Get_Task_Id_Call (Actual : Node_Id) return Node_Id is
+      Typ  : constant Entity_Id := Etype (Actual);
+      Id : constant Node_Id :=
+        New_Occurrence_Of
+          (Find_Prim_Op (Typ, Name_uDisp_Get_Task_Id), Sloc (Actual));
+      Result : constant Node_Id :=
+        Make_Function_Call (Sloc (Actual),
+          Name => Id,
+          Parameter_Associations => New_List (Actual));
+   begin
+      return Result;
+   end Build_Disp_Get_Task_Id_Call;
+
    --------------------------
    -- Build_Record_VS_Func --
    --------------------------
@@ -2469,6 +2489,7 @@ package body Exp_Attr is
       --  Transforms 'Callable attribute into a call to the Callable function
 
       when Attribute_Callable =>
+
          --  We have an object of a task interface class-wide type as a prefix
          --  to Callable. Generate:
          --    callable (Task_Id (Pref._disp_get_task_id));
@@ -2478,29 +2499,18 @@ package body Exp_Attr is
            and then Is_Interface (Ptyp)
            and then Is_Task_Interface (Ptyp)
          then
-            declare
-               Id : constant Node_Id :=
-                 New_Occurrence_Of
-                   (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
-               Call : constant Node_Id :=
-                 Make_Function_Call (Loc,
-                   Name => Id,
-                   Parameter_Associations => New_List (Pref));
-            begin
-               Rewrite (N,
-                 Make_Function_Call (Loc,
-                   Name =>
-                     New_Occurrence_Of (RTE (RE_Callable), Loc),
-                   Parameter_Associations => New_List (
-                     Make_Unchecked_Type_Conversion (Loc,
-                       Subtype_Mark =>
-                         New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
-                       Expression => Call))));
-            end;
+            Rewrite (N,
+              Make_Function_Call (Loc,
+                Name =>
+                  New_Occurrence_Of (RTE (RE_Callable), Loc),
+                Parameter_Associations => New_List (
+                  Make_Unchecked_Type_Conversion (Loc,
+                    Subtype_Mark =>
+                      New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
+                    Expression => Build_Disp_Get_Task_Id_Call (Pref)))));
 
          else
-            Rewrite (N,
-              Build_Call_With_Task (Pref, RTE (RE_Callable)));
+            Rewrite (N, Build_Call_With_Task (Pref, RTE (RE_Callable)));
          end if;
 
          Analyze_And_Resolve (N, Standard_Boolean);
@@ -3581,17 +3591,9 @@ package body Exp_Attr is
               and then Is_Interface (Ptyp)
               and then Is_Task_Interface (Ptyp)
             then
-               declare
-                  Id : constant Node_Id :=
-                    New_Occurrence_Of
-                      (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
-                  Call : constant Node_Id :=
-                    Make_Function_Call (Loc,
-                      Name => Id,
-                      Parameter_Associations => New_List (Pref));
-               begin
-                  Rewrite (N, Unchecked_Convert_To (Id_Kind, Call));
-               end;
+               Rewrite
+                 (N, Unchecked_Convert_To
+                       (Id_Kind, Build_Disp_Get_Task_Id_Call (Pref)));
 
             else
                Rewrite (N,
@@ -6278,25 +6280,15 @@ package body Exp_Attr is
            and then Is_Interface (Ptyp)
            and then Is_Task_Interface (Ptyp)
          then
-            declare
-               Id : constant Node_Id :=
-                 New_Occurrence_Of
-                   (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
-               Call : constant Node_Id :=
-                 Make_Function_Call (Loc,
-                   Name => Id,
-                   Parameter_Associations => New_List (Pref));
-            begin
-               Rewrite (N,
-                 Make_Function_Call (Loc,
-                   Name =>
-                     New_Occurrence_Of (RTE (RE_Terminated), Loc),
-                   Parameter_Associations => New_List (
-                     Make_Unchecked_Type_Conversion (Loc,
-                       Subtype_Mark =>
-                         New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
-                       Expression => Call))));
-            end;
+            Rewrite (N,
+              Make_Function_Call (Loc,
+                Name =>
+                  New_Occurrence_Of (RTE (RE_Terminated), Loc),
+                Parameter_Associations => New_List (
+                  Make_Unchecked_Type_Conversion (Loc,
+                    Subtype_Mark =>
+                      New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
+                    Expression => Build_Disp_Get_Task_Id_Call (Pref)))));
 
          elsif Restricted_Profile then
             Rewrite (N,
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 57691b9..eccfcd2 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -8926,6 +8926,9 @@ package body Exp_Ch4 is
       --  the same visibility as in the generic unit. This avoids duplicating
       --  or factoring the complex code for record/array equality tests etc.
 
+      --  This case is also used for the minimal expansion performed in
+      --  GNATprove mode.
+
       else
          declare
             Loc : constant Source_Ptr := Sloc (N);
@@ -8941,7 +8944,14 @@ package body Exp_Ch4 is
                   Make_Op_Eq (Loc,
                     Left_Opnd =>  Left_Opnd (N),
                     Right_Opnd => Right_Opnd (N)));
-            Set_Paren_Count (Right_Opnd (Neg), 1);
+
+            --  The level of parentheses is useless in GNATprove mode, and
+            --  bumping its level here leads to wrong columns being used in
+            --  check messages, hence skip it in this mode.
+
+            if not GNATprove_Mode then
+               Set_Paren_Count (Right_Opnd (Neg), 1);
+            end if;
 
             if Scope (Ne) /= Standard_Standard then
                Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
@@ -8958,7 +8968,12 @@ package body Exp_Ch4 is
          end;
       end if;
 
-      Optimize_Length_Comparison (N);
+      --  No need for optimization in GNATprove mode, where we would rather see
+      --  the original source expression.
+
+      if not GNATprove_Mode then
+         Optimize_Length_Comparison (N);
+      end if;
    end Expand_N_Op_Ne;
 
    ---------------------
diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb
index 97bc99b..6d31eb8 100644
--- a/gcc/ada/exp_fixd.adb
+++ b/gcc/ada/exp_fixd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -2008,6 +2008,31 @@ package body Exp_Fixd is
 
       else
          Do_Divide_Fixed_Fixed (N);
+
+         --  A focused optimization: if after constant folding the
+         --  expression is of the form:  T ((Exp * D) / D), where D is
+         --  a static constant, return  T (Exp). This form will show up
+         --  when D is the denominator of the static expression for the
+         --  'small of fixed-point types involved. This transformation
+         --  removes a division that may be expensive on some targets.
+
+         if Nkind (N) = N_Type_Conversion
+           and then Nkind (Expression (N)) = N_Op_Divide
+         then
+            declare
+               Num : constant Node_Id := Left_Opnd  (Expression (N));
+               Den : constant Node_Id := Right_Opnd (Expression (N));
+
+            begin
+               if Nkind (Den) = N_Integer_Literal
+                 and then Nkind (Num) = N_Op_Multiply
+                 and then Nkind (Right_Opnd (Num)) = N_Integer_Literal
+                 and then Intval (Den) = Intval (Right_Opnd (Num))
+               then
+                  Rewrite (Expression (N), Left_Opnd (Num));
+               end if;
+            end;
+         end if;
       end if;
    end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
 
diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb
index 7062e13..785652e 100644
--- a/gcc/ada/exp_spark.adb
+++ b/gcc/ada/exp_spark.adb
@@ -26,6 +26,7 @@
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
+with Exp_Ch4;
 with Exp_Ch5;  use Exp_Ch5;
 with Exp_Dbug; use Exp_Dbug;
 with Exp_Util; use Exp_Util;
@@ -62,6 +63,9 @@ package body Exp_SPARK is
    procedure Expand_SPARK_N_Object_Renaming_Declaration (N : Node_Id);
    --  Perform name evaluation for a renamed object
 
+   procedure Expand_SPARK_Op_Ne (N : Node_Id);
+   --  Rewrite operator /= based on operator = when defined explicitly
+
    ------------------
    -- Expand_SPARK --
    ------------------
@@ -125,6 +129,9 @@ package body Exp_SPARK is
          when N_Object_Renaming_Declaration =>
             Expand_SPARK_N_Object_Renaming_Declaration (N);
 
+         when N_Op_Ne =>
+            Expand_SPARK_Op_Ne (N);
+
          when N_Freeze_Entity =>
             if Is_Type (Entity (N)) then
                Expand_SPARK_Freeze_Type (Entity (N));
@@ -291,6 +298,26 @@ package body Exp_SPARK is
       Evaluate_Name (Name (N));
    end Expand_SPARK_N_Object_Renaming_Declaration;
 
+   ------------------------
+   -- Expand_SPARK_Op_Ne --
+   ------------------------
+
+   procedure Expand_SPARK_Op_Ne (N : Node_Id) is
+      Typ : constant Entity_Id := Etype (Left_Opnd (N));
+
+   begin
+      --  Case of elementary type with standard operator
+
+      if Is_Elementary_Type (Typ)
+        and then Sloc (Entity (N)) = Standard_Location
+      then
+         null;
+
+      else
+         Exp_Ch4.Expand_N_Op_Ne (N);
+      end if;
+   end Expand_SPARK_Op_Ne;
+
    -------------------------------------
    -- Expand_SPARK_Potential_Renaming --
    -------------------------------------
diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb
index f1ce4a4..91642ed 100644
--- a/gcc/ada/opt.adb
+++ b/gcc/ada/opt.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -219,11 +219,11 @@ package body Opt is
          External_Name_Exp_Casing    := As_Is;
          External_Name_Imp_Casing    := Lowercase;
          Optimize_Alignment          := 'O';
+         Optimize_Alignment_Local    := True;
          Persistent_BSS_Mode         := False;
          Prefix_Exception_Messages   := True;
          Uneval_Old                  := 'E';
          Use_VADS_Size               := False;
-         Optimize_Alignment_Local    := True;
 
          --  Note: we do not need to worry about Warnings_As_Errors_Count since
          --  we do not expect to get any warnings from compiling such a unit.
@@ -293,7 +293,6 @@ package body Opt is
       Default_Pool                   := Default_Pool_Config;
       Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
       Fast_Math                      := Fast_Math_Config;
-      Optimize_Alignment             := Optimize_Alignment_Config;
       Polling_Required               := Polling_Required_Config;
    end Set_Opt_Config_Switches;
 
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 09ed571..c73b622 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1194,10 +1194,12 @@ package Opt is
    --  type with the semantics that each value does more than the previous one.
 
    Optimize_Alignment : Character := 'O';
+   --  GNAT
    --  Setting of Optimize_Alignment, set to T/S/O for time/space/off. Can
    --  be modified by use of pragma Optimize_Alignment.
 
    Optimize_Alignment_Local : Boolean := False;
+   --  GNAT
    --  Set True if Optimize_Alignment mode is set by a local configuration
    --  pragma that overrides the gnat.adc (or other configuration file) default
    --  so that the unit is not dependent on the default setting. Also always
@@ -1213,10 +1215,12 @@ package Opt is
 
    Optimization_Level : Int;
    pragma Import (C, Optimization_Level, "optimize");
+   --  GNAT
    --  Constant reflecting the optimization level (0,1,2,3 for -O0,-O1,-O2,-O3)
 
    Optimize_Size : Int;
    pragma Import (C, Optimize_Size, "optimize_size");
+   --  GNAT
    --  Constant reflecting setting of -Os (optimize for size). Set to nonzero
    --  in -Os mode and set to zero otherwise.
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9ad370f..4f7691b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -19316,6 +19316,11 @@ package body Sem_Ch3 is
          when N_Attribute_Reference =>
             return Attribute_Name (Original_Node (Exp)) = Name_Input;
 
+         --  "return raise ..." is OK
+
+         when N_Raise_Expression =>
+            return True;
+
          --  For a case expression, all dependent expressions must be legal
 
          when N_Case_Expression =>
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 5c31c42..61e4f86 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -5996,9 +5996,11 @@ package body Sem_Ch6 is
                   & "(RM-2005 6.5(5.5/2))?y?", Expr);
             end if;
 
-         --  Ada 95 mode, compatibility warnings disabled
+         --  Ada 95 mode, and compatibility warnings disabled
 
          else
+            pragma Assert (Ada_Version <= Ada_95);
+            pragma Assert (not (Warn_On_Ada_2005_Compatibility or GNAT_Mode));
             return; --  skip continuation messages below
          end if;