From: Eric Botcazou <ebotca...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/checks.adb | 13 ++++---------
gcc/ada/einfo.ads | 8 --------
gcc/ada/gen_il-fields.ads | 1 -
gcc/ada/gen_il-gen-gen_entities.adb | 1 -
gcc/ada/sem_ch3.adb | 17 +----------------
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 bc078766117..06e7997cb3f 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 f0ae45ccb59..8255ae95683 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 29f18a3586c..34ae14260ae 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 4d2444ea347..f887e0c3c99 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 28fc25d0d0e..aa950692473 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 794bdedc490..25f164f8736 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
--
2.43.0
