https://gcc.gnu.org/g:537453af7c83432f5bde527f035f9dbb43921fd3
commit r16-1211-g537453af7c83432f5bde527f035f9dbb43921fd3
Author: Ronan Desplanques <desplanq...@adacore.com>
Date: Wed Feb 12 19:09:18 2025 +0100
ada: Improve large unconstrained-but-definite warning
Before this patch, Check_Discriminant_Use called Is_Limited type on
entities before they were fully analyzed. That caused Is_Limited_Type
to incorrectly return False for records that are limited because they
have a limited component.
This patch pushes back the emissions of the Check_Discriminant_Use
warning after analysis of record declarations. A new field to
E_Record_Type entity is added to take relevant discriminant uses into
account.
gcc/ada/ChangeLog:
* gen_il-fields.ads: New field.
* gen_il-gen-gen_entities.adb: New field.
* einfo.ads: Document new field.
* sem_res.adb (Check_Discriminant_Use): Record relevant uses in new
field. Move warning emission to...
* sem_ch3.adb (Analyze_Full_Type_Declaration): ... Here.
Diff:
---
gcc/ada/einfo.ads | 5 +++++
gcc/ada/gen_il-fields.ads | 1 +
gcc/ada/gen_il-gen-gen_entities.adb | 3 ++-
gcc/ada/sem_ch3.adb | 7 +++++++
gcc/ada/sem_res.adb | 16 +++-------------
5 files changed, 18 insertions(+), 14 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f154e7f0d763..1fce2f98b8f9 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2967,6 +2967,11 @@ package Einfo is
-- fully constructed, since it simply indicates the last state.
-- Thus this flag has no meaning to the backend.
+-- Is_Large_Unconstrained_Definite
+-- Defined in record types. Used to detect types with default
+-- discriminant values that have exaggerated sizes and emit warnings
+-- about them.
+
-- Is_Limited_Composite
-- Defined in all entities. Set for composite types that have a limited
-- component. Used to enforce the rule that operations on the composite
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index c293e0fa63fb..fe6d3387cfa9 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -744,6 +744,7 @@ package Gen_IL.Fields is
Is_Known_Non_Null,
Is_Known_Null,
Is_Known_Valid,
+ Is_Large_Unconstrained_Definite,
Is_Limited_Composite,
Is_Limited_Interface,
Is_Limited_Record,
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb
b/gcc/ada/gen_il-gen-gen_entities.adb
index 37ddd851d7c3..530af9085303 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -781,7 +781,8 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (No_Reordering, Flag, Impl_Base_Type_Only),
Sm (Parent_Subtype, Node_Id, Base_Type_Only),
Sm (Reverse_Bit_Order, Flag, Base_Type_Only),
- Sm (Underlying_Record_View, Node_Id)));
+ Sm (Underlying_Record_View, Node_Id),
+ Sm (Is_Large_Unconstrained_Definite, Flag, Impl_Base_Type_Only)));
Cc (E_Record_Subtype, Aggregate_Kind,
-- A record subtype, created by a record subtype declaration
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 47e7ede83e19..80359e5b68ee 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3553,6 +3553,13 @@ package body Sem_Ch3 is
end;
end if;
end if;
+
+ if Ekind (T) = E_Record_Type
+ and then Is_Large_Unconstrained_Definite (T)
+ and then not Is_Limited_Type (T)
+ then
+ Error_Msg_N ("??creation of & object may raise Storage_Error!", T);
+ end if;
end Analyze_Full_Type_Declaration;
----------------------------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 865f967a5b93..1ae72fab6629 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -757,14 +757,6 @@ package body Sem_Res is
goto No_Danger;
end if;
- -- If the enclosing type is limited, we allocate only the
- -- default value, not the maximum, and there is no need for
- -- a warning.
-
- if Is_Limited_Type (Scope (Disc)) then
- goto No_Danger;
- end if;
-
-- Check that it is the high bound
if N /= High_Bound (PN)
@@ -811,11 +803,9 @@ package body Sem_Res is
goto No_Danger;
end if;
- -- Warn about the danger
-
- Error_Msg_N
- ("??creation of & object may raise Storage_Error!",
- Scope (Disc));
+ if Ekind (Scope (Disc)) = E_Record_Type then
+ Set_Is_Large_Unconstrained_Definite (Scope (Disc));
+ end if;
<<No_Danger>>
null;
