[Ada] Error when passing subprogram'Access to null-defaulted formal subprogram

gcc/ada/

	* freeze.adb (Freeze_Subprogram): Don't propagate conventions
	Intrinsic or Entry to anonymous access-to-subprogram types
	associated with subprograms having those conventions. Update
	related comment.
	* sem_attr.adb (Resolve_Attribute, Attribute_*Access): Remove
	special-case warning code for cases where a called subprogram
	has convention Intrinsic as well as its formal's type (the
	expected type for the Access attribute), since this case can no
	longer occur.
This commit is contained in:
Gary Dismukes 2021-02-09 20:18:47 -05:00 committed by Pierre-Marie de Rodat
parent d675f35287
commit 3d4fbcb4c9
2 changed files with 9 additions and 30 deletions

View File

@ -9428,15 +9428,18 @@ package body Freeze is
end if;
-- Ensure that all anonymous access-to-subprogram types inherit the
-- convention of their related subprogram (RM 6.3.1 13.1/3). This is
-- convention of their related subprogram (RM 6.3.1(13.1/5)). This is
-- not done for a defaulted convention Ada because those types also
-- default to Ada. Convention Protected must not be propagated when
-- the subprogram is an entry because this would be illegal. The only
-- way to force convention Protected on these kinds of types is to
-- include keyword "protected" in the access definition.
-- include keyword "protected" in the access definition. Conventions
-- Entry and Intrinsic are also not propagated (specified by AI12-0207).
if Convention (E) /= Convention_Ada
and then Convention (E) /= Convention_Protected
and then Convention (E) /= Convention_Entry
and then Convention (E) /= Convention_Intrinsic
then
Set_Profile_Convention (E);
end if;

View File

@ -10887,34 +10887,10 @@ package body Sem_Attr is
if Convention (Designated_Type (Btyp)) /=
Convention (Entity (P))
then
-- The rule in 6.3.1 (8) deserves a special error
-- message.
if Convention (Btyp) = Convention_Intrinsic
and then Nkind (Parent (N)) = N_Procedure_Call_Statement
and then Is_Entity_Name (Name (Parent (N)))
and then Inside_A_Generic
then
declare
Subp : constant Entity_Id :=
Entity (Name (Parent (N)));
begin
if Convention (Subp) = Convention_Intrinsic then
Error_Msg_FE
("?subprogram and its formal access "
& "parameters have convention Intrinsic",
Parent (N), Subp);
Error_Msg_N
("actual cannot be access attribute", N);
end if;
end;
else
Error_Msg_FE
("subprogram & has wrong convention", P, Entity (P));
Error_Msg_Sloc := Sloc (Btyp);
Error_Msg_FE ("\does not match & declared#", P, Btyp);
end if;
Error_Msg_FE
("subprogram & has wrong convention", P, Entity (P));
Error_Msg_Sloc := Sloc (Btyp);
Error_Msg_FE ("\does not match & declared#", P, Btyp);
if not Is_Itype (Btyp)
and then not Has_Convention_Pragma (Btyp)