From: Bob Duff <duff@adacore.com>
Date: Thu, 22 Oct 2020 21:49:07 +0000 (-0400)
Subject: [Ada] Pass base type to Set_Has_Own_Invariants
X-Git-Tag: basepoints/gcc-12~2846
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ccd05f6c8fd4c90e6c4cd1f683991fe498aef74c;p=thirdparty%2Fgcc.git

[Ada] Pass base type to Set_Has_Own_Invariants

gcc/ada/

	* freeze.adb (Freeze_Array_Type): Remove propagation of
	Has_Own_Invariants to the first subtype. This is a no-op,
	because the current (incorrect) version of Has_Own_Invariants
	calls Base_Type.
	* sem_prag.adb, sem_util.adb: Pass the base type to
	Set_Has_Own_Invariants.
---

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 19f43852fe39..8183252e1e30 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2594,13 +2594,6 @@ package body Freeze is
               and then not GNATprove_Mode
             then
                Set_Has_Own_Invariants (Arr);
-
-               --  The array type is an implementation base type. Propagate the
-               --  same property to the first subtype.
-
-               if Is_Itype (Arr) then
-                  Set_Has_Own_Invariants (First_Subtype (Arr));
-               end if;
             end if;
 
             --  Warn for pragma Pack overriding foreign convention
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a54ece67a186..9c57ee31c89c 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -18533,7 +18533,7 @@ package body Sem_Prag is
             --  The pragma defines a type-specific invariant, the type is said
             --  to have invariants of its "own".
 
-            Set_Has_Own_Invariants (Typ);
+            Set_Has_Own_Invariants (Base_Type (Typ));
 
             --  If the invariant is class-wide, then it can be inherited by
             --  derived or interface implementing types. The type is said to
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4f2df8e1fb9f..6875e470825c 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -26262,7 +26262,7 @@ package body Sem_Util is
          end if;
 
          if Has_Own_Invariants (From_Typ) then
-            Set_Has_Own_Invariants (Typ);
+            Set_Has_Own_Invariants (Base_Type (Typ));
          end if;
 
          if Present (Full_IP) and then No (Invariant_Procedure (Typ)) then