diff options
| author | Arnaud Charlet <charlet@adacore.com> | 2020-06-17 04:00:47 -0400 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-07-27 04:05:19 -0400 |
| commit | 7b6fbc9ff3dfc84186d067a2cb4d97d64f3b3e62 (patch) | |
| tree | fad2d5a8b285b41517befb9add8c12f35c4cab30 /gcc | |
| parent | 2d4fe2035920a2440ca2d787cefc6eca03a4af40 (diff) | |
| download | gcc-7b6fbc9ff3dfc84186d067a2cb4d97d64f3b3e62.zip gcc-7b6fbc9ff3dfc84186d067a2cb4d97d64f3b3e62.tar.gz gcc-7b6fbc9ff3dfc84186d067a2cb4d97d64f3b3e62.tar.bz2 | |
[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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/sem_res.adb | 37 |
1 files changed, 22 insertions, 15 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c1c5b3e..4dc19f3 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; |