2010-06-17 Joel Brobecker <brobecker@adacore.com brobecker>

	* gnat_ugn.texi: Add a section introducing gdbserver.

2010-06-17  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb, sem_ch4.adb, s-stoele.adb, par-labl.adb: Minor
	reformatting.

2010-06-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Valid_Ancestor_Type): handle properly the case of a
	constrained discriminated parent that is a private type.
	(Analyze_Record_Aggregate): when collecting inherited discriminants,
	handle properly an ancestor type that is a constrained private type.

2010-06-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Enclosing_Subprogram): If the called subprogram is
	protected, use the protected_subprogram_body only if the original
	subprogram has not been eliminated.

2010-06-17  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Expression): The designated type of an
	access_to_suprogram type can only be frozen if all types in its profile
	are fully defined.

From-SVN: r160923

9 files changed, 173 insertions, 29 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9c9bdd8..d70d736 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2010-06-17  Joel Brobecker  <brobecker@adacore.com brobecker>
+
+	* gnat_ugn.texi: Add a section introducing gdbserver.
+
+2010-06-17  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_res.adb, sem_ch4.adb, s-stoele.adb, par-labl.adb: Minor
+	reformatting.
+
+2010-06-17  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb (Valid_Ancestor_Type): handle properly the case of a
+	constrained discriminated parent that is a private type.
+	(Analyze_Record_Aggregate): when collecting inherited discriminants,
+	handle properly an ancestor type that is a constrained private type.
+
+2010-06-17  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Enclosing_Subprogram): If the called subprogram is
+	protected, use the protected_subprogram_body only if the original
+	subprogram has not been eliminated.
+
+2010-06-17  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Expression): The designated type of an
+	access_to_suprogram type can only be frozen if all types in its profile
+	are fully defined.
+
 2010-06-17  Robert Dewar  <dewar@adacore.com>
 
 	* par.adb: Minor comment fix
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 553a80a..8900060 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -5306,6 +5306,26 @@ package body Freeze is
             return True;
          end;
 
+      --  For the designated type of an access to subprogram. all types in
+      --  the profile must be fully defined.
+
+      elsif Ekind (T) = E_Subprogram_Type then
+         declare
+            F : Entity_Id;
+
+         begin
+            F := First_Formal (T);
+            while Present (F) loop
+               if not Is_Fully_Defined (Etype (F)) then
+                  return False;
+               end if;
+
+               Next_Formal (F);
+            end loop;
+
+            return Is_Fully_Defined (Etype (T));
+         end;
+
       else
          return not Is_Private_Type (T)
            or else Present (Full_View (Base_Type (T)));
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 07f1cda..17e7fb9 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -531,6 +531,7 @@ Running and Debugging Ada Programs
 * Ada Exceptions::
 * Ada Tasks::
 * Debugging Generic Units::
+* Remote Debugging using gdbserver::
 * GNAT Abnormal Termination or Failure to Terminate::
 * Naming Conventions for GNAT Source Files::
 * Getting Internal Debugging Information::
@@ -22375,6 +22376,7 @@ the incorrect user program.
 * Ada Exceptions::
 * Ada Tasks::
 * Debugging Generic Units::
+* Remote Debugging using gdbserver::
 * GNAT Abnormal Termination or Failure to Terminate::
 * Naming Conventions for GNAT Source Files::
 * Getting Internal Debugging Information::
@@ -22832,6 +22834,56 @@ When the breakpoint occurs, you can step through the code of the
 instance in the normal manner and examine the values of local variables, as for
 other units.
 
+@node Remote Debugging using gdbserver
+@section Remote Debugging using gdbserver
+@cindex Remote Debugging using gdbserver
+
+@noindent
+On platforms where gdbserver is supported, it is possible to use this tool
+to debug your application remotely.  This can be useful in situations
+where the program needs to be run on a target host that is different
+from the host used for development, particularly when the target has
+a limited amount of resources (either CPU and/or memory).
+
+To do so, start your program using gdbserver on the target machine.
+gdbserver then automatically suspends the execution of your program
+at its entry point, waiting for a debugger to connect to it.  The
+following commands starts an application and tells gdbserver to
+wait for a connection with the debugger on localhost port 4444.
+
+@smallexample
+$ gdbserver localhost:4444 program
+Process program created; pid = 5685
+Listening on port 4444
+@end smallexample
+
+Once gdbserver has started listening, we can tell the debugger to establish
+a connection with this gdbserver, and then start the same debugging session
+as if the program was being debugged on the same host, directly under
+the control of GDB.
+
+@smallexample
+$ gdb program
+(gdb) target remote targethost:4444
+Remote debugging using targethost:4444
+0x00007f29936d0af0 in ?? () from /lib64/ld-linux-x86-64.so.
+(gdb) b foo.adb:3
+Breakpoint 1 at 0x401f0c: file foo.adb, line 3.
+(gdb) continue
+Continuing.
+
+Breakpoint 1, foo () at foo.adb:4
+4       end foo;
+@end smallexample
+
+It is also possible to use gdbserver to attach to an already running
+program, in which case the execution of that program is simply suspended
+until the connection between the debugger and gdbserver is established.
+
+For more information on how to use gdbserver, @ref{Top, Server, Using
+the gdbserver Program, gdb, Debugging with GDB}.  GNAT Pro provides support
+for gdbserver on x86-linux, x86-windows and x86_64-linux.
+
 @node GNAT Abnormal Termination or Failure to Terminate
 @section GNAT Abnormal Termination or Failure to Terminate
 @cindex GNAT Abnormal Termination or Failure to Terminate
diff --git a/gcc/ada/par-labl.adb b/gcc/ada/par-labl.adb
index e9ab0da..cb3ec19 100644
--- a/gcc/ada/par-labl.adb
+++ b/gcc/ada/par-labl.adb
@@ -381,15 +381,15 @@ procedure Labl is
                   --  statements are always part of some list, so
                   --  List_Containing always makes sense.
 
-                  if
-                    List_Containing (Node (N)) = List_Containing (Node (S1))
+                  if List_Containing (Node (N)) =
+                     List_Containing (Node (S1))
                   then
                      Source := S1;
                      Found  := True;
 
-                  else
-                     --  The goto is within some nested structure
+                  --  The goto is within some nested structure
 
+                  else
                      No_Header (N);
                      return;
                   end if;
diff --git a/gcc/ada/s-stoele.adb b/gcc/ada/s-stoele.adb
index 776aacb..cd3e22e 100644
--- a/gcc/ada/s-stoele.adb
+++ b/gcc/ada/s-stoele.adb
@@ -39,7 +39,7 @@ package body System.Storage_Elements is
 
    --  Conversion to/from address
 
-   --  Note qualification below of To_Address to avoid ambiguities on VMS.
+   --  Note qualification below of To_Address to avoid ambiguities on VMS
 
    function To_Address is
      new Ada.Unchecked_Conversion (Storage_Offset, Address);
@@ -51,18 +51,30 @@ package body System.Storage_Elements is
    --  These functions must be place first because they are inlined_always
    --  and are used and inlined in other subprograms defined in this unit.
 
-   function To_Integer (Value : Address) return Integer_Address is
-   begin
-      return Integer_Address (Value);
-   end To_Integer;
+   ----------------
+   -- To_Address --
+   ----------------
 
    function To_Address (Value : Integer_Address) return Address is
    begin
       return Address (Value);
    end To_Address;
 
+   ----------------
+   -- To_Integer --
+   ----------------
+
+   function To_Integer (Value : Address) return Integer_Address is
+   begin
+      return Integer_Address (Value);
+   end To_Integer;
+
    --  Address arithmetic
 
+   ---------
+   -- "+" --
+   ---------
+
    function "+" (Left : Address; Right : Storage_Offset) return Address is
    begin
       return Storage_Elements.To_Address
@@ -75,6 +87,10 @@ package body System.Storage_Elements is
         (To_Integer (To_Address (Left)) + To_Integer (Right));
    end "+";
 
+   ---------
+   -- "-" --
+   ---------
+
    function "-" (Left : Address; Right : Storage_Offset) return Address is
    begin
       return Storage_Elements.To_Address
@@ -87,6 +103,10 @@ package body System.Storage_Elements is
                          (To_Integer (Left) - To_Integer (Right)));
    end "-";
 
+   -----------
+   -- "mod" --
+   -----------
+
    function "mod"
      (Left  : Address;
       Right : Storage_Offset) return Storage_Offset
@@ -106,4 +126,5 @@ package body System.Storage_Elements is
          raise Constraint_Error;
       end if;
    end "mod";
+
 end System.Storage_Elements;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index a632b6a..55f8450 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2288,6 +2288,18 @@ package body Sem_Aggr is
             then
                A_Type := Etype (Imm_Type);
                return True;
+
+            --  The parent type may be a private extension. The aggregate is
+            --  legal if the type of the aggregate is an extension of it that
+            --  is not a private extension.
+
+            elsif Is_Private_Type (A_Type)
+              and then not Is_Private_Type (Imm_Type)
+              and then Present (Full_View (A_Type))
+              and then Base_Type (Full_View (A_Type)) = Etype (Imm_Type)
+            then
+               return True;
+
             else
                Imm_Type := Etype (Base_Type (Imm_Type));
             end if;
@@ -2502,11 +2514,9 @@ package body Sem_Aggr is
          From                   : List_Id;
          Consider_Others_Choice : Boolean := False)
          return                   Node_Id;
-      --  Given a record component stored in parameter Compon, the following
-      --  function returns its value as it appears in the list From, which is
-      --  a list of N_Component_Association nodes.
-      --  What is this referring to??? There is no "following function" in
-      --  sight???
+      --  Given a record component stored in parameter Compon, this function
+      --  returns its value as it appears in the list From, which is a list
+      --  of N_Component_Association nodes.
       --
       --  If no component association has a choice for the searched component,
       --  the value provided by the others choice is returned, if there is one,
@@ -3241,12 +3251,11 @@ package body Sem_Aggr is
 
                Dnode := Declaration_Node (Base_Type (Root_Typ));
 
-               --  If we don't get a full declaration, then we have some
-               --  error which will get signalled later so skip this part.
-               --  Otherwise, gather components of root that apply to the
-               --  aggregate type. We use the base type in case there is an
-               --  applicable stored constraint that renames the discriminants
-               --  of the root.
+               --  If we don't get a full declaration, then we have some error
+               --  which will get signalled later so skip this part. Otherwise
+               --  gather components of root that apply to the aggregate type.
+               --  We use the base type in case there is an applicable stored
+               --  constraint that renames the discriminants of the root.
 
                if Nkind (Dnode) = N_Full_Type_Declaration then
                   Record_Def := Type_Definition (Dnode);
@@ -3281,6 +3290,15 @@ package body Sem_Aggr is
                          Ancestor_Part (N), Parent_Typ);
                      return;
                   end if;
+
+               --  The current view of ancestor part may be a private type,
+               --  while the context type is always non-private.
+
+               elsif Is_Private_Type (Root_Typ)
+                 and then Present (Full_View (Root_Typ))
+                 and then Nkind (N) = N_Extension_Aggregate
+               then
+                  exit when Base_Type (Full_View (Root_Typ)) = Parent_Typ;
                end if;
             end loop;
 
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index aa936bb..80fad0b 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6119,8 +6119,8 @@ package body Sem_Ch4 is
          First_Actual : Node_Id;
 
       begin
-         --  Place the name of the operation, with its interpretations,
-         --  on the rewritten call.
+         --  Place the name of the operation, with its interpretations, on the
+         --  rewritten call.
 
          Set_Name (Call_Node, Subprog);
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 6f1a132..44adf31 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2076,7 +2076,7 @@ package body Sem_Res is
                         end if;
 
                         if Nkind_In
-                          (N, N_Procedure_Call_Statement, N_Function_Call)
+                             (N, N_Procedure_Call_Statement, N_Function_Call)
                           and then Present (Parameter_Associations (N))
                         then
                            Report_Ambiguous_Argument;
@@ -2121,7 +2121,7 @@ package body Sem_Res is
 
                      --  If this is an indirect call, use the subprogram_type
                      --  in the message, to have a meaningful location.
-                     --  Indicate as well if this is an inherited operation,
+                     --  Also indicate if this is an inherited operation,
                      --  created by a type declaration.
 
                      elsif Nkind (N) = N_Function_Call
@@ -2202,7 +2202,7 @@ package body Sem_Res is
                   null;
 
                --  For procedure or function calls, set the type of the name,
-               --  and also the entity pointer for the prefix
+               --  and also the entity pointer for the prefix.
 
                elsif Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
                  and then (Is_Entity_Name (Name (N))
@@ -2238,9 +2238,9 @@ package body Sem_Res is
       end if;
 
       --  At this stage Found indicates whether or not an acceptable
-      --  interpretation exists. If not, then we have an error, except
-      --  that if the context is Any_Type as a result of some other error,
-      --  then we suppress the error report.
+      --  interpretation exists. If not, then we have an error, except that if
+      --  the context is Any_Type as a result of some other error, then we
+      --  suppress the error report.
 
       if not Found then
          if Typ /= Any_Type then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a47e739..dcd6848 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2549,7 +2549,12 @@ package body Sem_Util is
       elsif Ekind (Dynamic_Scope) = E_Task_Type then
          return Get_Task_Body_Procedure (Dynamic_Scope);
 
-      elsif Convention (Dynamic_Scope) = Convention_Protected then
+      --  No body is generated if the protected operation is eliminated
+
+      elsif Convention (Dynamic_Scope) = Convention_Protected
+        and then not Is_Eliminated (Dynamic_Scope)
+        and then Present (Protected_Body_Subprogram (Dynamic_Scope))
+      then
          return Protected_Body_Subprogram (Dynamic_Scope);
 
       else