[COMMITTED,10/31] ada: Add "finally" GNAT extension

Message ID 20250107125350.619654-10-poulhies@adacore.com
State New
Headers
Series [COMMITTED,01/31] ada: Restrict previous change made to expansion of allocators |

Commit Message

Marc Poulhiès Jan. 7, 2025, 12:53 p.m. UTC
  From: Ronan Desplanques <desplanques@adacore.com>

This patch adds a new reserved word, "finally", and accompanying new
syntax that's similar to the Java equivalent.

gcc/ada/ChangeLog:

	* atree.adb (Parent_Or_List_Containing): New function.
	* atree.ads (Parent_Or_List_Containing): Likewise.
	* gen_il-fields.ads: Add new field.
	* gen_il-gen-gen_nodes.adb (Gen_Nodes): Extend handled sequence of
	statements node.
	* par-ch11.adb (P_Handled_Sequence_Of_Statements, P_Exception_Handler):
	Add new syntactic construct.
	* par-ch5.adb (P_Sequence_Of_Statements): Likewise.
	* par.adb: Likewise.
	* par-util.adb (Check_Future_Keyword): Warn that "finally" becomes a
	reserved word with extensions.
	* scans.adb (Initialize_Ada_Keywords): Add new reserved word.
	* snames.adb-tmpl: Likewise.
	* snames.ads-tmpl: Likewise.
	* scans.ads: Likewise.
	* sem_ch11.adb (Analyze_Handled_Statements): Adapt to new node field.
	* sem_ch5.adb (Analyze_Exit_Statement): Add legality check.
	(Analyze_Goto_Statement): Likewise.
	* sem_ch6.adb (Analyze_Return_Statement): Likewise.
	* sinfo-utils.adb (Lowest_Common_Ancestor, Destroy_Element): New
	subprograms.
	* sinfo-utils.ads (Lowest_Common_Ancestor): New function.
	* sinfo.ads: Add documentation for new field.
	* xsnamest.adb: Fix typo in comment.
	* doc/gnat_rm/gnat_language_extensions.rst: Document new extension.
	* warnsw.adb: Add new option.
	* warnsw.ads: Likewise.
	* exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Add abort
	deferral to finally part.
	* gnat_rm.texi: Regenerate.
	* gnat_ugn.texi: Regenerate.
	* gcc-interface/trans.cc (Handled_Sequence_Of_Statements_to_gnu):
	Handle finally statements.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/atree.adb                             |  15 ++
 gcc/ada/atree.ads                             |   5 +
 .../doc/gnat_rm/gnat_language_extensions.rst  |  43 ++++++
 gcc/ada/exp_ch11.adb                          |  12 ++
 gcc/ada/gcc-interface/trans.cc                |  23 ++++
 gcc/ada/gen_il-fields.ads                     |   1 +
 gcc/ada/gen_il-gen-gen_nodes.adb              |   1 +
 gcc/ada/gnat_rm.texi                          | 129 +++++++++++++-----
 gcc/ada/gnat_ugn.texi                         |   2 +-
 gcc/ada/par-ch11.adb                          |  11 +-
 gcc/ada/par-ch5.adb                           |  19 +++
 gcc/ada/par-util.adb                          |   8 ++
 gcc/ada/par.adb                               |  20 +--
 gcc/ada/scans.adb                             |   3 +
 gcc/ada/scans.ads                             |   1 +
 gcc/ada/sem_ch11.adb                          |   4 +
 gcc/ada/sem_ch5.adb                           |  56 +++++++-
 gcc/ada/sem_ch6.adb                           |  17 +++
 gcc/ada/sinfo-utils.adb                       |  68 +++++++++
 gcc/ada/sinfo-utils.ads                       |   4 +
 gcc/ada/sinfo.ads                             |   4 +
 gcc/ada/snames.adb-tmpl                       |   4 +-
 gcc/ada/snames.ads-tmpl                       |  10 ++
 gcc/ada/warnsw.adb                            |   1 +
 gcc/ada/warnsw.ads                            |   6 +
 gcc/ada/xsnamest.adb                          |   2 +-
 26 files changed, 421 insertions(+), 48 deletions(-)
  

Patch

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 8cc22394b0c..c2e026bcc6d 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -2076,6 +2076,21 @@  package body Atree is
       end if;
    end Node_Parent;
 
+   -------------------------------
+   -- Parent_Or_List_Containing --
+   -------------------------------
+
+   function Parent_Or_List_Containing (X : Union_Id) return Union_Id is
+   begin
+      if X in Node_Range then
+         return Link (Node_Id (X));
+      elsif X in List_Range then
+         return Union_Id (List_Parent (List_Id (X)));
+      else
+         raise Program_Error;
+      end if;
+   end Parent_Or_List_Containing;
+
    -------------
    -- Present --
    -------------
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 834cc3150f5..3adfb824a17 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -456,6 +456,11 @@  package Atree is
    --  Parent has the same name as the one in Nlists; Node_Parent can be used
    --  more easily in the debugger.
 
+   function Parent_Or_List_Containing (X : Union_Id) return Union_Id;
+   --  X must be in Node_Range or in List_Range. If X is in Node_Range and is
+   --  contained in a list, returns that list, otherwise return the parent of
+   --  the list or node represented by X.
+
    function Paren_Count (N : Node_Id) return Nat;
    pragma Inline (Paren_Count);
    --  Number of parentheses that surround an expression
diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
index 4e7f9fae602..ee2df668eb1 100644
--- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
+++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
@@ -1723,3 +1723,46 @@  Example:
 If ``Path`` is a relative path, it is interpreted relatively to the directory of the file that contains the aspect specification.
 
 .. attention:: The maximum size of loaded files is limited to 2\ :sup:`31` bytes.
+
+
+Finally construct
+-----------------
+
+The ``finally`` keyword makes it possible to have a sequence of statements be executed when
+another sequence of statements is completed, whether normally or abnormally.
+
+This feature is similar to the one with the same name in other languages such as Java.
+
+Syntax
+^^^^^^
+
+.. code-block:: text
+
+   handled_sequence_of_statements ::=
+        sequence_of_statements
+     [exception
+        exception_handler
+       {exception_handler}]
+     [finally
+       sequence_of_statements]
+
+Legality Rules
+^^^^^^^^^^^^^^
+
+Return statements in the ``sequence_of_statements`` attached to the finally that would cause control
+to be transferred outside the finally part are forbidden.
+
+Goto & exit where the target is outside of the finally's ``sequence_of_statements`` are forbidden
+
+Dynamic Semantics
+^^^^^^^^^^^^^^^^^
+
+Statements in the optional ``sequence_of_statements`` contained in the ``finally`` branch will be
+executed unconditionally, after the main ``sequence_of_statements`` is executed, and after any
+potential ``exception_handler`` is executed.
+
+If an exception is raised in the finally part, it cannot be caught by the ``exception_handler``.
+
+Abort/ATC (asynchronous transfer of control) cannot interrupt a finally block, nor prevent its
+execution, that is the finally block must be executed in full even if the containing task is
+aborted, or if the control is transferred out of the block.
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index eda9f17fa7d..66f38671008 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1301,6 +1301,18 @@  package body Exp_Ch11 is
          pragma Assert (not Is_Thunk (Current_Scope));
          Expand_Cleanup_Actions (Parent (N));
       end if;
+
+      if Present (Finally_Statements (N)) then
+         Prepend_To
+           (Finally_Statements (N),
+            Build_Runtime_Call (Sloc (N), RE_Abort_Defer));
+
+         Append_To
+           (Finally_Statements (N),
+            Build_Runtime_Call (Sloc (N), RE_Abort_Undefer));
+
+         Analyze_List (Finally_Statements (N));
+      end if;
    end Expand_N_Handled_Sequence_Of_Statements;
 
    -------------------------------------
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 3aa41253d74..cda73d509e8 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -5674,6 +5674,29 @@  Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
 	set_expr_location_from_node (gnu_result, gnat_node, true);
     }
 
+  if (Present (Finally_Statements (gnat_node)))
+    {
+      tree finally_stmts;
+      location_t locus;
+
+      start_stmt_group ();
+      for (gnat_temp = First_Non_Pragma (Finally_Statements (gnat_node));
+           Present (gnat_temp);
+           gnat_temp = Next_Non_Pragma (gnat_temp))
+        add_stmt (gnat_to_gnu (gnat_temp));
+      finally_stmts = end_stmt_group ();
+
+      gnu_result
+        = build2 (TRY_FINALLY_EXPR, void_type_node, gnu_result, finally_stmts);
+
+      /* Do as above for the TRY_CATCH_EXPR case.  */
+      if (Present (End_Label (gnat_node))
+          && Sloc_to_locus (Sloc (End_Label (gnat_node)), &locus))
+        SET_EXPR_LOCATION (gnu_result, locus);
+      else
+        set_expr_location_from_node (gnu_result, gnat_node, true);
+    }
+
   /* Process the At_End_Proc, if any.  */
   if (at_end)
     {
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 52c6997e6c9..70ece337e63 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -184,6 +184,7 @@  package Gen_IL.Fields is
       Expression_Copy,
       Expressions,
       File_Index,
+      Finally_Statements,
       First_Bit,
       First_Inlined_Subprogram,
       First_Name,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 9b8801b4b84..af5049bf33e 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -1349,6 +1349,7 @@  begin -- Gen_IL.Gen.Gen_Nodes
        (Sy (Statements, List_Id, Default_Empty_List),
         Sy (End_Label, Node_Id, Default_Empty),
         Sy (Exception_Handlers, List_Id, Default_No_List),
+        Sy (Finally_Statements, List_Id, Default_No_List),
         Sy (At_End_Proc, Node_Id, Default_Empty)));
 
    Cc (N_Index_Or_Discriminant_Constraint, Node_Kind,
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index d872c111a1b..97469d73952 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -925,6 +925,7 @@  Experimental Language Extensions
 * No_Raise aspect:: 
 * Inference of Dependent Types in Generic Instantiations:: 
 * External_Initialization Aspect:: 
+* Finally construct:: 
 
 Storage Model
 
@@ -945,6 +946,12 @@  No_Raise aspect
 * Composite types:: 
 * Interoperability with controlled types:: 
 
+Finally construct
+
+* Syntax: Syntax<2>. 
+* Legality Rules: Legality Rules<2>. 
+* Dynamic Semantics: Dynamic Semantics<2>. 
+
 Security Hardening Features
 
 * Register Scrubbing:: 
@@ -29898,6 +29905,7 @@  Features activated via @code{-gnatX0} or
 * No_Raise aspect:: 
 * Inference of Dependent Types in Generic Instantiations:: 
 * External_Initialization Aspect:: 
+* Finally construct:: 
 
 @end menu
 
@@ -31149,7 +31157,7 @@  package Int_Array_Operations is new Array_Operations
       Array_Type   => Int_Array);
 @end example
 
-@node External_Initialization Aspect,,Inference of Dependent Types in Generic Instantiations,Experimental Language Extensions
+@node External_Initialization Aspect,Finally construct,Inference of Dependent Types in Generic Instantiations,Experimental Language Extensions
 @anchor{gnat_rm/gnat_language_extensions external-initialization-aspect}@anchor{469}
 @subsection External_Initialization Aspect
 
@@ -31190,8 +31198,65 @@  The maximum size of loaded files is limited to 2@w{^31} bytes.
 @end quotation
 @end cartouche
 
+@node Finally construct,,External_Initialization Aspect,Experimental Language Extensions
+@anchor{gnat_rm/gnat_language_extensions finally-construct}@anchor{46a}
+@subsection Finally construct
+
+
+The @code{finally} keyword makes it possible to have a sequence of statements be executed when
+another sequence of statements is completed, whether normally or abnormally.
+
+This feature is similar to the one with the same name in other languages such as Java.
+
+@menu
+* Syntax: Syntax<2>. 
+* Legality Rules: Legality Rules<2>. 
+* Dynamic Semantics: Dynamic Semantics<2>. 
+
+@end menu
+
+@node Syntax<2>,Legality Rules<2>,,Finally construct
+@anchor{gnat_rm/gnat_language_extensions id4}@anchor{46b}
+@subsubsection Syntax
+
+
+@example
+handled_sequence_of_statements ::=
+     sequence_of_statements
+  [exception
+     exception_handler
+    @{exception_handler@}]
+  [finally
+    sequence_of_statements]
+@end example
+
+@node Legality Rules<2>,Dynamic Semantics<2>,Syntax<2>,Finally construct
+@anchor{gnat_rm/gnat_language_extensions id5}@anchor{46c}
+@subsubsection Legality Rules
+
+
+Return statements in the @code{sequence_of_statements} attached to the finally that would cause control
+to be transferred outside the finally part are forbidden.
+
+Goto & exit where the target is outside of the finally’s @code{sequence_of_statements} are forbidden
+
+@node Dynamic Semantics<2>,,Legality Rules<2>,Finally construct
+@anchor{gnat_rm/gnat_language_extensions id6}@anchor{46d}
+@subsubsection Dynamic Semantics
+
+
+Statements in the optional @code{sequence_of_statements} contained in the @code{finally} branch will be
+executed unconditionally, after the main @code{sequence_of_statements} is executed, and after any
+potential @code{exception_handler} is executed.
+
+If an exception is raised in the finally part, it cannot be caught by the @code{exception_handler}.
+
+Abort/ATC (asynchronous transfer of control) cannot interrupt a finally block, nor prevent its
+execution, that is the finally block must be executed in full even if the containing task is
+aborted, or if the control is transferred out of the block.
+
 @node Security Hardening Features,Obsolescent Features,GNAT language extensions,Top
-@anchor{gnat_rm/security_hardening_features doc}@anchor{46a}@anchor{gnat_rm/security_hardening_features id1}@anchor{46b}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15}
+@anchor{gnat_rm/security_hardening_features doc}@anchor{46e}@anchor{gnat_rm/security_hardening_features id1}@anchor{46f}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15}
 @chapter Security Hardening Features
 
 
@@ -31213,7 +31278,7 @@  change.
 @end menu
 
 @node Register Scrubbing,Stack Scrubbing,,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{46c}
+@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{470}
 @section Register Scrubbing
 
 
@@ -31249,7 +31314,7 @@  programming languages, see @cite{Using the GNU Compiler Collection (GCC)}.
 @c Stack Scrubbing:
 
 @node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{46d}
+@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{471}
 @section Stack Scrubbing
 
 
@@ -31393,7 +31458,7 @@  Bar_Callable_Ptr.
 @c Hardened Conditionals:
 
 @node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{46e}
+@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{472}
 @section Hardened Conditionals
 
 
@@ -31483,7 +31548,7 @@  be used with other programming languages supported by GCC.
 @c Hardened Booleans:
 
 @node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{46f}
+@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{473}
 @section Hardened Booleans
 
 
@@ -31544,7 +31609,7 @@  and more details on that attribute, see @cite{Using the GNU Compiler Collection
 @c Control Flow Redundancy:
 
 @node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{470}
+@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{474}
 @section Control Flow Redundancy
 
 
@@ -31712,7 +31777,7 @@  see @cite{Using the GNU Compiler Collection (GCC)}.  These options
 can be used with other programming languages supported by GCC.
 
 @node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top
-@anchor{gnat_rm/obsolescent_features doc}@anchor{471}@anchor{gnat_rm/obsolescent_features id1}@anchor{472}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
+@anchor{gnat_rm/obsolescent_features doc}@anchor{475}@anchor{gnat_rm/obsolescent_features id1}@anchor{476}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
 @chapter Obsolescent Features
 
 
@@ -31731,7 +31796,7 @@  compatibility purposes.
 @end menu
 
 @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id2}@anchor{473}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{474}
+@anchor{gnat_rm/obsolescent_features id2}@anchor{477}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{478}
 @section pragma No_Run_Time
 
 
@@ -31744,7 +31809,7 @@  preferred usage is to use an appropriately configured run-time that
 includes just those features that are to be made accessible.
 
 @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id3}@anchor{475}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{476}
+@anchor{gnat_rm/obsolescent_features id3}@anchor{479}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{47a}
 @section pragma Ravenscar
 
 
@@ -31753,7 +31818,7 @@  The pragma @code{Ravenscar} has exactly the same effect as pragma
 is part of the new Ada 2005 standard.
 
 @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id4}@anchor{477}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{478}
+@anchor{gnat_rm/obsolescent_features id4}@anchor{47b}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{47c}
 @section pragma Restricted_Run_Time
 
 
@@ -31763,7 +31828,7 @@  preferred since the Ada 2005 pragma @code{Profile} is intended for
 this kind of implementation dependent addition.
 
 @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id5}@anchor{479}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{47a}
+@anchor{gnat_rm/obsolescent_features id5}@anchor{47d}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{47e}
 @section pragma Task_Info
 
 
@@ -31789,7 +31854,7 @@  in the spec of package System.Task_Info in the runtime
 library.
 
 @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{47b}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{47c}
+@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{47f}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{480}
 @section package System.Task_Info (@code{s-tasinf.ads})
 
 
@@ -31799,7 +31864,7 @@  to support the @code{Task_Info} pragma. The predefined Ada package
 standard replacement for GNAT’s @code{Task_Info} functionality.
 
 @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top
-@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{47d}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{47e}
+@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{481}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{482}
 @chapter Compatibility and Porting Guide
 
 
@@ -31821,7 +31886,7 @@  applications developed in other Ada environments.
 @end menu
 
 @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{47f}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{480}
+@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{483}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{484}
 @section Writing Portable Fixed-Point Declarations
 
 
@@ -31943,7 +32008,7 @@  If you follow this scheme you will be guaranteed that your fixed-point
 types will be portable.
 
 @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{481}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{482}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{485}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{486}
 @section Compatibility with Ada 83
 
 
@@ -31971,7 +32036,7 @@  following subsections treat the most likely issues to be encountered.
 @end menu
 
 @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{483}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{484}
+@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{487}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{488}
 @subsection Legal Ada 83 programs that are illegal in Ada 95
 
 
@@ -32071,7 +32136,7 @@  the fix is usually simply to add the @code{(<>)} to the generic declaration.
 @end itemize
 
 @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{485}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{486}
+@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{489}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{48a}
 @subsection More deterministic semantics
 
 
@@ -32099,7 +32164,7 @@  which open select branches are executed.
 @end itemize
 
 @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{487}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{488}
+@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{48b}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{48c}
 @subsection Changed semantics
 
 
@@ -32141,7 +32206,7 @@  covers only the restricted range.
 @end itemize
 
 @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{489}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{48a}
+@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{48d}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{48e}
 @subsection Other language compatibility issues
 
 
@@ -32174,7 +32239,7 @@  include @code{pragma Interface} and the floating point type attributes
 @end itemize
 
 @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{48b}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{48c}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{48f}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{490}
 @section Compatibility between Ada 95 and Ada 2005
 
 
@@ -32246,7 +32311,7 @@  can declare a function returning a value from an anonymous access type.
 @end itemize
 
 @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{48d}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{48e}
+@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{491}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{492}
 @section Implementation-dependent characteristics
 
 
@@ -32269,7 +32334,7 @@  transition from certain Ada 83 compilers.
 @end menu
 
 @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{48f}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{490}
+@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{493}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{494}
 @subsection Implementation-defined pragmas
 
 
@@ -32291,7 +32356,7 @@  avoiding compiler rejection of units that contain such pragmas; they are not
 relevant in a GNAT context and hence are not otherwise implemented.
 
 @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{491}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{492}
+@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{495}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{496}
 @subsection Implementation-defined attributes
 
 
@@ -32305,7 +32370,7 @@  Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and
 @code{Type_Class}.
 
 @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{493}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{494}
+@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{497}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{498}
 @subsection Libraries
 
 
@@ -32334,7 +32399,7 @@  be preferable to retrofit the application using modular types.
 @end itemize
 
 @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{495}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{496}
+@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{499}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{49a}
 @subsection Elaboration order
 
 
@@ -32370,7 +32435,7 @@  pragmas either globally (as an effect of the `-gnatE' switch) or locally
 @end itemize
 
 @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{497}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{498}
+@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{49b}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{49c}
 @subsection Target-specific aspects
 
 
@@ -32383,10 +32448,10 @@  on the robustness of the original design.  Moreover, Ada 95 (and thus
 Ada 2005 and Ada 2012) are sometimes
 incompatible with typical Ada 83 compiler practices regarding implicit
 packing, the meaning of the Size attribute, and the size of access values.
-GNAT’s approach to these issues is described in @ref{499,,Representation Clauses}.
+GNAT’s approach to these issues is described in @ref{49d,,Representation Clauses}.
 
 @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{49a}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{49b}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{49e}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{49f}
 @section Compatibility with Other Ada Systems
 
 
@@ -32429,7 +32494,7 @@  far beyond this minimal set, as described in the next section.
 @end itemize
 
 @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{49c}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{499}
+@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{4a0}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{49d}
 @section Representation Clauses
 
 
@@ -32522,7 +32587,7 @@  with thin pointers.
 @end itemize
 
 @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{49d}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{49e}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{4a1}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{4a2}
 @section Compatibility with HP Ada 83
 
 
@@ -32552,7 +32617,7 @@  extension of package System.
 @end itemize
 
 @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top
-@anchor{share/gnu_free_documentation_license doc}@anchor{49f}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{4a0}
+@anchor{share/gnu_free_documentation_license doc}@anchor{4a3}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{4a4}
 @chapter GNU Free Documentation License
 
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 252b32f74ae..0b62540a2fd 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -29839,8 +29839,8 @@  to permit their use in free software.
 
 @printindex ge
 
-@anchor{d2}@w{                              }
 @anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{                              }
+@anchor{d2}@w{                              }
 
 @c %**end of body
 @bye
diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb
index d935b58807e..c988aa7099f 100644
--- a/gcc/ada/par-ch11.adb
+++ b/gcc/ada/par-ch11.adb
@@ -61,7 +61,7 @@  package body Ch11 is
       Handled_Stmt_Seq_Node :=
         New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
       Set_Statements
-        (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
+        (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Fitm_Sreq));
 
       if Token = Tok_Exception then
          Scan; -- past EXCEPTION
@@ -69,6 +69,12 @@  package body Ch11 is
            (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
       end if;
 
+      if Token = Tok_Finally then
+         Scan; -- past FINALLY
+         Set_Finally_Statements
+           (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Sreq));
+      end if;
+
       return Handled_Stmt_Seq_Node;
    end P_Handled_Sequence_Of_Statements;
 
@@ -141,7 +147,8 @@  package body Ch11 is
       end loop;
 
       TF_Arrow;
-      Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
+      Set_Statements
+        (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Fitm_Whtm));
       return Handler_Node;
    end P_Exception_Handler;
 
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 6e6690395f1..f49c7eb3c14 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -408,6 +408,25 @@  package body Ch5 is
 
                   exit;
 
+               --  Case of finally
+
+               when Tok_Finally =>
+                  Test_Statement_Required;
+
+                  --  See the analogous comment in the Tok_Exception branch.
+
+                  if not SS_Flags.Fitm
+                    and then Start_Column >= Scopes (Scope.Last).Ecol
+                  then
+                     Error_Msg_SC ("finally construct not permitted here");
+                     Scan; -- past FINALLY
+                     Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
+                  end if;
+
+                  --  We exit like in the exception branch, should we really???
+
+                  exit;
+
                --  Case of OR
 
                when Tok_Or =>
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index f254026431f..d93425aec76 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -199,6 +199,14 @@  package body Util is
          end if;
       end if;
 
+      if Ada_Version < Ada_With_All_Extensions then
+         if Token_Name = Name_Finally then
+            Error_Msg_N
+              ("& is a reserved word with all extensions enabled?",
+               Token_Node);
+         end if;
+      end if;
+
       --  Note: we deliberately do not emit these warnings when operating in
       --  Ada 83 mode because in that case we assume the user is building
       --  legacy code anyway and is not interested in updating Ada versions.
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 0df0c67daeb..c518fd43d62 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -400,6 +400,7 @@  function Par (Configuration_Pragmas : Boolean) return List_Id is
       Eftm : Boolean;      -- ELSIF can terminate sequence
       Eltm : Boolean;      -- ELSE can terminate sequence
       Extm : Boolean;      -- EXCEPTION can terminate sequence
+      Fitm : Boolean;      -- FINALLY can terminate sequence
       Ortm : Boolean;      -- OR can terminate sequence
       Sreq : Boolean;      -- at least one statement required
       Tatm : Boolean;      -- THEN ABORT can terminate sequence
@@ -408,15 +409,16 @@  function Par (Configuration_Pragmas : Boolean) return List_Id is
    end record;
    pragma Pack (SS_Rec);
 
-   SS_Eftm_Eltm_Sreq : constant SS_Rec := (T, T, F, F, T, F, F, F);
-   SS_Eltm_Ortm_Tatm : constant SS_Rec := (F, T, F, T, F, T, F, F);
-   SS_Extm_Sreq      : constant SS_Rec := (F, F, T, F, T, F, F, F);
-   SS_None           : constant SS_Rec := (F, F, F, F, F, F, F, F);
-   SS_Ortm_Sreq      : constant SS_Rec := (F, F, F, T, T, F, F, F);
-   SS_Sreq           : constant SS_Rec := (F, F, F, F, T, F, F, F);
-   SS_Sreq_Whtm      : constant SS_Rec := (F, F, F, F, T, F, T, F);
-   SS_Whtm           : constant SS_Rec := (F, F, F, F, F, F, T, F);
-   SS_Unco           : constant SS_Rec := (F, F, F, F, F, F, F, T);
+   SS_Eftm_Eltm_Sreq : constant SS_Rec := (T, T, F, F, F, T, F, F, F);
+   SS_Eltm_Ortm_Tatm : constant SS_Rec := (F, T, F, F, T, F, T, F, F);
+   SS_Extm_Fitm_Sreq : constant SS_Rec := (F, F, T, T, F, T, F, F, F);
+   SS_None           : constant SS_Rec := (F, F, F, F, F, F, F, F, F);
+   SS_Ortm_Sreq      : constant SS_Rec := (F, F, F, F, T, T, F, F, F);
+   SS_Sreq           : constant SS_Rec := (F, F, F, F, F, T, F, F, F);
+   SS_Sreq_Whtm      : constant SS_Rec := (F, F, F, F, F, T, F, T, F);
+   SS_Sreq_Fitm_Whtm : constant SS_Rec := (F, F, F, T, F, T, F, T, F);
+   SS_Whtm           : constant SS_Rec := (F, F, F, F, F, F, F, T, F);
+   SS_Unco           : constant SS_Rec := (F, F, F, F, F, F, F, F, T);
 
    Goto_List : Elist_Id;
    --  List of goto nodes appearing in the current compilation. Used to
diff --git a/gcc/ada/scans.adb b/gcc/ada/scans.adb
index 580f90ee727..23aee522165 100644
--- a/gcc/ada/scans.adb
+++ b/gcc/ada/scans.adb
@@ -134,6 +134,9 @@  package body Scans is
       --  Ada 2012 reserved words
 
       Set_Reserved (Name_Some, Tok_Some);
+
+      --  GNAT extensions reserved words
+      Set_Reserved (Name_Finally, Tok_Finally);
    end Initialize_Ada_Keywords;
 
    ------------------
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index c445635262a..0fce5cc3162 100644
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -159,6 +159,7 @@  package Scans is
       Tok_End,             -- END          Eterm, Sterm, After_SM
       Tok_Exception,       -- EXCEPTION    Eterm, Sterm, After_SM
       Tok_Exit,            -- EXIT         Eterm, Sterm, After_SM
+      Tok_Finally,         -- FINALLY      Eterm, Sterm, After_SM
       Tok_Goto,            -- GOTO         Eterm, Sterm, After_SM
       Tok_If,              -- IF           Eterm, Sterm, After_SM
       Tok_Pragma,          -- PRAGMA       Eterm, Sterm, After_SM
diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index e1b68359059..0a4611552b1 100644
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -443,6 +443,10 @@  package body Sem_Ch11 is
       elsif Present (At_End_Proc (N)) then
          Analyze (At_End_Proc (N));
       end if;
+
+      if Present (Finally_Statements (N)) then
+         Analyze_Statements (Finally_Statements (N));
+      end if;
    end Analyze_Handled_Statements;
 
    ------------------------------
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 944259a532a..5fc6001b254 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1249,9 +1249,12 @@  package body Sem_Ch5 is
 
       begin
          --  Initialize unblocked exit count for statements of begin block
-         --  plus one for each exception handler that is present.
+         --  plus one for each exception handler that is present, plus one for
+         --  the finally part if it present.
 
-         Unblocked_Exit_Count := 1 + List_Length (EH);
+         Unblocked_Exit_Count :=
+           1 + List_Length (EH)
+           + (if Present (Finally_Statements (HSS)) then 1 else 0);
 
          --  If a label is present analyze it and mark it as referenced
 
@@ -1706,6 +1709,33 @@  package body Sem_Ch5 is
          end if;
       end loop;
 
+      Finally_Legality_Check : declare
+         --  The following value can actually be a block statement due to
+         --  expansion, but we call it Target_Loop_Statement because it was
+         --  originally a loop statement.
+         Target_Loop_Statement : constant Node_Id :=
+           (if Present (U_Name) then Label_Construct ((Parent (U_Name)))
+            else Empty);
+
+         X : Node_Id := N;
+      begin
+         while Present (X) loop
+            if Nkind (X) = N_Loop_Statement
+              and then (No (Target_Loop_Statement)
+                        or else X = Target_Loop_Statement)
+            then
+               exit;
+            elsif Nkind (Parent (X)) = N_Handled_Sequence_Of_Statements
+              and then Is_List_Member (X)
+              and then List_Containing (X) = Finally_Statements (Parent (X))
+            then
+               Error_Msg_N ("cannot exit out of finally part", N);
+               exit;
+            end if;
+            X := Parent (X);
+         end loop;
+      end Finally_Legality_Check;
+
       --  Verify that if present the condition is a Boolean expression
 
       if Present (Cond) then
@@ -1767,6 +1797,28 @@  package body Sem_Ch5 is
          return;
       end if;
 
+      Finally_Legality_Check : declare
+         LCA : constant Union_Id :=
+           Lowest_Common_Ancestor (N, Label_Construct (Parent (Label_Ent)));
+
+         N1 : Union_Id := Union_Id (N);
+         N2 : Union_Id;
+      begin
+         while N1 /= LCA loop
+            N2 := Parent_Or_List_Containing (N1);
+
+            if N2 in Node_Range
+              and then Nkind (Node_Id (N2)) = N_Handled_Sequence_Of_Statements
+              and then Union_Id (Finally_Statements (Node_Id (N2))) = N1
+            then
+               Error_Msg_N ("cannot goto out of finally part", N);
+               exit;
+            end if;
+
+            N1 := N2;
+         end loop;
+      end Finally_Legality_Check;
+
       --  Here if goto passes initial validity checks
 
       Label_Scope := Enclosing_Scope (Label_Ent);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 1e91bf810ef..d81bdc50ee0 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2028,6 +2028,23 @@  package body Sem_Ch6 is
          End_Scope;
       end if;
 
+      Finally_Legality_Check : declare
+         X : Node_Id := N;
+      begin
+         while Present (X) loop
+            if Nkind (X) in N_Proper_Body then
+               exit;
+            elsif Nkind (Parent (X)) = N_Handled_Sequence_Of_Statements
+              and then Is_List_Member (X)
+              and then List_Containing (X) = Finally_Statements (Parent (X))
+            then
+               Error_Msg_N ("cannot return out of finally part", N);
+               exit;
+            end if;
+            X := Parent (X);
+         end loop;
+      end Finally_Legality_Check;
+
       Kill_Current_Values (Last_Assignment_Only => True);
       Check_Unreachable_Code (N);
 
diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb
index 666024284ba..d3436b20ccb 100644
--- a/gcc/ada/sinfo-utils.adb
+++ b/gcc/ada/sinfo-utils.adb
@@ -25,6 +25,7 @@ 
 
 with Atree;  use Atree;
 with Debug;  use Debug;
+with GNAT.Lists;
 with Output; use Output;
 with Seinfo;
 with Sinput; use Sinput;
@@ -346,6 +347,73 @@  package body Sinfo.Utils is
       end if;
    end Get_Pragma_Arg;
 
+   procedure Destroy_Element (Elem : in out Union_Id);
+   --  Does not do anything but is used to instantiate
+   --  GNAT.Lists.Doubly_Linked_Lists.
+
+   ---------------------
+   -- Destroy_Element --
+   ---------------------
+
+   procedure Destroy_Element (Elem : in out Union_Id) is
+   begin
+      null;
+   end Destroy_Element;
+
+   package Lists is
+     new GNAT.Lists.Doubly_Linked_Lists
+       (Element_Type => Union_Id, "=" => "=",
+      Destroy_Element => Destroy_Element, Check_Tampering => False);
+
+   ----------------------------
+   -- Lowest_Common_Ancestor --
+   ----------------------------
+
+   function Lowest_Common_Ancestor (N1, N2 : Node_Id) return Union_Id is
+      function Path_From_Root (N : Node_Id) return Lists.Doubly_Linked_List;
+
+      --------------------
+      -- Path_From_Root --
+      --------------------
+
+      function Path_From_Root (N : Node_Id) return Lists.Doubly_Linked_List is
+         L : constant Lists.Doubly_Linked_List := Lists.Create;
+
+         X : Union_Id := Union_Id (N);
+      begin
+         while X /= Union_Id (Empty) loop
+            Lists.Prepend (L, X);
+            X := Parent_Or_List_Containing (X);
+         end loop;
+
+         return L;
+      end Path_From_Root;
+
+      L1 : Lists.Doubly_Linked_List := Path_From_Root (N1);
+      L2 : Lists.Doubly_Linked_List := Path_From_Root (N2);
+
+      X1, X2 : Union_Id;
+
+      Common_Ancestor : Union_Id := Union_Id (Empty);
+   begin
+      while not Lists.Is_Empty (L1) and then not Lists.Is_Empty (L2) loop
+         X1 := Lists.First (L1);
+         Lists.Delete_First (L1);
+
+         X2 := Lists.First (L2);
+         Lists.Delete_First (L2);
+
+         exit when X1 /= X2;
+
+         Common_Ancestor := X1;
+      end loop;
+
+      Lists.Destroy (L1);
+      Lists.Destroy (L2);
+
+      return Common_Ancestor;
+   end Lowest_Common_Ancestor;
+
    ----------------------
    -- Set_End_Location --
    ----------------------
diff --git a/gcc/ada/sinfo-utils.ads b/gcc/ada/sinfo-utils.ads
index ebb96992802..632ebf95c54 100644
--- a/gcc/ada/sinfo-utils.ads
+++ b/gcc/ada/sinfo-utils.ads
@@ -137,6 +137,10 @@  package Sinfo.Utils is
    --  for the argument. This is Arg itself, or, in the case where Arg is a
    --  pragma argument association node, the expression from this node.
 
+   function Lowest_Common_Ancestor (N1, N2 : Node_Id) return Union_Id;
+   --  Returns the list or node that is the lowest common ancestor of N1 and
+   --  N2 in the syntax tree.
+
    -----------------------
    -- Utility Functions --
    -----------------------
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 06a976c935c..6abda7474bb 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1300,6 +1300,10 @@  package Sinfo is
    --    Present in N_External_Initializer nodes. Contains a Source_File_Index
    --    that references the file the external initializer points to.
 
+   --  Finally_Statements
+   --    Present in N_Handled_Statement_Sequences nodes. Points to a list
+   --    containing statements.
+
    --  First_Inlined_Subprogram
    --    Present in the N_Compilation_Unit node for the main program. Points
    --    to a chain of entities for subprograms that are to be inlined. The
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index 7f270b41f0e..d49fdf4d74a 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -431,7 +431,9 @@  package body Snames is
                    --  for compatibility with Ada 95 compilers implementing
                    --  only this Ada 2005 extension.
         and then (Ada_Version >= Ada_2012
-                   or else N not in Ada_2012_Reserved_Words);
+                   or else N not in Ada_2012_Reserved_Words)
+        and then (Ada_Version >= Ada_With_All_Extensions
+                   or else N not in GNAT_Extensions_Reserved_Words);
    end Is_Keyword_Name;
 
    --------------------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 539b77d8411..59637940bee 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -1432,6 +1432,16 @@  package Snames is
    subtype Ada_2012_Reserved_Words is Name_Id
      range First_2012_Reserved_Word .. Last_2012_Reserved_Word;
 
+   --  GNAT extensions reserved words
+
+   First_GNAT_Extensions_Reserved_Word   : constant Name_Id := N + $;
+   Name_Finally                          : constant Name_Id := N + $;
+   Last_GNAT_Extensions_Reserved_Word    : constant Name_Id := N + $;
+
+   subtype GNAT_Extensions_Reserved_Words is Name_Id
+     range First_GNAT_Extensions_Reserved_Word ..
+       Last_GNAT_Extensions_Reserved_Word;
+
    --  Mark last defined name for consistency check in Snames body
 
    Last_Predefined_Name                  : constant Name_Id := N + $;
diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb
index 2bfb56ec513..a104dca97ea 100644
--- a/gcc/ada/warnsw.adb
+++ b/gcc/ada/warnsw.adb
@@ -110,6 +110,7 @@  package body Warnsw is
       X.Warning_Doc_Switch |
       X.Warn_On_Ada_2022_Compatibility |
       X.Warn_On_Elab_Access |
+      X.Warn_On_GNAT_Extension_Compatibility |
       X.No_Warn_On_Non_Local_Exception => False,
       others => True);
    --  Warning_Doc_Switch is not really a warning to be enabled, but controls
diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads
index 0ca0f68e1ec..04ba566eef1 100644
--- a/gcc/ada/warnsw.ads
+++ b/gcc/ada/warnsw.ads
@@ -69,6 +69,7 @@  package Warnsw is
          Warn_On_Dereference,
          Warn_On_Elab_Access,
          Warn_On_Export_Import,
+         Warn_On_GNAT_Extension_Compatibility,
          Warn_On_Hiding,
          Warn_On_Ignored_Equality,
          Warn_On_Ineffective_Predicate_Test,
@@ -128,6 +129,7 @@  package Warnsw is
       Warn_On_Assumed_Low_Bound |
       Warn_On_Biased_Representation |
       Warn_On_Export_Import |
+      Warn_On_GNAT_Extension_Compatibility |
       Warn_On_No_Value_Assigned |
       Warn_On_Questionable_Missing_Parens |
       Warn_On_Reverse_Bit_Order |
@@ -328,6 +330,10 @@  package Warnsw is
    --  Set to True to generate warnings for suspicious use of export or
    --  import pragmas. Modified by use of -gnatwx/X.
 
+   Warn_On_GNAT_Extension_Compatibility : Boolean renames F (X.Warn_On_GNAT_Extension_Compatibility);
+   --  Set to True to generate all warnings on GNAT extension compatibility
+   --  issues. There is no switch controlling this option.
+
    Warn_On_Hiding : Boolean renames F (X.Warn_On_Hiding);
    --  Set to True to generate warnings if a declared entity hides another
    --  entity. The default is that this warning is suppressed. Modified by
diff --git a/gcc/ada/xsnamest.adb b/gcc/ada/xsnamest.adb
index 3ee31d71847..c937124e55c 100644
--- a/gcc/ada/xsnamest.adb
+++ b/gcc/ada/xsnamest.adb
@@ -28,7 +28,7 @@ 
 --  which the numbers are all written as $, and generates a new version of the
 --  spec file snames.ads (written to snames.ns). It also reads snames.adb-tmpl
 --  and generates an updated body (written to snames.nb), and snames.h-tmpl and
---  generates an updated C header file (written to snames.nh).
+--  generates an updated C header file (written to snames.h).
 
 with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;