[multiple changes]

2017-09-07  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Find_Role): The Global_Seen flag
	is now consulted not only for abstract states and variables,
	but for all kinds of items.
	(Collect_Subprogram_Inputs_Outputs): Do not process formal
	generic parameters, because unlike ordinary formal parameters,
	generic formals only act as input/ outputs if they are explicitly
	mentioned in a Global contract.

2017-09-07  Yannick Moy  <moy@adacore.com>

	* ghost.adb (Check_Ghost_Context): Do not err on ghost code inside
	predicate procedure. Check predicate pragma/aspect with Ghost entity.
	* exp_ch6.adb, par-ch6.adb, sem_ch13.adb, sem_prag.adb; Minor
	reformatting.

2017-09-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb: Move New_Copy_Tree_And_Dimensions to sem_dim
	(code cleanup);
	* sem_ch3.adb (Build_Derived_Record_Type):i Call
	Copy_Dimensions_Of_Components after creating the copy of the
	record declaration.
	* sem_dim.ads, sem_dim.adb (Copy_Dimensions_Of_Components): For a
	derived recor type, copy the dikensions if any of each component
	of the parent record to the corresponding component declarations
	of the derived record. These expressions are used among other
	things as default values in aggregates with box associations.
	* a-dirval-mingw.adb, g-cgi.adb, gnatcmd.adb, lib-xref.adb,
	repinfo.adb, sem_attr.adb, sem_ch10.adb, sem_ch6.adb, sem_prag.adb:
	Minor reformatting.

2017-09-07  Arnaud Charlet  <charlet@adacore.com>

	* sem_util.adb: Remove extra space after THEN.

2017-09-07  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch7.adb (Has_Referencer): For a subprogram renaming,
	also mark the renamed subprogram as referenced.

From-SVN: r251836

19 files changed, 304 insertions, 154 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7ab4ed4..157743b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2017-09-07  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_prag.adb (Find_Role): The Global_Seen flag
+	is now consulted not only for abstract states and variables,
+	but for all kinds of items.
+	(Collect_Subprogram_Inputs_Outputs): Do not process formal
+	generic parameters, because unlike ordinary formal parameters,
+	generic formals only act as input/ outputs if they are explicitly
+	mentioned in a Global contract.
+
+2017-09-07  Yannick Moy  <moy@adacore.com>
+
+	* ghost.adb (Check_Ghost_Context): Do not err on ghost code inside
+	predicate procedure. Check predicate pragma/aspect with Ghost entity.
+	* exp_ch6.adb, par-ch6.adb, sem_ch13.adb, sem_prag.adb; Minor
+	reformatting.
+
+2017-09-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb: Move New_Copy_Tree_And_Dimensions to sem_dim
+	(code cleanup);
+	* sem_ch3.adb (Build_Derived_Record_Type):i Call
+	Copy_Dimensions_Of_Components after creating the copy of the
+	record declaration.
+	* sem_dim.ads, sem_dim.adb (Copy_Dimensions_Of_Components): For a
+	derived recor type, copy the dikensions if any of each component
+	of the parent record to the corresponding component declarations
+	of the derived record. These expressions are used among other
+	things as default values in aggregates with box associations.
+	* a-dirval-mingw.adb, g-cgi.adb, gnatcmd.adb, lib-xref.adb,
+	repinfo.adb, sem_attr.adb, sem_ch10.adb, sem_ch6.adb, sem_prag.adb:
+	Minor reformatting.
+
+2017-09-07  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_util.adb: Remove extra space after THEN.
+
+2017-09-07  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch7.adb (Has_Referencer): For a subprogram renaming,
+	also mark the renamed subprogram as referenced.
+
 2017-09-07  Ed Schonberg  <schonberg@adacore.com>
 
 	* par-ch6.adb (P_Subprogram): Improve error message on null
diff --git a/gcc/ada/a-dirval-mingw.adb b/gcc/ada/a-dirval-mingw.adb
index dad5c4a..b0a9cc3 100644
--- a/gcc/ada/a-dirval-mingw.adb
+++ b/gcc/ada/a-dirval-mingw.adb
@@ -7,7 +7,7 @@
 --                                 B o d y                                  --
 --                            (Windows Version)                             --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -75,7 +75,7 @@ package body Ada.Directories.Validity is
          --  A drive letter may be specified at the beginning
 
          if Name'Length >= 2
-           and then  Name (Start + 1) = ':'
+           and then Name (Start + 1) = ':'
            and then
              (Name (Start) in 'A' .. 'Z' or else Name (Start) in 'a' .. 'z')
          then
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 39b11f8..908338f 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -137,7 +137,8 @@ package body Exp_Ch6 is
    --  there are no tasks.
 
    function Caller_Known_Size
-     (Func_Call : Node_Id; Result_Subt : Entity_Id) return Boolean;
+     (Func_Call   : Node_Id;
+      Result_Subt : Entity_Id) return Boolean;
    --  True if result subtype is definite, or has a size that does not require
    --  secondary stack usage (i.e. no variant part or components whose type
    --  depends on discriminants). In particular, untagged types with only
@@ -837,11 +838,14 @@ package body Exp_Ch6 is
    -----------------------
 
    function Caller_Known_Size
-     (Func_Call : Node_Id; Result_Subt : Entity_Id) return Boolean is
+     (Func_Call   : Node_Id;
+      Result_Subt : Entity_Id) return Boolean
+   is
    begin
-      return (Is_Definite_Subtype (Underlying_Type (Result_Subt))
-              and then No (Controlling_Argument (Func_Call)))
-          or else not Requires_Transient_Scope (Underlying_Type (Result_Subt));
+      return
+          (Is_Definite_Subtype (Underlying_Type (Result_Subt))
+            and then No (Controlling_Argument (Func_Call)))
+        or else not Requires_Transient_Scope (Underlying_Type (Result_Subt));
    end Caller_Known_Size;
 
    --------------------------------
@@ -8081,7 +8085,8 @@ package body Exp_Ch6 is
 
       declare
          Definite : constant Boolean :=
-           Caller_Known_Size (Func_Call, Result_Subt);
+                      Caller_Known_Size (Func_Call, Result_Subt);
+
       begin
          --  Create an access type designating the function's result subtype.
          --  We use the type of the original call because it may be a call to
diff --git a/gcc/ada/g-cgi.adb b/gcc/ada/g-cgi.adb
index 34058e0..9d658e6 100644
--- a/gcc/ada/g-cgi.adb
+++ b/gcc/ada/g-cgi.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                      Copyright (C) 2001-2010, AdaCore                    --
+--                      Copyright (C) 2001-2017, 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- --
@@ -110,7 +110,7 @@ package body GNAT.CGI is
    begin
       while K <= S'Last loop
          if K + 2 <= S'Last
-           and then  S (K) = '%'
+           and then S (K) = '%'
            and then Characters.Handling.Is_Hexadecimal_Digit (S (K + 1))
            and then Characters.Handling.Is_Hexadecimal_Digit (S (K + 2))
          then
diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index beb05f4..78ba5f3 100644
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -281,6 +281,13 @@ package body Ghost is
                   if Chars (Subp_Id) = Name_uPostconditions then
                      return True;
 
+                  --  The context is the internally built predicate function,
+                  --  which is OK because the real check was done before the
+                  --  predicate function was generated.
+
+                  elsif Is_Predicate_Function (Subp_Id) then
+                     return True;
+
                   else
                      Subp_Decl :=
                        Original_Node (Unit_Declaration_Node (Subp_Id));
@@ -362,10 +369,12 @@ package body Ghost is
                   return True;
 
                --  An assertion expression pragma is Ghost when it contains a
-               --  reference to a Ghost entity (SPARK RM 6.9(10)).
-
-               elsif Assertion_Expression_Pragma (Prag_Id) then
+               --  reference to a Ghost entity (SPARK RM 6.9(10)), except for
+               --  predicate pragmas (SPARK RM 6.9(11)).
 
+               elsif Assertion_Expression_Pragma (Prag_Id)
+                 and then Prag_Id /= Pragma_Predicate
+               then
                   --  Ensure that the assertion policy and the Ghost policy are
                   --  compatible (SPARK RM 6.9(18)).
 
@@ -464,9 +473,16 @@ package body Ghost is
                   return True;
 
                --  A reference to a Ghost entity can appear within an aspect
-               --  specification (SPARK RM 6.9(10)).
-
-               elsif Nkind (Par) = N_Aspect_Specification then
+               --  specification (SPARK RM 6.9(10)). The precise checking will
+               --  occur when analyzing the corresponding pragma. We make an
+               --  exception for predicate aspects that only allow referencing
+               --  a Ghost entity when the corresponding type declaration is
+               --  Ghost (SPARK RM 6.9(11)).
+
+               elsif Nkind (Par) = N_Aspect_Specification
+                 and then not Same_Aspect
+                                (Get_Aspect_Id (Par), Aspect_Predicate)
+               then
                   return True;
 
                elsif Is_OK_Declaration (Par) then
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index e5df7bb..55f79c3 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -573,9 +573,9 @@ begin
       --  report an error indicating that the command is no longer supporting
       --  project files.
 
-      if The_Command = Find or else  The_Command = Xref then
+      if The_Command = Find or else The_Command = Xref then
          declare
-            Argv    : String_Access;
+            Argv : String_Access;
          begin
             for Arg_Num in 1 .. Last_Switches.Last loop
                Argv := Last_Switches.Table (Arg_Num);
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index c2958ea..edc955b 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1079,7 +1079,7 @@ package body Lib.Xref is
          --  original discriminant, which gets the reference.
 
          elsif Ekind (E) = E_In_Parameter
-           and then  Present (Discriminal_Link (E))
+           and then Present (Discriminal_Link (E))
          then
             Ent := Discriminal_Link (E);
             Set_Referenced (Ent);
@@ -2702,7 +2702,7 @@ package body Lib.Xref is
                   if XE.Key.Loc /= No_Location
                     and then
                       (XE.Key.Loc /= Crloc
-                        or else (Prevt = 'm' and then  XE.Key.Typ = 'r'))
+                        or else (Prevt = 'm' and then XE.Key.Typ = 'r'))
                   then
                      Crloc := XE.Key.Loc;
                      Prevt := XE.Key.Typ;
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 58c46a9..83bb251 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -855,13 +855,14 @@ package body Ch6 is
 
                   if Is_Non_Empty_List (Aspects) then
                      if Func then
-                        Error_Msg ("aspect specifications must come after "
-                          & "parenthesized expression",
-                            Sloc (First (Aspects)));
+                        Error_Msg
+                          ("aspect specifications must come after "
+                           & "parenthesized expression",
+                           Sloc (First (Aspects)));
                      else
-                        Error_Msg ("aspect specifications must come after "
-                          & "subprogram specification",
-                            Sloc (First (Aspects)));
+                        Error_Msg
+                          ("aspect specifications must come after subprogram "
+                           & "specification", Sloc (First (Aspects)));
                      end if;
                   end if;
 
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index dbc5920..57528d6 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -341,7 +341,7 @@ package body Repinfo is
       begin
          Decl := Parent (E);
          while Present (Decl)
-           and then  Nkind (Decl) /= N_Package_Body
+           and then Nkind (Decl) /= N_Package_Body
            and then Nkind (Decl) /= N_Subprogram_Declaration
            and then Nkind (Decl) /= N_Subprogram_Body
          loop
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 1249fa0..a726904 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3279,14 +3279,6 @@ package body Sem_Aggr is
       --  An error message is emitted if the components taking their value from
       --  the others choice do not have same type.
 
-      function New_Copy_Tree_And_Copy_Dimensions
-        (Source    : Node_Id;
-         Map       : Elist_Id   := No_Elist;
-         New_Sloc  : Source_Ptr := No_Location;
-         New_Scope : Entity_Id  := Empty) return Node_Id;
-      --  Same as New_Copy_Tree (defined in Sem_Util), except that this routine
-      --  also copies the dimensions of Source to the returned node.
-
       procedure Propagate_Discriminants
         (Aggr       : Node_Id;
          Assoc_List : List_Id);
@@ -3733,26 +3725,6 @@ package body Sem_Aggr is
          return Expr;
       end Get_Value;
 
-      ---------------------------------------
-      -- New_Copy_Tree_And_Copy_Dimensions --
-      ---------------------------------------
-
-      function New_Copy_Tree_And_Copy_Dimensions
-        (Source    : Node_Id;
-         Map       : Elist_Id   := No_Elist;
-         New_Sloc  : Source_Ptr := No_Location;
-         New_Scope : Entity_Id  := Empty) return Node_Id
-      is
-         New_Copy : constant Node_Id :=
-                      New_Copy_Tree (Source, Map, New_Sloc, New_Scope);
-
-      begin
-         --  Move the dimensions of Source to New_Copy
-
-         Copy_Dimensions (Source, New_Copy);
-         return New_Copy;
-      end New_Copy_Tree_And_Copy_Dimensions;
-
       -----------------------------
       -- Propagate_Discriminants --
       -----------------------------
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index feef95a..09ca1fd 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3556,7 +3556,7 @@ package body Sem_Attr is
 
          elsif Nkind (P) = N_Indexed_Component then
             if not Is_Entity_Name (Prefix (P))
-              or else  No (Entity (Prefix (P)))
+              or else No (Entity (Prefix (P)))
               or else Ekind (Entity (Prefix (P))) /= E_Entry_Family
             then
                if Nkind (Prefix (P)) = N_Selected_Component
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 358b20a..3328639 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1748,7 +1748,7 @@ package body Sem_Ch10 is
             --  body may not be available, in which case do not try analysis.
 
             if Serious_Errors_Detected > 0
-              and then  No (Library_Unit (Library_Unit (N)))
+              and then No (Library_Unit (Library_Unit (N)))
             then
                return;
             end if;
@@ -2129,7 +2129,7 @@ package body Sem_Ch10 is
                      --  attempt processing.
 
                      if Serious_Errors_Detected > 0
-                       and then  No (Entity (Name (Item)))
+                       and then No (Entity (Name (Item)))
                      then
                         Set_Entity (Name (Item), Standard_Standard);
                      end if;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a99d2ee..124a4af 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12649,7 +12649,6 @@ package body Sem_Ch13 is
    --------------------------------
 
    procedure Resolve_Aspect_Expressions (E : Entity_Id) is
-
       function Resolve_Name (N : Node_Id) return Traverse_Result;
       --  Verify that all identifiers in the expression, with the exception
       --  of references to the current entity, denote visible entities. This
@@ -12668,6 +12667,7 @@ package body Sem_Ch13 is
 
       function Resolve_Name (N : Node_Id) return Traverse_Result is
          Dummy : Traverse_Result;
+
       begin
          if Nkind (N) = N_Selected_Component then
             if Nkind (Prefix (N)) = N_Identifier
@@ -12700,6 +12700,8 @@ package body Sem_Ch13 is
 
       procedure Resolve_Aspect_Expression is new Traverse_Proc (Resolve_Name);
 
+      --  Local variables
+
       ASN : Node_Id := First_Rep_Item (E);
 
    --  Start of processing for Resolve_Aspect_Expressions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 75348c7..41bf2a86 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9352,6 +9352,7 @@ package body Sem_Ch3 is
          New_Decl :=
            New_Copy_Tree
              (Parent (Parent_Base), Map => Assoc_List, New_Sloc => Loc);
+         Copy_Dimensions_Of_Components (Derived_Type);
 
          --  Restore the fields saved prior to the New_Copy_Tree call
          --  and compute the stored constraint.
@@ -11883,7 +11884,7 @@ package body Sem_Ch3 is
          --  or protected interfaces.
 
          elsif Nkind (N) = N_Full_Type_Declaration
-           and then  Protected_Present (Type_Def)
+           and then Protected_Present (Type_Def)
          then
             if Limited_Present (Iface_Def)
               or else Synchronized_Present (Iface_Def)
@@ -16795,7 +16796,7 @@ package body Sem_Ch3 is
 
    procedure Diagnose_Interface (N : Node_Id;  E : Entity_Id) is
    begin
-      if not Is_Interface (E) and then  E /= Any_Type then
+      if not Is_Interface (E) and then E /= Any_Type then
          Error_Msg_NE ("(Ada 2005) & must be an interface", N, E);
       end if;
    end Diagnose_Interface;
@@ -21450,7 +21451,7 @@ package body Sem_Ch3 is
                Constrain_Access (Def_Id, S, Related_Nod);
 
                if Expander_Active
-                 and then  Is_Itype (Designated_Type (Def_Id))
+                 and then Is_Itype (Designated_Type (Def_Id))
                  and then Nkind (Related_Nod) = N_Subtype_Declaration
                  and then not Is_Incomplete_Type (Designated_Type (Def_Id))
                then
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index f96c073..16f4f34 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -439,6 +439,23 @@ package body Sem_Ch7 is
                   then
                      Set_Is_Public (Decl_Id, False);
                   end if;
+
+                  --  For a subprogram renaming, if the entity is referenced,
+                  --  then so is the renamed subprogram. But there is an issue
+                  --  with generic bodies because instantiations are not done
+                  --  yet and, therefore, cannot be scanned for referencers.
+                  --  That's why we use an approximation and test that we have
+                  --  at least one subprogram referenced by an inlined body
+                  --  instead of precisely the entity of this renaming.
+
+                  if Nkind (Decl) = N_Subprogram_Renaming_Declaration
+                    and then Subprogram_Table.Get_First
+                    and then Is_Entity_Name (Name (Decl))
+                    and then Present (Entity (Name (Decl)))
+                    and then Is_Subprogram (Entity (Name (Decl)))
+                  then
+                     Subprogram_Table.Set (Entity (Name (Decl)), True);
+                  end if;
                end if;
 
                Prev (Decl);
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 2b4b843..6aae74b 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -2405,6 +2405,25 @@ package body Sem_Dim is
       end if;
    end Copy_Dimensions;
 
+   -----------------------------------
+   -- Copy_Dimensions_Of_Components --
+   -----------------------------------
+
+   procedure Copy_Dimensions_Of_Components (Rec : Entity_Id) is
+      C : Entity_Id;
+
+   begin
+      C := First_Component (Rec);
+      while Present (C) loop
+         if Nkind (Parent (C)) = N_Component_Declaration then
+            Copy_Dimensions
+              (Expression (Parent (Corresponding_Record_Component (C))),
+               Expression (Parent (C)));
+         end if;
+         Next_Component (C);
+      end loop;
+   end Copy_Dimensions_Of_Components;
+
    --------------------------
    -- Create_Rational_From --
    --------------------------
@@ -3483,6 +3502,26 @@ package body Sem_Dim is
       Remove_Dimensions (From);
    end Move_Dimensions;
 
+   ---------------------------------------
+   -- New_Copy_Tree_And_Copy_Dimensions --
+   ---------------------------------------
+
+   function New_Copy_Tree_And_Copy_Dimensions
+     (Source    : Node_Id;
+      Map       : Elist_Id   := No_Elist;
+      New_Sloc  : Source_Ptr := No_Location;
+      New_Scope : Entity_Id  := Empty) return Node_Id
+   is
+      New_Copy : constant Node_Id :=
+                   New_Copy_Tree (Source, Map, New_Sloc, New_Scope);
+
+   begin
+      --  Move the dimensions of Source to New_Copy
+
+      Copy_Dimensions (Source, New_Copy);
+      return New_Copy;
+   end New_Copy_Tree_And_Copy_Dimensions;
+
    ------------
    -- Reduce --
    ------------
diff --git a/gcc/ada/sem_dim.ads b/gcc/ada/sem_dim.ads
index bad3bf2..9452d7a 100644
--- a/gcc/ada/sem_dim.ads
+++ b/gcc/ada/sem_dim.ads
@@ -189,6 +189,20 @@ package Sem_Dim is
    --  node that is allowed to contain a dimension (see OK_For_Dimension in
    --  body of Sem_Dim).
 
+   procedure Copy_Dimensions_Of_Components (Rec : Entity_Id);
+   --  Propagate the dimensions of the components of a record type T to the
+   --  components of a record type derived from T. The derivation creates
+   --  a full copy of the type declaration of the parent, and the dimension
+   --  information of individual components must be transferred explicitly.
+
+   function New_Copy_Tree_And_Copy_Dimensions
+     (Source    : Node_Id;
+      Map       : Elist_Id   := No_Elist;
+      New_Sloc  : Source_Ptr := No_Location;
+      New_Scope : Entity_Id  := Empty) return Node_Id;
+   --  Same as New_Copy_Tree (defined in Sem_Util), except that this routine
+   --  also copies the dimensions of Source to the returned node.
+
    function Dimensions_Match (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
    --  If the common base type has a dimension system, verify that two
    --  subtypes have the same dimensions. Used for conformance checking.
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index bb36584..6d838b3 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1205,126 +1205,173 @@ package body Sem_Prag is
             Item_Is_Output : out Boolean)
          is
          begin
-            Item_Is_Input  := False;
-            Item_Is_Output := False;
+            case Ekind (Item_Id) is
 
-            --  Abstract states
+               --  Abstract states
 
-            if Ekind (Item_Id) = E_Abstract_State then
+               when E_Abstract_State =>
 
-               --  When pragma Global is present, the mode of the state may be
-               --  further constrained by setting a more restrictive mode.
+                  --  When pragma Global is present it determines the mode of
+                  --  the abstract state.
 
-               if Global_Seen then
-                  if Appears_In (Subp_Inputs, Item_Id) then
-                     Item_Is_Input := True;
-                  end if;
+                  if Global_Seen then
+                     Item_Is_Input  := Appears_In (Subp_Inputs, Item_Id);
+                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);
+
+                  --  Otherwise the state has a default IN OUT mode, because it
+                  --  behaves as a variable.
 
-                  if Appears_In (Subp_Outputs, Item_Id) then
+                  else
+                     Item_Is_Input  := True;
                      Item_Is_Output := True;
                   end if;
 
-               --  Otherwise the state has a default IN OUT mode
+               --  Constants and IN parameters
 
-               else
-                  Item_Is_Input  := True;
-                  Item_Is_Output := True;
-               end if;
+               when E_Constant
+                  | E_Generic_In_Parameter
+                  | E_In_Parameter
+                  | E_Loop_Parameter
+               =>
+                  --  When pragma Global is present it determines the mode
+                  --  of constant objects as inputs (and such objects cannot
+                  --  appear as outputs in the Global contract).
 
-            --  Constants
+                  if Global_Seen then
+                     Item_Is_Input := Appears_In (Subp_Inputs, Item_Id);
+                  else
+                     Item_Is_Input := True;
+                  end if;
 
-            elsif Ekind_In (Item_Id, E_Constant,
-                                     E_Loop_Parameter)
-            then
-               Item_Is_Input := True;
+                  Item_Is_Output := False;
 
-            --  Parameters
+               --  Variables and IN OUT parameters
 
-            elsif Ekind_In (Item_Id, E_Generic_In_Parameter,
-                                     E_In_Parameter)
-            then
-               Item_Is_Input := True;
+               when E_Generic_In_Out_Parameter
+                  | E_In_Out_Parameter
+                  | E_Variable
+               =>
+                  --  When pragma Global is present it determines the mode of
+                  --  the object.
 
-            elsif Ekind_In (Item_Id, E_Generic_In_Out_Parameter,
-                                     E_In_Out_Parameter)
-            then
-               Item_Is_Input  := True;
-               Item_Is_Output := True;
+                  if Global_Seen then
 
-            elsif Ekind (Item_Id) = E_Out_Parameter then
-               if Scope (Item_Id) = Spec_Id then
+                     --  A variable has mode IN when its type is unconstrained
+                     --  or tagged because array bounds, discriminants or tags
+                     --  can be read.
 
-                  --  An OUT parameter of the related subprogram has mode IN
-                  --  if its type is unconstrained or tagged because array
-                  --  bounds, discriminants or tags can be read.
+                     Item_Is_Input :=
+                       Appears_In (Subp_Inputs, Item_Id)
+                         or else Is_Unconstrained_Or_Tagged_Item (Item_Id);
 
-                  if Is_Unconstrained_Or_Tagged_Item (Item_Id) then
-                     Item_Is_Input := True;
+                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);
+
+                  --  Otherwise the variable has a default IN OUT mode
+
+                  else
+                     Item_Is_Input  := True;
+                     Item_Is_Output := True;
                   end if;
 
-                  Item_Is_Output := True;
+               when E_Out_Parameter =>
 
-               --  An OUT parameter of an enclosing subprogram behaves as a
-               --  read-write variable in which case the mode is IN OUT.
+                  --  An OUT parameter of the related subprogram; it cannot
+                  --  appear in Global.
 
-               else
-                  Item_Is_Input  := True;
-                  Item_Is_Output := True;
-               end if;
+                  if Scope (Item_Id) = Spec_Id then
 
-            --  Protected types
+                     --  The parameter has mode IN if its type is unconstrained
+                     --  or tagged because array bounds, discriminants or tags
+                     --  can be read.
 
-            elsif Ekind (Item_Id) = E_Protected_Type then
+                     Item_Is_Input :=
+                       Is_Unconstrained_Or_Tagged_Item (Item_Id);
 
-               --  A protected type acts as a formal parameter of mode IN when
-               --  it applies to a protected function.
+                     Item_Is_Output := True;
 
-               if Ekind (Spec_Id) = E_Function then
-                  Item_Is_Input := True;
+                  --  An OUT parameter of an enclosing subprogram; it can
+                  --  appear in Global and behaves as a read-write variable.
 
-               --  Otherwise the protected type acts as a formal of mode IN OUT
+                  else
+                     --  When pragma Global is present it determines the mode
+                     --  of the object.
 
-               else
-                  Item_Is_Input  := True;
-                  Item_Is_Output := True;
-               end if;
+                     if Global_Seen then
 
-            --  Task types
+                        --  A variable has mode IN when its type is
+                        --  unconstrained or tagged because array
+                        --  bounds, discriminants or tags can be read.
 
-            elsif Ekind (Item_Id) = E_Task_Type then
-               Item_Is_Input  := True;
-               Item_Is_Output := True;
+                        Item_Is_Input :=
+                          Appears_In (Subp_Inputs, Item_Id)
+                            or else Is_Unconstrained_Or_Tagged_Item (Item_Id);
 
-            --  Variable case
+                        Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);
 
-            else pragma Assert (Ekind (Item_Id) = E_Variable);
+                     --  Otherwise the variable has a default IN OUT mode
 
-               --  When pragma Global is present, the mode of the variable may
-               --  be further constrained by setting a more restrictive mode.
+                     else
+                        Item_Is_Input  := True;
+                        Item_Is_Output := True;
+                     end if;
+                  end if;
 
-               if Global_Seen then
+               --  Protected types
 
-                  --  A variable has mode IN when its type is unconstrained or
-                  --  tagged because array bounds, discriminants or tags can be
-                  --  read.
+               when E_Protected_Type =>
+                  if Global_Seen then
 
-                  if Appears_In (Subp_Inputs, Item_Id)
-                    or else Is_Unconstrained_Or_Tagged_Item (Item_Id)
-                  then
-                     Item_Is_Input := True;
+                     --  A variable has mode IN when its type is unconstrained
+                     --  or tagged because array bounds, discriminants or tags
+                     --  can be read.
+
+                     Item_Is_Input :=
+                       Appears_In (Subp_Inputs, Item_Id)
+                         or else Is_Unconstrained_Or_Tagged_Item (Item_Id);
+
+                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);
+
+                  else
+                     --  A protected type acts as a formal parameter of mode IN
+                     --  when it applies to a protected function.
+
+                     if Ekind (Spec_Id) = E_Function then
+                        Item_Is_Input  := True;
+                        Item_Is_Output := False;
+
+                     --  Otherwise the protected type acts as a formal of mode
+                     --  IN OUT.
+
+                     else
+                        Item_Is_Input  := True;
+                        Item_Is_Output := True;
+                     end if;
                   end if;
 
-                  if Appears_In (Subp_Outputs, Item_Id) then
+               --  Task types
+
+               when E_Task_Type =>
+
+                  --  When pragma Global is present it determines the mode of
+                  --  the object.
+
+                  if Global_Seen then
+                     Item_Is_Input :=
+                       Appears_In (Subp_Inputs, Item_Id)
+                         or else Is_Unconstrained_Or_Tagged_Item (Item_Id);
+
+                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);
+
+                  --  Otherwise task types act as IN OUT parameters
+
+                  else
+                     Item_Is_Input  := True;
                      Item_Is_Output := True;
                   end if;
 
-               --  Otherwise the variable has a default IN OUT mode
-
-               else
-                  Item_Is_Input  := True;
-                  Item_Is_Output := True;
-               end if;
-            end if;
+               when others =>
+                  raise Program_Error;
+            end case;
          end Find_Role;
 
          ----------------
@@ -5069,7 +5116,7 @@ package body Sem_Prag is
                --  pragma is inserted in its declarative part.
 
                elsif From_Aspect_Specification (N)
-                 and then  Ent = Current_Scope
+                 and then Ent = Current_Scope
                  and then
                    Nkind (Unit_Declaration_Node (Ent)) = N_Subprogram_Body
                then
@@ -28300,7 +28347,7 @@ package body Sem_Prag is
          if Nkind (Clause) = N_Null then
             null;
 
-         --  A dependency cause appears as component association
+         --  A dependency clause appears as component association
 
          elsif Nkind (Clause) = N_Component_Association then
             Collect_Dependency_Item
@@ -28424,21 +28471,15 @@ package body Sem_Prag is
          Subp_Decl := Unit_Declaration_Node (Subp_Id);
          Spec_Id   := Unique_Defining_Entity (Subp_Decl);
 
-         --  Process all [generic] formal parameters
+         --  Process all formal parameters
 
          Formal := First_Entity (Spec_Id);
          while Present (Formal) loop
-            if Ekind_In (Formal, E_Generic_In_Parameter,
-                                 E_In_Out_Parameter,
-                                 E_In_Parameter)
-            then
+            if Ekind_In (Formal, E_In_Out_Parameter, E_In_Parameter) then
                Append_New_Elmt (Formal, Subp_Inputs);
             end if;
 
-            if Ekind_In (Formal, E_Generic_In_Out_Parameter,
-                                 E_In_Out_Parameter,
-                                 E_Out_Parameter)
-            then
+            if Ekind_In (Formal, E_In_Out_Parameter, E_Out_Parameter) then
                Append_New_Elmt (Formal, Subp_Outputs);
 
                --  Out parameters can act as inputs when the related type is
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3ca92ce..5ea7b0b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -764,7 +764,7 @@ package body Sem_Util is
 
       if Inside_A_Generic then
          Gen := Current_Scope;
-         while Present (Gen) and then  Ekind (Gen) /= E_Generic_Package loop
+         while Present (Gen) and then Ekind (Gen) /= E_Generic_Package loop
             Gen := Scope (Gen);
          end loop;