[multiple changes]

2014-10-10  Robert Dewar  <dewar@adacore.com>

	* sem_ch7.adb, einfo.adb, einfo.ads, sem_prag.adb, sem_ch12.adb,
	freeze.adb, sem_util.adb, sem_res.adb, exp_ch6.adb, exp_ch13.adb,
	sem_ch6.adb, sem_cat.adb, sem_disp.adb
	(Is_Subprogram_Or_Generic_Subprogram): New primitive. Use this primitive
	throughout where appropriate.

2014-10-10  Bob Duff  <duff@adacore.com>

	* a-coinho-shared.ads: Minor reformatting.
	* s-traceb.adb: Minor clean up.

2014-10-10  Robert Dewar  <dewar@adacore.com>

	* ali.adb (Scan_ALI): Read and process new GP flag on ALI P line.
	* ali.ads (GNATprove_Mode): New component in ALI table.
	(GNATprove_Mode_Specified): New global.
	* gnatbind.adb (Gnatbind): Give fatal error if any file compiled
	in GNATProve mode.
	* lib-writ.ads, lib-writ.adb (GP): New flag on P line for
	GNATProve_Mode.

2014-10-10  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Build_Init_Procedure): Adding assertion.
	(Build_Init_Statement): Ensure that statements
	associated with the parent components are located at the beginning
	of the returned list of statements.

2014-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Inherit_Aspects_At_Freeze_Node): If the full
	view of a private type T that has a type invariant is a scalar
	or constrained array type, the base type created for the full
	view has the same type invariant.

From-SVN: r216074

23 files changed, 170 insertions, 88 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5d50356a7f4..e835483dca7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,42 @@
 2014-10-10  Robert Dewar  <dewar@adacore.com>
 
+	* sem_ch7.adb, einfo.adb, einfo.ads, sem_prag.adb, sem_ch12.adb,
+	freeze.adb, sem_util.adb, sem_res.adb, exp_ch6.adb, exp_ch13.adb,
+	sem_ch6.adb, sem_cat.adb, sem_disp.adb
+	(Is_Subprogram_Or_Generic_Subprogram): New primitive. Use this primitive
+	throughout where appropriate.
+
+2014-10-10  Bob Duff  <duff@adacore.com>
+
+	* a-coinho-shared.ads: Minor reformatting.
+	* s-traceb.adb: Minor clean up.
+
+2014-10-10  Robert Dewar  <dewar@adacore.com>
+
+	* ali.adb (Scan_ALI): Read and process new GP flag on ALI P line.
+	* ali.ads (GNATprove_Mode): New component in ALI table.
+	(GNATprove_Mode_Specified): New global.
+	* gnatbind.adb (Gnatbind): Give fatal error if any file compiled
+	in GNATProve mode.
+	* lib-writ.ads, lib-writ.adb (GP): New flag on P line for
+	GNATProve_Mode.
+
+2014-10-10  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch3.adb (Build_Init_Procedure): Adding assertion.
+	(Build_Init_Statement): Ensure that statements
+	associated with the parent components are located at the beginning
+	of the returned list of statements.
+
+2014-10-10  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Inherit_Aspects_At_Freeze_Node): If the full
+	view of a private type T that has a type invariant is a scalar
+	or constrained array type, the base type created for the full
+	view has the same type invariant.
+
+2014-10-10  Robert Dewar  <dewar@adacore.com>
+
 	* exp_util.ads, sem_ch12.adb, exp_util.adb, i-fortra.ads: Minor code
 	reorganization.
 
diff --git a/gcc/ada/a-coinho-shared.ads b/gcc/ada/a-coinho-shared.ads
index b040e666141..2ec30f88aef 100644
--- a/gcc/ada/a-coinho-shared.ads
+++ b/gcc/ada/a-coinho-shared.ads
@@ -29,12 +29,12 @@
 -- <http://www.gnu.org/licenses/>.                                          --
 ------------------------------------------------------------------------------
 
---  Missing documentation: what is this unit all about??? From its name it
---  is some variation of a-coinho.ads/adb, but documentation needs to be
---  HERE explaining that ???
+--  This is an optimized version of Indefinite_Holders using copy-on-write.
+--  It is used on platforms that support atomic built-ins.
 
 private with Ada.Finalization;
 private with Ada.Streams;
+
 private with System.Atomic_Counters;
 
 generic
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 2fe95525926..3a3431878aa 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -111,6 +111,7 @@ package body ALI is
       Locking_Policy_Specified               := ' ';
       No_Normalize_Scalars_Specified         := False;
       No_Object_Specified                    := False;
+      GNATprove_Mode_Specified               := False;
       Normalize_Scalars_Specified            := False;
       Partition_Elaboration_Policy_Specified := ' ';
       Queuing_Policy_Specified               := ' ';
@@ -875,6 +876,7 @@ package body ALI is
         First_Sdep                   => No_Sdep_Id,
         First_Specific_Dispatching   => Specific_Dispatching.Last + 1,
         First_Unit                   => No_Unit_Id,
+        GNATprove_Mode               => False,
         Last_Interrupt_State         => Interrupt_States.Last,
         Last_Sdep                    => No_Sdep_Id,
         Last_Specific_Dispatching    => Specific_Dispatching.Last,
@@ -1089,6 +1091,13 @@ package body ALI is
                ALIs.Table (Id).Partition_Elaboration_Policy :=
                  Partition_Elaboration_Policy_Specified;
 
+            --  Processing for GP
+
+            elsif C = 'G' then
+               Checkc ('P');
+               GNATprove_Mode_Specified := True;
+               ALIs.Table (Id).GNATprove_Mode := True;
+
             --  Processing for Lx
 
             elsif C = 'L' then
diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads
index f896e7d0088..c48d913d8a3 100644
--- a/gcc/ada/ali.ads
+++ b/gcc/ada/ali.ads
@@ -176,6 +176,11 @@ package ALI is
       --  always be set as well in this case. Not set if 'P' appears in
       --  Ignore_Lines.
 
+      GNATprove_Mode : Boolean;
+      --  Set to True if ALI and object file produced in GNATprove_Mode as
+      --  signalled by GP appearing on the P line. Not set if 'P' appears in
+      --  Ignore_Lines.
+
       No_Object : Boolean;
       --  Set to True if no object file generated. Not set if 'P' appears in
       --  Ignore_Lines.
@@ -465,6 +470,9 @@ package ALI is
    --  Set to False by Initialize_ALI. Set to True if Scan_ALI reads
    --  a unit for which dynamic elaboration checking is enabled.
 
+   GNATprove_Mode_Specified : Boolean := False;
+   --  Set to True if an ali file was produced in GNATprove mode.
+
    Initialize_Scalars_Used : Boolean := False;
    --  Set True if an ali file contains the Initialize_Scalars flag
 
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index c3b0f991966..e4e03601996 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -1129,8 +1129,7 @@ package body Einfo is
                        E_Package_Body,
                        E_Subprogram_Body,
                        E_Variable)
-          or else Is_Generic_Subprogram (Id)
-          or else Is_Subprogram (Id));
+          or else Is_Subprogram_Or_Generic_Subprogram (Id));
       return Node34 (Id);
    end Contract;
 
@@ -3405,6 +3404,13 @@ package body Einfo is
       return Ekind (Id) in Subprogram_Kind;
    end Is_Subprogram;
 
+   function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B is
+   begin
+      return Ekind (Id) in Subprogram_Kind
+               or else
+             Ekind (Id) in Generic_Subprogram_Kind;
+   end Is_Subprogram_Or_Generic_Subprogram;
+
    function Is_Task_Type                        (Id : E) return B is
    begin
       return Ekind (Id) in Task_Kind;
@@ -3593,15 +3599,14 @@ package body Einfo is
    begin
       pragma Assert
         (Ekind_In (Id, E_Entry,
-         E_Entry_Family,
-         E_Generic_Package,
-         E_Package,
-         E_Package_Body,
-         E_Subprogram_Body,
-         E_Variable,
-         E_Void)
-         or else Is_Generic_Subprogram (Id)
-         or else Is_Subprogram (Id));
+                         E_Entry_Family,
+                         E_Generic_Package,
+                         E_Package,
+                         E_Package_Body,
+                         E_Subprogram_Body,
+                         E_Variable,
+                         E_Void)
+          or else Is_Subprogram_Or_Generic_Subprogram (Id));
       Set_Node34 (Id, V);
    end Set_Contract;
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index d75beccb0ee..da63627748c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2974,6 +2974,10 @@ package Einfo is
 --       Applies to all entities, true for function, procedure and operator
 --       entities.
 
+--    Is_Subprogram_Or_Generic_Subprogram
+--       Applies to all entities, true for function procedure and operator
+--       entities, and also for the corresponding generic entities.
+
 --    Is_Synchronized_Interface (synthesized)
 --       Defined in types that are interfaces. True if interface is declared
 --       synchronized, task, or protected, or is derived from a synchronized
@@ -6964,6 +6968,7 @@ package Einfo is
    function Is_Scalar_Type                      (Id : E) return B;
    function Is_Signed_Integer_Type              (Id : E) return B;
    function Is_Subprogram                       (Id : E) return B;
+   function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B;
    function Is_Task_Type                        (Id : E) return B;
    function Is_Type                             (Id : E) return B;
 
@@ -8800,6 +8805,7 @@ package Einfo is
    pragma Inline (Is_Base_Type);
    pragma Inline (Is_Package_Or_Generic_Package);
    pragma Inline (Is_Packed_Array);
+   pragma Inline (Is_Subprogram_Or_Generic_Subprogram);
    pragma Inline (Is_Volatile);
    pragma Inline (Is_Wrapper_Package);
    pragma Inline (Known_RM_Size);
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 096365ccb40..ff73d94522b 100644
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -528,7 +528,7 @@ package body Exp_Ch13 is
            and then
              (Is_Entry (E_Scope)
                 or else (Is_Subprogram (E_Scope)
-                           and then Is_Protected_Type (Scope (E_Scope)))
+                          and then Is_Protected_Type (Scope (E_Scope)))
                 or else Is_Task_Type (E_Scope))
          then
             null;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index bd4886da512..9541ad096c1 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2372,7 +2372,15 @@ package body Exp_Ch3 is
                   --  generated.
 
                   if not Is_Interface (Etype (Rec_Ent)) then
-                     Prepend_To (Body_Stmts, Remove_Head (Stmts));
+                     declare
+                        First_Stmt : constant Node_Id := Remove_Head (Stmts);
+                     begin
+                        pragma Assert
+                          (Nkind (First_Stmt) = N_Procedure_Call_Statement
+                             and then
+                           Is_Init_Proc (Name (First_Stmt)));
+                        Prepend_To (Body_Stmts, First_Stmt);
+                     end;
                   end if;
 
                   Append_List_To (Body_Stmts, Stmts);
@@ -2655,15 +2663,16 @@ package body Exp_Ch3 is
       ---------------------------
 
       function Build_Init_Statements (Comp_List : Node_Id) return List_Id is
-         Checks     : constant List_Id := New_List;
-         Actions    : List_Id   := No_List;
-         Comp_Loc   : Source_Ptr;
-         Counter_Id : Entity_Id := Empty;
-         Decl       : Node_Id;
-         Has_POC    : Boolean;
-         Id         : Entity_Id;
-         Stmts      : List_Id;
-         Typ        : Entity_Id;
+         Checks       : constant List_Id := New_List;
+         Actions      : List_Id   := No_List;
+         Comp_Loc     : Source_Ptr;
+         Counter_Id   : Entity_Id := Empty;
+         Decl         : Node_Id;
+         Has_POC      : Boolean;
+         Id           : Entity_Id;
+         Parent_Stmts : List_Id;
+         Stmts        : List_Id;
+         Typ          : Entity_Id;
 
          procedure Increment_Counter (Loc : Source_Ptr);
          --  Generate an "increment by one" statement for the current counter
@@ -2727,6 +2736,7 @@ package body Exp_Ch3 is
             return New_List (Make_Null_Statement (Loc));
          end if;
 
+         Parent_Stmts := New_List;
          Stmts := New_List;
 
          --  Loop through visible declarations of task types and protected
@@ -2956,22 +2966,30 @@ package body Exp_Ch3 is
                end if;
 
                if Present (Checks) then
-                  Append_List_To (Stmts, Checks);
+                  if Chars (Id) = Name_uParent then
+                     Append_List_To (Parent_Stmts, Checks);
+                  else
+                     Append_List_To (Stmts, Checks);
+                  end if;
                end if;
 
                if Present (Actions) then
-                  Append_List_To (Stmts, Actions);
+                  if Chars (Id) = Name_uParent then
+                     Append_List_To (Parent_Stmts, Actions);
 
-                  --  Preserve the initialization state in the current counter
+                  else
+                     Append_List_To (Stmts, Actions);
 
-                  if Chars (Id) /= Name_uParent
-                    and then Needs_Finalization (Typ)
-                  then
-                     if No (Counter_Id) then
-                        Make_Counter (Comp_Loc);
-                     end if;
+                     --  Preserve the initialization state in the current
+                     --  counter
 
-                     Increment_Counter (Comp_Loc);
+                     if Needs_Finalization (Typ) then
+                        if No (Counter_Id) then
+                           Make_Counter (Comp_Loc);
+                        end if;
+
+                        Increment_Counter (Comp_Loc);
+                     end if;
                   end if;
                end if;
             end if;
@@ -2979,6 +2997,12 @@ package body Exp_Ch3 is
             Next_Non_Pragma (Decl);
          end loop;
 
+         --  The parent field must be initialized first because variable
+         --  size components of the parent affect the location of all the
+         --  new components.
+
+         Prepend_List_To (Stmts, Parent_Stmts);
+
          --  Set up tasks and protected object support. This needs to be done
          --  before any component with a per-object access discriminant
          --  constraint, or any variant part (which may contain such
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 97464167129..25a3972e758 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5825,9 +5825,8 @@ package body Exp_Ch6 is
         Defining_Identifier
           (First (Parameter_Specifications (Parent (Corr))));
 
-      if Is_Subprogram (Proc)
-        and then Proc /= Corr
-      then
+      if Is_Subprogram (Proc) and then Proc /= Corr then
+
          --  Protected function or procedure
 
          Set_Entity (Rec, Param);
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 17f96491c38..d5dbb440fbb 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1703,7 +1703,6 @@ package body Freeze is
       E := From;
       while Present (E) loop
          if Is_Subprogram (E) then
-
             if not Default_Expressions_Processed (E) then
                Process_Default_Expressions (E, After);
             end if;
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb
index 7cba0c684f2..0d99ccf155c 100644
--- a/gcc/ada/gnatbind.adb
+++ b/gcc/ada/gnatbind.adb
@@ -776,6 +776,13 @@ begin
          raise Unrecoverable_Error;
       end if;
 
+      --  Quit with message if we had a GNATprove file
+
+      if GNATprove_Mode_Specified then
+         Error_Msg ("one or more files compiled in GNATprove mode");
+         raise Unrecoverable_Error;
+      end if;
+
       --  Output list of ALI files in closure
 
       if Output_ALI_List then
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 1492852468b..67a4859a81f 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -1153,6 +1153,10 @@ package body Lib.Writ is
          end if;
       end if;
 
+      if GNATprove_Mode then
+         Write_Info_Str (" GP");
+      end if;
+
       if Partition_Elaboration_Policy /= ' ' then
          Write_Info_Str  (" E");
          Write_Info_Char (Partition_Elaboration_Policy);
diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads
index 5a061e49e4d..91c16c0f081 100644
--- a/gcc/ada/lib-writ.ads
+++ b/gcc/ada/lib-writ.ads
@@ -192,6 +192,9 @@ package Lib.Writ is
    --              the units in this file, where x is the first character
    --              (upper case) of the policy name (e.g. 'C' for Concurrent).
 
+   --         GP   Set if this compilation was done in GNATprove mode, either
+   --              from direct use of GNATprove, or from use of -gnatdF.
+
    --         Lx   A valid Locking_Policy pragma applies to all the units in
    --              this file, where x is the first character (upper case) of
    --              the policy name (e.g. 'C' for Ceiling_Locking).
@@ -200,7 +203,9 @@ package Lib.Writ is
    --              were not compiled to produce an object. This can occur as a
    --              result of the use of -gnatc, or if no object can be produced
    --              (e.g. when a package spec is compiled instead of the body,
-   --              or a subunit on its own).
+   --              or a subunit on its own). Note that in GNATprove mode, we
+   --              do produce an object. The object is not suitable for binding
+   --              and linking, but we do not set NO, instead we set GP.
 
    --         NR   No_Run_Time. Indicates that a pragma No_Run_Time applies
    --              to all units in the file.
diff --git a/gcc/ada/s-traceb.adb b/gcc/ada/s-traceb.adb
index 0a8726c6596..4855644434e 100644
--- a/gcc/ada/s-traceb.adb
+++ b/gcc/ada/s-traceb.adb
@@ -38,16 +38,6 @@ pragma Compiler_Unit_Warning;
 
 package body System.Traceback is
 
---   procedure Call_Chain
---     (Traceback   : System.Address;
---      Max_Len     : Natural;
---      Len         : out Natural;
---      Exclude_Min : System.Address := System.Null_Address;
---      Exclude_Max : System.Address := System.Null_Address;
---      Skip_Frames : Natural := 1);
---   --  Same as the exported version, but takes Traceback as an Address
---  ???See declaration in the spec for why this is temporarily commented out.
-
    ------------------
    -- C_Call_Chain --
    ------------------
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 9a65a05bb4f..04638aaa8d0 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -615,9 +615,7 @@ package body Sem_Cat is
 
       E := Current_Scope;
       loop
-         if Is_Subprogram (E)
-              or else
-            Is_Generic_Subprogram (E)
+         if Is_Subprogram_Or_Generic_Subprogram (E)
               or else
             Is_Concurrent_Type (E)
          then
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index ed96e8929f4..595a3b0a8b4 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3543,9 +3543,7 @@ package body Sem_Ch12 is
          else
             E := First_Entity (Gen_Unit);
             while Present (E) loop
-               if Is_Subprogram (E)
-                 and then Is_Inlined (E)
-               then
+               if Is_Subprogram (E) and then Is_Inlined (E) then
                   return True;
                end if;
 
@@ -6558,7 +6556,7 @@ package body Sem_Ch12 is
 
          if Ekind (Scop) = E_Generic_Package
            or else (Is_Subprogram (Scop)
-                      and then Nkind (Unit_Declaration_Node (Scop)) =
+                     and then Nkind (Unit_Declaration_Node (Scop)) =
                                         N_Generic_Subprogram_Declaration)
          then
             Elmt := First_Elmt (Inner_Instances (Inner));
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a73712bfb5f..10f4a7480b6 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -10705,6 +10705,15 @@ package body Sem_Ch13 is
          if Class_Present (Get_Rep_Item (Typ, Name_Invariant)) then
             Set_Has_Inheritable_Invariants (Typ);
          end if;
+
+      --  If the full view of the type is a scalar type or array type, the
+      --  implicit base type created for it has the same invariant.
+
+      elsif Has_Invariants (Typ) and then Base_Type (Typ) /= Typ
+        and then not Has_Invariants (Base_Type (Typ))
+      then
+         Set_Has_Invariants (Base_Type (Typ));
+         Set_Invariant_Procedure (Base_Type (Typ), Invariant_Procedure (Typ));
       end if;
 
       --  Volatile
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 01c6e26b50c..41c7fd8dae7 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8406,7 +8406,7 @@ package body Sem_Ch6 is
    procedure List_Inherited_Pre_Post_Aspects (E : Entity_Id) is
    begin
       if Opt.List_Inherited_Aspects
-        and then (Is_Subprogram (E) or else Is_Generic_Subprogram (E))
+        and then Is_Subprogram_Or_Generic_Subprogram (E)
       then
          declare
             Inherited : constant Subprogram_List := Inherited_Subprograms (E);
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 4821db529c8..2d96314fc35 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2808,7 +2808,7 @@ package body Sem_Ch7 is
 
       --  Body required if subprogram
 
-      elsif Is_Subprogram (P) or else Is_Generic_Subprogram (P) then
+      elsif Is_Subprogram_Or_Generic_Subprogram (P) then
          return True;
 
       --  Treat a block as requiring a body
@@ -2937,7 +2937,7 @@ package body Sem_Ch7 is
 
       --  Body required if subprogram
 
-      elsif Is_Subprogram (P) or else Is_Generic_Subprogram (P) then
+      elsif Is_Subprogram_Or_Generic_Subprogram (P) then
          Error_Msg_N ("info: & requires body (subprogram case)?Y?", P);
 
       --  Body required if generic parent has Elaborate_Body
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 6d6078dc9f5..a915ab05e77 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -2098,10 +2098,7 @@ package body Sem_Disp is
                      and then
                        Is_Interface (Find_Dispatching_Type (Parent_Op)));
 
-               if Is_Subprogram         (Parent_Op)
-                    or else
-                  Is_Generic_Subprogram (Parent_Op)
-               then
+               if Is_Subprogram_Or_Generic_Subprogram (Parent_Op) then
                   Store_IS (Parent_Op);
                end if;
             end loop;
@@ -2134,10 +2131,7 @@ package body Sem_Disp is
                      --  The following test eliminates some odd cases in which
                      --  Ekind (Prim) is Void, to be investigated further ???
 
-                     if not (Is_Subprogram         (Prim)
-                                or else
-                             Is_Generic_Subprogram (Prim))
-                     then
+                     if not Is_Subprogram_Or_Generic_Subprogram (Prim) then
                         null;
 
                      --  For [generic] subprogram, look at interface alias
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index dc084f9e13e..436b9b12a29 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -6736,10 +6736,9 @@ package body Sem_Prag is
                     ("dispatching subprogram# cannot use Stdcall convention!",
                      Arg1);
 
-               --  Subprogram is allowed, but not a generic subprogram
+               --  Subprograms are not allowed
 
-               elsif not Is_Subprogram (E)
-                 and then not Is_Generic_Subprogram (E)
+               elsif not Is_Subprogram_Or_Generic_Subprogram (E)
 
                  --  A variable is OK
 
@@ -7016,8 +7015,7 @@ package body Sem_Prag is
          --  For Intrinsic, a subprogram is required
 
          if C = Convention_Intrinsic
-           and then not Is_Subprogram (E)
-           and then not Is_Generic_Subprogram (E)
+           and then not Is_Subprogram_Or_Generic_Subprogram (E)
          then
             Error_Pragma_Arg
               ("second argument of pragma% must be a subprogram", Arg2);
@@ -7025,9 +7023,7 @@ package body Sem_Prag is
 
          --  Deal with non-subprogram cases
 
-         if not Is_Subprogram (E)
-           and then not Is_Generic_Subprogram (E)
-         then
+         if not Is_Subprogram_Or_Generic_Subprogram (E) then
             Set_Convention_From_Pragma (E);
 
             if Is_Type (E) then
@@ -7885,9 +7881,8 @@ package body Sem_Prag is
                end if;
             end if;
 
-         elsif Is_Subprogram (Def_Id)
-           or else Is_Generic_Subprogram (Def_Id)
-         then
+         elsif Is_Subprogram_Or_Generic_Subprogram (Def_Id) then
+
             --  If the name is overloaded, pragma applies to all of the denoted
             --  entities in the same declarative part, unless the pragma comes
             --  from an aspect specification or was generated by the compiler
@@ -7909,9 +7904,7 @@ package body Sem_Prag is
                --  If it is not a subprogram, it must be in an outer scope and
                --  pragma does not apply.
 
-               elsif not Is_Subprogram (Def_Id)
-                 and then not Is_Generic_Subprogram (Def_Id)
-               then
+               elsif not Is_Subprogram_Or_Generic_Subprogram (Def_Id) then
                   null;
 
                --  The pragma does not apply to primitives of interfaces
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f45e07e06cc..b35ffbd8626 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4289,9 +4289,7 @@ package body Sem_Res is
             then
                Error_Msg_N ("class-wide argument not allowed here!", A);
 
-               if Is_Subprogram (Nam)
-                 and then Comes_From_Source (Nam)
-               then
+               if Is_Subprogram (Nam) and then Comes_From_Source (Nam) then
                   Error_Msg_Node_2 := F_Typ;
                   Error_Msg_NE
                     ("& is not a dispatching operation of &!", A, Nam);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 01c16244621..85105e538e0 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4321,7 +4321,7 @@ package body Sem_Util is
    function Current_Subprogram return Entity_Id is
       Scop : constant Entity_Id := Current_Scope;
    begin
-      if Is_Subprogram (Scop) or else Is_Generic_Subprogram (Scop) then
+      if Is_Subprogram_Or_Generic_Subprogram (Scop) then
          return Scop;
       else
          return Enclosing_Subprogram (Scop);
@@ -16491,8 +16491,7 @@ package body Sem_Util is
          while not Comes_From_Source (Val_Actual)
            and then Nkind (Val_Actual) in N_Entity
            and then (Ekind (Val_Actual) = E_Enumeration_Literal
-                      or else Is_Subprogram (Val_Actual)
-                      or else Is_Generic_Subprogram (Val_Actual))
+                      or else Is_Subprogram_Or_Generic_Subprogram (Val_Actual))
            and then Present (Alias (Val_Actual))
          loop
             Val_Actual := Alias (Val_Actual);