[Ada] Implement new legality checks specified by AI12-0412

gcc/ada/

	* freeze.adb (Check_Inherited_Conditions): Setting of Ekind,
	LSP_Subprogram, and Is_Wrapper needs to happen for null
	procedures as well as other wrapper cases, so the code is moved
	from the else part in front of the if statement.  (Fixes a
	latent bug encountered while working on this set of changes.)
	* sem_attr.adb (Resolve_Attribute): Report an error for the case
	of an Access attribute applied to a primitive of an abstract
	type when the primitive has any nonstatic Pre'Class or
	Post'Class expressions.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Report an error for
	the case of a actual subprogram associated with a nonabstract
	formal subprogram when the actual is a primitive of an abstract
	type and the primitive has any nonstatic Pre'Class or Post'Class
	expressions.
	* sem_disp.adb (Check_Dispatching_Context): Remove special
	testing for null procedures, and replace it with a relaxed test
	that avoids getting an error about illegal calls to abstract
	subprograms in cases where RM 6.1.1(7/5) applies in
	Pre/Post'Class aspects. Also, remove special test for
	Postcondition, which seems to be unnecessary, update associated
	comments, and fix a typo in one comment.
	(Check_Dispatching_Call): Remove an unneeded return statement,
	and report an error for the case of a nondispatching call to a
	nonabstract subprogram of an abstract type where the subprogram
	has nonstatic Pre/Post'Class aspects.
	* sem_util.ads
	(Is_Prim_Of_Abst_Type_With_Nonstatic_CW_Pre_Post): New function.
	(In_Pre_Post_Condition): Add a flag formal Class_Wide_Only,
	defaulted to False, for indicating whether the function should
	only test for the node being within class-wide pre- and
	postconditions.
	* sem_util.adb
	(Is_Prim_Of_Abst_Type_With_Nonstatic_CW_Pre_Post): New function
	to determine whether a subprogram is a primitive of an abstract
	type where the primitive has class-wide Pre/Post'Class aspects
	specified with nonstatic expressions.
	(In_Pre_Post_Condition): Extend testing to account for the new
	formal Class_Wide_Only.

1 files changed, 43 insertions, 24 deletions

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 06c4b07..064e2b5 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -612,29 +612,32 @@ package body Sem_Disp is
                Set_Entity (Name (N), Alias (Subp));
                return;
 
-            --  An obscure special case: a null procedure may have a class-
-            --  wide pre/postcondition that includes a call to an abstract
-            --  subp. Calls within the expression may not have been rewritten
-            --  as dispatching calls yet, because the null body appears in
-            --  the current declarative part. The expression will be properly
-            --  rewritten/reanalyzed when the postcondition procedure is built.
-
-            --  Similarly, if this is a pre/postcondition for an abstract
-            --  subprogram, it may call another abstract function which is
-            --  a primitive of an abstract type. The call is non-dispatching
-            --  but will be legal in overridings of the operation. However,
-            --  if the call is tag-indeterminate we want to continue with
-            --  with the error checking below, as this case is illegal even
-            --  for abstract subprograms (see AI12-0170).
-
-            elsif (Is_Subprogram (Scop)
-                    or else Chars (Scop) = Name_Postcondition)
+            --  If this is a pre/postcondition for an abstract subprogram,
+            --  it may call another abstract function that is a primitive
+            --  of an abstract type. The call is nondispatching but will be
+            --  legal in overridings of the operation. However, if the call
+            --  is tag-indeterminate we want to continue with with the error
+            --  checking below, as this case is illegal even for abstract
+            --  subprograms (see AI12-0170).
+
+            --  Similarly, as per AI12-0412, a nonabstract subprogram may
+            --  have a class-wide pre/postcondition that includes a call to
+            --  an abstract primitive of the subprogram's controlling type.
+            --  Certain operations (nondispatching calls, 'Access, use as
+            --  a generic actual) applied to such a nonabstract subprogram
+            --  are illegal in the case where the type is abstract (see
+            --  RM 6.1.1(18.2/5)).
+
+            elsif Is_Subprogram (Scop)
+              and then not Is_Tag_Indeterminate (N)
+              and then In_Pre_Post_Condition (Call, Class_Wide_Only => True)
+
+              --  The tagged type associated with the called subprogram must be
+              --  the same as that of the subprogram with a class-wide aspect.
+
+              and then Is_Dispatching_Operation (Scop)
               and then
-                ((Is_Abstract_Subprogram (Scop)
-                   and then not Is_Tag_Indeterminate (N))
-                  or else
-                    (Nkind (Parent (Scop)) = N_Procedure_Specification
-                      and then Null_Present (Parent (Scop))))
+                Find_Dispatching_Type (Subp) = Find_Dispatching_Type (Scop)
             then
                null;
 
@@ -663,7 +666,7 @@ package body Sem_Disp is
                --  provides a tag to make the call dispatching. This requires
                --  the call to be the actual in an enclosing call, and that
                --  actual must be controlling. If the call is an operand of
-               --  equality, the other operand must not ve abstract.
+               --  equality, the other operand must not be abstract.
 
                if not Is_Tagged_Type (Typ)
                  and then not
@@ -970,7 +973,6 @@ package body Sem_Disp is
             end loop;
 
             Check_Dispatching_Context (N);
-            return;
 
          elsif Nkind (Parent (N)) in N_Subexpr then
             Check_Dispatching_Context (N);
@@ -985,6 +987,23 @@ package body Sem_Disp is
             return;
          end if;
 
+         --  If this is a nondispatching call to a nonabstract subprogram
+         --  and the subprogram has any Pre'Class or Post'Class aspects with
+         --  nonstatic values, then report an error. This is specified by
+         --  RM 6.1.1(18.2/5) (by AI12-0412).
+
+         if No (Control)
+           and then not Is_Abstract_Subprogram (Subp_Entity)
+           and then
+             Is_Prim_Of_Abst_Type_With_Nonstatic_CW_Pre_Post (Subp_Entity)
+         then
+            Error_Msg_N
+              ("nondispatching call to nonabstract subprogram of "
+                & "abstract type with nonstatic class-wide "
+                & "pre/postconditions",
+               N);
+         end if;
+
       else
          --  If dispatching on result, the enclosing call, if any, will
          --  determine the controlling argument. Otherwise this is the