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 --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f154e7f0d763a1d201dc48a12f00abf08ff8b080..1fce2f98b8f9fd6bed484a0582bb7ee2064f17d7 100644 (file)
--- 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 c293e0fa63fbe3b1739b5620fe875ce0cba14462..fe6d3387cfa955e06fe61ff37557aba4e2f246e6 100644 (file)
--- 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 37ddd851d7c3fd74ea397b4b51b3ccc5146377eb..530af90853038cfa2aadd49e19eb3a8d46543d6e 100644 (file)
--- 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 47e7ede83e19465d1a795c22717c508c2155e147..80359e5b68ee396f27b9d30b4bfb44d60126d4c8 100644 (file)
--- 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 865f967a5b93aa1f13ca174ba52d231bf0b79b12..1ae72fab662923a1eda5dac03d897e311d3dd065 100644 (file)
--- 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;