From 977b168196992b3f15d167c2f7d05cec38ac0302 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Tue, 5 May 2020 21:10:25 -0400 Subject: [PATCH] [Ada] Predicates and the current instance of a subtype (AI12-0068) gcc/ada/ * sem_attr.adb (Analyze_Attribute, Attribute_Constrained): Issue a warning if the attribute prefix is a current instance reference within an aspect of a type or subtype. (Address_Checks): Replace test of Is_Object (Ent) with Is_Object_Reference (P) so that testing for current instances will be done. (Eval_Attribute): Add test for current instance reference, to ensure that we still fold array attributes when current instances are involved, since value prefixes are allowed for array attributes, and will now be excluded by Is_Object_Reference. * sem_util.ads (Is_Current_Instance_Reference_In_Type_Aspect): New exported query function. * sem_util.adb (Is_Object_Reference): Return False for the case where N is a current instance reference within an aspect_specification of a type or subtype (basically if the reference occurs within a predicate, invariant, or DIC aspect expression). (Is_Current_Instance_Reference_In_Type_Aspect): New function that tests whether a node is a reference to a current instance formal of a predicate, invariant, or Default_Initial_Condition (DIC) subprogram. --- gcc/ada/sem_attr.adb | 38 ++++++++++++++++++++-------- gcc/ada/sem_util.adb | 60 +++++++++++++++++++++++++++++++++++++++++++- gcc/ada/sem_util.ads | 7 ++++++ 3 files changed, 94 insertions(+), 11 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index df2475f5e59..d012418c8a3 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -525,7 +525,7 @@ package body Sem_Attr is -- Object or label reference - elsif Is_Object (Ent) or else Ekind (Ent) = E_Label then + elsif Is_Object_Reference (P) or else Ekind (Ent) = E_Label then Set_Address_Taken (Ent); -- Deal with No_Implicit_Aliasing restriction @@ -3486,11 +3486,25 @@ package body Sem_Attr is return; end if; - -- Normal (non-obsolescent case) of application to object of + -- Normal (non-obsolescent case) of application to object or value of -- a discriminated type. else - Check_Object_Reference (P); + -- AI12-0068: In a type or subtype aspect, a prefix denoting the + -- current instance of the (sub)type is defined to be a value, + -- not an object, so the Constrained attribute is always True + -- (see RM 8.6(18/5) and RM 3.7.2(3/5)). We issue a warning about + -- this unintuitive result, to help avoid confusion. + + if Is_Current_Instance_Reference_In_Type_Aspect (P) then + Error_Msg_Name_1 := Aname; + Error_Msg_N + ("current instance attribute % in subtype aspect always " & + "true??", N); + + else + Check_Object_Reference (P); + end if; -- If N does not come from source, then we allow the -- the attribute prefix to be of a private type whose @@ -4169,11 +4183,13 @@ package body Sem_Attr is if Comes_From_Source (N) then - -- A similar attribute Valid_Scalars can be prefixed with - -- references to both functions and objects, but this attribute - -- can be only prefixed with references to objects. + -- This attribute be prefixed with references to objects or + -- values (such as a current instance value given within a type + -- or subtype aspect). - if not Is_Object_Reference (P) then + if not Is_Object_Reference (P) + and then not Is_Current_Instance_Reference_In_Type_Aspect (P) + then Error_Attr_P ("prefix of % attribute must be object"); end if; end if; @@ -7745,11 +7761,13 @@ package body Sem_Attr is return; end if; - -- Special processing for cases where the prefix is an object. For this - -- purpose, a string literal counts as an object (attributes of string - -- literals can only appear in generated code). + -- Special processing for cases where the prefix is an object or value, + -- including string literals (attributes of string literals can only + -- appear in generated code) and current instance prefixes in type or + -- subtype aspects. if Is_Object_Reference (P) + or else Is_Current_Instance_Reference_In_Type_Aspect (P) or else Nkind (P) = N_String_Literal or else (Is_Entity_Name (P) and then Ekind (Entity (P)) = E_Enumeration_Literal) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 40f34fd7b8a..7ce78a2451c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15029,6 +15029,59 @@ package body Sem_Util is return False; end Is_Current_Instance; + -------------------------------------------------- + -- Is_Current_Instance_Reference_In_Type_Aspect -- + -------------------------------------------------- + + function Is_Current_Instance_Reference_In_Type_Aspect + (N : Node_Id) return Boolean + is + begin + -- When a current_instance is referenced within an aspect_specification + -- of a type or subtype, it will show up as a reference to the formal + -- parameter of the aspect's associated subprogram rather than as a + -- reference to the type or subtype itself (in fact, the original name + -- is never even analyzed). We check for predicate, invariant, and + -- Default_Initial_Condition subprograms (in theory there could be + -- other cases added, in which case this function will need updating). + + if Is_Entity_Name (N) then + return Present (Entity (N)) + and then Ekind (Entity (N)) = E_In_Parameter + and then Ekind_In (Scope (Entity (N)), E_Function, E_Procedure) + and then + (Is_Predicate_Function (Scope (Entity (N))) + or else Is_Predicate_Function_M (Scope (Entity (N))) + or else Is_Invariant_Procedure (Scope (Entity (N))) + or else Is_Partial_Invariant_Procedure (Scope (Entity (N))) + or else Is_DIC_Procedure (Scope (Entity (N)))); + + else + case Nkind (N) is + when N_Indexed_Component + | N_Slice + => + return + Is_Current_Instance_Reference_In_Type_Aspect (Prefix (N)); + + when N_Selected_Component => + return + Is_Current_Instance_Reference_In_Type_Aspect (Prefix (N)); + + when N_Type_Conversion => + return Is_Current_Instance_Reference_In_Type_Aspect + (Expression (N)); + + when N_Qualified_Expression => + return Is_Current_Instance_Reference_In_Type_Aspect + (Expression (N)); + + when others => + return False; + end case; + end if; + end Is_Current_Instance_Reference_In_Type_Aspect; + -------------------- -- Is_Declaration -- -------------------- @@ -16983,8 +17036,13 @@ package body Sem_Util is function Is_Object_Reference (N : Node_Id) return Boolean is begin + -- AI12-0068: Note that a current instance reference in a type or + -- subtype's aspect_specification is considered a value, not an object + -- (see RM 8.6(18/5)). + if Is_Entity_Name (N) then - return Present (Entity (N)) and then Is_Object (Entity (N)); + return Present (Entity (N)) and then Is_Object (Entity (N)) + and then not Is_Current_Instance_Reference_In_Type_Aspect (N); else case Nkind (N) is diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index d99edeaa902..df7e62c923c 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1693,6 +1693,13 @@ package Sem_Util is -- declarations. In Ada 2012 it also covers type and subtype declarations -- with aspects: Invariant, Predicate, and Default_Initial_Condition. + function Is_Current_Instance_Reference_In_Type_Aspect + (N : Node_Id) return Boolean; + -- True if N is a reference to a current instance object that occurs within + -- an aspect_specification for a type or subtype. In this case N will be + -- a formal parameter of a subprogram created for a predicate, invariant, + -- or Default_Initial_Condition aspect. + function Is_Declaration (N : Node_Id; Body_OK : Boolean := True; -- 2.30.2