2015-10-27 Ed Schonberg <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Allocator): Do not perform legality check
	on allocators for limited objects in a qualified expression,
	because expression has not been resolved.
	* sem_res.adb (Resolve_Allocator): Perform check on legality of
	limited objects after resolution.  Add sem_ch3.adb to context.

2015-10-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Refined_Global_In_Decl_Part): Add variable
	States.
	(Check_Refined_Global_Item): An object or state acts as a
	constituent only when the corresponding encapsulating state
	appears in pragma Global.
	(Collect_Global_Item): Add a state with non-null visible refinement to
	list States.

2015-10-27  Gary Dismukes  <dismukes@adacore.com>

	* sem_util.ads, par.adb, sem_ch6.adb: Minor reformatting and a few
	typo corrections.

2015-10-27  Pierre-Marie de Rodat  <derodat@adacore.com>

	* namet.ads, namet.adb (Name_Equals): New function.
	* namet.h (Name_Equals): New macro.

2015-10-27  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch6.adb (Build_Procedure_Form): Use 'RESULT' for the extra
	parameter, to avoid ambiguity when generating tmps using _xxx which
	might end up reusing _result.



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

11 files changed, 106 insertions, 27 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 59ed03f170f..1ec3066ceca 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,37 @@
+2015-10-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Analyze_Allocator): Do not perform legality check
+	on allocators for limited objects in a qualified expression,
+	because expression has not been resolved.
+	* sem_res.adb (Resolve_Allocator): Perform check on legality of
+	limited objects after resolution.  Add sem_ch3.adb to context.
+
+2015-10-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Refined_Global_In_Decl_Part): Add variable
+	States.
+	(Check_Refined_Global_Item): An object or state acts as a
+	constituent only when the corresponding encapsulating state
+	appears in pragma Global.
+	(Collect_Global_Item): Add a state with non-null visible refinement to
+	list States.
+
+2015-10-27  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_util.ads, par.adb, sem_ch6.adb: Minor reformatting and a few
+	typo corrections.
+
+2015-10-27  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+	* namet.ads, namet.adb (Name_Equals): New function.
+	* namet.h (Name_Equals): New macro.
+
+2015-10-27  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch6.adb (Build_Procedure_Form): Use 'RESULT' for the extra
+	parameter, to avoid ambiguity when generating tmps using _xxx which
+	might end up reusing _result.
+
 2015-10-27  Javier Miranda  <miranda@adacore.com>
 
 	* sem_util.ads, sem_util.adb (Defining_Identifier): Adding a formal to
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index deaa8eab9d9..517143b9ea2 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5516,8 +5516,8 @@ package body Exp_Ch6 is
 
          --  Add an extra out parameter to carry the function result
 
-         Name_Len := 7;
-         Name_Buffer (1 .. Name_Len) := "_result";
+         Name_Len := 6;
+         Name_Buffer (1 .. Name_Len) := "RESULT";
          Append_To (Proc_Formals,
            Make_Parameter_Specification (Loc,
              Defining_Identifier =>
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 6def9f273b7..cfaec6e545a 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -1639,6 +1639,36 @@ package body Namet is
       end if;
    end Write_Name_Decoded;
 
+   -----------------
+   -- Name_Equals --
+   -----------------
+
+   function Name_Equals (N1, N2 : Name_Id) return Boolean is
+   begin
+      if N1 = N2 then
+         return True;
+      end if;
+
+      declare
+         L1 : constant Int := Int (Name_Entries.Table (N1).Name_Len);
+         L2 : constant Int := Int (Name_Entries.Table (N2).Name_Len);
+      begin
+         if L1 /= L2 then
+            return False;
+         end if;
+
+         declare
+            use Name_Chars;
+
+            I1 : constant Int := Name_Entries.Table (N1).Name_Chars_Index;
+            I2 : constant Int := Name_Entries.Table (N2).Name_Chars_Index;
+         begin
+            return (Name_Chars.Table (1 + I1 .. I1 + L1)
+                    = Name_Chars.Table (1 + I2 .. I2 + L2));
+         end;
+      end;
+   end Name_Equals;
+
 --  Package initialization, initialize tables
 
 begin
diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads
index 4a21ef5b87c..4a17e6eeee9 100644
--- a/gcc/ada/namet.ads
+++ b/gcc/ada/namet.ads
@@ -561,6 +561,9 @@ package Namet is
    --  described for Get_Decoded_Name_String, and the resulting value stored
    --  in Name_Len and Name_Buffer is the decoded name.
 
+   function Name_Equals (N1, N2 : Name_Id) return Boolean;
+   --  Return whether N1 and N2 denote the same character sequence
+
    ------------------------------
    -- File and Unit Name Types --
    ------------------------------
diff --git a/gcc/ada/namet.h b/gcc/ada/namet.h
index 1ca589ba50c..82af02d58fe 100644
--- a/gcc/ada/namet.h
+++ b/gcc/ada/namet.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *            Copyright (C) 1992-2014, Free Software Foundation, Inc.       *
+ *            Copyright (C) 1992-2015, 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- *
@@ -88,6 +88,9 @@ Get_Decoded_Name_String (Name_Id Id)
   return Name_Buffer;
 }
 
+#define Name_Equals namet__name_equals
+extern Boolean Name_Equals (Name_Id, Name_Id);
+
 /* Like Get_Decoded_Name_String, but the result has all qualification and
    package body entity suffixes stripped, and also all letters are upper
    cased.  This is used for building the enumeration literal table. */
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index dc573876276..7c38084033f 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -1577,8 +1577,8 @@ begin
                --  versions of these files. Another exception is System.RPC
                --  and its children. This allows a user to supply their own
                --  communication layer.
-               --  Similarly we do not generate an error in CodePeer mode
-               --  to allow users to analyze third party compier packages.
+               --  Similarly, we do not generate an error in CodePeer mode,
+               --  to allow users to analyze third-party compiler packages.
 
                if Comp_Unit_Node /= Error
                  and then Operating_Mode = Generate_Code
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index c354de8a498..394029cc87b 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -549,22 +549,6 @@ package body Sem_Ch4 is
          Type_Id := Etype (E);
          Set_Directly_Designated_Type (Acc_Type, Type_Id);
 
-         --  Allocators generated by the build-in-place expansion mechanism
-         --  are explicitly marked as coming from source but do not need to be
-         --  checked for limited initialization. To exclude this case, ensure
-         --  that the parent of the allocator is a source node.
-
-         if Is_Limited_Type (Type_Id)
-           and then Comes_From_Source (N)
-           and then Comes_From_Source (Parent (N))
-           and then not In_Instance_Body
-         then
-            if not OK_For_Limited_Init (Type_Id, Expression (E)) then
-               Error_Msg_N ("initialization not allowed for limited types", N);
-               Explain_Limited_Type (Type_Id, N);
-            end if;
-         end if;
-
          --  A qualified expression requires an exact match of the type,
          --  class-wide matching is not allowed.
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 8a86d4465b7..e1fe3bb73b7 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2383,7 +2383,7 @@ package body Sem_Ch6 is
          begin
             pragma Assert (Nkind (From) = N_Subprogram_Body);
 
-            --  The destination node must be part of a list as the pragmas are
+            --  The destination node must be part of a list, as the pragmas are
             --  inserted after it.
 
             pragma Assert (Is_List_Member (To));
@@ -3576,7 +3576,7 @@ package body Sem_Ch6 is
 
       --  Set the SPARK_Mode from the current context (may be overwritten later
       --  with explicit pragma). Exclude the case where the SPARK_Mode appears
-      --  initially on a stand alone subprogram body, but is then relocated to
+      --  initially on a stand-alone subprogram body, but is then relocated to
       --  a generated corresponding spec. In this scenario the mode is shared
       --  between the spec and body.
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8ac388e237f..0e4d30d2509 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -527,7 +527,7 @@ package body Sem_Prag is
       --    E_Constant                 - "constant"
       --    E_Discriminant             - "discriminant"
       --    E_Generic_In_Out_Parameter - "generic parameter"
-      --    E_Generic_Out_Parameter    - "generic parameter"
+      --    E_Generic_In_Parameter     - "generic parameter"
       --    E_In_Parameter             - "parameter"
       --    E_In_Out_Parameter         - "parameter"
       --    E_Loop_Parameter           - "loop parameter"
@@ -24057,6 +24057,9 @@ package body Sem_Prag is
       Spec_Id : Entity_Id;
       --  The entity of the subprogram subject to pragma Refined_Global
 
+      States : Elist_Id := No_Elist;
+      --  A list of all states with visible refinement found in pragma Global
+
       procedure Check_In_Out_States;
       --  Determine whether the corresponding Global pragma mentions In_Out
       --  states with visible refinement and if so, ensure that one of the
@@ -24566,11 +24569,14 @@ package body Sem_Prag is
          begin
             --  When the state or object acts as a constituent of another
             --  state with a visible refinement, collect it for the state
-            --  completeness checks performed later on.
+            --  completeness checks performed later on. Note that the item
+            --  acts as a constituent only when the encapsulating state is
+            --  present in pragma Global.
 
             if Ekind_In (Item_Id, E_Abstract_State, E_Constant, E_Variable)
              and then Present (Encapsulating_State (Item_Id))
              and then Has_Visible_Refinement (Encapsulating_State (Item_Id))
+             and then Contains (States, Encapsulating_State (Item_Id))
             then
                if Global_Mode = Name_Input then
                   Append_New_Elmt (Item_Id, In_Constits);
@@ -24715,6 +24721,8 @@ package body Sem_Prag is
                   Has_Null_State := True;
 
                elsif Has_Non_Null_Refinement (Item_Id) then
+                  Append_New_Elmt (Item_Id, States);
+
                   if Item_Mode = Name_Input then
                      Has_In_State := True;
                   elsif Item_Mode = Name_In_Out then
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index b82fd6f4adb..5ee73a938df 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -57,6 +57,7 @@ with Sem_Aggr; use Sem_Aggr;
 with Sem_Attr; use Sem_Attr;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch4;  use Sem_Ch4;
+with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch13; use Sem_Ch13;
@@ -4680,6 +4681,22 @@ package body Sem_Res is
          Check_Non_Static_Context (Expression (E));
          Check_Unset_Reference (Expression (E));
 
+         --  Allocators generated by the build-in-place expansion mechanism
+         --  are explicitly marked as coming from source but do not need to be
+         --  checked for limited initialization. To exclude this case, ensure
+         --  that the parent of the allocator is a source node.
+
+         if Is_Limited_Type (Etype (E))
+           and then Comes_From_Source (N)
+           and then Comes_From_Source (Parent (N))
+           and then not In_Instance_Body
+         then
+            if not OK_For_Limited_Init (Etype (E), Expression (E)) then
+               Error_Msg_N ("initialization not allowed for limited types", N);
+               Explain_Limited_Type (Etype (E), N);
+            end if;
+         end if;
+
          --  A qualified expression requires an exact match of the type.
          --  Class-wide matching is not allowed.
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 411798ed06a..0f6dd7ceaa4 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -480,8 +480,8 @@ package Sem_Util is
    --      internally generated entity which is subsequently returned. A node
    --      that does not allow for a defining entity raises Program_Error.
    --
-   --  The former semantic is appropriate for the backend; the latter semantic
-   --  is appropriate for the frontend.
+   --  The former semantics is appropriate for the back end; the latter
+   --  semantics is appropriate for the front end.
 
    function Denotes_Discriminant
      (N                : Node_Id;