[multiple changes]

2017-04-25  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch7.adb, einfo.ads, sem_prag.adb: Minor reformatting and typo
	correction.

2017-04-25  Yannick Moy  <moy@adacore.com>

	* sem_res.adb (Resolve_Comparison_Op): Do not
	attempt evaluation of relational operations inside assertions.

2017-04-25  Justin Squirek  <squirek@adacore.com>

	* exp_util.adb (Add_Interface_Invariants):
	Restored, code moved back from Build_Invariant_Procedure_Body.
	(Add_Parent_Invariants): Restored, code moved back from
	Build_Invariant_Procedure_Body.
	(Build_Invariant_Procedure_Body):
	Remove refactored calls and integrated code from
	Add_Parent_Invariants and Add_Interface_Invariants.

2017-04-25  Johannes Kanig  <kanig@adacore.com>

	* errout.adb (Output_Messages): Adjust computation of total
	errors
	* erroutc.adb (Error_Msg): In statistics counts, deal
	correctly with informational messages that are not warnings.
	* errutil.adb (Finalize): adjust computation of total errors.

2017-04-25  Arnaud Charlet  <charlet@adacore.com trojanek>

	* terminals.c (__gnat_terminate_pid): New.
	* g-exptty.ads (Terminate_Process): New. Update comments.

From-SVN: r247157

12 files changed, 314 insertions, 137 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 50e45b6..192e893 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2017-04-25  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch7.adb, einfo.ads, sem_prag.adb: Minor reformatting and typo
+	correction.
+
+2017-04-25  Yannick Moy  <moy@adacore.com>
+
+	* sem_res.adb (Resolve_Comparison_Op): Do not
+	attempt evaluation of relational operations inside assertions.
+
+2017-04-25  Justin Squirek  <squirek@adacore.com>
+
+	* exp_util.adb (Add_Interface_Invariants):
+	Restored, code moved back from Build_Invariant_Procedure_Body.
+	(Add_Parent_Invariants): Restored, code moved back from
+	Build_Invariant_Procedure_Body.
+	(Build_Invariant_Procedure_Body):
+	Remove refactored calls and integrated code from
+	Add_Parent_Invariants and Add_Interface_Invariants.
+
+2017-04-25  Johannes Kanig  <kanig@adacore.com>
+
+	* errout.adb (Output_Messages): Adjust computation of total
+	errors
+	* erroutc.adb (Error_Msg): In statistics counts, deal
+	correctly with informational messages that are not warnings.
+	* errutil.adb (Finalize): adjust computation of total errors.
+
+2017-04-25  Arnaud Charlet  <charlet@adacore.com trojanek>
+
+	* terminals.c (__gnat_terminate_pid): New.
+	* g-exptty.ads (Terminate_Process): New. Update comments.
+
 2017-04-25  Arnaud Charlet  <charlet@adacore.com>
 
 	* a-cfinve.ads, a-cofove.ads (Empty_Vector): add Global contract.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 9a0530d..5999018 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3711,8 +3711,8 @@ package Einfo is
 
 --    Original_Access_Type (Node28)
 --       Defined in E_Access_Subprogram_Type entities. Set only if the access
---       type was generated by the expander as part of processing an access
---       to protected subprogram type. Points to the access to protected
+--       type was generated by the expander as part of processing an access-
+--       to-protected-subprogram type. Points to the access-to-protected-
 --       subprogram type.
 
 --    Original_Array_Type (Node21)
@@ -4842,24 +4842,24 @@ package Einfo is
       --  keyword present.
 
       E_Access_Subprogram_Type,
-      --  An access to subprogram type, created by an access to subprogram
+      --  An access-to-subprogram type, created by an access-to-subprogram
       --  declaration.
 
       E_Access_Protected_Subprogram_Type,
       --  An access to a protected subprogram, created by the corresponding
       --  declaration. Values of such a type denote both a protected object
       --  and a protected operation within, and have different compile-time
-      --  and run-time properties than other access to subprograms.
+      --  and run-time properties than other access-to-subprogram values.
 
       E_Anonymous_Access_Protected_Subprogram_Type,
-      --  An anonymous access to protected subprogram type, created by an
-      --  access to subprogram declaration.
+      --  An anonymous access-to-protected-subprogram type, created by an
+      --  access-to-subprogram declaration.
 
       E_Anonymous_Access_Subprogram_Type,
-      --  An anonymous access to subprogram type, created by an access to
+      --  An anonymous access-to-subprogram type, created by an access-to-
       --  subprogram declaration, or generated for a current instance of
       --  a type name appearing within a component definition that has an
-      --  anonymous access to subprogram type.
+      --  anonymous access-to-subprogram type.
 
       E_Anonymous_Access_Type,
       --  An anonymous access type created by an access parameter or access
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 40eaf91..ea80639 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -2105,7 +2105,7 @@ package body Errout is
 
       if Warning_Mode = Treat_As_Error then
          Total_Errors_Detected :=
-           Total_Errors_Detected + Warnings_Detected - Info_Messages;
+           Total_Errors_Detected + Warnings_Detected;
          Warnings_Detected := Info_Messages;
       end if;
    end Output_Messages;
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index ada9315..f637083c 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -139,13 +139,16 @@ package body Erroutc is
 
             --  Adjust error message count
 
-            if Errors.Table (D).Warn or else Errors.Table (D).Style then
-               Warnings_Detected := Warnings_Detected - 1;
+            if Errors.Table (D).Info then
+               Info_Messages := Info_Messages - 1;
 
-               if Errors.Table (D).Info then
-                  Info_Messages := Info_Messages - 1;
+               if Errors.Table (D).Warn then
+                  Warnings_Detected := Warnings_Detected - 1;
                end if;
 
+            elsif Errors.Table (D).Warn or else Errors.Table (D).Style then
+               Warnings_Detected := Warnings_Detected - 1;
+
                --  Note: we do not need to decrement Warnings_Treated_As_Errors
                --  because this only gets incremented if we actually output the
                --  message, which we won't do if we are deleting it here!
@@ -240,7 +243,7 @@ package body Erroutc is
    function Compilation_Errors return Boolean is
    begin
       return Total_Errors_Detected /= 0
-        or else (Warnings_Detected - Info_Messages /= 0
+        or else (Warnings_Detected /= 0
                   and then Warning_Mode = Treat_As_Error)
         or else Warnings_Treated_As_Errors /= 0;
    end Compilation_Errors;
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index 3a8f0fb..e10624f 100644
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -588,7 +588,7 @@ package body Errutil is
 
       if Warning_Mode = Treat_As_Error then
          Total_Errors_Detected :=
-           Total_Errors_Detected + Warnings_Detected - Info_Messages;
+           Total_Errors_Detected + Warnings_Detected;
          Warnings_Detected := Info_Messages;
       end if;
 
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 852ae44..a3082e2 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -486,14 +486,14 @@ package body Exp_Ch7 is
       then
          return False;
 
-      --  Do not consider an access type which return on the secondary stack
+      --  Do not consider an access type that returns on the secondary stack
 
       elsif Present (Associated_Storage_Pool (Ptr_Typ))
         and then Is_RTE (Associated_Storage_Pool (Ptr_Typ), RE_SS_Pool)
       then
          return False;
 
-      --  Do not consider an access type which may never allocate an object
+      --  Do not consider an access type that can never allocate an object
 
       elsif No_Pool_Assigned (Ptr_Typ) then
          return False;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 034df56..9f5224c 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1999,6 +1999,25 @@ package body Exp_Util is
       --  Obj_Id denotes the entity of the _object formal parameter of the
       --  invariant procedure. All created checks are added to list Checks.
 
+      procedure Add_Inherited_Invariant
+        (Full_Typ : Entity_Id;
+         Priv_Typ : Entity_Id;
+         Obj_Id   : Entity_Id;
+         Checks   : in out List_Id);
+      --  Generate an invariant check for each inherited class-wide invariant
+      --  coming from all parent types of type T. Obj_Id denotes the entity of
+      --  the _object formal parameter of the invariant procedure. All created
+      --  checks are added to list Checks.
+
+      procedure Add_Interface_Invariants
+        (T      : Entity_Id;
+         Obj_Id : Entity_Id;
+         Checks : in out List_Id);
+      --  Generate an invariant check for each inherited class-wide invariant
+      --  coming from all interfaces implemented by type T. Obj_Id denotes the
+      --  entity of the _object formal parameter of the invariant procedure.
+      --  All created checks are added to list Checks.
+
       procedure Add_Invariant_Check
         (Prag      : Node_Id;
          Expr      : Node_Id;
@@ -2009,15 +2028,6 @@ package body Exp_Util is
       --  is added to list Checks. Flag Inherited should be set when the pragma
       --  is inherited from a parent or interface type.
 
-      procedure Add_Inherited_Invariant
-        (T      : Entity_Id;
-         Obj_Id : Entity_Id;
-         Checks : in out List_Id);
-      --  Generate an invariant check for each inherited class-wide invariant
-      --  coming from all parent types of type T. Obj_Id denotes the entity of
-      --  the _object formal parameter of the invariant procedure. All created
-      --  checks are added to list Checks.
-
       procedure Add_Own_Invariant
         (T         : Entity_Id;
          Obj_Id    : Entity_Id;
@@ -2028,6 +2038,15 @@ package body Exp_Util is
       --  invariant procedure. All created checks are added to list Checks.
       --  Priv_Item denotes the first rep item of the private type.
 
+      procedure Add_Parent_Invariants
+        (T      : Entity_Id;
+         Obj_Id : Entity_Id;
+         Checks : in out List_Id);
+      --  Generate an invariant check for each inherited class-wide invariant
+      --  coming from all parent types of type T. Obj_Id denotes the entity of
+      --  the _object formal parameter of the invariant procedure. All created
+      --  checks are added to list Checks.
+
       procedure Add_Record_Component_Invariants
         (T      : Entity_Id;
          Obj_Id : Entity_Id;
@@ -2197,9 +2216,10 @@ package body Exp_Util is
       -----------------------------
 
       procedure Add_Inherited_Invariant
-        (T      : Entity_Id;
-         Obj_Id : Entity_Id;
-         Checks : in out List_Id)
+        (Full_Typ : Entity_Id;
+         Priv_Typ : Entity_Id;
+         Obj_Id   : Entity_Id;
+         Checks   : in out List_Id)
       is
          Arg1 : Node_Id;
          Arg2 : Node_Id;
@@ -2211,11 +2231,16 @@ package body Exp_Util is
          --  instance of a type with the _object formal parameter
 
       begin
-         if not Present (T) then
+         if not Present (Priv_Typ) and then not Present (Full_Typ) then
             return;
          end if;
 
-         Prag := First_Rep_Item (T);
+         if Present (Priv_Typ) then
+            Prag := First_Rep_Item (Priv_Typ);
+         else
+            Prag := First_Rep_Item (Full_Typ);
+         end if;
+
          while Present (Prag) loop
             if Nkind (Prag) = N_Pragma
               and then Pragma_Name (Prag) = Name_Invariant
@@ -2229,30 +2254,30 @@ package body Exp_Util is
                --  Extract the arguments of the invariant pragma
 
                Arg1 := First (Pragma_Argument_Associations (Prag));
-               Arg2 := Next (Arg1);
-
+               Arg2 := Get_Pragma_Arg (Next (Arg1));
                Arg1 := Get_Pragma_Arg (Arg1);
-               Arg2 := Get_Pragma_Arg (Arg2);
+
+               --  The pragma applies to the partial view
+
+               if Present (Priv_Typ) and then Entity (Arg1) = Priv_Typ then
+                  Rep_Typ := Priv_Typ;
+
+               --  The pragma applies to the full view
+
+               elsif Present (Full_Typ) and then Entity (Arg1) = Full_Typ then
+                  Rep_Typ := Full_Typ;
 
                --  Otherwise the pragma applies to a parent type in which case
                --  it will be processed at a later stage by
                --  Add_Parent_Invariants or Add_Interface_Invariants.
 
-               if Entity (Arg1) = T then
-                  Rep_Typ := Entity (Arg1);
-
-               elsif Present (Full_View (T))
-                 and then Entity (Arg1) = Full_View (T)
-               then
-                  Rep_Typ := Full_View (T);
-
                else
                   return;
                end if;
 
-               --  Nothing to do when the caller requests the processing of
-               --  all inherited class-wide invariants, but the pragma does
-               --  not fall in this category.
+               --  Nothing to do when the caller requests the processing of all
+               --  inherited class-wide invariants, but the pragma does not
+               --  fall in this category.
 
                if not Class_Present (Prag) then
                   return;
@@ -2275,6 +2300,42 @@ package body Exp_Util is
          end loop;
       end Add_Inherited_Invariant;
 
+      ------------------------------
+      -- Add_Interface_Invariants --
+      ------------------------------
+
+      procedure Add_Interface_Invariants
+        (T      : Entity_Id;
+         Obj_Id : Entity_Id;
+         Checks : in out List_Id)
+      is
+         Iface_Elmt : Elmt_Id;
+         Ifaces     : Elist_Id;
+
+      begin
+         --  Generate an invariant check for each inherited class-wide
+         --  invariant coming from all interfaces implemented by type T. Obj_Id
+         --  denotes the entity of the _object formal parameter of the
+         --  invariant procedure. All created checks are added to list Checks.
+
+         if Is_Tagged_Type (T) then
+            Collect_Interfaces (T, Ifaces);
+
+            --  Process the class-wide invariants of all implemented interfaces
+
+            Iface_Elmt := First_Elmt (Ifaces);
+            while Present (Iface_Elmt) loop
+               Add_Inherited_Invariant
+                 (Full_Typ => Node (Iface_Elmt),
+                  Priv_Typ => Empty,
+                  Obj_Id   => Obj_Id,
+                  Checks   => Checks);
+
+               Next_Elmt (Iface_Elmt);
+            end loop;
+         end if;
+      end Add_Interface_Invariants;
+
       -------------------------
       -- Add_Invariant_Check --
       -------------------------
@@ -2355,6 +2416,80 @@ package body Exp_Util is
          Produced_Check := True;
       end Add_Invariant_Check;
 
+      ---------------------------
+      -- Add_Parent_Invariants --
+      ---------------------------
+
+      procedure Add_Parent_Invariants
+        (T      : Entity_Id;
+         Obj_Id : Entity_Id;
+         Checks : in out List_Id)
+      is
+         Dummy_1 : Entity_Id;
+         Dummy_2 : Entity_Id;
+
+         Curr_Typ : Entity_Id;
+         --  The entity of the current type being examined
+
+         Full_Typ : Entity_Id;
+         --  The full view of Par_Typ
+
+         Par_Typ : Entity_Id;
+         --  The entity of the parent type
+
+         Priv_Typ : Entity_Id;
+         --  The partial view of Par_Typ
+
+      begin
+         --  Do not process array types because they cannot have true parent
+         --  types. This also prevents the generation of a duplicate invariant
+         --  check when the input type is an array base type because its Etype
+         --  denotes the first subtype, both of which share the same component
+         --  type.
+
+         if Is_Array_Type (T) then
+            return;
+         end if;
+
+         --  Climb the parent type chain
+
+         Curr_Typ := T;
+         loop
+            --  Do not consider subtypes as they inherit the invariants
+            --  from their base types.
+
+            Par_Typ := Base_Type (Etype (Curr_Typ));
+
+            --  Stop the climb once the root of the parent chain is
+            --  reached.
+
+            exit when Curr_Typ = Par_Typ;
+
+            --  Process the class-wide invariants of the parent type
+
+            Get_Views (Par_Typ, Priv_Typ, Full_Typ, Dummy_1, Dummy_2);
+
+            --  Process the elements of an array type
+
+            if Is_Array_Type (Full_Typ) then
+               Add_Array_Component_Invariants (Full_Typ, Obj_Id, Checks);
+
+            --  Process the components of a record type
+
+            elsif Ekind (Full_Typ) = E_Record_Type then
+               Add_Record_Component_Invariants (Full_Typ, Obj_Id, Checks);
+            end if;
+
+            Add_Inherited_Invariant
+              (Full_Typ => Full_Typ,
+               Priv_Typ => Priv_Typ,
+               Obj_Id   => Obj_Id,
+               Checks   => Checks);
+
+            Curr_Typ := Par_Typ;
+         end loop;
+      end Add_Parent_Invariants;
+
       -----------------------
       -- Add_Own_Invariant --
       -----------------------
@@ -2399,17 +2534,15 @@ package body Exp_Util is
                --  Extract the arguments of the invariant pragma
 
                Arg1 := First (Pragma_Argument_Associations (Prag));
-               Arg2 := Next (Arg1);
-
+               Arg2 := Get_Pragma_Arg (Next (Arg1));
                Arg1 := Get_Pragma_Arg (Arg1);
-               Arg2 := Get_Pragma_Arg (Arg2);
-
                Asp  := Corresponding_Aspect (Prag);
                Ploc := Sloc (Prag);
 
-               --  Otherwise the pragma applies to a parent type in which case
-               --  it will be processed at a later stage by
-               --  Add_Parent_Invariants or Add_Interface_Invariants.
+               --  Verify the pragma belongs to T, otherwise the pragma applies
+               --  to a parent type in which case it will be processed at a
+               --  later stage by Add_Parent_Invariants or
+               --  Add_Interface_Invariants.
 
                if Entity (Arg1) /= T then
                   return;
@@ -2724,10 +2857,7 @@ package body Exp_Util is
 
       --  Local variables
 
-      Dummy_1      : Entity_Id;
-      Dummy_2      : Entity_Id;
-      Iface_Elmt   : Elmt_Id;
-      Ifaces       : Elist_Id;
+      Dummy        : Entity_Id;
       Mode         : Ghost_Mode_Type;
       Priv_Item    : Node_Id;
       Proc_Body    : Node_Id;
@@ -2799,7 +2929,7 @@ package body Exp_Util is
 
       --  Obtain both views of the type
 
-      Get_Views (Work_Typ, Priv_Typ, Full_Typ, Dummy_1, CRec_Typ);
+      Get_Views (Work_Typ, Priv_Typ, Full_Typ, Dummy, CRec_Typ);
 
       --  The caller requests a body for the partial invariant procedure
 
@@ -2991,81 +3121,12 @@ package body Exp_Util is
          --  Process the inherited class-wide invariants of all parent types.
          --  This also handles any invariants on record components.
 
-         declare
-            Curr_Typ : Entity_Id;
-            --  The entity of the current type being examined
-
-            Par_Full : Entity_Id;
-            --  The full view of Par_Typ
-
-            Par_Priv : Entity_Id;
-            --  The partial view of Par_Typ
-
-            Par_Typ : Entity_Id;
-            --  The entity of the parent type
-
-         begin
-            if not Is_Array_Type (Full_Typ) then
-
-               --  Climb the parent type chain
-
-               Curr_Typ := Full_Typ;
-               loop
-                  --  Do not consider subtypes as they inherit the invariants
-                  --  from their base types.
-
-                  Par_Typ := Base_Type (Etype (Curr_Typ));
-
-                  --  Stop the climb once the root of the parent chain is
-                  --  reached.
+         Add_Parent_Invariants (Full_Typ, Obj_Id, Stmts);
 
-                  exit when Curr_Typ = Par_Typ;
+         --  Process the inherited class-wide invariants of all implemented
+         --  interface types.
 
-                  --  Process the class-wide invariants of the parent type
-
-                  Get_Views (Par_Typ, Par_Priv, Par_Full, Dummy_1, Dummy_2);
-
-                  --  Process the elements of an array type
-
-                  if Is_Array_Type (Par_Full) then
-                     Add_Array_Component_Invariants (Par_Full, Obj_Id, Stmts);
-
-                  --  Process the components of a record type
-
-                  elsif Ekind (Par_Full) = E_Record_Type then
-                     Add_Record_Component_Invariants (Par_Full, Obj_Id, Stmts);
-                  end if;
-
-                  Add_Inherited_Invariant
-                    (T      => Par_Priv,
-                     Obj_Id => Obj_Id,
-                     Checks => Stmts);
-
-                  Curr_Typ := Par_Typ;
-               end loop;
-            end if;
-         end;
-
-         --  Generate an invariant check for each inherited class-wide
-         --  invariant coming from all interfaces implemented by type T. Obj_Id
-         --  denotes the entity of the _object formal parameter of the
-         --  invariant procedure. All created checks are added to list Checks.
-
-         if Is_Tagged_Type (Full_Typ) then
-            Collect_Interfaces (Full_Typ, Ifaces);
-
-            --  Process the class-wide invariants of all implemented interfaces
-
-            Iface_Elmt := First_Elmt (Ifaces);
-            while Present (Iface_Elmt) loop
-               Add_Inherited_Invariant
-                 (T      => Node (Iface_Elmt),
-                  Obj_Id => Obj_Id,
-                  Checks => Stmts);
-
-               Next_Elmt (Iface_Elmt);
-            end loop;
-         end if;
+         Add_Interface_Invariants (Full_Typ, Obj_Id, Stmts);
       end if;
 
       End_Scope;
diff --git a/gcc/ada/g-exptty.adb b/gcc/ada/g-exptty.adb
index 8b7fd6e..00615f9 100644
--- a/gcc/ada/g-exptty.adb
+++ b/gcc/ada/g-exptty.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                    Copyright (C) 2000-2014, AdaCore                      --
+--                    Copyright (C) 2000-2016, AdaCore                      --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -148,6 +148,17 @@ package body GNAT.Expect.TTY is
    end Interrupt;
 
    -----------------------
+   -- Terminate_Process --
+   -----------------------
+
+   procedure Terminate_Process (Pid : Integer) is
+      procedure Internal (Pid : Integer);
+      pragma Import (C, Internal, "__gnat_terminate_pid");
+   begin
+      Internal (Pid);
+   end Terminate_Process;
+
+   -----------------------
    -- Pseudo_Descriptor --
    -----------------------
 
diff --git a/gcc/ada/g-exptty.ads b/gcc/ada/g-exptty.ads
index e218e0b..10e0f81 100644
--- a/gcc/ada/g-exptty.ads
+++ b/gcc/ada/g-exptty.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                    Copyright (C) 2000-2011, AdaCore                      --
+--                    Copyright (C) 2000-2016, AdaCore                      --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -64,7 +64,13 @@ package GNAT.Expect.TTY is
    --  GNAT.TTY.Close_TTY.
 
    procedure Interrupt (Pid : Integer);
-   --  Interrupt a process given its pid
+   --  Interrupt a process given its pid.
+   --  This is equivalent to sending a ctrl-c event, or kill -SIGINT.
+
+   procedure Terminate_Process (Pid : Integer);
+   --  Terminate abruptly a process given its pid.
+   --  This is equivalent to kill -SIGKILL under unix, or TerminateProcess
+   --  under Windows.
 
    overriding procedure Send
      (Descriptor   : in out TTY_Process_Descriptor;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 0029c6a..c00e86b 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -17922,7 +17922,7 @@ package body Sem_Prag is
                if Is_Library_Level_Entity (Typ) then
                   null;
 
-               --  Qietly ignore an access-to-object type originally declared
+               --  Quietly ignore an access-to-object type originally declared
                --  at the library level within a generic, but instantiated at
                --  a non-library level. As a result the access-to-object type
                --  "loses" its No_Heap_Finalization property.
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 337b122..5a0797e 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6898,11 +6898,16 @@ package body Sem_Res is
             N, Etype (L));
       end if;
 
+      Analyze_Dimension (N);
+
       --  Evaluate the relation (note we do this after the above check since
-      --  this Eval call may change N to True/False.
+      --  this Eval call may change N to True/False. Skip this evaluation
+      --  inside assertions, in order to keep assertions as written by users
+      --  for tools that rely on these, e.g. GNATprove for loop invariants.
 
-      Analyze_Dimension (N);
-      Eval_Relational_Op (N);
+      if In_Assertion_Expr = 0 then
+         Eval_Relational_Op (N);
+      end if;
    end Resolve_Comparison_Op;
 
    -----------------------------------------
diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c
index 35cd743..9133a3b 100644
--- a/gcc/ada/terminals.c
+++ b/gcc/ada/terminals.c
@@ -90,6 +90,12 @@ __gnat_terminate_process (void *desc ATTRIBUTE_UNUSED)
 }
 
 int
+__gnat_terminate_pid (int pid ATTRIBUTE_UNUSED)
+{
+  return -1;
+}
+
+int
 __gnat_tty_fd (void* t ATTRIBUTE_UNUSED)
 {
   return -1;
@@ -962,6 +968,47 @@ __gnat_terminate_process (struct TTY_Process* p)
     return 0;
 }
 
+typedef struct {
+  DWORD dwProcessId;
+  HANDLE hwnd;
+} pid_struct;
+
+static BOOL CALLBACK
+find_process_handle (HWND hwnd, pid_struct * ps)
+{
+  DWORD thread_id;
+  DWORD process_id;
+
+  thread_id = GetWindowThreadProcessId (hwnd, &process_id);
+  if (process_id == ps->dwProcessId)
+    {
+      ps->hwnd = hwnd;
+      return FALSE;
+    }
+  /* keep looking */
+  return TRUE;
+}
+
+int
+__gnat_terminate_pid (int pid)
+{
+  pid_struct ps;
+
+  ps.dwProcessId = pid;
+  ps.hwnd = 0;
+  EnumWindows ((WNDENUMPROC) find_process_handle, (LPARAM) &ps);
+
+  if (ps.hwnd)
+    {
+      if (!TerminateProcess (ps.hwnd, 1))
+	return -1;
+      else
+	return 0;
+    }
+
+  return -1;
+}
+
 /* wait for process pid to terminate and return the process status. This
    implementation is different from the adaint.c one for Windows as it uses
    the Win32 API instead of the C one. */
@@ -1500,6 +1547,17 @@ int __gnat_terminate_process (pty_desc *desc)
   return kill (desc->child_pid, SIGKILL);
 }
 
+/* __gnat_terminate_pid - kill a process
+ *
+ * PARAMETERS
+ *   pid unix process id
+ */
+int
+__gnat_terminate_pid (int pid)
+{
+  return kill (pid, SIGKILL);
+}
+
 /* __gnat_tty_waitpid - wait for the child process to die
  *
  * PARAMETERS