From 2d6f6e08e69209d3df5b49b738c08ce3e921bf44 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 3 Mar 2020 11:51:49 -0500 Subject: [PATCH] [Ada] Code clean ups and comments updates 2020-06-09 Arnaud Charlet gcc/ada/ * exp_ch3.adb, exp_ch4.adb, exp_ch6.adb, exp_ch9.adb, exp_disp.adb, exp_util.adb: Add comments related to errors that should be moved to semantic analysis. Also replace "?" with "??" in warning messages. --- gcc/ada/exp_ch3.adb | 4 ++++ gcc/ada/exp_ch4.adb | 2 +- gcc/ada/exp_ch6.adb | 8 ++++++-- gcc/ada/exp_ch9.adb | 1 + gcc/ada/exp_disp.adb | 2 ++ gcc/ada/exp_util.adb | 4 +++- 6 files changed, 17 insertions(+), 4 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 6aaa4750558..381e4f11fb5 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4456,6 +4456,8 @@ package body Exp_Ch3 is procedure Check_Attr (Nam : Name_Id; TSS_Nam : TSS_Name_Type) is begin + -- Move this check to sem??? + if not Stream_Attribute_Available (Etype (Comp), TSS_Nam) then Error_Msg_Name_1 := Nam; Error_Msg_N @@ -9039,6 +9041,8 @@ package body Exp_Ch3 is end loop; pragma Assert (Present (Comp)); + + -- Move this check to sem??? Error_Msg_Node_2 := Comp; Error_Msg_NE ("parent type & with dynamic component & cannot be parent" diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d9a96a5ee6f..bd8360f2df4 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4486,7 +4486,7 @@ package body Exp_Ch4 is and then Nkind (Associated_Node_For_Itype (PtrT)) = N_Object_Declaration) then - Error_Msg_N ("?use of an anonymous access type allocator", N); + Error_Msg_N ("??use of an anonymous access type allocator", N); end if; -- RM E.2.2(17). We enforce that the expected type of an allocator diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4f8b47170c6..e948580ef2c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1960,7 +1960,7 @@ package body Exp_Ch6 is then if Comes_From_Source (N) then Error_Msg_N - ("?atomic actual passed by copy (RM C.6(19))", Actual); + ("??atomic actual passed by copy (RM C.6(19))", Actual); end if; return True; end if; @@ -1971,7 +1971,7 @@ package body Exp_Ch6 is then if Comes_From_Source (N) then Error_Msg_N - ("?volatile actual passed by copy (RM C.6(19))", Actual); + ("??volatile actual passed by copy (RM C.6(19))", Actual); end if; return True; end if; @@ -3921,6 +3921,8 @@ package body Exp_Ch6 is if Present (Ass) and then Is_Class_Wide_Type (Etype (Name (Ass))) then + -- Move the error messages below to sem??? + if Is_Access_Type (Etype (Call_Node)) then if Designated_Type (Etype (Call_Node)) /= Root_Type (Etype (Name (Ass))) @@ -4115,6 +4117,8 @@ package body Exp_Ch6 is Set_Entity (Name (Call_Node), Parent_Subp); + -- Move this check to sem??? + if Is_Abstract_Subprogram (Parent_Subp) and then not In_Instance then diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 2efa6d1b21f..4c2af03efe2 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -11168,6 +11168,7 @@ package body Exp_Ch9 is then null; else + -- Move this check to sem??? Error_Msg_NE ( "& is not a time type (RM 9.6(6))", Expression (Delay_Statement (Alt)), Time_Type); diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index a81255601e3..c8975749b58 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3836,6 +3836,7 @@ package body Exp_Disp is -- tagged type, when one of its primitive operations has a type in its -- profile whose full view has not been analyzed yet. More complex cases -- involve composite types that have one private unfrozen subcomponent. + -- Move this check to sem??? procedure Export_DT (Typ : Entity_Id; DT : Entity_Id; Index : Nat := 0); -- Export the dispatch table DT of tagged type Typ. Required to generate @@ -8150,6 +8151,7 @@ package body Exp_Disp is -- We exclude Input and Output stream operations because -- Limited_Controlled inherits useless Input and Output stream -- operations from Root_Controlled, which can never be overridden. + -- Move this check to sem??? if not Is_TSS (Prim, TSS_Stream_Input) and then diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 91d5c8131ee..7fce77a2d3a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1296,6 +1296,7 @@ package body Exp_Util is -- of the type. In the case of an inherited condition for an -- overriding operation, both the operation and the function -- are given by primitive wrappers. + -- Move this check to sem??? if Ekind (New_E) = E_Function and then Is_Primitive_Wrapper (New_E) @@ -1326,6 +1327,7 @@ package body Exp_Util is -- Check that there are no calls left to abstract operations if -- the current subprogram is not abstract. + -- Move this check to sem??? if Nkind (Parent (N)) = N_Function_Call and then N = Name (Parent (N)) @@ -3012,7 +3014,7 @@ package body Exp_Util is if Produced_Component_Check and then Has_Unchecked_Union (T) then Error_Msg_NE ("invariants cannot be checked on components of " - & "unchecked_union type &?", Comp_Id, T); + & "unchecked_union type &??", Comp_Id, T); end if; end Process_Record_Component; -- 2.30.2