diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2022-05-04 12:31:14 +0200 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-06-01 08:43:17 +0000 |
commit | 121522250886c8e5ea663af724affc1884944bbe (patch) | |
tree | d6f670ed3fde05d4e4057ef4ae5f719af5cc134a /gcc | |
parent | fdb2f2e696250fafc13635ac8c026d82e05f7738 (diff) | |
download | gcc-121522250886c8e5ea663af724affc1884944bbe.zip gcc-121522250886c8e5ea663af724affc1884944bbe.tar.gz gcc-121522250886c8e5ea663af724affc1884944bbe.tar.bz2 |
[Ada] Fix composability of return on the secondary stack
Having components that need to be returned on the secondary stack would
not always force a record type to be returned on the secondary stack
itself.
gcc/ada/
* sem_util.adb
(Returns_On_Secondary_Stack.Caller_Known_Size_Record): Directly
check the dependence on discriminants for the variant part, if
any, instead of calling the Is_Definite_Subtype predicate.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/sem_util.adb | 61 |
1 files changed, 47 insertions, 14 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 92c6636..21b6ee4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -27388,14 +27388,8 @@ package body Sem_Util is pragma Assert (if Present (Id) then Ekind (Id) in E_Void | Type_Kind); function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean; - -- This is called for untagged records and protected types, with - -- nondefaulted discriminants. Returns True if the size of function - -- results is known at the call site, False otherwise. Returns False - -- if there is a variant part that depends on the discriminants of - -- this type, or if there is an array constrained by the discriminants - -- of this type. ???Currently, this is overly conservative (the array - -- could be nested inside some other record that is constrained by - -- nondiscriminants). That is, the recursive calls are too conservative. + -- Called for untagged record and protected types. Return True if the + -- size of function results is known in the caller for Typ. function Large_Max_Size_Mutable (Typ : Entity_Id) return Boolean; -- Returns True if Typ is a nonlimited record with defaulted @@ -27409,22 +27403,61 @@ package body Sem_Util is function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean is pragma Assert (Typ = Underlying_Type (Typ)); + function Depends_On_Discriminant (Typ : Entity_Id) return Boolean; + -- Called for untagged record and protected types. Return True if Typ + -- depends on discriminants, either directly when it is unconstrained + -- or indirectly when it is constrained by uplevel discriminants. + + ----------------------------- + -- Depends_On_Discriminant -- + ----------------------------- + + function Depends_On_Discriminant (Typ : Entity_Id) return Boolean is + Cons : Elmt_Id; + + begin + if Has_Discriminants (Typ) then + if not Is_Constrained (Typ) then + return True; + + else + Cons := First_Elmt (Discriminant_Constraint (Typ)); + while Present (Cons) loop + if Nkind (Node (Cons)) = N_Identifier + and then Ekind (Entity (Node (Cons))) = E_Discriminant + then + return True; + end if; + + Next_Elmt (Cons); + end loop; + end if; + end if; + + return False; + end Depends_On_Discriminant; + begin - if Has_Variant_Part (Typ) and then not Is_Definite_Subtype (Typ) then + -- First see if we have a variant part and return False if it depends + -- on discriminants. + + if Has_Variant_Part (Typ) and then Depends_On_Discriminant (Typ) then return False; end if; + -- Then loop over components and return False if their subtype has a + -- caller-unknown size, possibly recursively. + + -- ??? This is overly conservative, an array could be nested inside + -- some other record that is constrained by nondiscriminants. That + -- is, the recursive calls are too conservative. + declare Comp : Entity_Id; begin Comp := First_Component (Typ); while Present (Comp) loop - - -- Only look at E_Component entities. No need to look at - -- E_Discriminant entities, and we must ignore internal - -- subtypes generated for constrained components. - declare Comp_Type : constant Entity_Id := Underlying_Type (Etype (Comp)); |