When using a "for ... of" loop with an element of a record type with
defaulted discriminants, a spurious disciminant check is emitted.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_ch8.adb (Check_Constrained_Object): Suppress discriminant
checks when the type has default discriminants and comes from
expansion of a "for of" loop.diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -776,8 +776,9 @@ package body Sem_Ch8 is
------------------------------
procedure Check_Constrained_Object is
- Typ : constant Entity_Id := Etype (Nam);
- Subt : Entity_Id;
+ Typ : constant Entity_Id := Etype (Nam);
+ Subt : Entity_Id;
+ Loop_Scheme : Node_Id;
begin
if Nkind (Nam) in N_Function_Call | N_Explicit_Dereference
@@ -821,6 +822,29 @@ package body Sem_Ch8 is
Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
Set_Etype (Nam, Subt);
+ -- Suppress discriminant checks on this subtype if the original
+ -- type has defaulted discriminants and Id is a "for of" loop
+ -- iterator.
+
+ if Has_Defaulted_Discriminants (Typ)
+ and then Nkind (Original_Node (Parent (N))) = N_Loop_Statement
+ then
+ Loop_Scheme := Iteration_Scheme (Original_Node (Parent (N)));
+
+ if Present (Loop_Scheme)
+ and then Present (Iterator_Specification (Loop_Scheme))
+ and then
+ Defining_Identifier
+ (Iterator_Specification (Loop_Scheme)) = Id
+ then
+ Set_Checks_May_Be_Suppressed (Subt);
+ Push_Local_Suppress_Stack_Entry
+ (Entity => Subt,
+ Check => Discriminant_Check,
+ Suppress => True);
+ end if;
+ end if;
+
-- Freeze subtype at once, to prevent order of elaboration
-- issues in the backend. The renamed object exists, so its
-- type is already frozen in any case.
