[Ada] Implementation of AI12-0131: legality of class-wide precondition

This patch refines the legality check on a class-wide precondition on a type
extension when ancestor does not have a class-wide precondition. Previously the
compiler accepted such a precondition when the ancestor had a class-wide
postcondition.

Compiling pck.ads must yield:

  pck.ads:7:04: illegal class-wide precondition on overriding operation

----
package Pck is
   type Parent is tagged null record;
   procedure Init (P : Parent) with Post'Class => True;

   type Child is new Parent with null record;
   overriding procedure Init (C : Child) with
   Pre'Class => True;
end Pck;

2018-05-23  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_prag.adb (Inherit_Class_Wide_Pre): Refine legality check on
	class-wide precondition on a type extension when ancestor does not have
	a class-wide precondition.  Previously the compiler accepted such a
	precondition when the ancestor had a class-wide postcondition.

From-SVN: r260592

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8874e6a..1a4e63e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-05-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_prag.adb (Inherit_Class_Wide_Pre): Refine legality check on
+       class-wide precondition on a type extension when ancestor does not have
+       a class-wide precondition.  Previously the compiler accepted such a
+       precondition when the ancestor had a class-wide postcondition.
+
 2018-05-23  Javier Miranda  <miranda@adacore.com>
 
        * sem_attr.adb (Valid_Scalars): Do not invoke Error_Attr_P to report

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index b864bb8..21ef6cb 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -4444,7 +4444,9 @@ package body Sem_Prag is
                if Present (Cont) then
                   Prag := Pre_Post_Conditions (Cont);
                   while Present (Prag) loop
-                     if Class_Present (Prag) then
+                     if Pragma_Name (Prag) = Name_Precondition
+                       and then Class_Present (Prag)
+                     then
                         return True;
                      end if;