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

[Ada] ACATS 4.1J - B854003 - Subtype conformance check missed

Browse Source 
2020-06-18  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* sem_ch6.ads, sem_ch6.adb (Check_Formal_Conformance): New
	subprogram.
	(Check_Conformance): Move code to Check_Formal_Conformance.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Check for formal
	conformance when needed.
This commit is contained in:
Arnaud Charlet 2020-04-23 14:46:27 -04:00 committed by Pierre-Marie de Rodat
parent 6c8e4f7e38
commit 424ce99fb5
3 changed files with 46 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
gcc/ada/sem_ch6.adb
View File

@ -5734,16 +5734,8 @@ package body Sem_Ch6 is
end if;
return;
elsif Is_Formal_Subprogram (Old_Id)
or else Is_Formal_Subprogram (New_Id)
or else (Is_Subprogram (New_Id)
and then Present (Alias (New_Id))
and then Is_Formal_Subprogram (Alias (New_Id)))
then
Conformance_Error
("\formal subprograms are not subtype conformant "
& "(RM 6.3.1 (17/3))");
else
Check_Formal_Subprogram_Conformance (New_Id, Old_Id, Err_Loc);
end if;
end if;
@ -6516,6 +6508,37 @@ package body Sem_Ch6 is
end if;
end Check_Discriminant_Conformance;
-----------------------------------------
-- Check_Formal_Subprogram_Conformance --
-----------------------------------------
procedure Check_Formal_Subprogram_Conformance
(New_Id : Entity_Id;
Old_Id : Entity_Id;
Err_Loc : Node_Id := Empty)
is
N : Node_Id;
begin
if Is_Formal_Subprogram (Old_Id)
or else Is_Formal_Subprogram (New_Id)
or else (Is_Subprogram (New_Id)
and then Present (Alias (New_Id))
and then Is_Formal_Subprogram (Alias (New_Id)))
then
if Present (Err_Loc) then
N := Err_Loc;
else
N := New_Id;
end if;
Error_Msg_Sloc := Sloc (Old_Id);
Error_Msg_N ("not subtype conformant with declaration#!", N);
Error_Msg_NE
("\formal subprograms are not subtype conformant "
& "(RM 6.3.1 (17/3))", N, New_Id);
end if;
end Check_Formal_Subprogram_Conformance;
----------------------------
-- Check_Fully_Conformant --
----------------------------

10
gcc/ada/sem_ch6.ads
View File

@ -69,6 +69,16 @@ package Sem_Ch6 is
-- the source location of the partial view, which may be different than
-- Prev in the case of private types.
procedure Check_Formal_Subprogram_Conformance
(New_Id : Entity_Id;
Old_Id : Entity_Id;
Err_Loc : Node_Id := Empty);
-- Check RM 6.3.1(17/3): the profile of a generic formal subprogram is not
-- subtype conformant with any other profile and post an error message if
-- either New_Id or Old_Id denotes a formal subprogram, with the flag being
-- placed on the Err_Loc node if it is specified, and on New_Id if not. See
-- also spec of Check_Fully_Conformant below for New_Id and Old_Id usage.
procedure Check_Fully_Conformant
(New_Id : Entity_Id;
Old_Id : Entity_Id;

4
gcc/ada/sem_ch8.adb
View File

@ -3171,7 +3171,7 @@ package body Sem_Ch8 is
Set_Kill_Elaboration_Checks (New_S, True);
-- If we had a previous error, indicate a completely is present to stop
-- If we had a previous error, indicate a completion is present to stop
-- junk cascaded messages, but don't take any further action.
if Etype (Nam) = Any_Type then
@ -3409,6 +3409,8 @@ package body Sem_Ch8 is
if Original_Subprogram (Old_S) = Rename_Spec then
Error_Msg_N ("unfrozen subprogram cannot rename itself ", N);
else
Check_Formal_Subprogram_Conformance (New_S, Old_S, Spec);
end if;
else
Check_Subtype_Conformant (New_S, Old_S, Spec);