[multiple changes]

2009-07-29  Robert Dewar  <dewar@adacore.com>

	* exp_atag.ads, exp_atag.adb, s-tasini.adb, s-soflin.ads,
	exp_disp.adb, g-socket.adb: Minor reformatting

2009-07-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb (New_Private_Type): Create class-wide type after other
	attributes have been established, so that they are all inherited by the
	class-wide type.
	* sem_cat.adb (Validate_Remote_Access_Object_Type_Declaration): Handle
	properly named subtypes of class-wide types.

From-SVN: r150201

9 files changed, 53 insertions, 34 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d2f86f6..e54daa9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2009-07-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_atag.ads, exp_atag.adb, s-tasini.adb, s-soflin.ads,
+	exp_disp.adb, g-socket.adb: Minor reformatting
+
+2009-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch7.adb (New_Private_Type): Create class-wide type after other
+	attributes have been established, so that they are all inherited by the
+	class-wide type.
+	* sem_cat.adb (Validate_Remote_Access_Object_Type_Declaration): Handle
+	properly named subtypes of class-wide types.
+
 2009-07-29  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch6.adb (Check_Overriding_Indicator): Handle properly overriding
diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb
index ae9a396..314258c 100644
--- a/gcc/ada/exp_atag.adb
+++ b/gcc/ada/exp_atag.adb
@@ -231,7 +231,7 @@ package body Exp_Atag is
      (Loc      : Source_Ptr;
       Position : Uint;
       Tag_Node : in out Node_Id;
-      New_Node :    out Node_Id)
+      New_Node : out Node_Id)
    is
       Ctrl_Tag : Node_Id;
 
@@ -352,7 +352,7 @@ package body Exp_Atag is
       Typ      : Entity_Id;
       Position : Uint;
       Tag_Node : in out Node_Id;
-      New_Node :    out Node_Id)
+      New_Node : out Node_Id)
    is
       New_Prefix : Node_Id;
 
diff --git a/gcc/ada/exp_atag.ads b/gcc/ada/exp_atag.ads
index 40277ac..42ec476 100644
--- a/gcc/ada/exp_atag.ads
+++ b/gcc/ada/exp_atag.ads
@@ -65,7 +65,7 @@ package Exp_Atag is
      (Loc      : Source_Ptr;
       Position : Uint;
       Tag_Node : in out Node_Id;
-      New_Node :    out Node_Id);
+      New_Node : out Node_Id);
    --  Given a pointer to a dispatch table (T) and a position in the DT, build
    --  code that gets the address of the predefined virtual function stored in
    --  it (used for dispatching calls). Tag_Node is relocated.
@@ -77,7 +77,7 @@ package Exp_Atag is
       Typ      : Entity_Id;
       Position : Uint;
       Tag_Node : in out Node_Id;
-      New_Node : out    Node_Id);
+      New_Node : out Node_Id);
    --  Build code that retrieves the address of the virtual function stored in
    --  a given position of the dispatch table (used for dispatching calls).
    --  Tag_Node is relocated.
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 64a4f1f..a38e4d8 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -811,11 +811,11 @@ package body Exp_Disp is
       else
          Controlling_Tag :=
            Make_Selected_Component (Loc,
-             Prefix => Duplicate_Subexpr_Move_Checks (Ctrl_Arg),
+             Prefix        => Duplicate_Subexpr_Move_Checks (Ctrl_Arg),
              Selector_Name => New_Reference_To (DTC_Entity (Subp), Loc));
       end if;
 
-      --  Handle dispatching calls to predefined primitives.
+      --  Handle dispatching calls to predefined primitives
 
       if Is_Predefined_Dispatching_Operation (Subp)
         or else Is_Predefined_Dispatching_Alias (Subp)
@@ -854,10 +854,10 @@ package body Exp_Disp is
          --  Handle renaming of selected component
 
          elsif Nkind (Controlling_Tag) = N_Identifier
-           and then Nkind (Parent (Entity (Controlling_Tag)))
-                      = N_Object_Renaming_Declaration
-           and then Nkind (Name (Parent (Entity (Controlling_Tag))))
-                      = N_Selected_Component
+           and then Nkind (Parent (Entity (Controlling_Tag))) =
+                                             N_Object_Renaming_Declaration
+           and then Nkind (Name (Parent (Entity (Controlling_Tag)))) =
+                                             N_Selected_Component
          then
             Set_SCIL_Controlling_Tag (SCIL_Node,
               Name (Parent (Entity (Controlling_Tag))));
@@ -867,8 +867,8 @@ package body Exp_Disp is
 
          elsif Nkind (Controlling_Tag) = N_Identifier
            and then Nkind_In (Parent (Entity (Controlling_Tag)),
-                                N_Object_Declaration,
-                                N_Parameter_Specification)
+                              N_Object_Declaration,
+                              N_Parameter_Specification)
          then
             Set_SCIL_Controlling_Tag (SCIL_Node,
               Parent (Entity (Controlling_Tag)));
@@ -879,8 +879,8 @@ package body Exp_Disp is
          elsif Nkind (Controlling_Tag) = N_Explicit_Dereference
             and then Nkind (Prefix (Controlling_Tag)) = N_Identifier
             and then Nkind_In (Parent (Entity (Prefix (Controlling_Tag))),
-                                 N_Object_Declaration,
-                                 N_Parameter_Specification)
+                               N_Object_Declaration,
+                               N_Parameter_Specification)
          then
             Set_SCIL_Controlling_Tag (SCIL_Node,
               Parent (Entity (Prefix (Controlling_Tag))));
@@ -894,9 +894,9 @@ package body Exp_Disp is
          then
             Set_SCIL_Controlling_Tag (SCIL_Node,
               Parent
-               (Node
-                (First_Elmt
-                 (Access_Disp_Table (Entity (Prefix (Controlling_Tag)))))));
+                (Node
+                  (First_Elmt
+                    (Access_Disp_Table (Entity (Prefix (Controlling_Tag)))))));
 
          --  Interfaces are not supported. For now we leave the SCIL node
          --  decorated with the Controlling_Tag. More work needed here???
@@ -913,7 +913,7 @@ package body Exp_Disp is
       if Nkind (Call_Node) = N_Function_Call then
          New_Call :=
            Make_Function_Call (Loc,
-             Name => New_Call_Name,
+             Name                   => New_Call_Name,
              Parameter_Associations => New_Params);
 
          --  If this is a dispatching "=", we must first compare the tags so
@@ -927,26 +927,26 @@ package body Exp_Disp is
                      Make_Op_Eq (Loc,
                        Left_Opnd =>
                          Make_Selected_Component (Loc,
-                           Prefix => New_Value (Param),
+                           Prefix        => New_Value (Param),
                            Selector_Name =>
                              New_Reference_To (First_Tag_Component (Typ),
                                                Loc)),
 
                        Right_Opnd =>
                          Make_Selected_Component (Loc,
-                           Prefix =>
+                           Prefix        =>
                              Unchecked_Convert_To (Typ,
                                New_Value (Next_Actual (Param))),
                            Selector_Name =>
-                             New_Reference_To (First_Tag_Component (Typ),
-                                               Loc))),
+                             New_Reference_To
+                               (First_Tag_Component (Typ), Loc))),
                 Right_Opnd => New_Call);
          end if;
 
       else
          New_Call :=
            Make_Procedure_Call_Statement (Loc,
-             Name => New_Call_Name,
+             Name                   => New_Call_Name,
              Parameter_Associations => New_Params);
       end if;
 
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 90d36f6..d32ebfc 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -1664,11 +1664,14 @@ package body GNAT.Sockets is
               (Msg_Name       => System.Null_Address,
                Msg_Namelen    => 0,
                Msg_Iov        => Vector'Address,
-               Msg_Iovlen     =>
-                 SOSC.Msg_Iovlen_T'Min (Vector'Length, SOSC.IOV_MAX),
+
                --  recvmsg(2) returns EMSGSIZE on Linux (and probably on other
                --  platforms) when the supplied vector is longer than IOV_MAX,
                --  so use minimum of the two lengths.
+
+               Msg_Iovlen     => SOSC.Msg_Iovlen_T'Min
+                                   (Vector'Length, SOSC.IOV_MAX),
+
                Msg_Control    => System.Null_Address,
                Msg_Controllen => 0,
                Msg_Flags      => 0);
diff --git a/gcc/ada/s-soflin.ads b/gcc/ada/s-soflin.ads
index 16b483b..783fd88 100644
--- a/gcc/ada/s-soflin.ads
+++ b/gcc/ada/s-soflin.ads
@@ -242,7 +242,7 @@ package System.Soft_Links is
    function Get_Exc_Stack_Addr_NT return Address;
    Get_Exc_Stack_Addr : Get_Address_Call := Get_Exc_Stack_Addr_NT'Access;
 
-   function  Get_Current_Excep_NT return EOA;
+   function Get_Current_Excep_NT return EOA;
 
    Get_Current_Excep : Get_EOA_Call := Get_Current_Excep_NT'Access;
 
diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb
index f473e0e..28b86cb 100644
--- a/gcc/ada/s-tasini.adb
+++ b/gcc/ada/s-tasini.adb
@@ -191,8 +191,8 @@ package body System.Tasking.Initialization is
       end if;
 
       --  pragma Assert
-      --    ((Self_ID.Pending_ATC_Level >= Self_ID.ATC_Nesting_Level or else
-      --      Self_ID.Deferral_Level > 0));
+      --    (Self_ID.Pending_ATC_Level >= Self_ID.ATC_Nesting_Level or else
+      --     Self_ID.Deferral_Level > 0);
 
       --  See comment in Defer_Abort on the situations in which it may be
       --  useful to uncomment the above assertion.
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index e24b456..d5d3823 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.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- --
@@ -1774,12 +1774,12 @@ package body Sem_Cat is
 
       --  Check RCI or RT unit type declaration. It may not contain the
       --  declaration of an access-to-object type unless it is a general access
-      --  type that designates a class-wide limited private type. There are
-      --  also constraints on the primitive subprograms of the class-wide type
-      --  (RM E.2.2(14), see Validate_RACW_Primitives).
+      --  type that designates a class-wide limited private type or subtype.
+      --  There are also constraints on the primitive subprograms of the
+      --  class-wide type (RM E.2.2(14), see Validate_RACW_Primitives).
 
       if Ekind (T) /= E_General_Access_Type
-        or else Ekind (Designated_Type (T)) /= E_Class_Wide_Type
+        or else not Is_Class_Wide_Type (Designated_Type (T))
       then
          if In_RCI_Declaration (Parent (T)) then
             Error_Msg_N
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index c3a1fb3..4edcfe7 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1907,12 +1907,15 @@ package body Sem_Ch7 is
 
       if Tagged_Present (Def) then
          Set_Ekind                (Id, E_Record_Type_With_Private);
-         Make_Class_Wide_Type     (Id);
          Set_Primitive_Operations (Id, New_Elmt_List);
          Set_Is_Abstract_Type     (Id, Abstract_Present (Def));
          Set_Is_Limited_Record    (Id, Limited_Present (Def));
          Set_Has_Delayed_Freeze   (Id, True);
 
+         --  Create a class-wide type with the same attributes.
+
+         Make_Class_Wide_Type     (Id);
+
       elsif Abstract_Present (Def) then
          Error_Msg_N ("only a tagged type can be abstract", N);
       end if;