[multiple changes]

2017-01-23  Yannick Moy  <moy@adacore.com>

	* sem_ch4.adb (Analyze_Indexed_Component_Form):
	Adapt to inlined prefix with string literal subtype.
	* inline.adb (Expand_Inlined_Call): Keep unchecked
	conversion inside inlined call when formal type is constrained.

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

	* sem_util.adb (New_Copy_Tree): Code cleanup:
	removal of global variables. All the global variables, global
	functions and tables of this subprogram are now declared locally.

From-SVN: r244807

gcc/ada/ChangeLog

+2017-01-23  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch4.adb (Analyze_Indexed_Component_Form):
+	Adapt to inlined prefix with string literal subtype.
+	* inline.adb (Expand_Inlined_Call): Keep unchecked
+	conversion inside inlined call when formal type is constrained.
+
+2017-01-23  Javier Miranda  <miranda@adacore.com>
+
+	* sem_util.adb (New_Copy_Tree): Code cleanup:
+	removal of global variables. All the global variables, global
+	functions and tables of this subprogram are now declared locally.
+
 2017-01-23  Gary Dismukes  <dismukes@adacore.com>
 
 	* exp_strm.ads: Minor reformatting and typo fixes.

gcc/ada/inline.adb

@@ -959,6 +959,7 @@ package body Inline is
 
       function Has_Single_Return_In_GNATprove_Mode return Boolean is
          Last_Statement : Node_Id := Empty;
+         Body_To_Inline : constant Node_Id := N;
 
          function Check_Return (N : Node_Id) return Traverse_Result;
          --  Returns OK on node N if this is not a return statement different
@@ -970,18 +971,29 @@ package body Inline is
 
          function Check_Return (N : Node_Id) return Traverse_Result is
          begin
-            if Nkind_In (N, N_Simple_Return_Statement,
-                            N_Extended_Return_Statement)
-            then
+            case Nkind (N) is
+               when N_Simple_Return_Statement
+                  | N_Extended_Return_Statement
+               =>
                   if N = Last_Statement then
                      return OK;
                   else
                      return Abandon;
                   end if;
 
-            else
+               --  Skip locally declared subprogram bodies inside the body to
+               --  inline, as the return statements inside those do not count.
+
+               when N_Subprogram_Body =>
+                  if N = Body_To_Inline then
                      return OK;
+                  else
+                     return Skip;
                   end if;
+
+               when others =>
+                  return OK;
+            end case;
          end Check_Return;
 
          function Check_All_Returns is new Traverse_Func (Check_Return);
@@ -3151,13 +3163,16 @@ package body Inline is
                    Subtype_Mark => New_Occurrence_Of (Etype (F), Loc),
                    Expression   => Relocate_Node (Expression (A)));
 
-            --  In GNATprove mode, keep the most precise type of the actual
-            --  for the temporary variable. Otherwise, the AST may contain
-            --  unexpected assignment statements to a temporary variable of
-            --  unconstrained type renaming a local variable of constrained
-            --  type, which is not expected by GNATprove.
+            --  In GNATprove mode, keep the most precise type of the actual for
+            --  the temporary variable, when the formal type is unconstrained.
+            --  Otherwise, the AST may contain unexpected assignment statements
+            --  to a temporary variable of unconstrained type renaming a
+            --  local variable of constrained type, which is not expected
+            --  by GNATprove.
 
-            elsif Etype (F) /= Etype (A) and then not GNATprove_Mode then
+            elsif Etype (F) /= Etype (A)
+              and then (not GNATprove_Mode or else Is_Constrained (Etype (F)))
+            then
                New_A    := Unchecked_Convert_To (Etype (F), Relocate_Node (A));
                Temp_Typ := Etype (F);
 

gcc/ada/sem_ch4.adb

@@ -2407,7 +2407,13 @@ package body Sem_Ch4 is
             end if;
 
             if Is_Array_Type (Array_Type) then
-               null;
+
+               --  In order to correctly access First_Index component later,
+               --  replace string literal subtype by its parent type.
+
+               if Ekind (Array_Type) = E_String_Literal_Subtype then
+                  Array_Type := Etype (Array_Type);
+               end if;
 
             elsif Present (Pent) and then Ekind (Pent) = E_Entry_Family then
                Analyze (Exp);

gcc/ada/sem_util.adb

@@ -71,35 +71,6 @@ with GNAT.HTable; use GNAT.HTable;
 
 package body Sem_Util is
 
-   ----------------------------------------
-   -- Global Variables for New_Copy_Tree --
-   ----------------------------------------
-
-   --  These global variables are used by New_Copy_Tree. See description of the
-   --  body of this subprogram for details. Global variables can be safely used
-   --  by New_Copy_Tree, since there is no case of a recursive call from the
-   --  processing inside New_Copy_Tree.
-
-   NCT_Hash_Threshold : constant := 20;
-   --  If there are more than this number of pairs of entries in the map, then
-   --  Hash_Tables_Used will be set, and the hash tables will be initialized
-   --  and used for the searches.
-
-   NCT_Hash_Tables_Used : Boolean := False;
-   --  Set to True if hash tables are in use
-
-   NCT_Table_Entries : Nat := 0;
-   --  Count entries in table to see if threshold is reached
-
-   NCT_Hash_Table_Setup : Boolean := False;
-   --  Set to True if hash table contains data. We set this True if we setup
-   --  the hash table with data, and leave it set permanently from then on,
-   --  this is a signal that second and subsequent users of the hash table
-   --  must clear the old entries before reuse.
-
-   subtype NCT_Header_Num is Int range 0 .. 511;
-   --  Defines range of headers in hash tables (512 headers)
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -1993,9 +1964,9 @@ package body Sem_Util is
          function Contains (List : Elist_Id; N : Node_Id) return Boolean;
          --  Returns True if List has a node whose Entity is Entity (N)
 
-         -------------------------
-         -- Check_Function_Call --
-         -------------------------
+         ----------------
+         -- Check_Node --
+         ----------------
 
          function Check_Node (N : Node_Id) return Traverse_Result is
             Is_Writable_Actual : Boolean := False;
@@ -16245,9 +16216,44 @@ package body Sem_Util is
       end if;
    end New_Copy_List_Tree;
 
-   --------------------------------------------------
-   -- New_Copy_Tree Auxiliary Data and Subprograms --
-   --------------------------------------------------
+   -------------------
+   -- New_Copy_Tree --
+   -------------------
+
+   function New_Copy_Tree
+     (Source    : Node_Id;
+      Map       : Elist_Id   := No_Elist;
+      New_Sloc  : Source_Ptr := No_Location;
+      New_Scope : Entity_Id  := Empty) return Node_Id
+   is
+      Actual_Map : Elist_Id := Map;
+      --  This is the actual map for the copy. It is initialized with the
+      --  given elements, and then enlarged as required for Itypes that are
+      --  copied during the first phase of the copy operation. The visit
+      --  procedures add elements to this map as Itypes are encountered.
+      --  The reason we cannot use Map directly, is that it may well be
+      --  (and normally is) initialized to No_Elist, and if we have mapped
+      --  entities, we have to reset it to point to a real Elist.
+
+      NCT_Hash_Threshold : constant := 20;
+      --  If there are more than this number of pairs of entries in the map,
+      --  then Hash_Tables_Used will be set, and the hash tables will be
+      --  initialized and used for the searches.
+
+      NCT_Hash_Tables_Used : Boolean := False;
+      --  Set to True if hash tables are in use
+
+      NCT_Table_Entries : Nat := 0;
+      --  Count entries in table to see if threshold is reached
+
+      NCT_Hash_Table_Setup : Boolean := False;
+      --  Set to True if hash table contains data. We set this True if we setup
+      --  the hash table with data. This is a signal that we must clear its
+      --  contents before returning the tree copy.
+
+      ------------------------------------
+      -- Auxiliary Data and Subprograms --
+      ------------------------------------
 
       use Atree.Unchecked_Access;
       use Atree_Private_Part;
@@ -16265,25 +16271,19 @@ package body Sem_Util is
       --  (because setting up a hash table for only a few entries takes
       --  more time than it saves.
 
+      subtype NCT_Header_Num is Int range 0 .. 511;
+      --  Defines range of headers in hash tables (512 headers)
+
       function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
       --  Hash function used for hash operations
 
-   -------------------
-   -- New_Copy_Hash --
-   -------------------
-
-   function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
-   begin
-      return Nat (E) mod (NCT_Header_Num'Last + 1);
-   end New_Copy_Hash;
-
       ---------------
       -- NCT_Assoc --
       ---------------
 
-   --  The hash table NCT_Assoc associates old entities in the table with their
-   --  corresponding new entities (i.e. the pairs of entries presented in the
-   --  original Map argument are Key-Element pairs).
+      --  The hash table NCT_Assoc associates old entities in the table with
+      --  their corresponding new entities (i.e. the pairs of entries presented
+      --  in the original Map argument are Key-Element pairs).
 
       package NCT_Assoc is new Simple_HTable (
         Header_Num => NCT_Header_Num,
@@ -16310,25 +16310,6 @@ package body Sem_Util is
         Hash       => New_Copy_Hash,
         Equal      => Types."=");
 
-   -------------------
-   -- New_Copy_Tree --
-   -------------------
-
-   function New_Copy_Tree
-     (Source    : Node_Id;
-      Map       : Elist_Id   := No_Elist;
-      New_Sloc  : Source_Ptr := No_Location;
-      New_Scope : Entity_Id  := Empty) return Node_Id
-   is
-      Actual_Map : Elist_Id := Map;
-      --  This is the actual map for the copy. It is initialized with the
-      --  given elements, and then enlarged as required for Itypes that are
-      --  copied during the first phase of the copy operation. The visit
-      --  procedures add elements to this map as Itypes are encountered.
-      --  The reason we cannot use Map directly, is that it may well be
-      --  (and normally is) initialized to No_Elist, and if we have mapped
-      --  entities, we have to reset it to point to a real Elist.
-
       function Assoc (N : Node_Or_Entity_Id) return Node_Id;
       --  Called during second phase to map entities into their corresponding
       --  copies using Actual_Map. If the argument is not an entity, or is not
@@ -16418,11 +16399,6 @@ package body Sem_Util is
          Ent  : Entity_Id;
 
       begin
-         if NCT_Hash_Table_Setup then
-            NCT_Assoc.Reset;
-            NCT_Itype_Assoc.Reset;
-         end if;
-
          Elmt := First_Elmt (Actual_Map);
          while Present (Elmt) loop
             Ent := Node (Elmt);
@@ -16814,6 +16790,15 @@ package body Sem_Util is
          return New_Node;
       end Copy_Node_With_Replacement;
 
+      -------------------
+      -- New_Copy_Hash --
+      -------------------
+
+      function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
+      begin
+         return Nat (E) mod (NCT_Header_Num'Last + 1);
+      end New_Copy_Hash;
+
       -----------------
       -- Visit_Elist --
       -----------------
@@ -17161,7 +17146,17 @@ package body Sem_Util is
 
       --  Now we can copy the actual tree
 
-      return Copy_Node_With_Replacement (Source);
+      declare
+         Result : constant Node_Id := Copy_Node_With_Replacement (Source);
+
+      begin
+         if NCT_Hash_Table_Setup then
+            NCT_Assoc.Reset;
+            NCT_Itype_Assoc.Reset;
+         end if;
+
+         return Result;
+      end;
    end New_Copy_Tree;
 
    -------------------------