From 339851314c269fb54a3df55505545508baebe33f Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 3 Dec 2018 15:49:56 +0000 Subject: [PATCH] [Ada] Fixes for various wrong and missing error messages on ACATS B85100[567] GNAT was missing errors as well as issuing messages on legal lines in new ACATS tests for illegal renamings of discriminant-dependent components. Cases that are fixed include object names involving qualified expressions, dereference cases, and generic formal access and formal derived types. Better implements the "known to be constrained" rules in the Ada RM. Tested by new ACATS tests B85100[567] that are soon to be released. 2018-12-03 Gary Dismukes gcc/ada/ * sem_aux.adb (Object_Type_Has_Constrained_Partial_View): Return True for an untagged discriminated formal derived type when referenced within a generic body (augments existing test for formal private types). * sem_util.adb (Is_Dependent_Component_Of_Mutable_Type): If the prefix of the name is a qualified expression, retrieve the operand of that. Add a test of whether the (possible) dereference prefix is a variable, and also test whether that prefix might just be of an access type (occurs in some implicit dereference cases) rather than being an explicit dereference. Retrieve the Original_Node of the object name's main prefix and handle the possibility of that being a qualified expression. Remove special-case code for explicit dereferences that don't come from source. Add test for the renaming not being within a generic body for proper determination of whether a formal access type is known to be constrained (it is within a generic spec, but not in the body). Fix an existing incorrect test for renaming of a discriminant-dependent component of a untagged generic formal type being within a generic body, adding test of taggedness and calling In_Generic_Body (now properly checks for cases where the renaming is in a nongeneric body nested within a generic). Return False in cases where the selector is not a component (or discriminant), which can occur for prefixed-notation calls. From-SVN: r266759 --- gcc/ada/ChangeLog | 27 ++++++++++++++++ gcc/ada/sem_aux.adb | 3 +- gcc/ada/sem_util.adb | 77 ++++++++++++++++++++++++++++++++++++-------- 3 files changed, 92 insertions(+), 15 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 15b5bcffc7a..b48c757b816 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2018-12-03 Gary Dismukes + + * sem_aux.adb (Object_Type_Has_Constrained_Partial_View): Return + True for an untagged discriminated formal derived type when + referenced within a generic body (augments existing test for + formal private types). + * sem_util.adb (Is_Dependent_Component_Of_Mutable_Type): If the + prefix of the name is a qualified expression, retrieve the + operand of that. Add a test of whether the (possible) + dereference prefix is a variable, and also test whether that + prefix might just be of an access type (occurs in some implicit + dereference cases) rather than being an explicit dereference. + Retrieve the Original_Node of the object name's main prefix and + handle the possibility of that being a qualified expression. + Remove special-case code for explicit dereferences that don't + come from source. Add test for the renaming not being within a + generic body for proper determination of whether a formal access + type is known to be constrained (it is within a generic spec, + but not in the body). Fix an existing incorrect test for + renaming of a discriminant-dependent component of a untagged + generic formal type being within a generic body, adding test of + taggedness and calling In_Generic_Body (now properly checks for + cases where the renaming is in a nongeneric body nested within a + generic). Return False in cases where the selector is not a + component (or discriminant), which can occur for + prefixed-notation calls. + 2018-12-03 Ed Schonberg * sem_res.adb (Apply_Check): For array types, apply a length diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index d82dced057e..80e82d2033c 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1472,7 +1472,8 @@ package body Sem_Aux is return Has_Constrained_Partial_View (Typ) or else (In_Generic_Body (Scop) and then Is_Generic_Type (Base_Type (Typ)) - and then Is_Private_Type (Base_Type (Typ)) + and then (Is_Private_Type (Base_Type (Typ)) + or else Is_Derived_Type (Base_Type (Typ))) and then not Is_Tagged_Type (Typ) and then not (Is_Array_Type (Typ) and then not Is_Constrained (Typ)) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1d34d2ae76c..cf13c246d4b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14123,6 +14123,15 @@ package body Sem_Util is Deref := Prefix (Deref); end loop; + -- If the prefix is a qualified expression of a variable, then function + -- Is_Variable will return False for that because a qualified expression + -- denotes a constant view, so we need to get the name being qualified + -- so we can test below whether that's a variable (or a dereference). + + if Nkind (Deref) = N_Qualified_Expression then + Deref := Expression (Deref); + end if; + -- Ada 2005: If we have a component or slice of a dereference, -- something like X.all.Y (2), and the type of X is access-to-constant, -- Is_Variable will return False, because it is indeed a constant @@ -14130,13 +14139,42 @@ package body Sem_Util is -- following condition to be True in that case. if Is_Variable (Object) + or else Is_Variable (Deref) or else (Ada_Version >= Ada_2005 - and then Nkind (Deref) = N_Explicit_Dereference) + and then (Nkind (Deref) = N_Explicit_Dereference + or else Is_Access_Type (Etype (Deref)))) then if Nkind (Object) = N_Selected_Component then - P := Prefix (Object); + + -- If the selector is not a component, then we definitely return + -- False (it could be a function selector in a prefix form call + -- occurring in an iterator specification). + + if not + Ekind_In + (Entity (Selector_Name (Object)), E_Component, E_Discriminant) + then + return False; + end if; + + -- Get the original node of the prefix in case it has been + -- rewritten, which can occur, for example, in qualified + -- expression cases. Also, a discriminant check on a selected + -- component may be expanded into a dereference when removing + -- side effects, and the subtype of the original node may be + -- unconstrained. + + P := Original_Node (Prefix (Object)); Prefix_Type := Etype (P); + -- If the prefix is a qualified expression, we want to look at + -- its operand. + + if Nkind (P) = N_Qualified_Expression then + P := Expression (P); + Prefix_Type := Etype (P); + end if; + if Is_Entity_Name (P) then if Ekind (Entity (P)) = E_Generic_In_Out_Parameter then Prefix_Type := Base_Type (Prefix_Type); @@ -14146,14 +14184,13 @@ package body Sem_Util is P_Aliased := True; end if; - -- A discriminant check on a selected component may be expanded - -- into a dereference when removing side effects. Recover the - -- original node and its type, which may be unconstrained. + -- For explicit dereferences we get the access prefix so we can + -- treat this similarly to implicit dereferences and examine the + -- kind of the access type and its designated subtype further + -- below. - elsif Nkind (P) = N_Explicit_Dereference - and then not (Comes_From_Source (P)) - then - P := Original_Node (P); + elsif Nkind (P) = N_Explicit_Dereference then + P := Prefix (P); Prefix_Type := Etype (P); else @@ -14186,12 +14223,23 @@ package body Sem_Util is else pragma Assert (Ada_Version >= Ada_2005); if Is_Access_Type (Prefix_Type) then + -- We need to make sure we have the base subtype, in case + -- this is actually an access subtype (whose Ekind will be + -- E_Access_Subtype). + + Prefix_Type := Etype (Prefix_Type); -- If the access type is pool-specific, and there is no -- constrained partial view of the designated type, then the - -- designated object is known to be constrained. + -- designated object is known to be constrained. If it's a + -- formal access type and the renaming is in the generic + -- spec, we also treat it as pool-specific (known to be + -- constrained), but assume the worst if in the generic body + -- (see RM 3.3(23.3/3)). if Ekind (Prefix_Type) = E_Access_Type + and then (not Is_Generic_Type (Prefix_Type) + or else not In_Generic_Body (Current_Scope)) and then not Object_Type_Has_Constrained_Partial_View (Typ => Designated_Type (Prefix_Type), Scop => Current_Scope) @@ -14212,16 +14260,17 @@ package body Sem_Util is Original_Record_Component (Entity (Selector_Name (Object))); -- As per AI-0017, the renaming is illegal in a generic body, even - -- if the subtype is indefinite. + -- if the subtype is indefinite (only applies to prefixes of an + -- untagged formal type, see RM 3.3 (23.11/3)). -- Ada 2005 (AI-363): In Ada 2005 an aliased object can be mutable if not Is_Constrained (Prefix_Type) and then (Is_Definite_Subtype (Prefix_Type) or else - (Is_Generic_Type (Prefix_Type) - and then Ekind (Current_Scope) = E_Generic_Package - and then In_Package_Body (Current_Scope))) + (not Is_Tagged_Type (Prefix_Type) + and then Is_Generic_Type (Prefix_Type) + and then In_Generic_Body (Current_Scope))) and then (Is_Declared_Within_Variant (Comp) or else Has_Discriminant_Dependent_Constraint (Comp)) -- 2.30.2