[gcc r11-5411] [Ada] Pass base type to Set_Has_Own_Invariants
Pierre-Marie de Rodat
pmderodat@gcc.gnu.org
Thu Nov 26 08:41:55 GMT 2020
https://gcc.gnu.org/g:ccd05f6c8fd4c90e6c4cd1f683991fe498aef74c
commit r11-5411-gccd05f6c8fd4c90e6c4cd1f683991fe498aef74c
Author: Bob Duff <duff@adacore.com>
Date: Thu Oct 22 17:49:07 2020 -0400
[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:
---
gcc/ada/freeze.adb | 7 -------
gcc/ada/sem_prag.adb | 2 +-
gcc/ada/sem_util.adb | 2 +-
3 files changed, 2 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 19f43852fe3..8183252e1e3 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 a54ece67a18..9c57ee31c89 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 4f2df8e1fb9..6875e470825 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
More information about the Gcc-cvs
mailing list