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.
This commit is contained in:
Eric Botcazou 2024-10-24 19:20:30 +02:00 committed by Marc Poulhiès
parent a45219815d
commit 3b78393b39
6 changed files with 11 additions and 35 deletions

View File

@ -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;
-----------------------------------------

View File

@ -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

View File

@ -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,

View File

@ -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),

View File

@ -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

View File

@ -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