@@ -723,6 +723,16 @@ package body Sem_Ch3 is
-- sets the flags SSO_Set_Low_By_Default/SSO_Set_High_By_Default according
-- to the setting of Opt.Default_SSO.
+ function Should_Build_Subtype (T : Entity_Id) return Boolean;
+ -- When analyzing components or object declarations, it is possible, in
+ -- some cases, to build subtypes for discriminated types. This is
+ -- worthwhile to avoid the backend allocating the maximum possible size for
+ -- objects of the type.
+ -- In particular, when T is limited, the discriminants and therefore the
+ -- size of an object of type T cannot change. Furthermore, if T is definite
+ -- with statically initialized defaulted discriminants, we are able and
+ -- want to build a constrained subtype of the right size.
+
procedure Signed_Integer_Type_Declaration (T : Entity_Id; Def : Node_Id);
-- Create a new signed integer entity, and apply the constraint to obtain
-- the required first named subtype of this type.
@@ -2203,17 +2213,9 @@ package body Sem_Ch3 is
end if;
end if;
- -- If the component is an unconstrained task or protected type with
- -- discriminants, the component and the enclosing record are limited
- -- and the component is constrained by its default values. Compute
- -- its actual subtype, else it may be allocated the maximum size by
- -- the backend, and possibly overflow.
+ -- When possible, build the default subtype
- if Is_Concurrent_Type (T)
- and then not Is_Constrained (T)
- and then Has_Discriminants (T)
- and then not Has_Discriminants (Current_Scope)
- then
+ if Should_Build_Subtype (T) then
declare
Act_T : constant Entity_Id := Build_Default_Subtype (T, N);
@@ -4799,14 +4801,9 @@ package body Sem_Ch3 is
Apply_Length_Check (E, T);
end if;
- -- If the type is limited unconstrained with defaulted discriminants and
- -- there is no expression, then the object is constrained by the
- -- defaults, so it is worthwhile building the corresponding subtype.
+ -- When possible, build the default subtype
- elsif (Is_Limited_Record (T) or else Is_Concurrent_Type (T))
- and then not Is_Constrained (T)
- and then Has_Discriminants (T)
- then
+ elsif Should_Build_Subtype (T) then
if No (E) then
Act_T := Build_Default_Subtype (T, N);
else
@@ -22879,6 +22876,80 @@ package body Sem_Ch3 is
end if;
end Set_Stored_Constraint_From_Discriminant_Constraint;
+ --------------------------
+ -- Should_Build_Subtype --
+ --------------------------
+
+ function Should_Build_Subtype (T : Entity_Id) return Boolean is
+
+ function Default_Discriminant_Values_Known_At_Compile_Time
+ (T : Entity_Id) return Boolean;
+ -- For an unconstrained type T, return False if the given type has a
+ -- discriminant with default value not known at compile time. Return
+ -- True otherwise.
+
+ ---------------------------------------------------------
+ -- Default_Discriminant_Values_Known_At_Compile_Time --
+ ---------------------------------------------------------
+
+ function Default_Discriminant_Values_Known_At_Compile_Time
+ (T : Entity_Id) return Boolean
+ is
+ Discr : Entity_Id;
+ DDV : Node_Id;
+
+ begin
+
+ -- If the type has no discriminant, we know them all at compile time
+
+ if not Has_Discriminants (T) then
+ return True;
+ end if;
+
+ -- The type has discriminants, check that none of them has a default
+ -- value not known at compile time.
+
+ Discr := First_Discriminant (T);
+
+ while Present (Discr) loop
+ DDV := Discriminant_Default_Value (Discr);
+
+ if Present (DDV) and then not Compile_Time_Known_Value (DDV) then
+ return False;
+ end if;
+
+ Next_Discriminant (Discr);
+ end loop;
+
+ return True;
+ end Default_Discriminant_Values_Known_At_Compile_Time;
+
+ -- Start of processing for Should_Build_Subtype
+
+ begin
+
+ if Is_Constrained (T) then
+
+ -- We won't build a new subtype if T is constrained
+
+ return False;
+ end if;
+
+ if not Default_Discriminant_Values_Known_At_Compile_Time (T) then
+
+ -- This is a special case of definite subtypes. To allocate a
+ -- specific size to the subtype, we need to know the value at compile
+ -- time. This might not be the case if the default value is the
+ -- result of a function. In that case, the object might be definite
+ -- and limited but the needed size might not be statically known or
+ -- too tricky to obtain. In that case, we will not build the subtype.
+
+ return False;
+ end if;
+
+ return Is_Definite_Subtype (T) and then Is_Limited_View (T);
+ end Should_Build_Subtype;
+
-------------------------------------
-- Signed_Integer_Type_Declaration --
-------------------------------------
We should build subtype for discriminated types in several situations where we know a priori that we never need to allocate the max possible size. To factorize these conditions between `Analyze_Component_Declaration` and `Analyze_Object_Declaration`, the function `Should_Build_Subtypes` is introduced. This new function fixes the condition for the following case: type Foo (Size : Natural) is record Bar : aliased Synchronized_Bounded_Queue_Package.Queue; Name : String (1..Size); end record; For that case, the condition relied on the fact that `Current_Scope` is discriminated to not build the subtype. A priori, it was thought that the Foo discriminant would be used for Bar. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch3.adb (Analyze_Component_Declaration): Rework condition to build subtypes. (Analyze_Object_Declaration): Likewise. (Should_Build_Subtype): New.