ada: Get rid of Kill_Range_Checks flag on entities

This flag is set in a single context, namely semantic analysis of record
type definitions, to avoid generating spurious range checks from it, and
a large testing campaign showed that, in practice, it makes a difference
in a single case, namely an access-to-constrained-array component with a
default expression, for example:

  type Acc_String is access all String (1 .. 100);

  type Rec (D : Positive) is record
    A : Acc_String := new String (1 .. D);
  end record;

Now there is another mechanism implemented in Process_Range_Expr_In_Decl to
avoid generating spurious range checks, which does not work in this specific
case but can be made to work with a small tweak to Denotes_Discriminant.

gcc/ada/ChangeLog:

	* checks.adb (Range_Checks_Suppressed): Remove test on the
	Kill_Range_Checks flag.
	* einfo.ads (Kill_Range_Checks): Delete.
	* gen_il-fields.ads (Opt_Field_Enum): Remove Kill_Range_Checks.
	* gen_il-gen-gen_entities.adb (Entity_Kind): Likewise.
	* sem_ch3.adb (Record_Type_Declaration): Do not set the
	Kill_Range_Checks flag.
	* sem_util.adb (Denotes_Discriminant): In a default expression,
	also return True for a discriminal.

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index bc078766117ba33740566801eabb1b5b62917ac8..06e7997cb3f820225d325a885e34cecfcc2c2240 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -9615,16 +9615,11 @@ package body Checks is
 
    function Range_Checks_Suppressed (E : Entity_Id) return Boolean is
    begin
-      if Present (E) then
-         if Kill_Range_Checks (E) then
-            return True;
-
-         elsif Checks_May_Be_Suppressed (E) then
-            return Is_Check_Suppressed (E, Range_Check);
-         end if;
+      if Present (E) and then Checks_May_Be_Suppressed (E) then
+         return Is_Check_Suppressed (E, Range_Check);
+      else
+         return Scope_Suppress.Suppress (Range_Check);
       end if;
-
-      return Scope_Suppress.Suppress (Range_Check);
    end Range_Checks_Suppressed;
 
    -----------------------------------------

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f0ae45ccb597e5a742fa852f2942a0dca235f9ad..8255ae9568334a0b5bab6ca41ad15c545274730e 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3510,13 +3510,6 @@ package Einfo is
 --       except that the effect is permanent and cannot be undone by a
 --       subsequent pragma Unsuppress.
 
---    Kill_Range_Checks
---       Defined in all entities. Equivalent in effect to the use of pragma
---       Suppress (Range_Checks) for that entity except that the result is
---       permanent and cannot be undone by a subsequent pragma Unsuppress.
---       This is currently only used in one odd situation in Sem_Ch3 for
---       record types, and it would be good to get rid of it???
-
 --    Known_To_Have_Preelab_Init
 --       Defined in all type and subtype entities. If set, then the type is
 --       known to have preelaborable initialization. In the case of a partial
@@ -4973,7 +4966,6 @@ package Einfo is
    --    Is_Unimplemented
    --    Is_Visible_Formal
    --    Kill_Elaboration_Checks
-   --    Kill_Range_Checks
    --    Low_Bound_Tested
    --    Materialize_Entity
    --    Needs_Debug_Info

diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 29f18a3586cf2c6fb7f32d696441c16ce4636165..34ae14260aecb19ff56ffe04de6aade765dff0ce 100644 (file)
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -801,7 +801,6 @@ package Gen_IL.Fields is
       Is_Wrapper,
       Itype_Printed,
       Kill_Elaboration_Checks,
-      Kill_Range_Checks,
       Known_To_Have_Preelab_Init,
       Last_Aggregate_Assignment,
       Last_Assignment,

diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index 4d2444ea3472de36effcc0233cbf1aab6c629d45..f887e0c3c9915e6e070799fe3f49cc4e04779593 100644 (file)
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -209,7 +209,6 @@ begin -- Gen_IL.Gen.Gen_Entities
         Sm (Is_Volatile_Full_Access, Flag),
         Sm (Is_Wrapper, Flag),
         Sm (Kill_Elaboration_Checks, Flag),
-        Sm (Kill_Range_Checks, Flag),
         Sm (Low_Bound_Tested, Flag),
         Sm (Materialize_Entity, Flag),
         Sm (May_Inherit_Delayed_Rep_Aspects, Flag),

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 28fc25d0d0ed1eee1c8c919d7db4ac3cf410012e..aa950692473f31e9dccfdbcf0b36330c16caef4b 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -23079,22 +23079,7 @@ package body Sem_Ch3 is
          Set_Direct_Primitive_Operations (T, New_Elmt_List);
       end if;
 
-      --  We must suppress range checks when processing record components in
-      --  the presence of discriminants, since we don't want spurious checks to
-      --  be generated during their analysis, but Suppress_Range_Checks flags
-      --  must be reset the after processing the record definition.
-
-      --  Note: this is the only use of Kill_Range_Checks, and is a bit odd,
-      --  couldn't we just use the normal range check suppression method here.
-      --  That would seem cleaner ???
-
-      if Has_Discriminants (T) and then not Range_Checks_Suppressed (T) then
-         Set_Kill_Range_Checks (T, True);
-         Record_Type_Definition (Def, Prev);
-         Set_Kill_Range_Checks (T, False);
-      else
-         Record_Type_Definition (Def, Prev);
-      end if;
+      Record_Type_Definition (Def, Prev);
 
       --  Exit from record scope
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 794bdedc49013935bb85f4c70fe980dbc2e7947d..25f164f8736b997f358c61bc644cb69d4c645f93 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6698,12 +6698,18 @@ package body Sem_Util is
          E := Entity (N);
       end if;
 
+      --  If we are checking in a default expression, the discriminant has been
+      --  rewritten as the corresponding discriminal.
+
       --  If we are checking for a protected type, the discriminant may have
       --  been rewritten as the corresponding discriminal of the original type
       --  or of the corresponding concurrent record, depending on whether we
       --  are in the spec or body of the protected type.
 
       return Ekind (E) = E_Discriminant
+        or else (In_Default_Expr
+                  and then Ekind (E) = E_In_Parameter
+                  and then Present (Discriminal_Link (E)))
         or else
           (Check_Concurrent
             and then Ekind (E) = E_In_Parameter