[multiple changes]

2017-01-13  Javier Miranda  <miranda@adacore.com>

	* sem_ch6.adb (Cloned_Expression): New subprogram.
	(Freeze_Expr_Types): Complete previous patch since the expression
	of an expression-function may have iterators and loops with
	defining identifiers which, as part of the preanalysis of the
	expression, may be left decorated with itypes that will not be
	available in the tree passed to the backend.

2017-01-13  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Apply_Type_Conversion_Checks): Optimize a type
	conversion to Integer of an expression that is an attribute
	reference 'Pos on an enumeration type.

2017-01-13  Bob Duff  <duff@adacore.com>

	* atree.ads: Minor comment fix.

From-SVN: r244423

4 files changed, 139 insertions, 12 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 37e48dba4e6..0702a6d31cd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2017-01-13  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch6.adb (Cloned_Expression): New subprogram.
+	(Freeze_Expr_Types): Complete previous patch since the expression
+	of an expression-function may have iterators and loops with
+	defining identifiers which, as part of the preanalysis of the
+	expression, may be left decorated with itypes that will not be
+	available in the tree passed to the backend.
+
+2017-01-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* checks.adb (Apply_Type_Conversion_Checks): Optimize a type
+	conversion to Integer of an expression that is an attribute
+	reference 'Pos on an enumeration type.
+
+2017-01-13  Bob Duff  <duff@adacore.com>
+
+	* atree.ads: Minor comment fix.
+
 2017-01-13  Justin Squirek  <squirek@adacore.com>
 
 	* sem_ch6.adb (Check_Aggregate_Accessibility): Ignore function
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index bf4e52e4ef1..6739be2dc51 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -298,10 +298,10 @@ package Atree is
    ------------------
 
    --  The following variables denote the count of errors of various kinds
-   --  detected in the tree. Note that these might be more logically located
-   --  in Err_Vars, but we put it to deal with licensing issues (we need this
-   --  to have the GPL exception licensing, since Check_Error_Detected can
-   --  be called from units with this licensing).
+   --  detected in the tree. Note that these might be more logically located in
+   --  Err_Vars, but we put it here to deal with licensing issues (we need this
+   --  to have the GPL exception licensing, since Check_Error_Detected can be
+   --  called from units with this licensing).
 
    Serious_Errors_Detected : Nat := 0;
    --  This is a count of errors that are serious enough to stop expansion,
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index a42338b1ebf..f67c44f37d4 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3390,7 +3390,53 @@ package body Checks is
                 In_Subrange_Of (Expr_Type, Target_Base, Fixed_Int => Conv_OK)
               and then not Float_To_Int
             then
-               Activate_Overflow_Check (N);
+               --  A small optimization : the attribute 'Pos applied to an
+               --  enumeration type has a known range, even though its type
+               --  is Universal_Integer. so in numeric conversions it is
+               --  usually within range of of the target integer type. Use the
+               --  static bounds of the base types to check.
+
+               if Nkind (Expr) = N_Attribute_Reference
+                 and then Attribute_Name (Expr) = Name_Pos
+                 and then Is_Enumeration_Type (Etype (Prefix (Expr)))
+                 and then Is_Integer_Type (Target_Type)
+               then
+                  declare
+                     Enum_T  : constant Entity_Id :=
+                               Root_Type (Etype (Prefix (Expr)));
+                     Int_T   : constant Entity_Id := Base_Type (Target_Type);
+                     Last_I  : constant Uint :=
+                        Intval (High_Bound (Scalar_Range (Int_T)));
+                     Last_E  : Uint;
+
+                  begin
+                     --  Character types have no explicit literals, we use
+                     --  the known number of characters in the type.
+
+                     if Root_Type (Enum_T) = Standard_Character then
+                        Last_E := UI_From_Int (255);
+
+                     elsif Enum_T = Standard_Wide_Character
+                       or else Enum_T = Standard_Wide_Wide_Character
+                     then
+                        Last_E := UI_From_Int (65535);
+
+                     else
+                        Last_E := Enumeration_Pos
+                            (Entity (High_Bound (Scalar_Range (Enum_T))));
+                     end if;
+
+                     if Last_E <= Last_I then
+                        null;
+
+                     else
+                        Activate_Overflow_Check (N);
+                     end if;
+                  end;
+
+               else
+                  Activate_Overflow_Check (N);
+               end if;
             end if;
 
             if not Range_Checks_Suppressed (Target_Type)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 39eecfb76f0..21f076932dc 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2978,9 +2978,73 @@ package body Sem_Ch6 is
       -----------------------
 
       procedure Freeze_Expr_Types (Spec_Id : Entity_Id) is
+         function Cloned_Expression return Node_Id;
+         --  Build a duplicate of the expression of the return statement that
+         --  has no defining entities shared with the original expression.
+
          function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result;
          --  Freeze all types referenced in the subtree rooted at Node
 
+         -----------------------
+         -- Cloned_Expression --
+         -----------------------
+
+         function Cloned_Expression return Node_Id is
+            function Clone_Id (Node : Node_Id) return Traverse_Result;
+            --  Tree traversal routine that clones the defining identifier of
+            --  iterator and loop parameter specification nodes.
+
+            ----------------
+            -- Check_Node --
+            ----------------
+
+            function Clone_Id (Node : Node_Id) return Traverse_Result is
+            begin
+               if Nkind_In (Node, N_Iterator_Specification,
+                                  N_Loop_Parameter_Specification)
+               then
+                  Set_Defining_Identifier (Node,
+                    New_Copy (Defining_Identifier (Node)));
+               end if;
+
+               return OK;
+            end Clone_Id;
+
+            -------------------
+            -- Clone_Def_Ids --
+            -------------------
+
+            procedure Clone_Def_Ids is new Traverse_Proc (Clone_Id);
+
+            --  Local variables
+
+            Return_Stmt : constant Node_Id :=
+                            First
+                              (Statements (Handled_Statement_Sequence (N)));
+            Dup_Expr    : Node_Id;
+
+         --  Start of processing for Cloned_Expression
+
+         begin
+            pragma Assert (Nkind (Return_Stmt) = N_Simple_Return_Statement);
+
+            --  We must duplicate the expression with semantic information to
+            --  inherit the decoration of global entities in generic instances.
+
+            Dup_Expr := New_Copy_Tree (Expression (Return_Stmt));
+
+            --  Replace the defining identifier of iterators and loop param
+            --  specifications by a clone to ensure that the cloned expression
+            --  and the original expression don't have shared identifiers;
+            --  otherwise, as part of the preanalysis of the expression, these
+            --  shared identifiers may be left decorated with itypes which
+            --  will not be available in the tree passed to the backend.
+
+            Clone_Def_Ids (Dup_Expr);
+
+            return Dup_Expr;
+         end Cloned_Expression;
+
          ----------------------
          -- Freeze_Type_Refs --
          ----------------------
@@ -3007,19 +3071,13 @@ package body Sem_Ch6 is
 
          --  Local variables
 
-         Return_Stmt : constant Node_Id :=
-                         First (Statements (Handled_Statement_Sequence (N)));
-         Dup_Expr    : constant Node_Id :=
-                         New_Copy_Tree (Expression (Return_Stmt));
-
          Saved_First_Entity : constant Entity_Id := First_Entity (Spec_Id);
          Saved_Last_Entity  : constant Entity_Id := Last_Entity  (Spec_Id);
+         Dup_Expr           : constant Node_Id   := Cloned_Expression;
 
       --  Start of processing for Freeze_Expr_Types
 
       begin
-         pragma Assert (Nkind (Return_Stmt) = N_Simple_Return_Statement);
-
          --  Preanalyze a duplicate of the expression to have available the
          --  minimum decoration needed to locate referenced unfrozen types
          --  without adding any decoration to the function expression. This
@@ -3043,6 +3101,10 @@ package body Sem_Ch6 is
          Set_First_Entity (Spec_Id, Saved_First_Entity);
          Set_Last_Entity  (Spec_Id, Saved_Last_Entity);
 
+         if Present (Last_Entity (Spec_Id)) then
+            Set_Next_Entity (Last_Entity (Spec_Id), Empty);
+         end if;
+
          --  Freeze all types referenced in the expression
 
          Freeze_References (Dup_Expr);