diff options
author | Arnaud Charlet <charlet@adacore.com> | 2020-04-23 14:46:27 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-18 05:08:36 -0400 |
commit | 424ce99fb53c994ba56f99e4b5513dc19e897463 (patch) | |
tree | ad2f329e78c545abf502e1e290e2b42ddd698e6c /gcc | |
parent | 6c8e4f7e38ec5c8aae7b3d475462bf64e61eea99 (diff) | |
download | gcc-424ce99fb53c994ba56f99e4b5513dc19e897463.zip gcc-424ce99fb53c994ba56f99e4b5513dc19e897463.tar.gz gcc-424ce99fb53c994ba56f99e4b5513dc19e897463.tar.bz2 |
[Ada] ACATS 4.1J - B854003 - Subtype conformance check missed
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/sem_ch6.adb | 43 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.ads | 10 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 4 |
3 files changed, 46 insertions, 11 deletions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index fa9bb5d..96099e7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/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 -- ---------------------------- diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index 653bfca..81b4821 100644 --- a/gcc/ada/sem_ch6.ads +++ b/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; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index acb5b21..4e85a15 100644 --- a/gcc/ada/sem_ch8.adb +++ b/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); |