[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

6 files changed, 569 insertions, 327 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 660211c..912de23 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,72 @@
+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>
 
 	* gcc-interface/misc.c (gnat_post_options): Clear warn_return_type.
diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb
index 2bdfbf6..96d813a 100644
--- a/gcc/ada/fname.adb
+++ b/gcc/ada/fname.adb
@@ -167,8 +167,11 @@ package body Fname is
    is
    begin
       --  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;
       end if;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 564ff0d..ccca8b7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -14317,7 +14317,7 @@ package body Sem_Ch13 is
                if Source_Siz /= Target_Siz then
                   Error_Msg
                     ("?z?types for unchecked conversion have different sizes!",
-                     Eloc);
+                     Eloc, Act_Unit);
 
                   if All_Errors_Mode then
                      Error_Msg_Name_1 := Chars (Source);
@@ -14353,17 +14353,17 @@ package body Sem_Ch13 is
                            if Bytes_Big_Endian then
                               Error_Msg
                                 ("\?z?target value will include ^ undefined "
-                                 & "low order bits!", Eloc);
+                                 & "low order bits!", Eloc, Act_Unit);
                            else
                               Error_Msg
                                 ("\?z?target value will include ^ undefined "
-                                 & "high order bits!", Eloc);
+                                 & "high order bits!", Eloc, Act_Unit);
                            end if;
 
                         else
                            Error_Msg
                              ("\?z?^ trailing bits of target value will be "
-                              & "undefined!", Eloc);
+                              & "undefined!", Eloc, Act_Unit);
                         end if;
 
                      else pragma Assert (Source_Siz > Target_Siz);
@@ -14371,17 +14371,17 @@ package body Sem_Ch13 is
                            if Bytes_Big_Endian then
                               Error_Msg
                                 ("\?z?^ low order bits of source will be "
-                                 & "ignored!", Eloc);
+                                 & "ignored!", Eloc, Act_Unit);
                            else
                               Error_Msg
                                 ("\?z?^ high order bits of source will be "
-                                 & "ignored!", Eloc);
+                                 & "ignored!", Eloc, Act_Unit);
                            end if;
 
                         else
                            Error_Msg
                              ("\?z?^ trailing bits of source will be "
-                              & "ignored!", Eloc);
+                              & "ignored!", Eloc, Act_Unit);
                         end if;
                      end if;
                   end if;
@@ -14435,10 +14435,10 @@ package body Sem_Ch13 is
                            Error_Msg_Node_2 := D_Source;
                            Error_Msg
                              ("?z?alignment of & (^) is stricter than "
-                              & "alignment of & (^)!", Eloc);
+                              & "alignment of & (^)!", Eloc, Act_Unit);
                            Error_Msg
                              ("\?z?resulting access value may have invalid "
-                              & "alignment!", Eloc);
+                              & "alignment!", Eloc, Act_Unit);
                         end if;
                      end;
                   end if;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index bdc8aba..df176a7 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -9057,6 +9057,7 @@ package body Sem_Ch8 is
               and then Comes_From_Source (Curr)
               and then not Is_Effective_Use_Clause (Curr)
               and then not In_Instance
+              and then not In_Inlined_Body
             then
                --  We are dealing with a potentially unused use_package_clause
 
@@ -9865,6 +9866,7 @@ package body Sem_Ch8 is
 
         and then not Spec_Reloaded_For_Body
         and then not In_Instance
+        and then not In_Inlined_Body
       then
          --  The type already has a use clause
 
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 8dec428..735ecf7 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -785,12 +785,15 @@ package body Sem_Elab is
    --  string " in SPARK" is added to the end of the message.
 
    procedure Ensure_Prior_Elaboration
-     (N            : Node_Id;
-      Unit_Id      : Entity_Id;
-      In_Task_Body : Boolean);
+     (N              : Node_Id;
+      Unit_Id        : Entity_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Guarantee the elaboration of unit Unit_Id with respect to the main unit.
-   --  N denotes the related scenario. Flag In_Task_Body should be set when the
-   --  need for elaboration is initiated from a task body.
+   --  N denotes the related scenario. Flag In_Partial_Fin should be set when
+   --  the need for elaboration is initiated by a partial finalization routine.
+   --  Flag In_Task_Body should be set when the need for prior elaboration is
+   --  initiated from a task body.
 
    procedure Ensure_Prior_Elaboration_Dynamic
      (N        : Node_Id;
@@ -1202,86 +1205,111 @@ package body Sem_Elab is
    --  Pop the top of the scenario stack. A check is made to ensure that the
    --  scenario being removed is the same as N.
 
-   procedure Process_Access (Attr : Node_Id; In_Task_Body : Boolean);
+   procedure Process_Access
+     (Attr           : Node_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Perform ABE checks and diagnostics for 'Access to entry, operator, or
-   --  subprogram denoted by Attr. Flag In_Task_Body should be set when the
-   --  processing is initiated from a task body.
+   --  subprogram denoted by Attr. Flag In_Partial_Fin shoud be set when the
+   --  processing is initiated by a partial finalization routine. Flag
+   --  In_Task_Body should be set when the processing is initiated from a task
+   --  body.
 
    generic
       with procedure Process_Single_Activation
-        (Call         : Node_Id;
-         Call_Attrs   : Call_Attributes;
-         Obj_Id       : Entity_Id;
-         Task_Attrs   : Task_Attributes;
-         In_Task_Body : Boolean);
+        (Call           : Node_Id;
+         Call_Attrs     : Call_Attributes;
+         Obj_Id         : Entity_Id;
+         Task_Attrs     : Task_Attributes;
+         In_Partial_Fin : Boolean;
+         In_Task_Body   : Boolean);
       --  Perform ABE checks and diagnostics for task activation call Call
       --  which activates task Obj_Id. Call_Attrs are the attributes of the
       --  activation call. Task_Attrs are the attributes of the task type.
-      --  Flag In_Task_Body should be set when the processing is initiated
-      --  from a task body.
+      --  Flag In_Partial_Fin shoud be set when the processing is initiated
+      --  by a partial finalization routine. Flag In_Task_Body should be set
+      --  when the processing is initiated from a task body.
 
    procedure Process_Activation_Call
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      In_Task_Body : Boolean);
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Perform ABE checks and diagnostics for activation call Call by invoking
    --  routine Process_Single_Activation on each task object being activated.
-   --  Call_Attrs are the attributes of the activation call. Flag In_Task_Body
-   --  should be set when the processing is initiated from a task body.
+   --  Call_Attrs are the attributes of the activation call. In_Partial_Fin
+   --  shoud be set when the processing is initiated by a partial finalization
+   --  routine. Flag In_Task_Body should be set when the processing is started
+   --  from a task body.
 
    procedure Process_Activation_Conditional_ABE_Impl
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Obj_Id       : Entity_Id;
-      Task_Attrs   : Task_Attributes;
-      In_Task_Body : Boolean);
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Obj_Id         : Entity_Id;
+      Task_Attrs     : Task_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Perform common conditional ABE checks and diagnostics for call Call
    --  which activates task Obj_Id ignoring the Ada or SPARK rules. CAll_Attrs
    --  are the attributes of the activation call. Task_Attrs are the attributes
-   --  of the task type. Flag In_Task_Body should be set when the processing is
-   --  initiated from a task body.
+   --  of the task type. Flag In_Partial_Fin shoud be set when the processing
+   --  is initiated by a partial finalization routine. Flag In_Task_Body should
+   --  be set when the processing is initiated from a task body.
 
    procedure Process_Activation_Guaranteed_ABE_Impl
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Obj_Id       : Entity_Id;
-      Task_Attrs   : Task_Attributes;
-      In_Task_Body : Boolean);
-   --  Perform common guaranteed ABE checks and diagnostics for call Call
-   --  which activates task Obj_Id ignoring the Ada or SPARK rules. CAll_Attrs
-   --  are the attributes of the activation call. Task_Attrs are the attributes
-   --  of the task type. Flag In_Task_Body should be set when the processing is
-   --  initiated from a task body.
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Obj_Id         : Entity_Id;
+      Task_Attrs     : Task_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
+   --  Perform common guaranteed ABE checks and diagnostics for call Call which
+   --  activates task Obj_Id ignoring the Ada or SPARK rules. Task_Attrs are
+   --  the attributes of the task type. The following parameters are provided
+   --  for compatibility and are unused.
+   --
+   --    Call_Attrs
+   --    In_Partial_Fin
+   --    In_Task_Body
 
    procedure Process_Call
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      In_Task_Body : Boolean);
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Top-level dispatcher for processing of calls. Perform ABE checks and
    --  diagnostics for call Call which invokes target Target_Id. Call_Attrs
-   --  are the attributes of the call. Flag In_Task_Body should be set when
-   --  the processing is initiated from a task body.
+   --  are the attributes of the call. Flag In_Partial_Fin shoud be set when
+   --  the processing is initiated by a partial finalization routine. Flag
+   --  In_Task_Body should be set when the processing is started from a task
+   --  body.
 
    procedure Process_Call_Ada
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      Target_Attrs : Target_Attributes;
-      In_Task_Body : Boolean);
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      Target_Attrs   : Target_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Perform ABE checks and diagnostics for call Call which invokes target
    --  Target_Id using the Ada rules. Call_Attrs are the attributes of the
-   --  call. Target_Attrs are attributes of the target. Flag In_Task_Body
-   --  should be set when the processing is initiated from a task body.
+   --  call. Target_Attrs are attributes of the target. Flag In_Partial_Fin
+   --  shoud be set when the processing is initiated by a partial finalization
+   --  routine. Flag In_Task_Body should be set when the processing is started
+   --  from a task body.
 
    procedure Process_Call_Conditional_ABE
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      Target_Attrs : Target_Attributes);
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      Target_Attrs   : Target_Attributes;
+      In_Partial_Fin : Boolean);
    --  Perform common conditional ABE checks and diagnostics for call Call that
    --  invokes target Target_Id ignoring the Ada or SPARK rules. Call_Attrs are
    --  the attributes of the call. Target_Attrs are attributes of the target.
+   --  Flag In_Partial_Fin shoud be set when the processing is initiated by a
+   --  partial finalization routine.
 
    procedure Process_Call_Guaranteed_ABE
      (Call       : Node_Id;
@@ -1292,49 +1320,59 @@ package body Sem_Elab is
    --  the attributes of the call.
 
    procedure Process_Call_SPARK
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      Target_Attrs : Target_Attributes);
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      Target_Attrs   : Target_Attributes;
+      In_Partial_Fin : Boolean);
    --  Perform ABE checks and diagnostics for call Call which invokes target
    --  Target_Id using the SPARK rules. Call_Attrs are the attributes of the
-   --  call. Target_Attrs are attributes of the target.
+   --  call. Target_Attrs are attributes of the target. Flag In_Partial_Fin
+   --  shoud be set when the processing is initiated by a partial finalization
+   --  routine.
 
    procedure Process_Guaranteed_ABE (N : Node_Id);
    --  Top level dispatcher for processing of scenarios which result in a
    --  guaranteed ABE.
 
    procedure Process_Instantiation
-     (Exp_Inst     : Node_Id;
-      In_Task_Body : Boolean);
+     (Exp_Inst       : Node_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Top level dispatcher for processing of instantiations. Perform ABE
    --  checks and diagnostics for expanded instantiation Exp_Inst. Flag
-   --  In_Task_Body should be set when the processing is initiated from a
-   --  task body.
+   --  In_Partial_Fin shoud be set when the processing is initiated by a
+   --  partial finalization routine. Flag In_Task_Body should be set when
+   --  the processing is initiated from a task body.
 
    procedure Process_Instantiation_Ada
-     (Exp_Inst     : Node_Id;
-      Inst         : Node_Id;
-      Inst_Attrs   : Instantiation_Attributes;
-      Gen_Id       : Entity_Id;
-      Gen_Attrs    : Target_Attributes;
-      In_Task_Body : Boolean);
+     (Exp_Inst       : Node_Id;
+      Inst           : Node_Id;
+      Inst_Attrs     : Instantiation_Attributes;
+      Gen_Id         : Entity_Id;
+      Gen_Attrs      : Target_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Perform ABE checks and diagnostics for expanded instantiation Exp_Inst
    --  of generic Gen_Id using the Ada rules. Inst is the instantiation node.
-   --  Inst_Attrs are the attributes of the instance. Gen_Attrs are the
-   --  attributes of the generic. Flag In_Task_Body should be set when the
-   --  processing is initiated from a task body.
+   --  Inst_Attrs are the attributes of the instance. Gen_Attrs denotes the
+   --  attributes of the generic. Flag In_Partial_Fin shoud be set when the
+   --  processing is initiated by a partial finalization routine. In_Task_Body
+   --  should be set when the processing is initiated from a task body.
 
    procedure Process_Instantiation_Conditional_ABE
-     (Exp_Inst   : Node_Id;
-      Inst       : Node_Id;
-      Inst_Attrs : Instantiation_Attributes;
-      Gen_Id     : Entity_Id;
-      Gen_Attrs  : Target_Attributes);
+     (Exp_Inst       : Node_Id;
+      Inst           : Node_Id;
+      Inst_Attrs     : Instantiation_Attributes;
+      Gen_Id         : Entity_Id;
+      Gen_Attrs      : Target_Attributes;
+      In_Partial_Fin : Boolean);
    --  Perform common conditional ABE checks and diagnostics for expanded
    --  instantiation Exp_Inst of generic Gen_Id ignoring the Ada or SPARK
    --  rules. Inst is the instantiation node. Inst_Attrs are the attributes
-   --  of the instance. Gen_Attrs are the attributes of the generic.
+   --  of the instance. Gen_Attrs are the attributes of the generic. Flag
+   --  In_Partial_Fin shoud be set when the processing is initiated by a
+   --  partial finalization routine.
 
    procedure Process_Instantiation_Guaranteed_ABE (Exp_Inst : Node_Id);
    --  Perform common guaranteed ABE checks and diagnostics for expanded
@@ -1342,20 +1380,27 @@ package body Sem_Elab is
    --  rules.
 
    procedure Process_Instantiation_SPARK
-     (Exp_Inst   : Node_Id;
-      Inst       : Node_Id;
-      Inst_Attrs : Instantiation_Attributes;
-      Gen_Id     : Entity_Id;
-      Gen_Attrs  : Target_Attributes);
+     (Exp_Inst       : Node_Id;
+      Inst           : Node_Id;
+      Inst_Attrs     : Instantiation_Attributes;
+      Gen_Id         : Entity_Id;
+      Gen_Attrs      : Target_Attributes;
+      In_Partial_Fin : Boolean);
    --  Perform ABE checks and diagnostics for expanded instantiation Exp_Inst
    --  of generic Gen_Id using the SPARK rules. Inst is the instantiation node.
-   --  Inst_Attrs are the attributes of the instance. Gen_Attrs are the
-   --  attributes of the generic.
-
-   procedure Process_Scenario (N : Node_Id; In_Task_Body : Boolean := False);
+   --  Inst_Attrs are the attributes of the instance. Gen_Attrs denotes the
+   --  attributes of the generic. Flag In_Partial_Fin shoud be set when the
+   --  processing is initiated by a partial finalization routine.
+
+   procedure Process_Scenario
+     (N              : Node_Id;
+      In_Partial_Fin : Boolean := False;
+      In_Task_Body   : Boolean := False);
    --  Top level dispatcher for processing of various elaboration scenarios.
-   --  Perform ABE checks and diagnostics for scenario N. Flag In_Task_Body
-   --  should be set when the processing is initiated from a task body.
+   --  Perform ABE checks and diagnostics for scenario N. Flag In_Partial_Fin
+   --  shoud be set when the processing is initiated by a partial finalization
+   --  routine. Flag In_Task_Body should be set when the processing is started
+   --  from a task body.
 
    procedure Process_Variable_Assignment (Asmt : Node_Id);
    --  Top level dispatcher for processing of variable assignments. Perform ABE
@@ -1391,10 +1436,15 @@ package body Sem_Elab is
    pragma Inline (Static_Elaboration_Checks);
    --  Determine whether the static model is in effect
 
-   procedure Traverse_Body (N : Node_Id; In_Task_Body : Boolean);
+   procedure Traverse_Body
+     (N              : Node_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean);
    --  Inspect the declarations and statements of subprogram body N for
-   --  suitable elaboration scenarios and process them. Flag In_Task_Body
-   --  should be set when the traversal is initiated from a task body.
+   --  suitable elaboration scenarios and process them. Flag In_Partial_Fin
+   --  shoud be set when the processing is initiated by a partial finalization
+   --  routine. Flag In_Task_Body should be set when the traversal is initiated
+   --  from a task body.
 
    procedure Update_Elaboration_Scenario (New_N : Node_Id; Old_N : Node_Id);
    pragma Inline (Update_Elaboration_Scenario);
@@ -1996,9 +2046,10 @@ package body Sem_Elab is
    ------------------------------
 
    procedure Ensure_Prior_Elaboration
-     (N            : Node_Id;
-      Unit_Id      : Entity_Id;
-      In_Task_Body : Boolean)
+     (N              : Node_Id;
+      Unit_Id        : Entity_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
       Prag_Nam : Name_Id;
 
@@ -2035,11 +2086,18 @@ package body Sem_Elab is
          Prag_Nam := Name_Elaborate_All;
       end if;
 
+      --  Nothing to do when the need for prior elaboration came from a partial
+      --  finalization routine which occurs in an initialization context. This
+      --  behaviour parallels that of the old ABE mechanism.
+
+      if In_Partial_Fin then
+         return;
+
       --  Nothing to do when the need for prior elaboration came from a task
       --  body and switch -gnatd.y (disable implicit pragma Elaborate_All on
       --  task bodies) is in effect.
 
-      if Debug_Flag_Dot_Y and then In_Task_Body then
+      elsif Debug_Flag_Dot_Y and then In_Task_Body then
          return;
 
       --  Nothing to do when the unit is elaborated prior to the main unit.
@@ -6253,7 +6311,11 @@ package body Sem_Elab is
    -- Process_Access --
    --------------------
 
-   procedure Process_Access (Attr : Node_Id; In_Task_Body : Boolean) is
+   procedure Process_Access
+     (Attr           : Node_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
+   is
       function Build_Access_Marker (Target_Id : Entity_Id) return Node_Id;
       pragma Inline (Build_Access_Marker);
       --  Create a suitable call marker which invokes target Target_Id
@@ -6340,17 +6402,19 @@ package body Sem_Elab is
 
       if Debug_Flag_Dot_O then
          Process_Scenario
-           (N            => Build_Access_Marker (Target_Id),
-            In_Task_Body => In_Task_Body);
+           (N              => Build_Access_Marker (Target_Id),
+            In_Partial_Fin => In_Partial_Fin,
+            In_Task_Body   => In_Task_Body);
 
       --  Otherwise ensure that the unit with the corresponding body is
       --  elaborated prior to the main unit.
 
       else
          Ensure_Prior_Elaboration
-           (N            => Attr,
-            Unit_Id      => Target_Attrs.Unit_Id,
-            In_Task_Body => In_Task_Body);
+           (N              => Attr,
+            Unit_Id        => Target_Attrs.Unit_Id,
+            In_Partial_Fin => In_Partial_Fin,
+            In_Task_Body   => In_Task_Body);
       end if;
    end Process_Access;
 
@@ -6359,9 +6423,10 @@ package body Sem_Elab is
    -----------------------------
 
    procedure Process_Activation_Call
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      In_Task_Body : Boolean)
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
       procedure Process_Task_Object (Obj_Id : Entity_Id; Typ : Entity_Id);
       --  Perform ABE checks and diagnostics for object Obj_Id with type Typ.
@@ -6389,11 +6454,12 @@ package body Sem_Elab is
                Attrs => Task_Attrs);
 
             Process_Single_Activation
-              (Call         => Call,
-               Call_Attrs   => Call_Attrs,
-               Obj_Id       => Obj_Id,
-               Task_Attrs   => Task_Attrs,
-               In_Task_Body => In_Task_Body);
+              (Call           => Call,
+               Call_Attrs     => Call_Attrs,
+               Obj_Id         => Obj_Id,
+               Task_Attrs     => Task_Attrs,
+               In_Partial_Fin => In_Partial_Fin,
+               In_Task_Body   => In_Task_Body);
 
          --  Examine the component type when the object is an array
 
@@ -6507,11 +6573,12 @@ package body Sem_Elab is
    ---------------------------------------------
 
    procedure Process_Activation_Conditional_ABE_Impl
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Obj_Id       : Entity_Id;
-      Task_Attrs   : Task_Attributes;
-      In_Task_Body : Boolean)
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Obj_Id         : Entity_Id;
+      Task_Attrs     : Task_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
       Check_OK : constant Boolean :=
                    not Is_Ignored_Ghost_Entity (Obj_Id)
@@ -6650,12 +6717,19 @@ package body Sem_Elab is
 
          if Earlier_In_Extended_Unit (Root, Task_Attrs.Body_Decl) then
 
+            --  Do not emit any ABE diagnostics when the activation occurs in
+            --  a partial finalization context because this leads to confusing
+            --  noise.
+
+            if In_Partial_Fin then
+               null;
+
             --  ABE diagnostics are emitted only in the static model because
             --  there is a well-defined order to visiting scenarios. Without
             --  this order diagnostics appear jumbled and result in unwanted
             --  noise.
 
-            if Static_Elaboration_Checks then
+            elsif Static_Elaboration_Checks then
                Error_Msg_Sloc := Sloc (Call);
                Error_Msg_N
                  ("??task & will be activated # before elaboration of its "
@@ -6707,12 +6781,16 @@ package body Sem_Elab is
 
       else
          Ensure_Prior_Elaboration
-           (N            => Call,
-            Unit_Id      => Task_Attrs.Unit_Id,
-            In_Task_Body => In_Task_Body);
+           (N              => Call,
+            Unit_Id        => Task_Attrs.Unit_Id,
+            In_Partial_Fin => In_Partial_Fin,
+            In_Task_Body   => In_Task_Body);
       end if;
 
-      Traverse_Body (Task_Attrs.Body_Decl, In_Task_Body => True);
+      Traverse_Body
+        (N              => Task_Attrs.Body_Decl,
+         In_Partial_Fin => In_Partial_Fin,
+         In_Task_Body   => True);
    end Process_Activation_Conditional_ABE_Impl;
 
    procedure Process_Activation_Conditional_ABE is
@@ -6723,13 +6801,15 @@ package body Sem_Elab is
    --------------------------------------------
 
    procedure Process_Activation_Guaranteed_ABE_Impl
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Obj_Id       : Entity_Id;
-      Task_Attrs   : Task_Attributes;
-      In_Task_Body : Boolean)
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Obj_Id         : Entity_Id;
+      Task_Attrs     : Task_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
       pragma Unreferenced (Call_Attrs);
+      pragma Unreferenced (In_Partial_Fin);
       pragma Unreferenced (In_Task_Body);
 
       Check_OK : constant Boolean :=
@@ -6868,19 +6948,108 @@ package body Sem_Elab is
    ------------------
 
    procedure Process_Call
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      In_Task_Body : Boolean)
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
+      function In_Initialization_Context (N : Node_Id) return Boolean;
+      --  Determine whether arbitrary node N appears within a type init proc,
+      --  primitive [Deep_]Initialize, or a block created for initialization
+      --  purposes.
+
+      function Is_Partial_Finalization_Proc return Boolean;
+      pragma Inline (Is_Partial_Finalization_Proc);
+      --  Determine whether call Call with target Target_Id invokes a partial
+      --  finalization procedure.
+
+      -------------------------------
+      -- In_Initialization_Context --
+      -------------------------------
+
+      function In_Initialization_Context (N : Node_Id) return Boolean is
+         Par     : Node_Id;
+         Spec_Id : Entity_Id;
+
+      begin
+         --  Climb the parent chain looking for initialization actions
+
+         Par := Parent (N);
+         while Present (Par) loop
+
+            --  A block may be part of the initialization actions of a default
+            --  initialized object.
+
+            if Nkind (Par) = N_Block_Statement
+              and then Is_Initialization_Block (Par)
+            then
+               return True;
+
+            --  A subprogram body may denote an initialization routine
+
+            elsif Nkind (Par) = N_Subprogram_Body then
+               Spec_Id := Unique_Defining_Entity (Par);
+
+               --  The current subprogram body denotes a type init proc or
+               --  primitive [Deep_]Initialize.
+
+               if Is_Init_Proc (Spec_Id)
+                 or else Is_Controlled_Proc (Spec_Id, Name_Initialize)
+                 or else Is_TSS (Spec_Id, TSS_Deep_Initialize)
+               then
+                  return True;
+               end if;
+
+            --  Prevent the search from going too far
+
+            elsif Is_Body_Or_Package_Declaration (Par) then
+               exit;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         return False;
+      end In_Initialization_Context;
+
+      ----------------------------------
+      -- Is_Partial_Finalization_Proc --
+      ----------------------------------
+
+      function Is_Partial_Finalization_Proc return Boolean is
+      begin
+         --  To qualify, the target must denote primitive [Deep_]Finalize or a
+         --  finalizer procedure, and the call must appear in an initialization
+         --  context.
+
+         return
+           (Is_Controlled_Proc (Target_Id, Name_Finalize)
+              or else Is_Finalizer_Proc (Target_Id)
+              or else Is_TSS (Target_Id, TSS_Deep_Finalize))
+            and then In_Initialization_Context (Call);
+      end Is_Partial_Finalization_Proc;
+
+      --  Local variables
+
+      Partial_Fin_On : Boolean;
       SPARK_Rules_On : Boolean;
       Target_Attrs   : Target_Attributes;
 
+   --  Start of processing for Process_Call
+
    begin
       Extract_Target_Attributes
         (Target_Id => Target_Id,
          Attrs     => Target_Attrs);
 
+      --  The call occurs in a partial finalization context when a prior
+      --  scenario is already in that mode, or when the target denotes a
+      --  [Deep_]Finalize primitive or a finalizer within an initialization
+      --  context.
+
+      Partial_Fin_On := In_Partial_Fin or else Is_Partial_Finalization_Proc;
+
       --  The SPARK rules are in effect when both the call and target are
       --  subject to SPARK_Mode On.
 
@@ -6954,28 +7123,30 @@ package body Sem_Elab is
 
       elsif SPARK_Rules_On and Debug_Flag_Dot_V then
          Process_Call_SPARK
-           (Call         => Call,
-            Call_Attrs   => Call_Attrs,
-            Target_Id    => Target_Id,
-            Target_Attrs => Target_Attrs);
+           (Call           => Call,
+            Call_Attrs     => Call_Attrs,
+            Target_Id      => Target_Id,
+            Target_Attrs   => Target_Attrs,
+            In_Partial_Fin => In_Partial_Fin);
 
       --  Otherwise the Ada rules are in effect, or SPARK code is allowed to
       --  violate the SPARK rules.
 
       else
          Process_Call_Ada
-           (Call         => Call,
-            Call_Attrs   => Call_Attrs,
-            Target_Id    => Target_Id,
-            Target_Attrs => Target_Attrs,
-            In_Task_Body => In_Task_Body);
+           (Call           => Call,
+            Call_Attrs     => Call_Attrs,
+            Target_Id      => Target_Id,
+            Target_Attrs   => Target_Attrs,
+            In_Partial_Fin => Partial_Fin_On,
+            In_Task_Body   => In_Task_Body);
       end if;
 
       --  Inspect the target body (and barried function) for other suitable
       --  elaboration scenarios.
 
-      Traverse_Body (Target_Attrs.Body_Barf, In_Task_Body);
-      Traverse_Body (Target_Attrs.Body_Decl, In_Task_Body);
+      Traverse_Body (Target_Attrs.Body_Barf, Partial_Fin_On, In_Task_Body);
+      Traverse_Body (Target_Attrs.Body_Decl, Partial_Fin_On, In_Task_Body);
    end Process_Call;
 
    ----------------------
@@ -6983,67 +7154,13 @@ package body Sem_Elab is
    ----------------------
 
    procedure Process_Call_Ada
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      Target_Attrs : Target_Attributes;
-      In_Task_Body : Boolean)
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      Target_Attrs   : Target_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
-      function In_Initialization_Context (N : Node_Id) return Boolean;
-      --  Determine whether arbitrary node N appears within a type init proc or
-      --  primitive [Deep_]Initialize.
-
-      -------------------------------
-      -- In_Initialization_Context --
-      -------------------------------
-
-      function In_Initialization_Context (N : Node_Id) return Boolean is
-         Par     : Node_Id;
-         Spec_Id : Entity_Id;
-
-      begin
-         --  Climb the parent chain looking for initialization actions
-
-         Par := Parent (N);
-         while Present (Par) loop
-
-            --  A block may be part of the initialization actions of a default
-            --  initialized object.
-
-            if Nkind (Par) = N_Block_Statement
-              and then Is_Initialization_Block (Par)
-            then
-               return True;
-
-            --  A subprogram body may denote an initialization routine
-
-            elsif Nkind (Par) = N_Subprogram_Body then
-               Spec_Id := Unique_Defining_Entity (Par);
-
-               --  The current subprogram body denotes a type init proc or
-               --  primitive [Deep_]Initialize.
-
-               if Is_Init_Proc (Spec_Id)
-                 or else Is_Controlled_Proc (Spec_Id, Name_Initialize)
-                 or else Is_TSS (Spec_Id, TSS_Deep_Initialize)
-               then
-                  return True;
-               end if;
-
-            --  Prevent the search from going too far
-
-            elsif Is_Body_Or_Package_Declaration (Par) then
-               exit;
-            end if;
-
-            Par := Parent (Par);
-         end loop;
-
-         return False;
-      end In_Initialization_Context;
-
-      --  Local variables
-
       Check_OK : constant Boolean :=
                    not Call_Attrs.Ghost_Mode_Ignore
                      and then not Target_Attrs.Ghost_Mode_Ignore
@@ -7053,8 +7170,6 @@ package body Sem_Elab is
       --  target have active elaboration checks, and both are not ignored Ghost
       --  constructs.
 
-   --  Start of processing for Process_Call_Ada
-
    begin
       --  Nothing to do for an Ada dispatching call because there are no ABE
       --  diagnostics for either models. ABE checks for the dynamic model are
@@ -7088,10 +7203,11 @@ package body Sem_Elab is
         and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl)
       then
          Process_Call_Conditional_ABE
-           (Call         => Call,
-            Call_Attrs   => Call_Attrs,
-            Target_Id    => Target_Id,
-            Target_Attrs => Target_Attrs);
+           (Call           => Call,
+            Call_Attrs     => Call_Attrs,
+            Target_Id      => Target_Id,
+            Target_Attrs   => Target_Attrs,
+            In_Partial_Fin => In_Partial_Fin);
 
       --  Otherwise the target body is not available in this compilation or it
       --  resides in an external unit. Install a run-time ABE check to verify
@@ -7105,35 +7221,17 @@ package body Sem_Elab is
             Id      => Target_Attrs.Unit_Id);
       end if;
 
-      --  No implicit pragma Elaborate[_All] is generated when the call has
-      --  elaboration checks suppressed. This behaviour parallels that of the
-      --  old ABE mechanism.
-
-      if not Call_Attrs.Elab_Checks_OK then
-         null;
-
-      --  No implicit pragma Elaborate[_All] is generated for finalization
-      --  actions when primitive [Deep_]Finalize is not defined in the main
-      --  unit and the call appears within some initialization actions. This
-      --  behaviour parallels that of the old ABE mechanism.
-
-      --  Performance note: parent traversal
-
-      elsif (Is_Controlled_Proc (Target_Id, Name_Finalize)
-              or else Is_TSS (Target_Id, TSS_Deep_Finalize))
-        and then not In_Extended_Main_Code_Unit (Target_Attrs.Spec_Decl)
-        and then In_Initialization_Context (Call)
-      then
-         null;
-
-      --  Otherwise ensure that the unit with the target body is elaborated
-      --  prior to the main unit.
+      --  Ensure that the unit with the target body is elaborated prior to the
+      --  main unit. The implicit Elaborate[_All] is generated only when the
+      --  call has elaboration checks enabled. This behaviour parallels that of
+      --  the old ABE mechanism.
 
-      else
+      if Call_Attrs.Elab_Checks_OK then
          Ensure_Prior_Elaboration
-           (N            => Call,
-            Unit_Id      => Target_Attrs.Unit_Id,
-            In_Task_Body => In_Task_Body);
+           (N              => Call,
+            Unit_Id        => Target_Attrs.Unit_Id,
+            In_Partial_Fin => In_Partial_Fin,
+            In_Task_Body   => In_Task_Body);
       end if;
    end Process_Call_Ada;
 
@@ -7142,10 +7240,11 @@ package body Sem_Elab is
    ----------------------------------
 
    procedure Process_Call_Conditional_ABE
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      Target_Attrs : Target_Attributes)
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      Target_Attrs   : Target_Attributes;
+      In_Partial_Fin : Boolean)
    is
       Check_OK : constant Boolean :=
                    not Call_Attrs.Ghost_Mode_Ignore
@@ -7186,11 +7285,17 @@ package body Sem_Elab is
 
       if Earlier_In_Extended_Unit (Root, Target_Attrs.Body_Decl) then
 
+         --  Do not emit any ABE diagnostics when the call occurs in a partial
+         --  finalization context because this leads to confusing noise.
+
+         if In_Partial_Fin then
+            null;
+
          --  ABE diagnostics are emitted only in the static model because there
          --  is a well-defined order to visiting scenarios. Without this order
          --  diagnostics appear jumbled and result in unwanted noise.
 
-         if Static_Elaboration_Checks then
+         elsif Static_Elaboration_Checks then
             Error_Msg_NE ("??cannot call & before body seen", Call, Target_Id);
             Error_Msg_N ("\Program_Error may be raised at run time", Call);
 
@@ -7329,10 +7434,11 @@ package body Sem_Elab is
    ------------------------
 
    procedure Process_Call_SPARK
-     (Call         : Node_Id;
-      Call_Attrs   : Call_Attributes;
-      Target_Id    : Entity_Id;
-      Target_Attrs : Target_Attributes)
+     (Call           : Node_Id;
+      Call_Attrs     : Call_Attributes;
+      Target_Id      : Entity_Id;
+      Target_Attrs   : Target_Attributes;
+      In_Partial_Fin : Boolean)
    is
    begin
       --  A call to a source target or to a target which emulates Ada or SPARK
@@ -7376,10 +7482,11 @@ package body Sem_Elab is
         and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl)
       then
          Process_Call_Conditional_ABE
-           (Call         => Call,
-            Call_Attrs   => Call_Attrs,
-            Target_Id    => Target_Id,
-            Target_Attrs => Target_Attrs);
+           (Call           => Call,
+            Call_Attrs     => Call_Attrs,
+            Target_Id      => Target_Id,
+            Target_Attrs   => Target_Attrs,
+            In_Partial_Fin => In_Partial_Fin);
 
       --  Otherwise the target body is not available in this compilation or it
       --  resides in an external unit. There is no need to guarantee the prior
@@ -7416,9 +7523,10 @@ package body Sem_Elab is
 
          if Is_Activation_Proc (Target_Id) then
             Process_Activation_Guaranteed_ABE
-              (Call         => N,
-               Call_Attrs   => Call_Attrs,
-               In_Task_Body => False);
+              (Call           => N,
+               Call_Attrs     => Call_Attrs,
+               In_Partial_Fin => False,
+               In_Task_Body   => False);
 
          else
             Process_Call_Guaranteed_ABE
@@ -7442,8 +7550,9 @@ package body Sem_Elab is
    ---------------------------
 
    procedure Process_Instantiation
-     (Exp_Inst     : Node_Id;
-      In_Task_Body : Boolean)
+     (Exp_Inst       : Node_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
       Gen_Attrs  : Target_Attributes;
       Gen_Id     : Entity_Id;
@@ -7524,23 +7633,25 @@ package body Sem_Elab is
 
       elsif SPARK_Rules_On and Debug_Flag_Dot_V then
          Process_Instantiation_SPARK
-           (Exp_Inst   => Exp_Inst,
-            Inst       => Inst,
-            Inst_Attrs => Inst_Attrs,
-            Gen_Id     => Gen_Id,
-            Gen_Attrs  => Gen_Attrs);
+           (Exp_Inst       => Exp_Inst,
+            Inst           => Inst,
+            Inst_Attrs     => Inst_Attrs,
+            Gen_Id         => Gen_Id,
+            Gen_Attrs      => Gen_Attrs,
+            In_Partial_Fin => In_Partial_Fin);
 
       --  Otherwise the Ada rules are in effect, or SPARK code is allowed to
       --  violate the SPARK rules.
 
       else
          Process_Instantiation_Ada
-           (Exp_Inst     => Exp_Inst,
-            Inst         => Inst,
-            Inst_Attrs   => Inst_Attrs,
-            Gen_Id       => Gen_Id,
-            Gen_Attrs    => Gen_Attrs,
-            In_Task_Body => In_Task_Body);
+           (Exp_Inst       => Exp_Inst,
+            Inst           => Inst,
+            Inst_Attrs     => Inst_Attrs,
+            Gen_Id         => Gen_Id,
+            Gen_Attrs      => Gen_Attrs,
+            In_Partial_Fin => In_Partial_Fin,
+            In_Task_Body   => In_Task_Body);
       end if;
    end Process_Instantiation;
 
@@ -7549,12 +7660,13 @@ package body Sem_Elab is
    -------------------------------
 
    procedure Process_Instantiation_Ada
-     (Exp_Inst     : Node_Id;
-      Inst         : Node_Id;
-      Inst_Attrs   : Instantiation_Attributes;
-      Gen_Id       : Entity_Id;
-      Gen_Attrs    : Target_Attributes;
-      In_Task_Body : Boolean)
+     (Exp_Inst       : Node_Id;
+      Inst           : Node_Id;
+      Inst_Attrs     : Instantiation_Attributes;
+      Gen_Id         : Entity_Id;
+      Gen_Attrs      : Target_Attributes;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
    is
       Check_OK : constant Boolean :=
                    not Inst_Attrs.Ghost_Mode_Ignore
@@ -7591,11 +7703,12 @@ package body Sem_Elab is
         and then In_Extended_Main_Code_Unit (Gen_Attrs.Body_Decl)
       then
          Process_Instantiation_Conditional_ABE
-           (Exp_Inst   => Exp_Inst,
-            Inst       => Inst,
-            Inst_Attrs => Inst_Attrs,
-            Gen_Id     => Gen_Id,
-            Gen_Attrs  => Gen_Attrs);
+           (Exp_Inst       => Exp_Inst,
+            Inst           => Inst,
+            Inst_Attrs     => Inst_Attrs,
+            Gen_Id         => Gen_Id,
+            Gen_Attrs      => Gen_Attrs,
+            In_Partial_Fin => In_Partial_Fin);
 
       --  Otherwise the generic body is not available in this compilation or it
       --  resides in an external unit. Install a run-time ABE check to verify
@@ -7616,9 +7729,10 @@ package body Sem_Elab is
 
       if Inst_Attrs.Elab_Checks_OK then
          Ensure_Prior_Elaboration
-           (N            => Inst,
-            Unit_Id      => Gen_Attrs.Unit_Id,
-            In_Task_Body => In_Task_Body);
+           (N              => Inst,
+            Unit_Id        => Gen_Attrs.Unit_Id,
+            In_Partial_Fin => In_Partial_Fin,
+            In_Task_Body   => In_Task_Body);
       end if;
    end Process_Instantiation_Ada;
 
@@ -7627,11 +7741,12 @@ package body Sem_Elab is
    -------------------------------------------
 
    procedure Process_Instantiation_Conditional_ABE
-     (Exp_Inst   : Node_Id;
-      Inst       : Node_Id;
-      Inst_Attrs : Instantiation_Attributes;
-      Gen_Id     : Entity_Id;
-      Gen_Attrs  : Target_Attributes)
+     (Exp_Inst       : Node_Id;
+      Inst           : Node_Id;
+      Inst_Attrs     : Instantiation_Attributes;
+      Gen_Id         : Entity_Id;
+      Gen_Attrs      : Target_Attributes;
+      In_Partial_Fin : Boolean)
    is
       Check_OK : constant Boolean :=
                    not Inst_Attrs.Ghost_Mode_Ignore
@@ -7676,11 +7791,17 @@ package body Sem_Elab is
 
       if Earlier_In_Extended_Unit (Root, Gen_Attrs.Body_Decl) then
 
+         --  Do not emit any ABE diagnostics when the instantiation occurs in a
+         --  partial finalization context because this leads to unwanted noise.
+
+         if In_Partial_Fin then
+            null;
+
          --  ABE diagnostics are emitted only in the static model because there
          --  is a well-defined order to visiting scenarios. Without this order
          --  diagnostics appear jumbled and result in unwanted noise.
 
-         if Static_Elaboration_Checks then
+         elsif Static_Elaboration_Checks then
             Error_Msg_NE
               ("??cannot instantiate & before body seen", Inst, Gen_Id);
             Error_Msg_N ("\Program_Error may be raised at run time", Inst);
@@ -7832,11 +7953,12 @@ package body Sem_Elab is
    ---------------------------------
 
    procedure Process_Instantiation_SPARK
-     (Exp_Inst   : Node_Id;
-      Inst       : Node_Id;
-      Inst_Attrs : Instantiation_Attributes;
-      Gen_Id     : Entity_Id;
-      Gen_Attrs  : Target_Attributes)
+     (Exp_Inst       : Node_Id;
+      Inst           : Node_Id;
+      Inst_Attrs     : Instantiation_Attributes;
+      Gen_Id         : Entity_Id;
+      Gen_Attrs      : Target_Attributes;
+      In_Partial_Fin : Boolean)
    is
       Req_Nam : Name_Id;
 
@@ -7882,11 +8004,12 @@ package body Sem_Elab is
         and then In_Extended_Main_Code_Unit (Gen_Attrs.Body_Decl)
       then
          Process_Instantiation_Conditional_ABE
-           (Exp_Inst   => Exp_Inst,
-            Inst       => Inst,
-            Inst_Attrs => Inst_Attrs,
-            Gen_Id     => Gen_Id,
-            Gen_Attrs  => Gen_Attrs);
+           (Exp_Inst       => Exp_Inst,
+            Inst           => Inst,
+            Inst_Attrs     => Inst_Attrs,
+            Gen_Id         => Gen_Id,
+            Gen_Attrs      => Gen_Attrs,
+            In_Partial_Fin => In_Partial_Fin);
 
       --  Otherwise the generic body is not available in this compilation or
       --  it resides in an external unit. There is no need to guarantee the
@@ -8086,7 +8209,11 @@ package body Sem_Elab is
    -- Process_Scenario --
    ----------------------
 
-   procedure Process_Scenario (N : Node_Id; In_Task_Body : Boolean := False) is
+   procedure Process_Scenario
+     (N              : Node_Id;
+      In_Partial_Fin : Boolean := False;
+      In_Task_Body   : Boolean := False)
+   is
       Call_Attrs : Call_Attributes;
       Target_Id  : Entity_Id;
 
@@ -8098,7 +8225,7 @@ package body Sem_Elab is
       --  'Access
 
       if Is_Suitable_Access (N) then
-         Process_Access (N, In_Task_Body);
+         Process_Access (N, In_Partial_Fin, In_Task_Body);
 
       --  Calls
 
@@ -8119,23 +8246,25 @@ package body Sem_Elab is
 
             if Is_Activation_Proc (Target_Id) then
                Process_Activation_Conditional_ABE
-                 (Call         => N,
-                  Call_Attrs   => Call_Attrs,
-                  In_Task_Body => In_Task_Body);
+                 (Call           => N,
+                  Call_Attrs     => Call_Attrs,
+                  In_Partial_Fin => In_Partial_Fin,
+                  In_Task_Body   => In_Task_Body);
 
             else
                Process_Call
-                 (Call         => N,
-                  Call_Attrs   => Call_Attrs,
-                  Target_Id    => Target_Id,
-                  In_Task_Body => In_Task_Body);
+                 (Call           => N,
+                  Call_Attrs     => Call_Attrs,
+                  Target_Id      => Target_Id,
+                  In_Partial_Fin => In_Partial_Fin,
+                  In_Task_Body   => In_Task_Body);
             end if;
          end if;
 
       --  Instantiations
 
       elsif Is_Suitable_Instantiation (N) then
-         Process_Instantiation (N, In_Task_Body);
+         Process_Instantiation (N, In_Partial_Fin, In_Task_Body);
 
       --  Variable assignments
 
@@ -8328,7 +8457,11 @@ package body Sem_Elab is
    -- Traverse_Body --
    -------------------
 
-   procedure Traverse_Body (N : Node_Id; In_Task_Body : Boolean) is
+   procedure Traverse_Body
+     (N              : Node_Id;
+      In_Partial_Fin : Boolean;
+      In_Task_Body   : Boolean)
+   is
       function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result;
       --  Determine whether arbitrary node Nod denotes a suitable scenario and
       --  if so, process it.
@@ -8387,7 +8520,7 @@ package body Sem_Elab is
          --  General case
 
          elsif Is_Suitable_Scenario (Nod) then
-            Process_Scenario (Nod, In_Task_Body);
+            Process_Scenario (Nod, In_Partial_Fin, In_Task_Body);
          end if;
 
          return OK;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3698bbf..79c8864 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -141,7 +141,9 @@ package body Sem_Util is
 
    function Subprogram_Name (N : Node_Id) return String;
    --  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 --
@@ -594,6 +596,7 @@ package body Sem_Util is
       -----------
 
       procedure Inner (E : Entity_Id) is
+         Scop : Node_Id;
       begin
          --  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
@@ -615,21 +618,23 @@ package body Sem_Util is
             end if;
          end;
 
+         Scop := Scope (E);
+
          --  Just print entity name if its scope is at the outer level
 
-         if Scope (E) = Standard_Standard then
+         if Scop = Standard_Standard then
             null;
 
          --  If scope comes from source, write scope and entity
 
-         elsif Comes_From_Source (Scope (E)) then
-            Append_Entity_Name (Temp, Scope (E));
+         elsif Comes_From_Source (Scop) then
+            Append_Entity_Name (Temp, Scop);
             Append (Temp, '.');
 
          --  If in wrapper package skip past it
 
-         elsif Is_Wrapper_Package (Scope (E)) then
-            Append_Entity_Name (Temp, Scope (Scope (E)));
+         elsif Present (Scop) and then Is_Wrapper_Package (Scop) then
+            Append_Entity_Name (Temp, Scope (Scop));
             Append (Temp, '.');
 
          --  Otherwise nothing to output (happens in unnamed block statements)
@@ -23295,6 +23300,7 @@ package body Sem_Util is
    function Subprogram_Name (N : Node_Id) return String is
       Buf : Bounded_String;
       Ent : Node_Id := N;
+      Nod : Node_Id;
 
    begin
       while Present (Ent) loop
@@ -23303,17 +23309,32 @@ package body Sem_Util is
                Ent := Defining_Unit_Name (Specification (Ent));
                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_Subprogram_Specification
             =>
                Ent := Defining_Unit_Name (Ent);
                exit;
 
+            when N_Protected_Type_Declaration =>
+               Ent := Corresponding_Body (Ent);
+               exit;
+
             when N_Protected_Body
-               | N_Protected_Type_Declaration
                | N_Task_Body
             =>
+               Ent := Defining_Identifier (Ent);
                exit;
 
             when others =>
@@ -23324,18 +23345,32 @@ package body Sem_Util is
       end loop;
 
       if No (Ent) then
-         return "unknown subprogram";
+         return "unknown subprogram:unknown file:0:0";
       end if;
 
       --  If the subprogram is a child unit, use its simple name to start the
       --  construction of the fully qualified name.
 
       if Nkind (Ent) = N_Defining_Program_Unit_Name then
-         Append_Entity_Name (Buf, Defining_Identifier (Ent));
-      else
-         Append_Entity_Name (Buf, Ent);
+         Ent := Defining_Identifier (Ent);
       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;
    end Subprogram_Name;