OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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.
This commit is contained in:
Arnaud Charlet 2020-06-17 04:00:47 -04:00 committed by Pierre-Marie de Rodat
parent 2d4fe20359
commit 7b6fbc9ff3
1 changed files with 22 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
gcc/ada/sem_res.adb
View File

@ -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;