@@ -1570,26 +1570,17 @@ package body Exp_Ch4 is
(Outer_Type => Typ, Nod => Nod, Comp_Type => Component_Type (Typ),
Lhs => L, Rhs => R);
- -- If some (sub)component is an unchecked_union, the whole operation
- -- will raise program error.
+ -- This is necessary to give the warning about Program_Error being
+ -- raised when some (sub)component is an unchecked_union.
- if Nkind (Test) = N_Raise_Program_Error then
+ Preserve_Comes_From_Source (Test, Nod);
- -- This node is going to be inserted at a location where a
- -- statement is expected: clear its Etype so analysis will set
- -- it to the expected Standard_Void_Type.
-
- Set_Etype (Test, Empty);
- return Test;
-
- else
- return
- Make_Implicit_If_Statement (Nod,
- Condition => Make_Op_Not (Loc, Right_Opnd => Test),
- Then_Statements => New_List (
- Make_Simple_Return_Statement (Loc,
- Expression => New_Occurrence_Of (Standard_False, Loc))));
- end if;
+ return
+ Make_Implicit_If_Statement (Nod,
+ Condition => Make_Op_Not (Loc, Right_Opnd => Test),
+ Then_Statements => New_List (
+ Make_Simple_Return_Statement (Loc,
+ Expression => New_Occurrence_Of (Standard_False, Loc))));
end Component_Equality;
------------------
@@ -12119,11 +12119,14 @@ package body Sem_Util is
and then Is_Constrained (Etype (Subtype_Mark (N)));
-- For all other names, it is sufficient to have a constrained
- -- Unchecked_Union nominal subtype.
+ -- Unchecked_Union nominal subtype, unless it is incomplete or
+ -- private because it cannot have a known discriminant part in
+ -- this case (RM B.3.3 (11/2)).
else
return Is_Unchecked_Union (Etype (N))
- and then Is_Constrained (Etype (N));
+ and then Is_Constrained (Etype (N))
+ and then not Is_Incomplete_Or_Private_Type (Etype (N));
end if;
end Has_Inferable_Discriminants;
From: Eric Botcazou <ebotcazou@adacore.com> The code is legal and, therefore, must be accepted by the compiler, but it must raise Program_Error at run time due to operands not having inferable discriminants and a warning be given at compile time (RM B.3.3(22-23)). gcc/ada/ * exp_ch4.adb (Expand_Array_Equality.Component_Equality): Copy the Comes_From_Source flag from the original test to the new one, and remove obsolete code dealing with unchecked unions. * sem_util.adb (Has_Inferable_Discriminants): Return False for an incomplete or private nominal subtype. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch4.adb | 27 +++++++++------------------ gcc/ada/sem_util.adb | 7 +++++-- 2 files changed, 14 insertions(+), 20 deletions(-)