[multiple changes]

2015-05-26  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb, sem_ch3.adb, sem_ch5.adb, exp_ch11.adb, ghost.adb,
	exp_ch6.adb, sem_ch6.adb, sem_ch8.adb, sem_ch11.adb, sem_ch13.adb,
	exp_ch3.adb: Minor reformatting.

2015-05-26  Bob Duff  <duff@adacore.com>

	* treepr.adb: Minor improvement to debugging routines (pp, pn)
	robustness.  Rearrange the code so passing a nonexistent Node_Id
	prints "No such node" rather than crashing, and causing gdb to
	generate confusing messages.

2015-05-26  Gary Dismukes  <dismukes@adacore.com>

	* sem_util.adb: Minor typo fix.

2015-05-26  Yannick Moy  <moy@adacore.com>

	* sem_aux.adb (Subprogram_Body_Entity): Deal with subprogram stubs.

From-SVN: r223685

15 files changed, 99 insertions, 62 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d3ef056..c042274 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2015-05-26  Robert Dewar  <dewar@adacore.com>
+
+	* exp_prag.adb, sem_ch3.adb, sem_ch5.adb, exp_ch11.adb, ghost.adb,
+	exp_ch6.adb, sem_ch6.adb, sem_ch8.adb, sem_ch11.adb, sem_ch13.adb,
+	exp_ch3.adb: Minor reformatting.
+
+2015-05-26  Bob Duff  <duff@adacore.com>
+
+	* treepr.adb: Minor improvement to debugging routines (pp, pn)
+	robustness.  Rearrange the code so passing a nonexistent Node_Id
+	prints "No such node" rather than crashing, and causing gdb to
+	generate confusing messages.
+
+2015-05-26  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_util.adb: Minor typo fix.
+
+2015-05-26  Yannick Moy  <moy@adacore.com>
+
+	* sem_aux.adb (Subprogram_Body_Entity): Deal with subprogram stubs.
+
 2015-05-26  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch3.adb (Expand_N_Full_Type_Declaration): Capture, set and
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index dd0423a..47c3730 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1191,11 +1191,11 @@ package body Exp_Ch11 is
 
    procedure Expand_N_Exception_Declaration (N : Node_Id) is
       GM      : constant Ghost_Mode_Type := Ghost_Mode;
-      Id      : constant Entity_Id  := Defining_Identifier (N);
-      Loc     : constant Source_Ptr := Sloc (N);
+      Id      : constant Entity_Id       := Defining_Identifier (N);
+      Loc     : constant Source_Ptr      := Sloc (N);
       Ex_Id   : Entity_Id;
       Flag_Id : Entity_Id;
-      L       : List_Id := New_List;
+      L       : List_Id;
 
       procedure Force_Static_Allocation_Of_Referenced_Objects
         (Aggregate : Node_Id);
@@ -1304,6 +1304,7 @@ package body Exp_Ch11 is
       --  Create the aggregate list for type Standard.Exception_Type:
       --  Handled_By_Other component: False
 
+      L := Empty_List;
       Append_To (L, New_Occurrence_Of (Standard_False, Loc));
 
       --  Lang component: 'A'
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index d7f4534..7141769 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4792,8 +4792,8 @@ package body Exp_Ch3 is
 
       --  Local declarations
 
-      Def_Id : constant Entity_Id := Defining_Identifier (N);
-      B_Id   : constant Entity_Id := Base_Type (Def_Id);
+      Def_Id : constant Entity_Id       := Defining_Identifier (N);
+      B_Id   : constant Entity_Id       := Base_Type (Def_Id);
       GM     : constant Ghost_Mode_Type := Ghost_Mode;
       FN     : Node_Id;
       Par_Id : Entity_Id;
@@ -4942,13 +4942,13 @@ package body Exp_Ch3 is
    ---------------------------------
 
    procedure Expand_N_Object_Declaration (N : Node_Id) is
-      Def_Id   : constant Entity_Id  := Defining_Identifier (N);
-      Expr     : constant Node_Id    := Expression (N);
+      Loc      : constant Source_Ptr      := Sloc (N);
+      Def_Id   : constant Entity_Id       := Defining_Identifier (N);
+      Expr     : constant Node_Id         := Expression (N);
       GM       : constant Ghost_Mode_Type := Ghost_Mode;
-      Loc      : constant Source_Ptr := Sloc (N);
-      Obj_Def  : constant Node_Id    := Object_Definition (N);
-      Typ      : constant Entity_Id  := Etype (Def_Id);
-      Base_Typ : constant Entity_Id  := Base_Type (Typ);
+      Obj_Def  : constant Node_Id         := Object_Definition (N);
+      Typ      : constant Entity_Id       := Etype (Def_Id);
+      Base_Typ : constant Entity_Id       := Base_Type (Typ);
       Expr_Q   : Node_Id;
 
       function Build_Equivalent_Aggregate return Boolean;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 01081a0..5afaf49 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5006,8 +5006,8 @@ package body Exp_Ch6 is
 
    procedure Expand_N_Subprogram_Body (N : Node_Id) is
       GM       : constant Ghost_Mode_Type := Ghost_Mode;
-      Loc      : constant Source_Ptr := Sloc (N);
-      HSS      : constant Node_Id    := Handled_Statement_Sequence (N);
+      Loc      : constant Source_Ptr      := Sloc (N);
+      HSS      : constant Node_Id         := Handled_Statement_Sequence (N);
       Body_Id  : Entity_Id;
       Except_H : Node_Id;
       L        : List_Id;
@@ -5451,10 +5451,10 @@ package body Exp_Ch6 is
    --  If the declaration is for a null procedure, emit null body
 
    procedure Expand_N_Subprogram_Declaration (N : Node_Id) is
+      Loc       : constant Source_Ptr      := Sloc (N);
       GM        : constant Ghost_Mode_Type := Ghost_Mode;
-      Loc       : constant Source_Ptr := Sloc (N);
-      Subp      : constant Entity_Id  := Defining_Entity (N);
-      Scop      : constant Entity_Id  := Scope (Subp);
+      Subp      : constant Entity_Id       := Defining_Entity (N);
+      Scop      : constant Entity_Id       := Scope (Subp);
       Prot_Bod  : Node_Id;
       Prot_Decl : Node_Id;
       Prot_Id   : Entity_Id;
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index fab3fac..d47e31c 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -294,8 +294,8 @@ package body Exp_Prag is
 
    procedure Expand_Pragma_Check (N : Node_Id) is
       GM   : constant Ghost_Mode_Type := Ghost_Mode;
-      Cond : constant Node_Id := Arg2 (N);
-      Nam  : constant Name_Id := Chars (Arg1 (N));
+      Cond : constant Node_Id         := Arg2 (N);
+      Nam  : constant Name_Id         := Chars (Arg1 (N));
       Msg  : Node_Id;
 
       Loc : constant Source_Ptr := Sloc (First_Node (Cond));
@@ -1580,8 +1580,9 @@ package body Exp_Prag is
    --     end loop;
 
    procedure Expand_Pragma_Loop_Variant (N : Node_Id) is
-      Last_Var : constant Node_Id := Last (Pragma_Argument_Associations (N));
       Loc      : constant Source_Ptr := Sloc (N);
+      Last_Var : constant Node_Id    :=
+                   Last (Pragma_Argument_Associations (N));
 
       Curr_Assign : List_Id   := No_List;
       Flag_Id     : Entity_Id := Empty;
diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 75ceb4b..05295a0 100644
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -121,18 +121,18 @@ package body Ghost is
 
          Error_Msg_N ("incompatible ghost policies in effect", Partial_View);
          Error_Msg_N ("\& declared with ghost policy `Check`", Partial_View);
-         Error_Msg_N
-           ("\& completed # with ghost policy `Ignore`", Partial_View);
+         Error_Msg_N ("\& completed # with ghost policy `Ignore`",
+                                                               Partial_View);
 
       elsif Is_Ignored_Ghost_Entity (Partial_View)
         and then Policy = Name_Check
       then
          Error_Msg_Sloc := Sloc (Full_View);
 
-         Error_Msg_N ("incompatible ghost policies in effect", Partial_View);
+         Error_Msg_N ("incompatible ghost policies in effect",  Partial_View);
          Error_Msg_N ("\& declared with ghost policy `Ignore`", Partial_View);
-         Error_Msg_N
-           ("\& completed # with ghost policy `Check`", Partial_View);
+         Error_Msg_N ("\& completed # with ghost policy `Check`",
+                                                                Partial_View);
       end if;
    end Check_Ghost_Completion;
 
@@ -300,7 +300,8 @@ package body Ghost is
 
                if GP = Name_Ignore and then AP /= Name_Ignore then
                   Error_Msg_N
-                    ("incompatible ghost policies in effect", Ghost_Ref);
+                    ("incompatible ghost policies in effect",
+                     Ghost_Ref);
                   Error_Msg_NE
                     ("\ghost entity & has policy `Ignore`",
                      Ghost_Ref, Ghost_Id);
@@ -494,14 +495,14 @@ package body Ghost is
 
             Error_Msg_N  ("incompatible ghost policies in effect", Err_N);
             Error_Msg_NE ("\& declared with ghost policy `Check`", Err_N, Id);
-            Error_Msg_NE ("\& used # with ghost policy `Ignore`", Err_N, Id);
+            Error_Msg_NE ("\& used # with ghost policy `Ignore`",  Err_N, Id);
 
          elsif Is_Ignored_Ghost_Entity (Id) and then Policy = Name_Check then
             Error_Msg_Sloc := Sloc (Err_N);
 
-            Error_Msg_N  ("incompatible ghost policies in effect", Err_N);
+            Error_Msg_N  ("incompatible ghost policies in effect",  Err_N);
             Error_Msg_NE ("\& declared with ghost policy `Ignore`", Err_N, Id);
-            Error_Msg_NE ("\& used # with ghost policy `Check`", Err_N, Id);
+            Error_Msg_NE ("\& used # with ghost policy `Check`",    Err_N, Id);
          end if;
       end Check_Ghost_Policy;
 
@@ -558,7 +559,7 @@ package body Ghost is
 
             if not Is_Ghost_Entity (Iface) then
                Error_Msg_N  ("type extension & cannot be ghost", Typ);
-               Error_Msg_NE ("\interface type & is not ghost", Typ, Iface);
+               Error_Msg_NE ("\interface type & is not ghost",   Typ, Iface);
                return;
             end if;
 
@@ -587,10 +588,10 @@ package body Ghost is
          if Is_Checked_Ghost_Entity (Par_Subp)
            and then Is_Ignored_Ghost_Entity (Subp)
          then
-            Error_Msg_N ("incompatible ghost policies in effect", Subp);
+            Error_Msg_N ("incompatible ghost policies in effect",    Subp);
 
             Error_Msg_Sloc := Sloc (Par_Subp);
-            Error_Msg_N ("\& declared # with ghost policy `Check`", Subp);
+            Error_Msg_N ("\& declared # with ghost policy `Check`",  Subp);
 
             Error_Msg_Sloc := Sloc (Subp);
             Error_Msg_N ("\overridden # with ghost policy `Ignore`", Subp);
@@ -598,13 +599,13 @@ package body Ghost is
          elsif Is_Ignored_Ghost_Entity (Par_Subp)
            and then Is_Checked_Ghost_Entity (Subp)
          then
-            Error_Msg_N ("incompatible ghost policies in effect", Subp);
+            Error_Msg_N ("incompatible ghost policies in effect",    Subp);
 
             Error_Msg_Sloc := Sloc (Par_Subp);
             Error_Msg_N ("\& declared # with ghost policy `Ignore`", Subp);
 
             Error_Msg_Sloc := Sloc (Subp);
-            Error_Msg_N ("\overridden # with ghost policy `Check`", Subp);
+            Error_Msg_N ("\overridden # with ghost policy `Check`",  Subp);
          end if;
       end if;
    end Check_Ghost_Overriding;
@@ -1158,7 +1159,6 @@ package body Ghost is
    begin
       if Is_Checked_Ghost_Entity (Id) then
          Ghost_Mode := Check;
-
       elsif Is_Ignored_Ghost_Entity (Id) then
          Ghost_Mode := Ignore;
       end if;
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index ef88959..31644b0 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -1524,15 +1524,15 @@ package body Sem_Aux is
       N := Parent (Subprogram_Specification (E));
 
       --  If this declaration is not a subprogram body, then it must be a
-      --  subprogram declaration, from which we can retrieve the entity for
-      --  the corresponding subprogram body if any, or an abstract subprogram
-      --  declaration, for which we return Empty.
+      --  subprogram declaration or body stub, from which we can retrieve the
+      --  entity for the corresponding subprogram body if any, or an abstract
+      --  subprogram declaration, for which we return Empty.
 
       case Nkind (N) is
          when N_Subprogram_Body =>
             return E;
 
-         when N_Subprogram_Declaration =>
+         when N_Subprogram_Declaration | N_Subprogram_Body_Stub =>
             return Corresponding_Body (N);
 
          when others =>
diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index e1ff0c1..82b59e92 100644
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -56,8 +56,8 @@ package body Sem_Ch11 is
 
    procedure Analyze_Exception_Declaration (N : Node_Id) is
       GM : constant Ghost_Mode_Type := Ghost_Mode;
-      Id : constant Entity_Id := Defining_Identifier (N);
-      PF : constant Boolean   := Is_Pure (Current_Scope);
+      Id : constant Entity_Id       := Defining_Identifier (N);
+      PF : constant Boolean         := Is_Pure (Current_Scope);
 
    begin
       --  The exception declaration may be subject to pragma Ghost with policy
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8db5b50..d994ba3 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7763,14 +7763,14 @@ package body Sem_Ch13 is
    function Build_Invariant_Procedure_Declaration
      (Typ : Entity_Id) return Node_Id
    is
+      Loc    : constant Source_Ptr      := Sloc (Typ);
       GM     : constant Ghost_Mode_Type := Ghost_Mode;
-      Loc    : constant Source_Ptr := Sloc (Typ);
       Decl   : Node_Id;
       Obj_Id : Entity_Id;
       SId    : Entity_Id;
 
    begin
-      --  Check for duplicate definiations
+      --  Check for duplicate definitions
 
       if Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)) then
          return Empty;
@@ -8011,7 +8011,7 @@ package body Sem_Ch13 is
             --  analyzed at the end of the private part, but that yields the
             --  wrong visibility.
 
-            --  Historic note: we used to set N as the parent, but a package
+            --  Historical note: we used to set N as the parent, but a package
             --  specification as the parent of an expression is bizarre.
 
             Set_Parent (Expr, Parent (Arg2));
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index fa84de4..df86250 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2556,8 +2556,8 @@ package body Sem_Ch3 is
    -----------------------------------
 
    procedure Analyze_Full_Type_Declaration (N : Node_Id) is
-      Def    : constant Node_Id   := Type_Definition (N);
-      Def_Id : constant Entity_Id := Defining_Identifier (N);
+      Def    : constant Node_Id         := Type_Definition (N);
+      Def_Id : constant Entity_Id       := Defining_Identifier (N);
       GM     : constant Ghost_Mode_Type := Ghost_Mode;
       T      : Entity_Id;
       Prev   : Entity_Id;
@@ -2923,7 +2923,7 @@ package body Sem_Ch3 is
    ----------------------------------
 
    procedure Analyze_Incomplete_Type_Decl (N : Node_Id) is
-      F  : constant Boolean := Is_Pure (Current_Scope);
+      F  : constant Boolean         := Is_Pure (Current_Scope);
       GM : constant Ghost_Mode_Type := Ghost_Mode;
       T  : Entity_Id;
 
@@ -3406,9 +3406,9 @@ package body Sem_Ch3 is
    --------------------------------
 
    procedure Analyze_Object_Declaration (N : Node_Id) is
+      Loc   : constant Source_Ptr      := Sloc (N);
       GM    : constant Ghost_Mode_Type := Ghost_Mode;
-      Id    : constant Entity_Id  := Defining_Identifier (N);
-      Loc   : constant Source_Ptr := Sloc (N);
+      Id    : constant Entity_Id       := Defining_Identifier (N);
       Act_T : Entity_Id;
       T     : Entity_Id;
 
@@ -4544,8 +4544,8 @@ package body Sem_Ch3 is
 
    procedure Analyze_Private_Extension_Declaration (N : Node_Id) is
       GM          : constant Ghost_Mode_Type := Ghost_Mode;
-      Indic       : constant Node_Id   := Subtype_Indication (N);
-      T           : constant Entity_Id := Defining_Identifier (N);
+      Indic       : constant Node_Id         := Subtype_Indication (N);
+      T           : constant Entity_Id       := Defining_Identifier (N);
       Parent_Base : Entity_Id;
       Parent_Type : Entity_Id;
 
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 162e6db..2b2e918 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -91,8 +91,8 @@ package body Sem_Ch5 is
 
    procedure Analyze_Assignment (N : Node_Id) is
       GM   : constant Ghost_Mode_Type := Ghost_Mode;
-      Lhs  : constant Node_Id := Name (N);
-      Rhs  : constant Node_Id := Expression (N);
+      Lhs  : constant Node_Id         := Name (N);
+      Rhs  : constant Node_Id         := Expression (N);
       T1   : Entity_Id;
       T2   : Entity_Id;
       Decl : Node_Id;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 07579f0..a225883 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -210,8 +210,8 @@ package body Sem_Ch6 is
 
    procedure Analyze_Abstract_Subprogram_Declaration (N : Node_Id) is
       GM      : constant Ghost_Mode_Type := Ghost_Mode;
-      Scop    : constant Entity_Id := Current_Scope;
-      Subp_Id : constant Entity_Id :=
+      Scop    : constant Entity_Id       := Current_Scope;
+      Subp_Id : constant Entity_Id       :=
                   Analyze_Subprogram_Specification (Specification (N));
 
    begin
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 239fadc..df1eff3 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -672,7 +672,9 @@ package body Sem_Ch8 is
       GM    : constant Ghost_Mode_Type := Ghost_Mode;
       New_P : constant Entity_Id       := Defining_Entity (N);
       Old_P : Entity_Id;
-      Inst  : Boolean := False; -- prevent junk warning
+
+      Inst  : Boolean := False;
+      --  Prevent junk warning
 
    begin
       if Name (N) = Error then
@@ -2646,7 +2648,7 @@ package body Sem_Ch8 is
       --  type is class-wide.
 
       GM        : constant Ghost_Mode_Type := Ghost_Mode;
-      Inst_Node : Node_Id := Empty;
+      Inst_Node : Node_Id                  := Empty;
       New_S     : Entity_Id;
 
    --  Start of processing for Analyze_Subprogram_Renaming
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c7d220c..08a6fbb 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -17003,7 +17003,7 @@ package body Sem_Util is
             Comp := First_Entity (Typ);
             while Present (Comp) loop
                if Ekind (Comp) = E_Component then
-                  --  ???It's not cleare we need a full recursive call to
+                  --  ???It's not clear we need a full recursive call to
                   --  Requires_Transient_Scope here. Note that the following
                   --  can't happen.
 
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index 8ad81b9..d11a12b 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -974,7 +974,7 @@ package body Treepr is
       Prefix_Char : Character)
    is
       F : Fchar;
-      P : Natural := Pchar_Pos (Nkind (N));
+      P : Natural;
 
       Field_To_Be_Printed : Boolean;
       Prefix_Str_Char     : String (Prefix_Str'First .. Prefix_Str'Last + 1);
@@ -987,10 +987,14 @@ package body Treepr is
          return;
       end if;
 
-      if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) then
-         Fmt := Hex;
-      else
-         Fmt := Auto;
+      --  If there is no such node, indicate that. Skip the rest, so we don't
+      --  crash getting fields of the nonexistent node.
+
+      if N > Atree_Private_Part.Nodes.Last then
+         Print_Str ("No such node: ");
+         Print_Int (Int (N));
+         Print_Eol;
+         return;
       end if;
 
       Prefix_Str_Char (Prefix_Str'Range)    := Prefix_Str;
@@ -1184,6 +1188,14 @@ package body Treepr is
 
       --  Loop to print fields included in Pchars array
 
+      P := Pchar_Pos (Nkind (N));
+
+      if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) then
+         Fmt := Hex;
+      else
+         Fmt := Auto;
+      end if;
+
       while P < Pchar_Pos (Node_Kind'Succ (Nkind (N))) loop
          F := Pchars (P);
          P := P + 1;