From 7b6fbc9ff3dfc84186d067a2cb4d97d64f3b3e62 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 17 Jun 2020 04:00:47 -0400 Subject: [PATCH] [Ada] AI12-0377 View conversions and out parameters revisited gcc/ada/ * sem_res.adb (Resolve_Actuals): Refine 6.4.1 rules as per AI12-0377. --- gcc/ada/sem_res.adb | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c1c5b3e36f2..4dc19f35a86 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4175,27 +4175,34 @@ package body Sem_Res is end if; end if; - -- AI12-0074 + -- AI12-0074 & AI12-0377 -- Check 6.4.1: If the mode is out, the actual parameter is -- a view conversion, and the type of the formal parameter - -- is a scalar type that has the Default_Value aspect - -- specified, then - -- - there shall exist a type (other than a root numeric - -- type) that is an ancestor of both the target type and - -- the operand type; and - -- - the type of the operand of the conversion shall have - -- the Default_Value aspect specified. + -- is a scalar type, then either: + -- - the target and operand type both do not have the + -- Default_Value aspect specified; or + -- - the target and operand type both have the + -- Default_Value aspect specified, and there shall exist + -- a type (other than a root numeric type) that is an + -- ancestor of both the target type and the operand + -- type. elsif Ekind (F) = E_Out_Parameter and then Is_Scalar_Type (Etype (F)) - and then Present (Default_Aspect_Value (Etype (F))) - and then - (not Same_Ancestor (Etype (F), Expr_Typ) - or else No (Default_Aspect_Value (Expr_Typ))) then - Error_Msg_N - ("view conversion between unrelated types with " - & "Default_Value not allowed (RM 6.4.1)", A); + if Has_Default_Aspect (Etype (F)) /= + Has_Default_Aspect (Expr_Typ) + then + Error_Msg_N + ("view conversion requires Default_Value on both " & + "types (RM 6.4.1)", A); + elsif Has_Default_Aspect (Expr_Typ) + and then not Same_Ancestor (Etype (F), Expr_Typ) + then + Error_Msg_N + ("view conversion between unrelated types with " + & "Default_Value not allowed (RM 6.4.1)", A); + end if; end if; end; -- 2.30.2