From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 28 Oct 2024 10:58:55 +0000 (+0100)
Subject: ada: Fix assertion failure on illegal use of aspect Type_Invariant
X-Git-Tag: basepoints/gcc-16~4399
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0362d7aa8fcdb63505a6b37a36fc7cc5845ba80c;p=thirdparty%2Fgcc.git

ada: Fix assertion failure on illegal use of aspect Type_Invariant

The illegal use is on a type derived from a formal private type, e.g.:

generic

  type T is private;

package G is

  type D is new T with Type_Invariant => True;

end G;

gcc/ada/ChangeLog:

	PR ada/113037
	* sem_prag.adb (Analyze_Pragma) <Pragma_Invariant>: Reject types
	that are derived from formal private types.
---

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f4ae89fd2e7a..ef9039652321 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -19773,18 +19773,26 @@ package body Sem_Prag is
 
             --  An invariant must apply to a private type, or appear in the
             --  private part of a package spec and apply to a completion.
-            --  a class-wide invariant can only appear on a private declaration
+            --  A class-wide invariant can only appear on a private declaration
             --  or private extension, not a completion.
 
-            --  A [class-wide] invariant may be associated a [limited] private
-            --  type or a private extension.
+            --  A [class-wide] invariant may be associated with a [limited]
+            --  private type. We need to explicitly exclude types that are
+            --  derived from formal private types here.
 
             elsif Ekind (Typ) in E_Limited_Private_Type
                                | E_Private_Type
-                               | E_Record_Type_With_Private
+              and then not (Is_Derived_Type (Typ)
+                             and then Is_Generic_Type (Etype (Typ)))
             then
                null;
 
+            --  A [class-wide] invariant may be associated with a private
+            --  extension.
+
+            elsif Ekind (Typ) = E_Record_Type_With_Private then
+               null;
+
             --  A non-class-wide invariant may be associated with the full view
             --  of a [limited] private type or a private extension.