[COMMITTED] ada: Restore object constraint optimization
Checks
Commit Message
From: Ronan Desplanques <desplanques@adacore.com>
This patch relaxes the requirement that discriminants values should be
known at compile time for a particular optimization to be applied. That
optimization is the one that treats an unconstrained object as constrained
when the object is of a limited type, in order to reduce the size of the
object.
What makes it possible to relax this requirement is that the set of
cases where the optimization is applied was narrowed in a previous
patch.
gcc/ada/
* sem_util.adb (Build_Default_Subtype_OK): Relax
known-at-compile-time requirement.
* sem_util.ads (Build_Default_Subtype_OK): Bring documentation
comment up-to-date.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_util.adb | 57 --------------------------------------------
gcc/ada/sem_util.ads | 11 ++++-----
2 files changed, 5 insertions(+), 63 deletions(-)
@@ -1813,51 +1813,6 @@ package body Sem_Util is
------------------------------
function Build_Default_Subtype_OK (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 Build_Default_Subtype_OK
-
begin
if Is_Constrained (T) then
@@ -1867,18 +1822,6 @@ package body Sem_Util is
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_Inherently_Limited_Type (T);
end Build_Default_Subtype_OK;
@@ -282,14 +282,13 @@ package Sem_Util is
-- subtype. Otherwise, simply return T.
function Build_Default_Subtype_OK (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.
+ -- When analyzing 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.
+ -- with initialized defaulted discriminants, we are able and want to build
+ -- a constrained subtype of the right size.
function Build_Discriminal_Subtype_Of_Component
(T : Entity_Id) return Node_Id;