[multiple changes]

2013-04-11  Ben Brosgol  <brosgol@adacore.com>

	* gnat_ugn.texi: Minor clean ups.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* nlists.ads, nlists.adb, treepr.adb, treepr.ads: Move debugging
	function p from Nlists to Treepr.

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_disp.adb (Check_Dispatching_Context): If the context is
	a contract for a null procedure defer error reporting until
	postcondition body is created.
	* exp_ch13.adb (Expand_N_Freeze_Entity): If the entity is a
	null procedure, complete the analysis of its contracts so that
	calls within classwide conditions are properly rewritten as
	dispatching calls.

From-SVN: r197794

8 files changed, 97 insertions, 47 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2728524..8ac9c7d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2013-04-11  Ben Brosgol  <brosgol@adacore.com>
+
+	* gnat_ugn.texi: Minor clean ups.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+	* nlists.ads, nlists.adb, treepr.adb, treepr.ads: Move debugging
+	function p from Nlists to Treepr.
+
+2013-04-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_disp.adb (Check_Dispatching_Context): If the context is
+	a contract for a null procedure defer error reporting until
+	postcondition body is created.
+	* exp_ch13.adb (Expand_N_Freeze_Entity): If the entity is a
+	null procedure, complete the analysis of its contracts so that
+	calls within classwide conditions are properly rewritten as
+	dispatching calls.
+
 2013-04-11  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_ch10.adb, sem_ch12.adb: Minor reformatting.
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 141e144..ba36805 100644
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -43,6 +43,7 @@ with Sem_Aux;  use Sem_Aux;
 with Sem_Ch7;  use Sem_Ch7;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Eval; use Sem_Eval;
+with Sem_Prag; use Sem_Prag;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
@@ -553,6 +554,28 @@ package body Exp_Ch13 is
                end;
 
             else
+               --  If the action is the generated body of a null subprogram,
+               --  analyze the expressions in its delayed aspects, because we
+               --  may not have reached the end of the declarative list when
+               --  delayed aspects are normally analyzed. This ensures that
+               --  dispatching calls are properly rewritten when the inner
+               --  postcondition procedure is analyzed.
+
+               if Is_Subprogram (E)
+                 and then Nkind (Parent (E)) = N_Procedure_Specification
+                 and then Null_Present (Parent (E))
+               then
+                  declare
+                     Prag : Node_Id;
+                  begin
+                     Prag := Spec_PPC_List (Contract (E));
+                     while Present (Prag) loop
+                        Analyze_PPC_In_Decl_Part (Prag, E);
+                        Prag := Next_Pragma (Prag);
+                     end loop;
+                  end;
+               end if;
+
                Analyze (Decl, Suppress => All_Checks);
             end if;
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 6d6376a..5a456cc 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -454,18 +454,6 @@ Stack Related Facilities
 * Static Stack Usage Analysis::
 * Dynamic Stack Usage Analysis::
 
-Some Useful Memory Pools
-
-The GNAT Debug Pool Facility
-
-@ifclear vms
-The gnatmem Tool
-
-* Running gnatmem::
-* Switches for gnatmem::
-* Example of gnatmem Usage::
-@end ifclear
-
 Verifying Properties Using gnatcheck
 
 Sample Bodies Using gnatstub
diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb
index 453e665..41b5ac2 100644
--- a/gcc/ada/nlists.adb
+++ b/gcc/ada/nlists.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -987,21 +987,6 @@ package body Nlists is
       return Int (Lists.Last) - Int (Lists.First) + 1;
    end Num_Lists;
 
-   -------
-   -- p --
-   -------
-
-   function p (U : Union_Id) return Node_Or_Entity_Id is
-   begin
-      if U in Node_Range then
-         return Parent (Node_Or_Entity_Id (U));
-      elsif U in List_Range then
-         return Parent (List_Id (U));
-      else
-         return 99_999_999;
-      end if;
-   end p;
-
    ------------
    -- Parent --
    ------------
diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads
index 10c04ed..5fd66de 100644
--- a/gcc/ada/nlists.ads
+++ b/gcc/ada/nlists.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -363,12 +363,4 @@ package Nlists is
    --  These functions return the addresses of the Next_Node and Prev_Node
    --  tables (used in Back_End for Gigi).
 
-   function p (U : Union_Id) return Node_Or_Entity_Id;
-   --  This function is intended for use from the debugger, it determines
-   --  whether U is a Node_Id or List_Id, and calls the appropriate Parent
-   --  function and returns the parent Node in either case. This is shorter
-   --  to type, and avoids the overloading problem of using Parent. It
-   --  should NEVER be used except from the debugger. If p is called with
-   --  other than a node or list id value, it returns 99_999_999.
-
 end Nlists;
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index d7d73b4..db266e8 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -536,6 +536,21 @@ package body Sem_Disp is
                Set_Entity (Name (N), Alias (Subp));
                return;
 
+            --  An obscure special case: a null procedure may have a class-
+            --  wide pre/postcondition that includes a call to an abstract
+            --  subp. Calls within the expression may not have been rewritten
+            --  as dispatching calls yet, because the null body appears in
+            --  the current declarative part. The expression will be properly
+            --  rewritten/reanalyzed when the postcondition procedure is built.
+
+            elsif In_Spec_Expression
+              and then Is_Subprogram (Current_Scope)
+              and then
+                Nkind (Parent (Current_Scope)) = N_Procedure_Specification
+              and then Null_Present (Parent (Current_Scope))
+            then
+               null;
+
             else
                --  We need to determine whether the context of the call
                --  provides a tag to make the call dispatching. This requires
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index 64dbf2d..4de6b85 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -215,6 +215,27 @@ package body Treepr is
    --  descendents are to be printed. Prefix_Str is to be added to all
    --  printed lines.
 
+   -------
+   -- p --
+   -------
+
+   function p (N : Union_Id) return Node_Or_Entity_Id is
+   begin
+      case N is
+         when List_Low_Bound .. List_High_Bound - 1 =>
+            return Nlists.Parent (List_Id (N));
+
+         when Node_Range =>
+            return Atree.Parent (Node_Or_Entity_Id (N));
+
+         when others =>
+            Write_Int (Int (N));
+            Write_Str (" is not a Node_Id or List_Id value");
+            Write_Eol;
+            return Empty;
+      end case;
+   end p;
+
    --------
    -- pe --
    --------
diff --git a/gcc/ada/treepr.ads b/gcc/ada/treepr.ads
index 212c491..d33e93b 100644
--- a/gcc/ada/treepr.ads
+++ b/gcc/ada/treepr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -62,16 +62,27 @@ package Treepr is
 
    --  The following debugging procedures are intended to be called from gdb
 
+   function p (N : Union_Id) return Node_Or_Entity_Id;
+   pragma Export (Ada, p);
+   --  Returns parent of a list or node (depending on the value of N). If N
+   --  is neither a list nor a node id, then prints a message to that effect
+   --  and returns Empty.
+
+   procedure pn (N : Union_Id);
+   --  Prints a node, node list, uint, or anything else that falls under
+   --  the definition of Union_Id. Historically this was only for printing
+   --  nodes, hence the name.
+
    procedure pp (N : Union_Id);
    pragma Export (Ada, pp);
-   --  Prints a node, node list, uint, or anything else that falls under
-   --  Union_Id.
+   --  Identical to pn, present for historical reasons
 
    procedure ppp (N : Node_Id);
    pragma Export (Ada, ppp);
    --  Same as Print_Node_Subtree
 
-   --  The following are no longer needed; you can use pp or ppp instead
+   --  The following are no longer really needed, now that pn will print
+   --  anything you throw at it!
 
    procedure pe (E : Elist_Id);
    pragma Export (Ada, pe);
@@ -84,10 +95,6 @@ package Treepr is
    --  on the left and add a minus sign. This just saves some typing in the
    --  debugger.
 
-   procedure pn (N : Union_Id);
-   pragma Export (Ada, pn);
-   --  Same as pp
-
    procedure pt (N : Node_Id);
    pragma Export (Ada, pt);
    --  Same as ppp