Commit e5148da0 by Pierre-Marie de Rodat

[multiple changes]

2017-11-08  Yannick Moy  <moy@adacore.com>

	* sem_ch8.adb (Use_One_Type, Update_Use_Clause_Chain): Do not report
	about unused use-type or use-package clauses inside inlined bodies.

2017-11-08  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_elab.adb (Ensure_Prior_Elaboration): Add new parameter
	In_Partial_Fin along with a comment on its usage. Do not guarantee the
	prior elaboration of a unit when the need came from a partial
	finalization context.
	(In_Initialization_Context): Relocated to Process_Call.
	(Is_Partial_Finalization_Proc): New routine.
	(Process_Access): Add new parameter In_Partial_Fin along with a comment
	on its usage.
	(Process_Activation_Call): Add new parameter In_Partial_Fin along with
	a comment on its usage.
	(Process_Activation_Conditional_ABE_Impl): Add new parameter
	In_Partial_Fin along with a comment on its usage. Do not emit any ABE
	diagnostics when the activation occurs in a partial finalization
	context.
	(Process_Activation_Guaranteed_ABE_Impl): Add new parameter
	In_Partial_Fin along with a comment on its usage.
	(Process_Call): Add new parameter In_Partial_Fin along with a comment
	on its usage. A call is within a partial finalization context when it
	targets a finalizer or primitive [Deep_]Finalize, and the call appears
	in initialization actions. Pass this information down to the recursive
	steps of the Processing phase.
	(Process_Call_Ada): Add new parameter In_Partial_Fin along with a
	comment on its usage. Remove the guard which suppresses the generation
	of implicit Elaborate[_All] pragmas. This is now done in
	Ensure_Prior_Elaboration.
	(Process_Call_Conditional_ABE): Add new parameter In_Partial_Fin along
	with a comment on its usage. Do not emit any ABE diagnostics when the
	call occurs in a partial finalization context.
	(Process_Call_SPARK): Add new parameter In_Partial_Fin along with a
	comment on its usage.
	(Process_Instantiation): Add new parameter In_Partial_Fin along with a
	comment on its usage.
	(Process_Instantiation_Ada): Add new parameter In_Partial_Fin along
	with a comment on its usage.
	(Process_Instantiation_Conditional_ABE): Add new parameter
	In_Partial_Fin along with a comment on its usage. Do not emit any ABE
	diagnostics when the instantiation occurs in a partial finalization
	context.
	(Process_Instantiation_SPARK): Add new parameter In_Partial_Fin along
	with a comment on its usage.
	(Process_Scenario): Add new parameter In_Partial_Fin along  with a
	comment on its usage.
	(Process_Single_Activation): Add new parameter In_Partial_Fin along
	with a comment on its usage.
	(Traverse_Body): Add new parameter In_Partial_Fin along with a comment
	on its usage.

2017-11-08  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch13.adb: Add optional parameter to Error_Msg.

2017-11-08  Jerome Lambourg  <lambourg@adacore.com>

	* fname.adb (Is_Internal_File_Name): Do not check the 8+3 naming schema
	for the Interfaces.* hierarchy as longer unit names are now allowed.

2017-11-08  Arnaud Charlet  <charlet@adacore.com>

	* sem_util.adb (Subprogram_Name): Emit sloc for the enclosing
	subprogram as well.  Support more cases of entities.
	(Append_Entity_Name): Add some defensive code.

From-SVN: r254528
parent 63ee5404
2017-11-08 Yannick Moy <moy@adacore.com>
* sem_ch8.adb (Use_One_Type, Update_Use_Clause_Chain): Do not report
about unused use-type or use-package clauses inside inlined bodies.
2017-11-08 Hristian Kirtchev <kirtchev@adacore.com>
* sem_elab.adb (Ensure_Prior_Elaboration): Add new parameter
In_Partial_Fin along with a comment on its usage. Do not guarantee the
prior elaboration of a unit when the need came from a partial
finalization context.
(In_Initialization_Context): Relocated to Process_Call.
(Is_Partial_Finalization_Proc): New routine.
(Process_Access): Add new parameter In_Partial_Fin along with a comment
on its usage.
(Process_Activation_Call): Add new parameter In_Partial_Fin along with
a comment on its usage.
(Process_Activation_Conditional_ABE_Impl): Add new parameter
In_Partial_Fin along with a comment on its usage. Do not emit any ABE
diagnostics when the activation occurs in a partial finalization
context.
(Process_Activation_Guaranteed_ABE_Impl): Add new parameter
In_Partial_Fin along with a comment on its usage.
(Process_Call): Add new parameter In_Partial_Fin along with a comment
on its usage. A call is within a partial finalization context when it
targets a finalizer or primitive [Deep_]Finalize, and the call appears
in initialization actions. Pass this information down to the recursive
steps of the Processing phase.
(Process_Call_Ada): Add new parameter In_Partial_Fin along with a
comment on its usage. Remove the guard which suppresses the generation
of implicit Elaborate[_All] pragmas. This is now done in
Ensure_Prior_Elaboration.
(Process_Call_Conditional_ABE): Add new parameter In_Partial_Fin along
with a comment on its usage. Do not emit any ABE diagnostics when the
call occurs in a partial finalization context.
(Process_Call_SPARK): Add new parameter In_Partial_Fin along with a
comment on its usage.
(Process_Instantiation): Add new parameter In_Partial_Fin along with a
comment on its usage.
(Process_Instantiation_Ada): Add new parameter In_Partial_Fin along
with a comment on its usage.
(Process_Instantiation_Conditional_ABE): Add new parameter
In_Partial_Fin along with a comment on its usage. Do not emit any ABE
diagnostics when the instantiation occurs in a partial finalization
context.
(Process_Instantiation_SPARK): Add new parameter In_Partial_Fin along
with a comment on its usage.
(Process_Scenario): Add new parameter In_Partial_Fin along with a
comment on its usage.
(Process_Single_Activation): Add new parameter In_Partial_Fin along
with a comment on its usage.
(Traverse_Body): Add new parameter In_Partial_Fin along with a comment
on its usage.
2017-11-08 Arnaud Charlet <charlet@adacore.com>
* sem_ch13.adb: Add optional parameter to Error_Msg.
2017-11-08 Jerome Lambourg <lambourg@adacore.com>
* fname.adb (Is_Internal_File_Name): Do not check the 8+3 naming schema
for the Interfaces.* hierarchy as longer unit names are now allowed.
2017-11-08 Arnaud Charlet <charlet@adacore.com>
* sem_util.adb (Subprogram_Name): Emit sloc for the enclosing
subprogram as well. Support more cases of entities.
(Append_Entity_Name): Add some defensive code.
2017-11-06 Eric Botcazou <ebotcazou@adacore.com> 2017-11-06 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/misc.c (gnat_post_options): Clear warn_return_type. * gcc-interface/misc.c (gnat_post_options): Clear warn_return_type.
......
...@@ -167,8 +167,11 @@ package body Fname is ...@@ -167,8 +167,11 @@ package body Fname is
is is
begin begin
-- Definitely false if longer than 12 characters (8.3) -- Definitely false if longer than 12 characters (8.3)
-- except for the Interfaces packages
if Fname'Length > 12 then if Fname'Length > 12
and then Fname (Fname'First .. Fname'First + 1) /= "i-"
then
return False; return False;
end if; end if;
......
...@@ -14317,7 +14317,7 @@ package body Sem_Ch13 is ...@@ -14317,7 +14317,7 @@ package body Sem_Ch13 is
if Source_Siz /= Target_Siz then if Source_Siz /= Target_Siz then
Error_Msg Error_Msg
("?z?types for unchecked conversion have different sizes!", ("?z?types for unchecked conversion have different sizes!",
Eloc); Eloc, Act_Unit);
if All_Errors_Mode then if All_Errors_Mode then
Error_Msg_Name_1 := Chars (Source); Error_Msg_Name_1 := Chars (Source);
...@@ -14353,17 +14353,17 @@ package body Sem_Ch13 is ...@@ -14353,17 +14353,17 @@ package body Sem_Ch13 is
if Bytes_Big_Endian then if Bytes_Big_Endian then
Error_Msg Error_Msg
("\?z?target value will include ^ undefined " ("\?z?target value will include ^ undefined "
& "low order bits!", Eloc); & "low order bits!", Eloc, Act_Unit);
else else
Error_Msg Error_Msg
("\?z?target value will include ^ undefined " ("\?z?target value will include ^ undefined "
& "high order bits!", Eloc); & "high order bits!", Eloc, Act_Unit);
end if; end if;
else else
Error_Msg Error_Msg
("\?z?^ trailing bits of target value will be " ("\?z?^ trailing bits of target value will be "
& "undefined!", Eloc); & "undefined!", Eloc, Act_Unit);
end if; end if;
else pragma Assert (Source_Siz > Target_Siz); else pragma Assert (Source_Siz > Target_Siz);
...@@ -14371,17 +14371,17 @@ package body Sem_Ch13 is ...@@ -14371,17 +14371,17 @@ package body Sem_Ch13 is
if Bytes_Big_Endian then if Bytes_Big_Endian then
Error_Msg Error_Msg
("\?z?^ low order bits of source will be " ("\?z?^ low order bits of source will be "
& "ignored!", Eloc); & "ignored!", Eloc, Act_Unit);
else else
Error_Msg Error_Msg
("\?z?^ high order bits of source will be " ("\?z?^ high order bits of source will be "
& "ignored!", Eloc); & "ignored!", Eloc, Act_Unit);
end if; end if;
else else
Error_Msg Error_Msg
("\?z?^ trailing bits of source will be " ("\?z?^ trailing bits of source will be "
& "ignored!", Eloc); & "ignored!", Eloc, Act_Unit);
end if; end if;
end if; end if;
end if; end if;
...@@ -14435,10 +14435,10 @@ package body Sem_Ch13 is ...@@ -14435,10 +14435,10 @@ package body Sem_Ch13 is
Error_Msg_Node_2 := D_Source; Error_Msg_Node_2 := D_Source;
Error_Msg Error_Msg
("?z?alignment of & (^) is stricter than " ("?z?alignment of & (^) is stricter than "
& "alignment of & (^)!", Eloc); & "alignment of & (^)!", Eloc, Act_Unit);
Error_Msg Error_Msg
("\?z?resulting access value may have invalid " ("\?z?resulting access value may have invalid "
& "alignment!", Eloc); & "alignment!", Eloc, Act_Unit);
end if; end if;
end; end;
end if; end if;
......
...@@ -9057,6 +9057,7 @@ package body Sem_Ch8 is ...@@ -9057,6 +9057,7 @@ package body Sem_Ch8 is
and then Comes_From_Source (Curr) and then Comes_From_Source (Curr)
and then not Is_Effective_Use_Clause (Curr) and then not Is_Effective_Use_Clause (Curr)
and then not In_Instance and then not In_Instance
and then not In_Inlined_Body
then then
-- We are dealing with a potentially unused use_package_clause -- We are dealing with a potentially unused use_package_clause
...@@ -9865,6 +9866,7 @@ package body Sem_Ch8 is ...@@ -9865,6 +9866,7 @@ package body Sem_Ch8 is
and then not Spec_Reloaded_For_Body and then not Spec_Reloaded_For_Body
and then not In_Instance and then not In_Instance
and then not In_Inlined_Body
then then
-- The type already has a use clause -- The type already has a use clause
......
...@@ -141,7 +141,9 @@ package body Sem_Util is ...@@ -141,7 +141,9 @@ package body Sem_Util is
function Subprogram_Name (N : Node_Id) return String; function Subprogram_Name (N : Node_Id) return String;
-- Return the fully qualified name of the enclosing subprogram for the -- Return the fully qualified name of the enclosing subprogram for the
-- given node N. -- given node N, with file:line:col information appended, e.g.
-- "subp:file:line:col", corresponding to the source location of the
-- body of the subprogram.
------------------------------ ------------------------------
-- Abstract_Interface_List -- -- Abstract_Interface_List --
...@@ -594,6 +596,7 @@ package body Sem_Util is ...@@ -594,6 +596,7 @@ package body Sem_Util is
----------- -----------
procedure Inner (E : Entity_Id) is procedure Inner (E : Entity_Id) is
Scop : Node_Id;
begin begin
-- If entity has an internal name, skip by it, and print its scope. -- If entity has an internal name, skip by it, and print its scope.
-- Note that we strip a final R from the name before the test; this -- Note that we strip a final R from the name before the test; this
...@@ -615,21 +618,23 @@ package body Sem_Util is ...@@ -615,21 +618,23 @@ package body Sem_Util is
end if; end if;
end; end;
Scop := Scope (E);
-- Just print entity name if its scope is at the outer level -- Just print entity name if its scope is at the outer level
if Scope (E) = Standard_Standard then if Scop = Standard_Standard then
null; null;
-- If scope comes from source, write scope and entity -- If scope comes from source, write scope and entity
elsif Comes_From_Source (Scope (E)) then elsif Comes_From_Source (Scop) then
Append_Entity_Name (Temp, Scope (E)); Append_Entity_Name (Temp, Scop);
Append (Temp, '.'); Append (Temp, '.');
-- If in wrapper package skip past it -- If in wrapper package skip past it
elsif Is_Wrapper_Package (Scope (E)) then elsif Present (Scop) and then Is_Wrapper_Package (Scop) then
Append_Entity_Name (Temp, Scope (Scope (E))); Append_Entity_Name (Temp, Scope (Scop));
Append (Temp, '.'); Append (Temp, '.');
-- Otherwise nothing to output (happens in unnamed block statements) -- Otherwise nothing to output (happens in unnamed block statements)
...@@ -23295,6 +23300,7 @@ package body Sem_Util is ...@@ -23295,6 +23300,7 @@ package body Sem_Util is
function Subprogram_Name (N : Node_Id) return String is function Subprogram_Name (N : Node_Id) return String is
Buf : Bounded_String; Buf : Bounded_String;
Ent : Node_Id := N; Ent : Node_Id := N;
Nod : Node_Id;
begin begin
while Present (Ent) loop while Present (Ent) loop
...@@ -23303,17 +23309,32 @@ package body Sem_Util is ...@@ -23303,17 +23309,32 @@ package body Sem_Util is
Ent := Defining_Unit_Name (Specification (Ent)); Ent := Defining_Unit_Name (Specification (Ent));
exit; exit;
when N_Package_Body when N_Subprogram_Declaration =>
Nod := Corresponding_Body (Ent);
if Present (Nod) then
Ent := Nod;
else
Ent := Defining_Unit_Name (Specification (Ent));
end if;
exit;
when N_Subprogram_Instantiation
| N_Package_Body
| N_Package_Specification | N_Package_Specification
| N_Subprogram_Specification
=> =>
Ent := Defining_Unit_Name (Ent); Ent := Defining_Unit_Name (Ent);
exit; exit;
when N_Protected_Type_Declaration =>
Ent := Corresponding_Body (Ent);
exit;
when N_Protected_Body when N_Protected_Body
| N_Protected_Type_Declaration
| N_Task_Body | N_Task_Body
=> =>
Ent := Defining_Identifier (Ent);
exit; exit;
when others => when others =>
...@@ -23324,18 +23345,32 @@ package body Sem_Util is ...@@ -23324,18 +23345,32 @@ package body Sem_Util is
end loop; end loop;
if No (Ent) then if No (Ent) then
return "unknown subprogram"; return "unknown subprogram:unknown file:0:0";
end if; end if;
-- If the subprogram is a child unit, use its simple name to start the -- If the subprogram is a child unit, use its simple name to start the
-- construction of the fully qualified name. -- construction of the fully qualified name.
if Nkind (Ent) = N_Defining_Program_Unit_Name then if Nkind (Ent) = N_Defining_Program_Unit_Name then
Append_Entity_Name (Buf, Defining_Identifier (Ent)); Ent := Defining_Identifier (Ent);
else
Append_Entity_Name (Buf, Ent);
end if; end if;
Append_Entity_Name (Buf, Ent);
-- Append source location of Ent to Buf so that the string will
-- look like "subp:file:line:col".
declare
Loc : constant Source_Ptr := Sloc (Ent);
begin
Append (Buf, ':');
Append (Buf, Reference_Name (Get_Source_File_Index (Loc)));
Append (Buf, ':');
Append (Buf, Nat (Get_Logical_Line_Number (Loc)));
Append (Buf, ':');
Append (Buf, Nat (Get_Column_Number (Loc)));
end;
return +Buf; return +Buf;
end Subprogram_Name; end Subprogram_Name;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment