2015-01-06 Eric Botcazou <ebotcazou@adacore.com>

	* einfo.ads (Has_Independent_Components): Document extended usage.
	* einfo.adb (Has_Independent_Components): Remove obsolete assertion.
	(Set_Has_Independent_Components): Adjust assertion.
	* sem_prag.adb (Analyze_Pragma): Also set Has_Independent_Components
	for pragma Atomic_Components.  Set Has_Independent_Components
	on the object instead of the type for an object declaration with
	pragma Independent_Components.

2015-01-06  Olivier Hainque  <hainque@adacore.com>

	* set_targ.adb (Read_Target_Dependent_Values): Set
	Long_Double_Index when "long double" is read.
	(elaboration code): Register_Back_End_Types only when not reading from
	config files. Doing otherwise is pointless and error prone.

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* s-valrea.adb (Value_Real): Check for Str'Last = Positive'Last

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* a-wtgeau.adb, a-ztgeau.adb, a-tigeau.adb (String_Skip): Raise PE if
	Str'Last = Positive'Last.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Matches_Limited_View): Handle properly the case
	where the non-limited type is a generic actual and appears as
	a subtype of the non-limited view of the other.
	* freeze.adb (Build_Renamed_Body): If the return type of the
	declaration that is being completed is a limited view and the
	non-limited view is available, use it in the specification of
	the generated body.

2015-01-06  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb: Reapplying reversed patch.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Find_Type_Name): If there is a previous tagged
	incomplete view, the type of the classwide type common to both
	views is the type being declared.



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

13 files changed, 203 insertions, 42 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3ee3eae270e..d8fb6f0e294 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,52 @@
 2015-01-06  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* einfo.ads (Has_Independent_Components): Document extended
+	usage.
+	* einfo.adb (Has_Independent_Components): Remove obsolete assertion.
+	(Set_Has_Independent_Components): Adjust assertion.
+	* sem_prag.adb (Analyze_Pragma): Also set Has_Independent_Components
+	for pragma Atomic_Components.  Set Has_Independent_Components
+	on the object instead of the type for an object declaration with
+	pragma Independent_Components.
+
+2015-01-06  Olivier Hainque  <hainque@adacore.com>
+
+	* set_targ.adb (Read_Target_Dependent_Values): Set
+	Long_Double_Index when "long double" is read.
+	(elaboration code): Register_Back_End_Types only when not reading from
+	config files. Doing otherwise is pointless and error prone.
+
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
+	* s-valrea.adb (Value_Real): Check for Str'Last = Positive'Last
+
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
+	* a-wtgeau.adb, a-ztgeau.adb, a-tigeau.adb (String_Skip): Raise PE if
+	Str'Last = Positive'Last.
+
+2015-01-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Matches_Limited_View): Handle properly the case
+	where the non-limited type is a generic actual and appears as
+	a subtype of the non-limited view of the other.
+	* freeze.adb (Build_Renamed_Body): If the return type of the
+	declaration that is being completed is a limited view and the
+	non-limited view is available, use it in the specification of
+	the generated body.
+
+2015-01-06  Javier Miranda  <miranda@adacore.com>
+
+	* exp_disp.adb: Reapplying reversed patch.
+
+2015-01-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Find_Type_Name): If there is a previous tagged
+	incomplete view, the type of the classwide type common to both
+	views is the type being declared.
+
+2015-01-06  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* einfo.ads (Is_Independent): Further document extended usage.
 
 2015-01-06  Eric Botcazou  <ebotcazou@adacore.com>
diff --git a/gcc/ada/a-tigeau.adb b/gcc/ada/a-tigeau.adb
index 24d753b040e..218aec87b8a 100644
--- a/gcc/ada/a-tigeau.adb
+++ b/gcc/ada/a-tigeau.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -443,6 +443,19 @@ package body Ada.Text_IO.Generic_Aux is
 
    procedure String_Skip (Str : String; Ptr : out Integer) is
    begin
+      --  Routines calling String_Skip malfunction if Str'Last = Positive'Last.
+      --  It's too much trouble to make this silly case work, so we just raise
+      --  Program_Error with an appropriate message. We raise Program_Error
+      --  rather than Constraint_Error because we don't want this case to be
+      --  converted to Data_Error.
+
+      if Str'Last = Positive'Last then
+         raise Program_Error with
+           "string upper bound is Positive'Last, not supported";
+      end if;
+
+      --  Normal case where Str'Last < Positive'Last
+
       Ptr := Str'First;
 
       loop
diff --git a/gcc/ada/a-wtgeau.adb b/gcc/ada/a-wtgeau.adb
index f8c02755e18..7e2777313f0 100644
--- a/gcc/ada/a-wtgeau.adb
+++ b/gcc/ada/a-wtgeau.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -484,6 +484,19 @@ package body Ada.Wide_Text_IO.Generic_Aux is
 
    procedure String_Skip (Str : String; Ptr : out Integer) is
    begin
+      --  Routines calling String_Skip malfunction if Str'Last = Positive'Last.
+      --  It's too much trouble to make this silly case work, so we just raise
+      --  Program_Error with an appropriate message. We raise Program_Error
+      --  rather than Constraint_Error because we don't want this case to be
+      --  converted to Data_Error.
+
+      if Str'Last = Positive'Last then
+         raise Program_Error with
+           "string upper bound is Positive'Last, not supported";
+      end if;
+
+      --  Normal case where Str'Last < Positive'Last
+
       Ptr := Str'First;
 
       loop
diff --git a/gcc/ada/a-ztgeau.adb b/gcc/ada/a-ztgeau.adb
index 27de665b18f..7f182a13fe8 100644
--- a/gcc/ada/a-ztgeau.adb
+++ b/gcc/ada/a-ztgeau.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -484,6 +484,19 @@ package body Ada.Wide_Wide_Text_IO.Generic_Aux is
 
    procedure String_Skip (Str : String; Ptr : out Integer) is
    begin
+      --  Routines calling String_Skip malfunction if Str'Last = Positive'Last.
+      --  It's too much trouble to make this silly case work, so we just raise
+      --  Program_Error with an appropriate message. We raise Program_Error
+      --  rather than Constraint_Error because we don't want this case to be
+      --  converted to Data_Error.
+
+      if Str'Last = Positive'Last then
+         raise Program_Error with
+           "string upper bound is Positive'Last, not supported";
+      end if;
+
+      --  Normal case where Str'Last < Positive'Last
+
       Ptr := Str'First;
 
       loop
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index c5ff28ef216..7407d48f0ea 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -1468,8 +1468,7 @@ package body Einfo is
 
    function Has_Independent_Components (Id : E) return B is
    begin
-      pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
-      return Flag34 (Base_Type (Id));
+      return Flag34 (Implementation_Base_Type (Id));
    end Has_Independent_Components;
 
    function Has_Inheritable_Invariants (Id : E) return B is
@@ -4262,8 +4261,7 @@ package body Einfo is
 
    procedure Set_Has_Independent_Components (Id : E; V : B := True) is
    begin
-      pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
-        and then Is_Base_Type (Id));
+      pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
       Set_Flag34 (Id, V);
    end Set_Has_Independent_Components;
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 736ab308adb..91d7c56ddf6 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1605,11 +1605,16 @@ package Einfo is
 --       Implicit_Dereference. Set also on the discriminant named in the aspect
 --       clause, to simplify type resolution.
 
---    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_Independent_Components (Flag34) [implementation base type only]
+--       Defined in all types and objects. Set only for a record type or an
+--       array type or array object if a valid pragma Independent_Components
+--       applies to the type or object. Note that in the case of an object,
+--       this flag is only set on the object if there was an explicit pragma
+--       for the object. In other words, the proper test for whether an object
+--       has independent components is to see if either the object or its base
+--       type has this flag set. Note that in the case of a type, the pragma
+--       will be chained to the rep item chain of the first subtype in the
+--       usual manner.
 
 --    Has_Inheritable_Invariants (Flag248)
 --       Defined in all type entities. Set in private types from which one
@@ -5525,6 +5530,7 @@ package Einfo is
    --    Has_Atomic_Components               (Flag86)
    --    Has_Biased_Representation           (Flag139)
    --    Has_Completion                      (Flag26)   (constants only)
+   --    Has_Independent_Components          (Flag34)
    --    Has_Thunks                          (Flag228)  (constants only)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Up_Level_Access                 (Flag215)
@@ -6236,6 +6242,7 @@ package Einfo is
    --    Has_Alignment_Clause                (Flag46)
    --    Has_Atomic_Components               (Flag86)
    --    Has_Biased_Representation           (Flag139)
+   --    Has_Independent_Components          (Flag34)
    --    Has_Initial_Value                   (Flag219)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Up_Level_Access                 (Flag215)
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 99105e0ea4f..905311b6eb9 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1138,6 +1138,25 @@ package body Exp_Disp is
          Operand_Typ := Base_Type (Corresponding_Record_Type (Operand_Typ));
       end if;
 
+      --  No displacement of the pointer to the object needed when the type of
+      --  the operand is not an interface type and the interface is one of
+      --  its parent types (since they share the primary dispatch table).
+
+      declare
+         Opnd : Entity_Id := Operand_Typ;
+
+      begin
+         if Is_Access_Type (Opnd) then
+            Opnd := Designated_Type (Opnd);
+         end if;
+
+         if not Is_Interface (Opnd)
+           and then Is_Ancestor (Iface_Typ, Opnd, Use_Full_View => True)
+         then
+            return;
+         end if;
+      end;
+
       --  Evaluate if we can statically displace the pointer to the object
 
       declare
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index cc5553e09ab..e87b1f4944c 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -412,6 +412,26 @@ package body Freeze is
          Set_Body_To_Inline (Decl, Old_S);
       end if;
 
+      --  Check whether the return type is a limited view. If the subprogram
+      --  is already frozen the generated body may have a non-limited view
+      --  of the type, that must be used, because it is the one in the spec
+      --  of the renaming declaration.
+
+      if Ekind (Old_S) = E_Function
+        and then Is_Entity_Name (Result_Definition (Spec))
+      then
+         declare
+            Ret_Type : constant Entity_Id := Etype (Result_Definition (Spec));
+         begin
+            if Ekind (Ret_Type) = E_Incomplete_Type
+              and then Present (Non_Limited_View (Ret_Type))
+            then
+               Set_Result_Definition (Spec,
+                  New_Occurrence_Of (Non_Limited_View (Ret_Type), Loc));
+            end if;
+         end;
+      end if;
+
       --  The body generated for this renaming is an internal artifact, and
       --  does not  constitute a freeze point for the called entity.
 
diff --git a/gcc/ada/s-valrea.adb b/gcc/ada/s-valrea.adb
index 5d6960df1d5..b7be0ca0435 100644
--- a/gcc/ada/s-valrea.adb
+++ b/gcc/ada/s-valrea.adb
@@ -377,12 +377,30 @@ package body System.Val_Real is
    ----------------
 
    function Value_Real (Str : String) return Long_Long_Float is
-      V : Long_Long_Float;
-      P : aliased Integer := Str'First;
    begin
-      V := Scan_Real (Str, P'Access, Str'Last);
-      Scan_Trailing_Blanks (Str, P);
-      return V;
+      --  We have to special case Str'Last = Positive'Last because the normal
+      --  circuit ends up setting P to Str'Last + 1 which is out of bounds. We
+      --  deal with this by converting to a subtype which fixes the bounds.
+
+      if Str'Last = Positive'Last then
+         declare
+            subtype NT is String (1 .. Str'Length);
+         begin
+            return Value_Real (NT (Str));
+         end;
+
+      --  Normal case where Str'Last < Positive'Last
+
+      else
+         declare
+            V : Long_Long_Float;
+            P : aliased Integer := Str'First;
+         begin
+            V := Scan_Real (Str, P'Access, Str'Last);
+            Scan_Trailing_Blanks (Str, P);
+            return V;
+         end;
+      end if;
    end Value_Real;
 
 end System.Val_Real;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9adcb8208ac..c067539eb1c 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16354,14 +16354,12 @@ package body Sem_Ch3 is
                Set_Ekind (Id, Ekind (Prev));         --  will be reset later
                Set_Class_Wide_Type (Id, Class_Wide_Type (Prev));
 
-               --  If the incomplete type is completed by a private declaration
-               --  the class-wide type remains associated with the incomplete
-               --  type, to prevent order-of-elaboration issues in gigi, else
-               --  we associate the class-wide type with the known full view.
+               --  The type of the classwide type is the current Id. Previously
+               --  this was not done for private declarations because of order-
+               --  of elaboration issues in the back-end, but gigi now handles
+               --  this properly.
 
-               if Nkind (N) /= N_Private_Type_Declaration then
-                  Set_Etype (Class_Wide_Type (Id), Id);
-               end if;
+               Set_Etype (Class_Wide_Type (Id), Id);
             end if;
 
          --  Case of full declaration of private type
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 5794209e9d5..fcca80b3878 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6600,13 +6600,22 @@ package body Sem_Ch6 is
       begin
          --  In some cases a type imported through a limited_with clause, and
          --  its nonlimited view are both visible, for example in an anonymous
-         --  access-to-class-wide type in a formal. Both entities designate the
-         --  same type.
-
-         if From_Limited_With (T1) and then T2 = Available_View (T1) then
+         --  access-to-class-wide type in a formal, or when building the body
+         --  for a subprogram renaming after the subprogram has been frozen.
+         --  In these cases Both entities designate the same type. In addition,
+         --  if one of them is an actual in an instance, it may be a subtype of
+         --  the non-limited view of the other.
+
+         if From_Limited_With (T1)
+           and then (T2 = Available_View (T1)
+                      or else Is_Subtype_Of (T2, Available_View (T1)))
+         then
             return True;
 
-         elsif From_Limited_With (T2) and then T1 = Available_View (T2) then
+         elsif From_Limited_With (T2)
+           and then (T1 = Available_View (T2)
+                      or else Is_Subtype_Of (T1, Available_View (T2)))
+         then
             return True;
 
          elsif From_Limited_With (T1)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d5c1599498d..74607e57655 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11491,12 +11491,15 @@ package body Sem_Prag is
                   E := Base_Type (E);
                end if;
 
-               Set_Has_Volatile_Components (E);
+               --  Atomic implies both Independent and Volatile
 
                if Prag_Id = Pragma_Atomic_Components then
                   Set_Has_Atomic_Components (E);
+                  Set_Has_Independent_Components (E);
                end if;
 
+               Set_Has_Volatile_Components (E);
+
             else
                Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
             end if;
@@ -14977,11 +14980,13 @@ package body Sem_Prag is
             D := Declaration_Node (E);
             K := Nkind (D);
 
+            --  The flag is set on the base type, or on the object
+
             if K = N_Full_Type_Declaration
               and then (Is_Array_Type (E) or else Is_Record_Type (E))
             then
-               Independence_Checks.Append ((N, Base_Type (E)));
                Set_Has_Independent_Components (Base_Type (E));
+               Independence_Checks.Append ((N, Base_Type (E)));
 
                --  For record type, set all components independent
 
@@ -14998,8 +15003,8 @@ package body Sem_Prag is
               and then Nkind (Object_Definition (D)) =
                                            N_Constrained_Array_Definition
             then
-               Independence_Checks.Append ((N, Base_Type (Etype (E))));
-               Set_Has_Independent_Components (Base_Type (Etype (E)));
+               Set_Has_Independent_Components (E);
+               Independence_Checks.Append ((N, E));
 
             else
                Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb
index 0f063e52bb8..4dbd735e97f 100755
--- a/gcc/ada/set_targ.adb
+++ b/gcc/ada/set_targ.adb
@@ -165,7 +165,7 @@ package body Set_Targ is
    --  type can be found if it gets registered at all.
 
    Long_Double_Index : Integer := -1;
-   --  Once all the back-end types have been registered, the index in
+   --  Once all the floating point types have been registered, the index in
    --  FPT_Mode_Table at which "long double" can be found, if anywhere. A
    --  negative value means that no "long double" has been registered. This
    --  is useful to know whether we have a "long double" available at all and
@@ -769,6 +769,10 @@ package body Set_Targ is
          begin
             E.NAME := new String'(Nam_Buf (1 .. Nam_Len));
 
+            if Long_Double_Index < 0 and then E.NAME.all = "long double" then
+               Long_Double_Index := Num_FPT_Modes;
+            end if;
+
             E.DIGS := Get_Nat;
             Check_Spaces;
 
@@ -887,13 +891,6 @@ begin
       end loop;
    end;
 
-   --  Register floating-point types from the back end. We do this
-   --  unconditionally so C_Type_For may be called regardless of -gnateT, for
-   --  which cstand has a use, and early so we can use FPT_Mode_Table below to
-   --  compute some FP attributes.
-
-   Register_Back_End_Types (Register_Float_Type'Access);
-
    --  Case of reading the target dependent values from file
 
    --  This is bit more complex than might be expected, because it has to be
@@ -939,7 +936,11 @@ begin
             Wchar_T_Size               := Get_Wchar_T_Size;
             Words_BE                   := Get_Words_BE;
 
-            --  Compute the sizes of floating point types
+            --  Let the back-end register its floating point types and compute
+            --  the sizes of our standard types from there:
+
+            Num_FPT_Modes := 0;
+            Register_Back_End_Types (Register_Float_Type'Access);
 
             declare
                T : FPT_Mode_Entry renames