[gcc r16-1211] ada: Improve large unconstrained-but-definite warning

[Marc Poulhies]

https://gcc.gnu.org/g:537453af7c83432f5bde527f035f9dbb43921fd3

commit r16-1211-g537453af7c83432f5bde527f035f9dbb43921fd3
Author: Ronan Desplanques <desplanques@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;