2010-06-17 Robert Dewar <dewar@adacore.com>

	* par.adb: Minor comment fix
	* sem_aggr.adb, sem_ch3.adb: Minor reformatting

2010-06-17  Doug Rupp  <rupp@adacore.com>

	* s-auxdec-vms_64.ads: Revert Integer to Long_Integer change, instead
	change Address to Short_Address in functions where both must be the
	same size for intrinsics to work.

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

	* sem_ch4.adb (Analyze_Selected_Component): A selected component may
	not denote a (private) component of a protected object.

2010-06-17  Bob Duff  <duff@adacore.com>

	* par-labl.adb (Try_Loop): Test whether the label and the goto are in
	the same list.

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

	* gnat_ugn.texi: Update the documentation about GDB re: exception
	catchpoints.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160919 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 134 insertions, 69 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9ec46d14200..9c9bdd8682b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2010-06-17  Robert Dewar  <dewar@adacore.com>
+
+	* par.adb: Minor comment fix
+	* sem_aggr.adb, sem_ch3.adb: Minor reformatting
+
+2010-06-17  Doug Rupp  <rupp@adacore.com>
+
+	* s-auxdec-vms_64.ads: Revert Integer to Long_Integer change, instead
+	change Address to Short_Address in functions where both must be the
+	same size for intrinsics to work.
+
+2010-06-17  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch4.adb (Analyze_Selected_Component): A selected component may
+	not denote a (private) component of a protected object.
+
+2010-06-17  Bob Duff  <duff@adacore.com>
+
+	* par-labl.adb (Try_Loop): Test whether the label and the goto are in
+	the same list.
+
+2010-06-17  Joel Brobecker  <brobecker@adacore.com brobecker>
+
+	* gnat_ugn.texi: Update the documentation about GDB re: exception
+	catchpoints.
+
 2010-06-17  Arnaud Charlet  <charlet@adacore.com>
 
 	* gnatvsn.ads: Bump to 4.6 version.
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 2d4c86fbaa8..07f1cdaa84f 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -22520,11 +22520,10 @@ and execution encounters the breakpoint, then the program
 stops and @code{GDB} signals that the breakpoint was encountered by
 printing the line of code before which the program is halted.
 
-@item breakpoint exception @var{name}
-A special form of the breakpoint command which breakpoints whenever
-exception @var{name} is raised.
-If @var{name} is omitted,
-then a breakpoint will occur when any exception is raised.
+@item catch exception @var{name}
+This command causes the program execution to stop whenever exception
+@var{name} is raised.  If @var{name} is omitted, then the execution is
+suspended when any exception is raised.
 
 @item print @var{expression}
 This will print the value of the given expression. Most simple
@@ -22686,25 +22685,25 @@ The value returned is always that from the first return statement
 that was stepped through.
 
 @node Ada Exceptions
-@section Breaking on Ada Exceptions
+@section Stopping when Ada Exceptions are Raised
 @cindex Exceptions
 
 @noindent
-You can set breakpoints that trip when your program raises
-selected exceptions.
+You can set catchpoints that stop the program execution when your program
+raises selected exceptions.
 
 @table @code
-@item break exception
-Set a breakpoint that trips whenever (any task in the) program raises
-any exception.
+@item catch exception
+Set a catchpoint that stops execution whenever (any task in the) program
+raises any exception.
 
-@item break exception @var{name}
-Set a breakpoint that trips whenever (any task in the) program raises
-the exception @var{name}.
+@item catch exception @var{name}
+Set a catchpoint that stops execution whenever (any task in the) program
+raises the exception @var{name}.
 
-@item break exception unhandled
-Set a breakpoint that trips whenever (any task in the) program raises an
-exception for which there is no handler.
+@item catch exception unhandled
+Set a catchpoint that stops executino whenever (any task in the) program
+raises an exception for which there is no handler.
 
 @item info exceptions
 @itemx info exceptions @var{regexp}
diff --git a/gcc/ada/par-labl.adb b/gcc/ada/par-labl.adb
index 9874c4fcef9..e9ab0daa076 100644
--- a/gcc/ada/par-labl.adb
+++ b/gcc/ada/par-labl.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -375,7 +375,15 @@ procedure Labl is
               and then Matches (Node (N), Node (S1))
             then
                if not Found then
-                  if Parent (Node (N)) = Parent (Node (S1)) then
+
+                  --  If the label and the goto are both in the same statement
+                  --  list, then we've found a loop. Note that labels and goto
+                  --  statements are always part of some list, so
+                  --  List_Containing always makes sense.
+
+                  if
+                    List_Containing (Node (N)) = List_Containing (Node (S1))
+                  then
                      Source := S1;
                      Found  := True;
 
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 78ffd604ebd..145dda49e92 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -1182,12 +1182,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
    --------------
 
    procedure Labl;
-   --  This procedure creates implicit label declarations for all label that
-   --  are declared in the current unit. Note that this could conceptually
-   --  be done at the point where the labels are declared, but it is tricky
-   --  to do it then, since the tree is not hooked up at the point where the
-   --  label is declared (e.g. a sequence of statements is not yet attached
-   --  to its containing scope at the point a label in the sequence is found)
+   --  This procedure creates implicit label declarations for all labels that
+   --  are declared in the current unit. Note that this could conceptually be
+   --  done at the point where the labels are declared, but it is tricky to do
+   --  it then, since the tree is not hooked up at the point where the label is
+   --  declared (e.g. a sequence of statements is not yet attached to its
+   --  containing scope at the point a label in the sequence is found).
 
    --------------
    -- Par.Load --
diff --git a/gcc/ada/s-auxdec-vms_64.ads b/gcc/ada/s-auxdec-vms_64.ads
index 3a6d221911d..be90c03d951 100644
--- a/gcc/ada/s-auxdec-vms_64.ads
+++ b/gcc/ada/s-auxdec-vms_64.ads
@@ -107,10 +107,10 @@ package System.Aux_DEC is
    Address_Size       : constant := Standard'Address_Size;
    Short_Address_Size : constant := 32;
 
-   function "+" (Left : Address; Right : Long_Integer) return Address;
-   function "+" (Left : Long_Integer; Right : Address) return Address;
-   function "-" (Left : Address; Right : Address) return Long_Integer;
-   function "-" (Left : Address; Right : Long_Integer) return Address;
+   function "+" (Left : Short_Address; Right : Integer) return Short_Address;
+   function "+" (Left : Integer; Right : Short_Address) return Short_Address;
+   function "-" (Left : Short_Address; Right : Short_Address) return Integer;
+   function "-" (Left : Short_Address; Right : Integer) return Short_Address;
 
    pragma Import (Intrinsic, "+");
    pragma Import (Intrinsic, "-");
@@ -230,16 +230,16 @@ package System.Aux_DEC is
    type Unsigned_Quadword_Array is
       array (Integer range <>) of Unsigned_Quadword;
 
-   function To_Address      (X : Integer)           return Address;
+   function To_Address      (X : Integer)           return Short_Address;
    pragma Pure_Function (To_Address);
 
-   function To_Address_Long (X : Unsigned_Longword) return Address;
+   function To_Address_Long (X : Unsigned_Longword) return Short_Address;
    pragma Pure_Function (To_Address_Long);
 
-   function To_Integer      (X : Address)           return Integer;
+   function To_Integer      (X : Short_Address)     return Integer;
 
-   function To_Unsigned_Longword (X : Address)     return Unsigned_Longword;
-   function To_Unsigned_Longword (X : AST_Handler) return Unsigned_Longword;
+   function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword;
+   function To_Unsigned_Longword (X : AST_Handler)   return Unsigned_Longword;
 
    --  Conventional names for static subtypes of type UNSIGNED_LONGWORD
 
@@ -657,31 +657,31 @@ private
    --  want warnings when we compile on such systems.
 
    function To_Address_A is new
-     Ada.Unchecked_Conversion (Integer, Address);
+     Ada.Unchecked_Conversion (Integer, Short_Address);
    pragma Pure_Function (To_Address_A);
 
-   function To_Address (X : Integer) return Address
+   function To_Address (X : Integer) return Short_Address
      renames To_Address_A;
    pragma Pure_Function (To_Address);
 
    function To_Address_Long_A is new
-     Ada.Unchecked_Conversion (Unsigned_Longword, Address);
+     Ada.Unchecked_Conversion (Unsigned_Longword, Short_Address);
    pragma Pure_Function (To_Address_Long_A);
 
-   function To_Address_Long (X : Unsigned_Longword) return Address
+   function To_Address_Long (X : Unsigned_Longword) return Short_Address
      renames To_Address_Long_A;
    pragma Pure_Function (To_Address_Long);
 
    function To_Integer_A is new
-     Ada.Unchecked_Conversion (Address, Integer);
+     Ada.Unchecked_Conversion (Short_Address, Integer);
 
-   function To_Integer (X : Address) return Integer
+   function To_Integer (X : Short_Address) return Integer
      renames To_Integer_A;
 
    function To_Unsigned_Longword_A is new
-     Ada.Unchecked_Conversion (Address, Unsigned_Longword);
+     Ada.Unchecked_Conversion (Short_Address, Unsigned_Longword);
 
-   function To_Unsigned_Longword (X : Address) return Unsigned_Longword
+   function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword
      renames To_Unsigned_Longword_A;
 
    function To_Unsigned_Longword_A is new
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index bdc2be0b1af..a632b6a546f 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2489,8 +2489,8 @@ package body Sem_Aggr is
       --  This routine checks whether this is indeed the case and if so returns
       --  False, signaling that no value for Discr should appear in N's
       --  aggregate part. Also, in this case, the routine appends to
-      --  New_Assoc_List the discriminant value specified in the ancestor
-      --  part.
+      --  New_Assoc_List the discriminant value specified in the ancestor part.
+      --
       --  If the aggregate is in a context with expansion delayed, it will be
       --  reanalyzed, The inherited discriminant values must not be reinserted
       --  in the component list to prevent spurious errors, but it must be
@@ -2507,6 +2507,7 @@ package body Sem_Aggr is
       --  a list of N_Component_Association nodes.
       --  What is this referring to??? There is no "following function" in
       --  sight???
+      --
       --  If no component association has a choice for the searched component,
       --  the value provided by the others choice is returned, if there is one,
       --  and Consider_Others_Choice is set to true. Otherwise Empty is
@@ -2585,6 +2586,7 @@ package body Sem_Aggr is
                if Inherited_Discriminant (Comp_Assoc) then
                   return True;
                end if;
+
                Next (Comp_Assoc);
             end loop;
          end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 74a39ed83f9..fb8e77690c3 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -17491,7 +17491,7 @@ package body Sem_Ch3 is
                Make_Class_Wide_Type (Typ);
                Error_Msg_N
                  ("incomplete view of tagged type should be declared tagged?",
-                    Parent (Current_Entity (Typ)));
+                  Parent (Current_Entity (Typ)));
             end if;
             return;
 
@@ -17499,13 +17499,12 @@ package body Sem_Ch3 is
             Inc_T := Make_Defining_Identifier (Loc, Chars (Typ));
             Decl  := Make_Incomplete_Type_Declaration (Loc, Inc_T);
 
-            --  Type has already been inserted into the current scope.
-            --  Remove it, and add incomplete declaration for type, so
-            --  that subsequent anonymous access types can use it.
-            --  The entity is unchained from the homonym list and from
-            --  immediate visibility. After analysis, the entity in the
-            --  incomplete declaration becomes immediately visible in the
-            --  record declaration that follows.
+            --  Type has already been inserted into the current scope. Remove
+            --  it, and add incomplete declaration for type, so that subsequent
+            --  anonymous access types can use it. The entity is unchained from
+            --  the homonym list and from immediate visibility. After analysis,
+            --  the entity in the incomplete declaration becomes immediately
+            --  visible in the record declaration that follows.
 
             H := Current_Entity (Typ);
 
@@ -17526,8 +17525,9 @@ package body Sem_Ch3 is
             Set_Full_View (Inc_T, Typ);
 
             if Is_Tagged then
-               --  Create a common class-wide type for both views, and set
-               --  the Etype of the class-wide type to the full view.
+
+               --  Create a common class-wide type for both views, and set the
+               --  Etype of the class-wide type to the full view.
 
                Make_Class_Wide_Type (Inc_T);
                Set_Class_Wide_Type (Typ, Class_Wide_Type (Inc_T));
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 010802b0cdc..aa936bbeaff 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3105,8 +3105,8 @@ package body Sem_Ch4 is
    -- Analyze_Selected_Component --
    --------------------------------
 
-   --  Prefix is a record type or a task or protected type. In the
-   --  later case, the selector must denote a visible entry.
+   --  Prefix is a record type or a task or protected type. In the latter case,
+   --  the selector must denote a visible entry.
 
    procedure Analyze_Selected_Component (N : Node_Id) is
       Name          : constant Node_Id := Prefix (N);
@@ -3124,6 +3124,9 @@ package body Sem_Ch4 is
       --  a class-wide type, we use its root type, whose components are
       --  present in the class-wide type.
 
+      Is_Single_Concurrent_Object : Boolean;
+      --  Set True if the prefix is a single task or a single protected object
+
       function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean;
       --  It is known that the parent of N denotes a subprogram call. Comp
       --  is an overloadable component of the concurrent type of the prefix.
@@ -3294,6 +3297,15 @@ package body Sem_Ch4 is
          Type_To_Use := Root_Type (Prefix_Type);
       end if;
 
+      --  If the prefix is a single concurrent object, use its name in error
+      --  messages, rather than that of its anonymous type.
+
+      Is_Single_Concurrent_Object :=
+        Is_Concurrent_Type (Prefix_Type)
+          and then Is_Internal_Name (Chars (Prefix_Type))
+          and then not Is_Derived_Type (Prefix_Type)
+          and then Is_Entity_Name (Name);
+
       Comp := First_Entity (Type_To_Use);
 
       --  If the selector has an original discriminant, the node appears in
@@ -3532,9 +3544,8 @@ package body Sem_Ch4 is
                   return;
 
                else
-                  Error_Msg_NE
-                    ("invisible selector for }",
-                     N, First_Subtype (Prefix_Type));
+                  Error_Msg_Node_2 := First_Subtype (Prefix_Type);
+                  Error_Msg_NE ("invisible selector& for }", N, Sel);
                   Set_Entity (Sel, Any_Id);
                   Set_Etype (N, Any_Type);
                end if;
@@ -3579,8 +3590,13 @@ package body Sem_Ch4 is
                      Has_Candidate := True;
                   end if;
 
+               --  Note: a selected component may not denote a component of a
+               --  protected type (4.1.3(7)).
+
                elsif Ekind_In (Comp, E_Discriminant, E_Entry_Family)
-                 or else (In_Scope and then Is_Entity_Name (Name))
+                 or else (In_Scope
+                            and then not Is_Protected_Type (Prefix_Type)
+                            and then Is_Entity_Name (Name))
                then
                   Set_Entity_With_Style_Check (Sel, Comp);
                   Generate_Reference (Comp, Sel);
@@ -3644,6 +3660,28 @@ package body Sem_Ch4 is
             end if;
          end if;
 
+         if Etype (N) = Any_Type and then Is_Protected_Type (Prefix_Type) then
+            --  Case of a prefix of a protected type: selector might denote
+            --  an invisible private component.
+
+            Comp := First_Private_Entity (Base_Type (Prefix_Type));
+            while Present (Comp) and then Chars (Comp) /= Chars (Sel) loop
+               Next_Entity (Comp);
+            end loop;
+
+            if Present (Comp) then
+               if Is_Single_Concurrent_Object then
+                  Error_Msg_Node_2 := Entity (Name);
+                  Error_Msg_NE ("invisible selector& for &", N, Sel);
+
+               else
+                  Error_Msg_Node_2 := First_Subtype (Prefix_Type);
+                  Error_Msg_NE ("invisible selector& for }", N, Sel);
+               end if;
+               return;
+            end if;
+         end if;
+
          Set_Is_Overloaded (N, Is_Overloaded (Sel));
 
       else
@@ -3656,15 +3694,7 @@ package body Sem_Ch4 is
 
       if Etype (N) = Any_Type then
 
-         --  If the prefix is a single concurrent object, use its name in the
-         --  error message, rather than that of its anonymous type.
-
-         if Is_Concurrent_Type (Prefix_Type)
-           and then Is_Internal_Name (Chars (Prefix_Type))
-           and then not Is_Derived_Type (Prefix_Type)
-           and then Is_Entity_Name (Name)
-         then
-
+         if Is_Single_Concurrent_Object then
             Error_Msg_Node_2 := Entity (Name);
             Error_Msg_NE ("no selector& for&", N, Sel);