We identify all the places where error messages are issued in the
expander and should be issued in semantic analysis instead, for future
clean ups.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-09 Arnaud Charlet <char...@adacore.com>
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
+++ 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"
--- gcc/ada/exp_ch4.adb
+++ 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
--- gcc/ada/exp_ch6.adb
+++ 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
--- gcc/ada/exp_ch9.adb
+++ 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);
--- gcc/ada/exp_disp.adb
+++ 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
--- gcc/ada/exp_util.adb
+++ 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;
