[multiple changes]

2014-06-11  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Input_Item): Allow formal
	parameters to appear as input_items in an initialization_list
	of pragma Initializes. Encapsulation now applies to states and
	variables only (as it should). Add RM references to key errors.
	* sem_prag.adb (Set_Imported): Suppress errors
	about preceding Imports when the pragma does not come from source,
	which can happen through use of pragma Provide_Shift_Operators.

2014-06-11  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb: Minor reformatting.
	* einfo.ads (Full_View): Minor comment update.

From-SVN: r211460

4 files changed, 191 insertions, 92 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0bfe92d..126ffbe 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,40 @@
+2014-06-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Input_Item): Allow formal
+	parameters to appear as input_items in an initialization_list
+	of pragma Initializes. Encapsulation now applies to states and
+	variables only (as it should). Add RM references to key errors.
+	* sem_prag.adb (Set_Imported): Suppress errors
+	about preceding Imports when the pragma does not come from source,
+	which can happen through use of pragma Provide_Shift_Operators.
+
+2014-06-11  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch3.adb: Minor reformatting.
+	* einfo.ads (Full_View): Minor comment update.
+
+2014-06-11  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.adb (Is_Independent): New flag.
+	* einfo.ads (Is_Independent): New flag.
+	(Has_Independent_Components): Clean up and fix comments.
+	* sem_prag.adb (Fix_Error): Deal with changing argument
+	[of] to entity [for].
+	(Analyze_Pragma, case Independent): Set Is_Independent flag
+	(Analyze_Pragma, case Independent_Components): Set Is_Independent flag
+	in all components of specified record.
+
+2014-06-11  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch12.adb (Analyze_Formal_Decimal_Fixed_Point_Type):
+	Set proper Etype on bounds of dummy type created for analysis
+	of the generic.
+
+2014-06-11  Robert Dewar  <dewar@adacore.com>
+
+	* debug.adb: Minor comment fix (add missing section of dot
+	numeric flags).
+
 2014-06-11  Robert Dewar  <dewar@adacore.com>
 
 	* gnat_rm.texi, switch-c.adb, sem_prag.adb, a-tgdico.ads, par-prag.adb,
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 6a608a5..cbe2ea9 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1336,12 +1336,12 @@ package Einfo is
 
 --    Full_View (Node11)
 --       Defined in all type and subtype entities and in deferred constants.
---       References the entity for the corresponding full type declaration.
---       For all types other than private and incomplete types, this field
---       always contains Empty. If an incomplete type E1 is completed by a
---       private type E2 whose full type declaration entity is E3 then the
---       full view of E1 is E2, and the full view of E2 is E3. See also
---       Underlying_Type.
+--       References the entity for the corresponding full type or constant
+--       declaration. For all types other than private and incomplete types,
+--       this field always contains Empty. If an incomplete type E1 is
+--       completed by a private type E2 whose full type declaration entity is
+--       E3 then the full view of E1 is E2, and the full view of E2 is E3. See
+--       also Underlying_Type.
 
 --    Generic_Homonym (Node11)
 --       Defined in generic packages. The generic homonym is the entity of
@@ -1581,9 +1581,11 @@ package Einfo is
 --       Implicit_Dereference. Set also on the discriminant named in the aspect
 --       clause, to simplify type resolution.
 
---    Has_Independent_Components (Flag34)
---       Defined in objects and types. Set if the aspect Independent_Components
---       applies (as set by coresponding pragma or aspect specification).
+--    Has_Independent_Components (Flag34) [base type only]
+--       Defined in types. Set if the aspect Independent_Components applies
+--       (in the base type only), if corresponding pragma or aspect applies.
+--       In the case of an object of anonymous array type, the flag is set on
+--       the created array type.
 
 --    Has_Inheritable_Invariants (Flag248)
 --       Defined in all type entities. Set in private types from which one
@@ -2415,6 +2417,11 @@ package Einfo is
 --    Is_Incomplete_Type (synthesized)
 --       Applies to all entities, true for incomplete types and subtypes
 
+--    Is_Independent (Flag268)
+--       Defined in record components. Set if a valid pragma or aspect
+--       Independent applies to the component, or if a valid pragma or aspect
+--       Independent_Components applies to the enclosing record type.
+
 --    Is_Inlined (Flag11)
 --       Defined in all entities. Set for functions and procedures which are
 --       to be inlined. For subprograms created during expansion, this flag
@@ -4215,7 +4222,7 @@ package Einfo is
 --  In addition, we define the kind E_Allocator_Type to label allocators.
 --  This is because special resolution rules apply to this construct.
 --  Eventually the constructs are labeled with the access type imposed by
---  the context. Gigi should never see the type E_Allocator.
+--  the context. Gigi should never see types with this Ekind.
 
 --  Similarly, the type E_Access_Attribute_Type is used as the initial kind
 --  associated with an access attribute. After resolution a specific access
@@ -4398,8 +4405,8 @@ package Einfo is
       --  'Unrestricted_Access and Unchecked_Access)
 
       E_Allocator_Type,
-      --  A special internal type used to label allocators and attribute
-      --  references using 'Access. This is needed because special resolution
+      --  A special internal type used to label allocators and references to
+      --  objects using 'Reference. This is needed because special resolution
       --  rules apply to these constructs. On the resolution pass, this type
       --  is always replaced by the actual access type, so Gigi should never
       --  see types with this Ekind.
@@ -5350,6 +5357,7 @@ package Einfo is
    --    Has_Biased_Representation           (Flag139)
    --    Has_Per_Object_Constraint           (Flag154)
    --    Is_Atomic                           (Flag85)
+   --    Is_Independent                      (Flag268)
    --    Is_Tag                              (Flag78)
    --    Is_Volatile                         (Flag16)
    --    Treat_As_Volatile                   (Flag41)
@@ -5379,7 +5387,6 @@ package Einfo is
    --    Has_Atomic_Components               (Flag86)
    --    Has_Biased_Representation           (Flag139)
    --    Has_Completion                      (Flag26)   (constants only)
-   --    Has_Independent_Components          (Flag34)   (base type only)
    --    Has_Thunks                          (Flag228)  (constants only)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Up_Level_Access                 (Flag215)
@@ -6089,7 +6096,6 @@ package Einfo is
    --    Has_Alignment_Clause                (Flag46)
    --    Has_Atomic_Components               (Flag86)
    --    Has_Biased_Representation           (Flag139)
-   --    Has_Independent_Components          (Flag34)   (base type only)
    --    Has_Initial_Value                   (Flag219)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Up_Level_Access                 (Flag215)
@@ -6589,6 +6595,7 @@ package Einfo is
    function Is_Immediately_Visible              (Id : E) return B;
    function Is_Implementation_Defined           (Id : E) return B;
    function Is_Imported                         (Id : E) return B;
+   function Is_Independent                      (Id : E) return B;
    function Is_Inlined                          (Id : E) return B;
    function Is_Instantiated                     (Id : E) return B;
    function Is_Interface                        (Id : E) return B;
@@ -7217,6 +7224,7 @@ package Einfo is
    procedure Set_Is_Immediately_Visible          (Id : E; V : B := True);
    procedure Set_Is_Implementation_Defined       (Id : E; V : B := True);
    procedure Set_Is_Imported                     (Id : E; V : B := True);
+   procedure Set_Is_Independent                  (Id : E; V : B := True);
    procedure Set_Is_Inlined                      (Id : E; V : B := True);
    procedure Set_Is_Instantiated                 (Id : E; V : B := True);
    procedure Set_Is_Interface                    (Id : E; V : B := True);
@@ -7979,6 +7987,7 @@ package Einfo is
    pragma Inline (Is_Imported);
    pragma Inline (Is_Incomplete_Or_Private_Type);
    pragma Inline (Is_Incomplete_Type);
+   pragma Inline (Is_Independent);
    pragma Inline (Is_Inlined);
    pragma Inline (Is_Instantiated);
    pragma Inline (Is_Integer_Type);
@@ -8426,6 +8435,7 @@ package Einfo is
    pragma Inline (Set_Is_Immediately_Visible);
    pragma Inline (Set_Is_Implementation_Defined);
    pragma Inline (Set_Is_Imported);
+   pragma Inline (Set_Is_Independent);
    pragma Inline (Set_Is_Inlined);
    pragma Inline (Set_Is_Instantiated);
    pragma Inline (Set_Is_Interface);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 763b85a..684b0a4 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -15508,7 +15508,6 @@ package body Sem_Ch3 is
                       or else No (Full_View (Prev))
                       or else not Is_Private_Type (Full_View (Prev)))
          then
-
             --  Indicate that the incomplete declaration has a matching full
             --  declaration. The defining occurrence of the incomplete
             --  declaration remains the visible one, and the procedure
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 07468c7..622a2c0 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -2583,8 +2583,12 @@ package body Sem_Prag is
                if Is_Entity_Name (Input) then
                   Input_Id := Entity_Of (Input);
 
-                  if Ekind_In (Input_Id, E_Abstract_State, E_Variable) then
-
+                  if Ekind_In (Input_Id, E_Abstract_State,
+                                         E_In_Parameter,
+                                         E_In_Out_Parameter,
+                                         E_Out_Parameter,
+                                         E_Variable)
+                  then
                      --  The input cannot denote states or variables declared
                      --  within the related package.
 
@@ -2610,13 +2614,15 @@ package body Sem_Prag is
                            Add_Item (Input_Id, States_Seen);
                         end if;
 
-                        if Present (Encapsulating_State (Input_Id)) then
+                        if Ekind_In (Input_Id, E_Abstract_State, E_Variable)
+                          and then Present (Encapsulating_State (Input_Id))
+                        then
                            Add_Item (Input_Id, Constits_Seen);
                         end if;
                      end if;
 
                   --  The input references something that is not a state or a
-                  --  variable.
+                  --  variable (SPARK RM 7.1.5(3)).
 
                   else
                      Error_Msg_N
@@ -2624,6 +2630,7 @@ package body Sem_Prag is
                   end if;
 
                --  Some form of illegal construct masquerading as a name
+               --  (SPARK RM 7.1.5(3)).
 
                else
                   Error_Msg_N
@@ -3219,14 +3226,27 @@ package body Sem_Prag is
       --  procedure identified by Name, returns it if it exists, otherwise
       --  errors out and uses Arg as the pragma argument for the message.
 
-      procedure Fix_Error (Msg : in out String);
-      --  This is called prior to issuing an error message. Msg is a string
-      --  that typically contains the substring "pragma". If the pragma comes
-      --  from an aspect, each such "pragma" substring is replaced with the
-      --  characters "aspect", and Error_Msg_Name_1 is set to the name of the
-      --  aspect (which may be different from the pragma name). If the current
-      --  pragma results from rewriting another pragma, then Error_Msg_Name_1
-      --  is set to the original pragma name.
+      function Fix_Error (Msg : String) return String;
+      --  This is called prior to issuing an error message. Msg is the normal
+      --  error message issued in the pragma case. This routine checks for the
+      --  case of a pragma coming from an aspect in the source, and returns a
+      --  message suitable for the aspect case as follows:
+      --
+      --    Each substring "pragma" is replaced by "aspect"
+      --
+      --    If "argument of" is at the start of the error message text, it is
+      --    replaced by "entity for".
+      --
+      --    If "argument" is at the start of the error message text, it is
+      --    replaced by "entity".
+      --
+      --  So for example, "argument of pragma X must be discrete type"
+      --  returns "entity for aspect X must be a discrete type".
+
+      --  Finally Error_Msg_Name_1 is set to the name of the aspect (which may
+      --  be different from the pragma name). If the current pragma results
+      --  from rewriting another pragma, then Error_Msg_Name_1 is set to the
+      --  original pragma name.
 
       procedure Gather_Associations
         (Names : Name_List;
@@ -3746,12 +3766,11 @@ package body Sem_Prag is
                Error_Msg_Name_1 := Pname;
 
                declare
-                  Msg : String :=
+                  Msg : constant String :=
                           "argument for pragma% must be a identifier or "
                           & "static string expression!";
                begin
-                  Fix_Error (Msg);
-                  Flag_Non_Static_Expr (Msg, Argx);
+                  Flag_Non_Static_Expr (Fix_Error (Msg), Argx);
                   raise Pragma_Exit;
                end;
             end if;
@@ -4419,15 +4438,9 @@ package body Sem_Prag is
 
          else
             Error_Msg_Name_1 := Pname;
-
-            declare
-               Msg : String :=
-                       "argument for pragma% must be a static expression!";
-            begin
-               Fix_Error (Msg);
-               Flag_Non_Static_Expr (Msg, Expr);
-            end;
-
+            Flag_Non_Static_Expr
+              (Fix_Error ("argument for pragma% must be a static expression!"),
+               Expr);
             raise Pragma_Exit;
          end if;
       end Check_Expr_Is_Static_Expression;
@@ -5822,11 +5835,9 @@ package body Sem_Prag is
       ------------------
 
       procedure Error_Pragma (Msg : String) is
-         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
-         Fix_Error (MsgF);
-         Error_Msg_N (MsgF, N);
+         Error_Msg_N (Fix_Error (Msg), N);
          raise Pragma_Exit;
       end Error_Pragma;
 
@@ -5835,20 +5846,16 @@ package body Sem_Prag is
       ----------------------
 
       procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id) is
-         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
-         Fix_Error (MsgF);
-         Error_Msg_N (MsgF, Get_Pragma_Arg (Arg));
+         Error_Msg_N (Fix_Error (Msg), Get_Pragma_Arg (Arg));
          raise Pragma_Exit;
       end Error_Pragma_Arg;
 
       procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id) is
-         MsgF : String := Msg1;
       begin
          Error_Msg_Name_1 := Pname;
-         Fix_Error (MsgF);
-         Error_Msg_N (MsgF, Get_Pragma_Arg (Arg));
+         Error_Msg_N (Fix_Error (Msg1), Get_Pragma_Arg (Arg));
          Error_Pragma_Arg (Msg2, Arg);
       end Error_Pragma_Arg;
 
@@ -5857,11 +5864,9 @@ package body Sem_Prag is
       ----------------------------
 
       procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id) is
-         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
-         Fix_Error (MsgF);
-         Error_Msg_N (MsgF, Arg);
+         Error_Msg_N (Fix_Error (Msg), Arg);
          raise Pragma_Exit;
       end Error_Pragma_Arg_Ident;
 
@@ -5870,12 +5875,10 @@ package body Sem_Prag is
       ----------------------
 
       procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id) is
-         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
-         Fix_Error (MsgF);
-         Error_Msg_Sloc   := Sloc (Ref);
-         Error_Msg_NE (MsgF, N, Ref);
+         Error_Msg_Sloc := Sloc (Ref);
+         Error_Msg_NE (Fix_Error (Msg), N, Ref);
          raise Pragma_Exit;
       end Error_Pragma_Ref;
 
@@ -6006,7 +6009,11 @@ package body Sem_Prag is
       -- Fix_Error --
       ---------------
 
-      procedure Fix_Error (Msg : in out String) is
+      function Fix_Error (Msg : String) return String is
+         Res      : String (Msg'Range) := Msg;
+         Res_Last : Natural            := Msg'Last;
+         J        : Natural;
+
       begin
          --  If we have a rewriting of another pragma, go to that pragma
 
@@ -6022,16 +6029,47 @@ package body Sem_Prag is
 
             --  Change appearence of "pragma" in message to "aspect"
 
-            for J in Msg'First .. Msg'Last - 5 loop
-               if Msg (J .. J + 5) = "pragma" then
-                  Msg (J .. J + 5) := "aspect";
+            J := Res'First;
+            while J <= Res_Last - 5 loop
+               if Res (J .. J + 5) = "pragma" then
+                  Res (J .. J + 5) := "aspect";
+                  J := J + 6;
+
+               else
+                  J := J + 1;
                end if;
             end loop;
 
+            --  Change "argument of" at start of message to "entity for"
+
+            if Res'Length > 11
+              and then Res (Res'First .. Res'First + 10) = "argument of"
+            then
+               Res (Res'First .. Res'First + 9) := "entity for";
+               Res (Res'First + 10 .. Res_Last - 1) :=
+                 Res (Res'First + 11 .. Res_Last);
+               Res_Last := Res_Last - 1;
+            end if;
+
+            --  Change "argument" at start of message to "entity"
+
+            if Res'Length > 8
+              and then Res (Res'First .. Res'First + 7) = "argument"
+            then
+               Res (Res'First .. Res'First + 5) := "entity";
+               Res (Res'First + 6 .. Res_Last - 2) :=
+                 Res (Res'First + 8 .. Res_Last);
+               Res_Last := Res_Last - 2;
+            end if;
+
             --  Get name from corresponding aspect
 
             Error_Msg_Name_1 := Original_Aspect_Name (N);
          end if;
+
+         --  Return possibly modified message
+
+         return Res (Res'First .. Res_Last);
       end Fix_Error;
 
       -------------------------
@@ -9538,6 +9576,12 @@ package body Sem_Prag is
             elsif Import_Interface_Present (N) then
                goto OK;
 
+            --  OK if the pragma was expanded by the compiler. Can occur when
+            --  using pragma Provide_Shift_Operators on multiple types.
+
+            elsif not Comes_From_Source (N) then
+               goto OK;
+
             --  Error if being set Imported twice
 
             else
@@ -14974,13 +15018,11 @@ package body Sem_Prag is
          -- Independent --
          -----------------
 
-         --  pragma Independent (LOCAL_NAME);
+         --  pragma Independent (record_component_LOCAL_NAME);
 
          when Pragma_Independent => Independent : declare
             E_Id : Node_Id;
             E    : Entity_Id;
-            D    : Node_Id;
-            K    : Node_Kind;
 
          begin
             Check_Ada_83_Warning;
@@ -14995,38 +15037,32 @@ package body Sem_Prag is
             end if;
 
             E := Entity (E_Id);
-            D := Declaration_Node (E);
-            K := Nkind (D);
+
+            --  Check we have a record component. We have not yet setup
+            --  components fully, so identify by syntactic structure.
+
+            if Nkind (Declaration_Node (E)) /= N_Component_Declaration then
+               Error_Pragma_Arg
+                 ("argument for pragma% must be record component", Arg1);
+            end if;
 
             --  Check duplicate before we chain ourselves
 
             Check_Duplicate_Pragma (E);
 
-            --  Check appropriate entity
+            --  Chain pragma
 
-            if Is_Type (E) then
-               if Rep_Item_Too_Early (E, N)
-                    or else
-                  Rep_Item_Too_Late (E, N)
-               then
-                  return;
-               else
-                  Check_First_Subtype (Arg1);
-               end if;
-
-            elsif K = N_Object_Declaration
-              or else (K = N_Component_Declaration
-                        and then Original_Record_Component (E) = E)
+            if Rep_Item_Too_Early (E, N)
+                 or else
+               Rep_Item_Too_Late (E, N)
             then
-               if Rep_Item_Too_Late (E, N) then
-                  return;
-               end if;
-
-            else
-               Error_Pragma_Arg
-                 ("inappropriate entity for pragma%", Arg1);
+               return;
             end if;
 
+            --  Set flag in component
+
+            Set_Is_Independent (E);
+
             Independence_Checks.Append ((N, E));
          end Independent;
 
@@ -15043,6 +15079,7 @@ package body Sem_Prag is
             E    : Entity_Id;
             D    : Node_Id;
             K    : Node_Kind;
+            C    : Node_Id;
 
          begin
             Check_Ada_83_Warning;
@@ -15077,16 +15114,26 @@ package body Sem_Prag is
             if K = N_Full_Type_Declaration
               and then (Is_Array_Type (E) or else Is_Record_Type (E))
             then
-               Independence_Checks.Append ((N, E));
+               Independence_Checks.Append ((N, Base_Type (E)));
                Set_Has_Independent_Components (Base_Type (E));
 
+               --  For record type, set all components independent
+
+               if Is_Record_Type (E) then
+                  C := First_Component (E);
+                  while Present (C) loop
+                     Set_Is_Independent (C);
+                     Next_Component (C);
+                  end loop;
+               end if;
+
             elsif (Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
               and then Nkind (D) = N_Object_Declaration
               and then Nkind (Object_Definition (D)) =
                                            N_Constrained_Array_Definition
             then
-               Independence_Checks.Append ((N, E));
-               Set_Has_Independent_Components (E);
+               Independence_Checks.Append ((N, Base_Type (Etype (E))));
+               Set_Has_Independent_Components (Base_Type (Etype (E)));
 
             else
                Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
@@ -17426,8 +17473,15 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
-
             Type_Id := Get_Pragma_Arg (Assoc);
+
+            if not Is_Entity_Name (Type_Id)
+              or else not Is_Type (Entity (Type_Id))
+            then
+               Error_Pragma_Arg
+                 ("argument for pragma% must be type or subtype", Arg1);
+            end if;
+
             Find_Type (Type_Id);
             Typ := Entity (Type_Id);
 
@@ -19650,13 +19704,12 @@ package body Sem_Prag is
             --------------------------------
 
             procedure Check_Library_Level_Entity (E : Entity_Id) is
-               MsgF : String := "incorrect placement of pragma%";
+               MsgF : constant String := "incorrect placement of pragma%";
 
             begin
                if not Is_Library_Level_Entity (E) then
                   Error_Msg_Name_1 := Pname;
-                  Fix_Error (MsgF);
-                  Error_Msg_N (MsgF, N);
+                  Error_Msg_N (Fix_Error (MsgF), N);
 
                   if Ekind_In (E, E_Generic_Package,
                                   E_Package,