AI12-0068 defines a reference to a current instance occurring in an
aspect_specification of a type or subtype to be a value, not an object.
This means that a Constrained attribute in such a context is always
True. It also means that attributes that take a prefix that must be an
object are illegal in that context. We determine whether we have such a
current instance reference by testing for a reference to a formal in
parameter of one of the subprograms that get created for subtype
predicates, invariants, or Default_Initial_Condition aspects, since the
current instance reference itself never gets analyzed but has been
changed into a reference to the special formal parameter by the time
Analyze_Attribute is called.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- 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
--- 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
--- 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;
