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

	* exp_ch7.adb (Process_Declarations): A loop
	parameter does not require finalization actions.

2015-10-20  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch6.adb (Expand_Simple_Function_Return): Do not create an
	actual subtype for a mutable record return type if the expression
	is itself a function call.

2015-10-20  Dmitriy Anisimkov  <anisimko@adacore.com>

	* s-atocou.adb, s-atocou-builtin.adb: Fix implementation description
	related to new type support.

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

	* sem_res.adb (Resolve_Explicit_Dererence): Call Analyze_Dimension
	to propagate dimension information from prefix.
	* sem_dim.adb (Analyze_Dimension): Handle Explicit_Dereference.
	* inline.ads: minor whitespace fix in comment
	* sem_ch6.adb: minor gramar fix in comment

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

	* sem_ch3.adb (Analyze_Object_Contract):
	A protected type or a protected object is allowed to have a
	discriminated part.

2015-10-20  Bob Duff  <duff@adacore.com>

	* sem_util.adb (Requires_Transient_Scope):
	Return true for mutable records if the maximum size is very large.

2015-10-20  Eric Botcazou  <ebotcazou@adacore.com>

	* a-except-2005.adb (To_Stderr): Import Put_Char_Stderr with
	the same signature as in System.IO.Put.



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

1 files changed, 94 insertions, 2 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 6875f3aeb96..0c6e2b00b61 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -17215,6 +17215,11 @@ package body Sem_Util is
       --  could be nested inside some other record that is constrained by
       --  nondiscriminants). That is, the recursive calls are too conservative.
 
+      function Large_Max_Size_Mutable (Typ : Entity_Id) return Boolean;
+      --  Returns True if Typ is a nonlimited record with defaulted
+      --  discriminants whose max size makes it unsuitable for allocating on
+      --  the primary stack.
+
       ------------------------------
       -- Caller_Known_Size_Record --
       ------------------------------
@@ -17267,6 +17272,85 @@ package body Sem_Util is
          return True;
       end Caller_Known_Size_Record;
 
+      ------------------------------
+      -- Large_Max_Size_Mutable --
+      ------------------------------
+
+      function Large_Max_Size_Mutable (Typ : Entity_Id) return Boolean is
+         pragma Assert (Typ = Underlying_Type (Typ));
+
+         function Is_Large_Discrete_Type (T : Entity_Id) return Boolean;
+         --  Returns true if the discrete type T has a large range
+
+         ----------------------------
+         -- Is_Large_Discrete_Type --
+         ----------------------------
+
+         function Is_Large_Discrete_Type (T : Entity_Id) return Boolean is
+            Threshold : constant Int := 16;
+            --  Arbitrary threshold above which we consider it "large". We want
+            --  a fairly large threshold, because these large types really
+            --  shouldn't have default discriminants in the first place, in
+            --  most cases.
+
+         begin
+            return UI_To_Int (RM_Size (T)) > Threshold;
+         end Is_Large_Discrete_Type;
+
+      begin
+         if Is_Record_Type (Typ)
+           and then not Is_Limited_View (Typ)
+           and then Has_Defaulted_Discriminants (Typ)
+         then
+            --  Loop through the components, looking for an array whose upper
+            --  bound(s) depends on discriminants, where both the subtype of
+            --  the discriminant and the index subtype are too large.
+
+            declare
+               Comp : Entity_Id;
+
+            begin
+               Comp := First_Entity (Typ);
+               while Present (Comp) loop
+                  if Ekind (Comp) = E_Component then
+                     declare
+                        Comp_Type : constant Entity_Id :=
+                                      Underlying_Type (Etype (Comp));
+                        Indx : Node_Id;
+                        Ityp : Entity_Id;
+                        Hi   : Node_Id;
+
+                     begin
+                        if Is_Array_Type (Comp_Type) then
+                           Indx := First_Index (Comp_Type);
+
+                           while Present (Indx) loop
+                              Ityp := Etype (Indx);
+                              Hi := Type_High_Bound (Ityp);
+
+                              if Nkind (Hi) = N_Identifier
+                                and then Ekind (Entity (Hi)) = E_Discriminant
+                                and then Is_Large_Discrete_Type (Ityp)
+                                and then Is_Large_Discrete_Type
+                                           (Etype (Entity (Hi)))
+                              then
+                                 return True;
+                              end if;
+
+                              Next_Index (Indx);
+                           end loop;
+                        end if;
+                     end;
+                  end if;
+
+                  Next_Entity (Comp);
+               end loop;
+            end;
+         end if;
+
+         return False;
+      end Large_Max_Size_Mutable;
+
       --  Local declarations
 
       Typ : constant Entity_Id := Underlying_Type (Id);
@@ -17313,10 +17397,18 @@ package body Sem_Util is
 
       --  Untagged definite subtypes are known size. This includes all
       --  elementary [sub]types. Tasks are known size even if they have
-      --  discriminants.
+      --  discriminants. So we return False here, with one exception:
+      --  For a type like:
+      --    type T (Last : Natural := 0) is
+      --       X : String (1 .. Last);
+      --    end record;
+      --  we return True. That's because for "P(F(...));", where F returns T,
+      --  we don't know the size of the result at the call site, so if we
+      --  allocated it on the primary stack, we would have to allocate the
+      --  maximum size, which is way too big.
 
       elsif Is_Definite_Subtype (Typ) or else Is_Task_Type (Typ) then
-         return False;
+         return Large_Max_Size_Mutable (Typ);
 
       --  Indefinite (discriminated) untagged record or protected type