aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2024-10-24 19:20:30 +0200
committerMarc Poulhiès <dkm@gcc.gnu.org>2024-11-12 14:00:50 +0100
commit3b78393b39a848dadfe6f7b703cda01b9870b6bd (patch)
tree3ac9ff161c781e83c630118a18384c63c1c7aae3 /gcc/ada
parenta45219815d17b050abc25a6348bfe7c981399363 (diff)
downloadgcc-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.adb13
-rw-r--r--gcc/ada/einfo.ads8
-rw-r--r--gcc/ada/gen_il-fields.ads1
-rw-r--r--gcc/ada/gen_il-gen-gen_entities.adb1
-rw-r--r--gcc/ada/sem_ch3.adb17
-rw-r--r--gcc/ada/sem_util.adb6
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