diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2024-10-24 19:20:30 +0200 |
---|---|---|
committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-11-12 14:00:50 +0100 |
commit | 3b78393b39a848dadfe6f7b703cda01b9870b6bd (patch) | |
tree | 3ac9ff161c781e83c630118a18384c63c1c7aae3 /gcc/ada | |
parent | a45219815d17b050abc25a6348bfe7c981399363 (diff) | |
download | gcc-3b78393b39a848dadfe6f7b703cda01b9870b6bd.zip gcc-3b78393b39a848dadfe6f7b703cda01b9870b6bd.tar.gz gcc-3b78393b39a848dadfe6f7b703cda01b9870b6bd.tar.bz2 |
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.
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/checks.adb | 13 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 8 | ||||
-rw-r--r-- | gcc/ada/gen_il-fields.ads | 1 | ||||
-rw-r--r-- | gcc/ada/gen_il-gen-gen_entities.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 17 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 6 |
6 files changed, 11 insertions, 35 deletions
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index bc07876..06e7997 100644 --- 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 f0ae45c..8255ae9 100644 --- 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 29f18a3..34ae142 100644 --- 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 4d2444e..f887e0c 100644 --- 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 28fc25d..aa95069 100644 --- 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 794bded..25f164f 100644 --- 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 |