[Ada] Predicates and the current instance of a subtype (AI12-0068)

Message ID 20200706113855.GA135527@adacore.com
State New
Headers show
Series
  • [Ada] Predicates and the current instance of a subtype (AI12-0068)
Related show

Commit Message

Pierre-Marie de Rodat July 6, 2020, 11:38 a.m.
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.

Patch

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;