This test shows that GNAT was missing formal subprogram conformance
checking in some cases, now fixed.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-18 Arnaud Charlet <char...@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.--- gcc/ada/sem_ch6.adb
+++ gcc/ada/sem_ch6.adb
@@ -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 --
----------------------------
--- gcc/ada/sem_ch6.ads
+++ gcc/ada/sem_ch6.ads
@@ -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;
--- gcc/ada/sem_ch8.adb
+++ gcc/ada/sem_ch8.adb
@@ -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);
