2009-04-20 Javier Miranda <miranda@adacore.com>

	* einfo.ads, einfo.adb (Is_Underlying_Record_View): New subprogram
	(Set_Is_Underlying_Record_View): New subprogram

	* sem_aggr.adb (Discr_Present, Resolve_Record_Aggregate): In case of
	private types with unknown discriminants use the underlying record view
	if available.

	* sem_ch3.adb (Build_Derived_Private_Type): Enable construction of the
	underlying record view in the full view of private types whose parent
	has unknown discriminants.
	(Build_Derived_Record_Type): Avoid generating the class-wide entity
	associated with an underlying record view.
	(Derived_Type_Declaration): Avoid deriving parent primitives in
	underlying record views.

	* sem_ch6.adb (Check_Return_Subtype_Indication): Add support for
	records with unknown discriminants.

	* sem_type.adb (Covers): Handle underlying record views.
	(Is_Ancestor): Add support for underlying record views.

	* exp_attr.adb (Expand_Attribute): Expand attribute 'size into a
	dispatching call if the type of the target object is tagged and has
	unknown discriminants.

	* exp_aggr.adb (Resolve_Record_Aggregate): Add support for records with
	unknown discriminants.

	* exp_disp.adb (Build_Dispatch_Tables): Avoid generating dispatch
	tables for internally built underlying record views.

	* sprint.adb (sprint_node_actual): Improve output of aggregates with an
	empty list of component associations.

2009-04-20  Thomas Quinot  <quinot@adacore.com>

	* sem_ch10.adb: Minor reformatting

	* socket.c, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.ads,
	g-socthi-mingw.ads, g-socthi.ads, g-socket.adb
	(GNAT.Sockets.Inet_Addr): Do not use non-portable inet_aton, instead use
	standard inet_pton API (and emulate it on platforms that do not
	support it).
	(GNAT.Sockets.Thin.Inet_Pton, VMS case): Implement in terms of
	DECC$INET_ADDR, imported in Ada.
	(GNAT.Sockets.Thin.Inet_Pton, VxWorks and Windows cases): Use C
	implementation provided by GNAT runtime.
	(__gnat_inet_pton): C implementation of inet_pton(3) for VxWorks and
	Windows.



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

19 files changed, 338 insertions, 69 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d2370239a88..80163b61035 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,55 @@
+2009-04-20  Javier Miranda  <miranda@adacore.com>
+
+	* einfo.ads, einfo.adb (Is_Underlying_Record_View): New subprogram
+	(Set_Is_Underlying_Record_View): New subprogram
+
+	* sem_aggr.adb (Discr_Present, Resolve_Record_Aggregate): In case of
+	private types with unknown discriminants use the underlying record view
+	if available.
+
+	* sem_ch3.adb (Build_Derived_Private_Type): Enable construction of the
+	underlying record view in the full view of private types whose parent
+	has unknown discriminants.
+	(Build_Derived_Record_Type): Avoid generating the class-wide entity
+	associated with an underlying record view.
+	(Derived_Type_Declaration): Avoid deriving parent primitives in
+	underlying record views.
+
+	* sem_ch6.adb (Check_Return_Subtype_Indication): Add support for
+	records with unknown discriminants.
+
+	* sem_type.adb (Covers): Handle underlying record views.
+	(Is_Ancestor): Add support for underlying record views.
+
+	* exp_attr.adb (Expand_Attribute): Expand attribute 'size into a
+	dispatching call if the type of the target object is tagged and has
+	unknown discriminants.
+
+	* exp_aggr.adb (Resolve_Record_Aggregate): Add support for records with
+	unknown discriminants.
+
+	* exp_disp.adb (Build_Dispatch_Tables): Avoid generating dispatch
+	tables for internally built underlying record views.
+
+	* sprint.adb (sprint_node_actual): Improve output of aggregates with an
+	empty list of component associations.
+
+2009-04-20  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch10.adb: Minor reformatting
+
+	* socket.c, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.ads,
+	g-socthi-mingw.ads, g-socthi.ads, g-socket.adb
+	(GNAT.Sockets.Inet_Addr): Do not use non-portable inet_aton, instead use
+	standard inet_pton API (and emulate it on platforms that do not
+	support it).
+	(GNAT.Sockets.Thin.Inet_Pton, VMS case): Implement in terms of
+	DECC$INET_ADDR, imported in Ada.
+	(GNAT.Sockets.Thin.Inet_Pton, VxWorks and Windows cases): Use C
+	implementation provided by GNAT runtime.
+	(__gnat_inet_pton): C implementation of inet_pton(3) for VxWorks and
+	Windows.
+
 2009-04-20  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat_ugn.texi: Add documentation for -fno-ivopts.
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 92d9ce26b8f..0146c649699 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -506,8 +506,8 @@ package body Einfo is
    --    Overlays_Constant               Flag243
    --    Is_RACW_Stub_Type               Flag244
    --    Is_Private_Primitive            Flag245
+   --    Is_Underlying_Record_View       Flag246
 
-   --    (unused)                        Flag246
    --    (unused)                        Flag247
 
    -----------------------
@@ -2066,6 +2066,11 @@ package body Einfo is
       return Flag117 (Implementation_Base_Type (Id));
    end Is_Unchecked_Union;
 
+   function Is_Underlying_Record_View (Id : E) return B is
+   begin
+      return Flag246 (Id);
+   end Is_Underlying_Record_View;
+
    function Is_Unsigned_Type (Id : E) return B is
    begin
       pragma Assert (Is_Type (Id));
@@ -2675,7 +2680,6 @@ package body Einfo is
 
    function Underlying_Record_View (Id : E) return E is
    begin
-      pragma Assert (Ekind (Id) = E_Record_Type);
       return Node24 (Id);
    end Underlying_Record_View;
 
@@ -4543,6 +4547,12 @@ package body Einfo is
       Set_Flag117 (Id, V);
    end Set_Is_Unchecked_Union;
 
+   procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Record_Type);
+      Set_Flag246 (Id, V);
+   end Set_Is_Underlying_Record_View;
+
    procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
@@ -6973,6 +6983,7 @@ package body Einfo is
       W ("Is_Trivial_Subprogram",           Flag235 (Id));
       W ("Is_True_Constant",                Flag163 (Id));
       W ("Is_Unchecked_Union",              Flag117 (Id));
+      W ("Is_Underlying_Record_View",       Flag246 (Id));
       W ("Is_Unsigned_Type",                Flag144 (Id));
       W ("Is_VMS_Exception",                Flag133 (Id));
       W ("Is_Valued_Procedure",             Flag127 (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 91883e72a89..87bddb9a7f2 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2633,6 +2633,13 @@ package Einfo is
 --       Present in all entities. Set only in record types to which the
 --       pragma Unchecked_Union has been validly applied.
 
+--    Is_Underlying_Record_View (Flag246) [base type only]
+--       Present in all entities. Set only in record types that represent the
+--       underlying record view. This view is built for derivations of types
+--       with unknown discriminants; it is a record with the same structure
+--       than its corresponding record type, and whose parent is the full view
+--       of the parent in the original type extension.
+
 --    Is_Unsigned_Type (Flag144)
 --       Present in all types, but can be set only for discrete and fixed-point
 --       type and subtype entities. This flag is only valid if the entity is
@@ -3560,10 +3567,13 @@ package Einfo is
 
 --    Underlying_Record_View (Node24)
 --       Present in record types. Set for record types that are extensions of
---       types with unknown discriminants. Such types do not have a completion,
---       but they cannot be used without having some discriminated view at
---       hand. This view is a record type with the same structure, whose parent
---       type is the full view of the parent in the original type extension.
+--       types with unknown discriminants, and also set for internally built
+--       underlying record views to reference its original record type. Record
+--       types that are extensions of types with unknown discriminants do not
+--       have a completion, but they cannot be used without having some
+--       discriminated view at hand. This view is a record type with the same
+--       structure, whose parent type is the full view of the parent in the
+--       original type extension.
 
 --    Underlying_Type (synthesized)
 --       Applies to all entities. This is the identity function except in the
@@ -5889,6 +5899,7 @@ package Einfo is
    function Is_Trivial_Subprogram               (Id : E) return B;
    function Is_True_Constant                    (Id : E) return B;
    function Is_Unchecked_Union                  (Id : E) return B;
+   function Is_Underlying_Record_View           (Id : E) return B;
    function Is_Unsigned_Type                    (Id : E) return B;
    function Is_VMS_Exception                    (Id : E) return B;
    function Is_Valued_Procedure                 (Id : E) return B;
@@ -6441,6 +6452,7 @@ package Einfo is
    procedure Set_Is_Trivial_Subprogram           (Id : E; V : B := True);
    procedure Set_Is_True_Constant                (Id : E; V : B := True);
    procedure Set_Is_Unchecked_Union              (Id : E; V : B := True);
+   procedure Set_Is_Underlying_Record_View       (Id : E; V : B := True);
    procedure Set_Is_Unsigned_Type                (Id : E; V : B := True);
    procedure Set_Is_VMS_Exception                (Id : E; V : B := True);
    procedure Set_Is_Valued_Procedure             (Id : E; V : B := True);
@@ -7132,6 +7144,7 @@ package Einfo is
    pragma Inline (Is_Trivial_Subprogram);
    pragma Inline (Is_Type);
    pragma Inline (Is_Unchecked_Union);
+   pragma Inline (Is_Underlying_Record_View);
    pragma Inline (Is_Unsigned_Type);
    pragma Inline (Is_VMS_Exception);
    pragma Inline (Is_Valued_Procedure);
@@ -7520,6 +7533,7 @@ package Einfo is
    pragma Inline (Set_Is_Trivial_Subprogram);
    pragma Inline (Set_Is_True_Constant);
    pragma Inline (Set_Is_Unchecked_Union);
+   pragma Inline (Set_Is_Underlying_Record_View);
    pragma Inline (Set_Is_Unsigned_Type);
    pragma Inline (Set_Is_VMS_Exception);
    pragma Inline (Set_Is_Valued_Procedure);
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 9200165b844..0ffbb453ade 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1869,7 +1869,9 @@ package body Exp_Aggr is
 
          Parent_Typ := Etype (Current_Typ);
          while Current_Typ /= Parent_Typ loop
-            if Has_Discriminants (Parent_Typ) then
+            if Has_Discriminants (Parent_Typ)
+              and then not Has_Unknown_Discriminants (Parent_Typ)
+            then
                Parent_Disc := First_Discriminant (Parent_Typ);
 
                --  We either get the association from the subtype indication
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index d1d6ee9862c..5772d58487e 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3908,8 +3908,11 @@ package body Exp_Attr is
          --  For X'Size applied to an object of a class-wide type, transform
          --  X'Size into a call to the primitive operation _Size applied to X.
 
-         elsif Is_Class_Wide_Type (Ptyp) then
-
+         elsif Is_Class_Wide_Type (Ptyp)
+           or else (Id = Attribute_Size
+                      and then Is_Tagged_Type (Ptyp)
+                      and then Has_Unknown_Discriminants (Ptyp))
+         then
             --  No need to do anything else compiling under restriction
             --  No_Dispatching_Calls. During the semantic analysis we
             --  already notified such violation.
@@ -3936,7 +3939,7 @@ package body Exp_Attr is
 
             Rewrite (N, New_Node);
             Analyze_And_Resolve (N, Typ);
-               return;
+            return;
 
          --  Case of known RM_Size of a type
 
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 54a823a848a..85a51f3e633 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -170,16 +170,18 @@ package body Exp_Disp is
               and then Ekind (Defining_Entity (D)) /= E_Record_Subtype
               and then not Is_Private_Type (Defining_Entity (D))
             then
-               --  We do not generate dispatch tables for the internal type
+               --  We do not generate dispatch tables for the internal types
                --  created for a type extension with unknown discriminants
                --  The needed information is shared with the source type,
                --  See Expand_N_Record_Extension.
 
-               if not Comes_From_Source (Defining_Entity (D))
-                 and then
+               if Is_Underlying_Record_View (Defining_Entity (D))
+                 or else
+                  (not Comes_From_Source (Defining_Entity (D))
+                     and then
                    Has_Unknown_Discriminants (Etype (Defining_Entity (D)))
-                 and then
-                   not Comes_From_Source (First_Subtype (Defining_Entity (D)))
+                     and then
+                   not Comes_From_Source (First_Subtype (Defining_Entity (D))))
                then
                   null;
 
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 962a8fbae60..cc31d142c57 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -1278,6 +1278,7 @@ package body GNAT.Sockets is
       use Interfaces.C.Strings;
 
       Img    : aliased char_array := To_C (Image);
+      Cp     : constant chars_ptr := To_Chars_Ptr (Img'Unchecked_Access);
       Addr   : aliased C.int;
       Res    : C.int;
       Result : Inet_Addr_Type;
@@ -1290,9 +1291,12 @@ package body GNAT.Sockets is
          Raise_Socket_Error (SOSC.EINVAL);
       end if;
 
-      Res := Inet_Aton (To_Chars_Ptr (Img'Unchecked_Access), Addr'Address);
+      Res := Inet_Pton (SOSC.AF_INET, Cp, Addr'Address);
 
-      if Res = 0 then
+      if Res < 0 then
+         Raise_Socket_Error (Socket_Errno);
+
+      elsif Res = 0 then
          Raise_Socket_Error (SOSC.EINVAL);
       end if;
 
diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads
index 5588dd00387..9c3ab0c0145 100644
--- a/gcc/ada/g-socthi-mingw.ads
+++ b/gcc/ada/g-socthi-mingw.ads
@@ -115,8 +115,9 @@ package GNAT.Sockets.Thin is
       Optval  : System.Address;
       Optlen  : not null access C.int) return C.int;
 
-   function Inet_Aton
-     (Cp  : C.Strings.chars_ptr;
+   function Inet_Pton
+     (Af  : C.int;
+      Cp  : C.Strings.chars_ptr;
       Inp : System.Address) return C.int;
 
    function C_Ioctl
@@ -233,7 +234,7 @@ private
    pragma Import (Stdcall, C_Getpeername, "getpeername");
    pragma Import (Stdcall, C_Getsockname, "getsockname");
    pragma Import (Stdcall, C_Getsockopt, "getsockopt");
-   pragma Import (Stdcall, Inet_Aton, "inet_aton");
+   pragma Import (Stdcall, Inet_Pton, "__gnat_inet_pton");
    pragma Import (Stdcall, C_Ioctl, "ioctlsocket");
    pragma Import (Stdcall, C_Listen, "listen");
    pragma Import (Stdcall, C_Recv, "recv");
diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb
index d065f998073..9ca32f3c4f5 100644
--- a/gcc/ada/g-socthi-vms.adb
+++ b/gcc/ada/g-socthi-vms.adb
@@ -354,15 +354,15 @@ package body GNAT.Sockets.Thin is
    package body Host_Error_Messages is separate;
 
    ---------------
-   -- Inet_Aton --
+   -- Inet_Pton --
    ---------------
 
-   --  VMS does not support inet_aton(3), so emulate it here in terms of
-   --  inet_addr(3). Note: unlike other C functions, inet_aton reports
-   --  failure with a 0 return, and success with a non-zero return.
+   --  VMS does not support inet_pton(3), so emulate it here in terms of
+   --  inet_addr(3).
 
-   function Inet_Aton
-     (Cp  : C.Strings.chars_ptr;
+   function Inet_Pton
+     (Af  : C.int;
+      Cp  : C.Strings.chars_ptr;
       Inp : System.Address) return C.int
    is
       use C.Strings;
@@ -373,6 +373,11 @@ package body GNAT.Sockets.Thin is
       function C_Inet_Addr (Cp : C.Strings.chars_ptr) return C.int;
       pragma Import (C, C_Inet_Addr, "DECC$INET_ADDR");
    begin
+      if Af /= SOSC.AF_INET then
+         Set_Socket_Errno (SOSC.EAFNOSUPPORT);
+         return -1;
+      end if;
+
       if Cp = Null_Ptr or else Inp = Null_Address then
          return 0;
       end if;
@@ -387,13 +392,18 @@ package body GNAT.Sockets.Thin is
       end if;
 
       Res := C_Inet_Addr (Cp);
+
+      --  String is not a valid dotted quad
+
       if Res = -1 then
          return 0;
       end if;
 
+      --  Success
+
       Conv.To_Pointer (Inp).all := Res;
       return 1;
-   end Inet_Aton;
+   end Inet_Pton;
 
    ----------------
    -- Initialize --
diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads
index 1abcbb3385d..1a6e5af99ae 100644
--- a/gcc/ada/g-socthi-vms.ads
+++ b/gcc/ada/g-socthi-vms.ads
@@ -118,8 +118,9 @@ package GNAT.Sockets.Thin is
       Optval  : System.Address;
       Optlen  : not null access C.int) return C.int;
 
-   function Inet_Aton
-     (Cp  : C.Strings.chars_ptr;
+   function Inet_Pton
+     (Af  : C.int;
+      Cp  : C.Strings.chars_ptr;
       Inp : System.Address) return C.int;
 
    function C_Ioctl
diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads
index 10c3754f81e..30c2b5057b0 100644
--- a/gcc/ada/g-socthi-vxworks.ads
+++ b/gcc/ada/g-socthi-vxworks.ads
@@ -116,8 +116,9 @@ package GNAT.Sockets.Thin is
       Optval  : System.Address;
       Optlen  : not null access C.int) return C.int;
 
-   function Inet_Aton
-     (Cp  : C.Strings.chars_ptr;
+   function Inet_Pton
+     (Af  : C.int;
+      Cp  : C.Strings.chars_ptr;
       Inp : System.Address) return C.int;
 
    function C_Ioctl
@@ -227,7 +228,7 @@ private
    pragma Import (C, C_Getpeername, "getpeername");
    pragma Import (C, C_Getsockname, "getsockname");
    pragma Import (C, C_Getsockopt, "getsockopt");
-   pragma Import (C, Inet_Aton, "inet_aton");
+   pragma Import (C, Inet_Pton, "__gnat_inet_pton");
    pragma Import (C, C_Listen, "listen");
    pragma Import (C, C_Readv, "readv");
    pragma Import (C, C_Select, "select");
diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads
index e54d59c6a57..720efcdee95 100644
--- a/gcc/ada/g-socthi.ads
+++ b/gcc/ada/g-socthi.ads
@@ -117,8 +117,9 @@ package GNAT.Sockets.Thin is
       Optval  : System.Address;
       Optlen  : not null access C.int) return C.int;
 
-   function Inet_Aton
-     (Cp  : C.Strings.chars_ptr;
+   function Inet_Pton
+     (Af  : C.int;
+      Cp  : C.Strings.chars_ptr;
       Inp : System.Address) return C.int;
 
    function C_Ioctl
@@ -252,7 +253,7 @@ private
    pragma Import (C, C_Getpeername, "getpeername");
    pragma Import (C, C_Getsockname, "getsockname");
    pragma Import (C, C_Getsockopt, "getsockopt");
-   pragma Import (C, Inet_Aton, "inet_aton");
+   pragma Import (C, Inet_Pton, "inet_pton");
    pragma Import (C, C_Listen, "listen");
    pragma Import (C, C_Readv, "readv");
    pragma Import (C, C_Select, "select");
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 402b7384c9a..e29bca991c7 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2427,6 +2427,16 @@ package body Sem_Aggr is
          Ancestor_Typ := Etype (Ancestor);
          Loc          := Sloc (Ancestor);
 
+         --  In case of private types with unknown discriminants use the
+         --  underlying record view if it is available
+
+         if Has_Unknown_Discriminants (Ancestor_Typ)
+           and then Present (Full_View (Ancestor_Typ))
+           and then Present (Underlying_Record_View (Full_View (Ancestor_Typ)))
+         then
+            Ancestor_Typ := Underlying_Record_View (Full_View (Ancestor_Typ));
+         end if;
+
          Ancestor_Is_Subtyp :=
            Is_Entity_Name (Ancestor) and then Is_Type (Entity (Ancestor));
 
@@ -2868,7 +2878,11 @@ package body Sem_Aggr is
             Positional_Expr := Empty;
          end if;
 
-         if Has_Discriminants (Typ) then
+         if Has_Unknown_Discriminants (Typ)
+           and then Present (Underlying_Record_View (Typ))
+         then
+            Discrim := First_Discriminant (Underlying_Record_View (Typ));
+         elsif Has_Discriminants (Typ) then
             Discrim := First_Discriminant (Typ);
          else
             Discrim := Empty;
@@ -2948,7 +2962,10 @@ package body Sem_Aggr is
       --  this may be a problem. What should be done in this case is
       --  to reuse itypes as much as possible.
 
-      if Has_Discriminants (Typ) then
+      if Has_Discriminants (Typ)
+        or else (Has_Unknown_Discriminants (Typ)
+                   and then Present (Underlying_Record_View (Typ)))
+      then
          Build_Constrained_Itype : declare
             Loc         : constant Source_Ptr := Sloc (N);
             Indic       : Node_Id;
@@ -2964,10 +2981,23 @@ package body Sem_Aggr is
                Next (New_Assoc);
             end loop;
 
-            Indic :=
-              Make_Subtype_Indication (Loc,
-                Subtype_Mark => New_Occurrence_Of (Base_Type (Typ), Loc),
-                Constraint  => Make_Index_Or_Discriminant_Constraint (Loc, C));
+            if Has_Unknown_Discriminants (Typ)
+              and then Present (Underlying_Record_View (Typ))
+            then
+               Indic :=
+                 Make_Subtype_Indication (Loc,
+                   Subtype_Mark =>
+                     New_Occurrence_Of (Underlying_Record_View (Typ), Loc),
+                   Constraint  =>
+                     Make_Index_Or_Discriminant_Constraint (Loc, C));
+            else
+               Indic :=
+                 Make_Subtype_Indication (Loc,
+                   Subtype_Mark =>
+                     New_Occurrence_Of (Base_Type (Typ), Loc),
+                   Constraint  =>
+                     Make_Index_Or_Discriminant_Constraint (Loc, C));
+            end if;
 
             Def_Id := Create_Itype (Ekind (Typ), N);
 
@@ -3044,7 +3074,7 @@ package body Sem_Aggr is
                end if;
             end if;
 
-            Parent_Typ  := Base_Type (Typ);
+            Parent_Typ := Base_Type (Typ);
             while Parent_Typ /= Root_Typ loop
                Prepend_Elmt (Parent_Typ, To => Parent_Typ_List);
                Parent_Typ := Etype (Parent_Typ);
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 0a32539774f..cd713c84f77 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -774,7 +774,7 @@ package body Sem_Ch10 is
             Version_Update (N, Lib_Unit);
          end if;
 
-         --  If this is a child unit, generate references to the parents.
+         --  If this is a child unit, generate references to the parents
 
          if Nkind (Defining_Unit_Name (Specification (Unit_Node))) =
                                              N_Defining_Program_Unit_Name
@@ -785,8 +785,8 @@ package body Sem_Ch10 is
          end if;
       end if;
 
-      --  If it is a child unit, the parent must be elaborated first
-      --  and we update version, since we are dependent on our parent.
+      --  If it is a child unit, the parent must be elaborated first and we
+      --  update version, since we are dependent on our parent.
 
       if Is_Child_Spec (Unit_Node) then
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d53cb88cbc6..b72fb2f0669 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5523,29 +5523,38 @@ package body Sem_Ch3 is
 
    begin
       if Is_Tagged_Type (Parent_Type) then
+         Full_P := Full_View (Parent_Type);
 
          --  A type extension of a type with unknown discriminants is an
          --  indefinite type that the back-end cannot handle directly.
          --  We treat it as a private type, and build a completion that is
          --  derived from the full view of the parent, and hopefully has
-         --  known discriminants.  The implementation of more complex chains
-         --  of derivation with unknown discriminants is left to the more
-         --  enterprising reader.
+         --  known discriminants.
+
+         --  If the full view of the parent type has its underlying record view
+         --  available then use it to generate the underlying record view of
+         --  this Derived_Type (required to handle chains of derivations with
+         --  unknown discriminants).
+
+         --  Minor optimization: We avoid the generation of useless underlying
+         --  record view entities if the private type declaration has unknown
+         --  discriminants but its corresponding full view has no discriminants
 
          if Has_Unknown_Discriminants (Parent_Type)
-           and then Present (Full_View (Parent_Type))
+           and then Present (Full_P)
+           and then (Has_Discriminants (Full_P)
+                      or else Present (Underlying_Record_View (Full_P)))
            and then not In_Open_Scopes (Par_Scope)
-           and then not Is_Completion
            and then Expander_Active
          then
             declare
                Full_Der : constant Entity_Id :=
                             Make_Defining_Identifier (Loc,
                               Chars => New_Internal_Name ('T'));
-               Decl     : Node_Id;
                New_Ext  : constant Node_Id :=
                             Copy_Separate_Tree
                               (Record_Extension_Part (Type_Definition (N)));
+               Decl     : Node_Id;
 
             begin
                Build_Derived_Record_Type
@@ -5566,13 +5575,40 @@ package body Sem_Ch3 is
                          New_Copy_Tree
                            (Subtype_Indication (Type_Definition (N))),
                        Record_Extension_Part => New_Ext));
+
                Set_Has_Private_Declaration (Full_Der);
                Set_Has_Private_Declaration (Derived_Type);
 
+               --  If the parent type has its underlying record view then we
+               --  force here its use to derive the new underlying record view.
+
+               if Present (Underlying_Record_View (Full_P)) then
+                  pragma Assert
+                    (Nkind (Subtype_Indication (Type_Definition (Decl)))
+                       = N_Identifier);
+                  Set_Entity (Subtype_Indication (Type_Definition (Decl)),
+                    Underlying_Record_View (Full_P));
+               end if;
+
                Install_Private_Declarations (Par_Scope);
                Install_Visible_Declarations (Par_Scope);
                Insert_After (N, Decl);
+
+               --  Mark the entity as underlying record view before its
+               --  analysis. Done to avoid the generation of its list of
+               --  primitives (which is not really required for this entity)
+               --  and thus avoid supurious errors associated with missing
+               --  overriding of its abstract primitives (because they are
+               --  overriden in the list of primitives of Derived_Type).
+
+               Set_Ekind (Full_Der, E_Record_Type);
+               Set_Is_Underlying_Record_View (Full_Der);
+
                Analyze (Decl);
+
+               pragma Assert (Has_Discriminants (Full_Der)
+                 and then not Has_Unknown_Discriminants (Full_Der));
+
                Uninstall_Declarations (Par_Scope);
 
                --  Freeze the underlying record view, to prevent generation
@@ -5580,7 +5616,12 @@ package body Sem_Ch3 is
                --  with the real derived type.
 
                Set_Is_Frozen (Full_Der);
-               Set_Underlying_Record_View (Derived_Type, Full_Der);
+
+               --  Keep fully linked the real entity and its underlying record
+               --  view entity
+
+               Set_Underlying_Record_View (Derived_Type, Base_Type (Full_Der));
+               Set_Underlying_Record_View (Base_Type (Full_Der), Derived_Type);
             end;
 
          --  if discriminants are known, build derived record
@@ -7084,7 +7125,13 @@ package body Sem_Ch3 is
             Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Base));
          end if;
 
-         Make_Class_Wide_Type (Derived_Type);
+         --  Minor optimization: There is no need to generate the class wide
+         --  entity associated with an underlying record view
+
+         if not Is_Underlying_Record_View (Derived_Type) then
+            Make_Class_Wide_Type (Derived_Type);
+         end if;
+
          Set_Is_Abstract_Type (Derived_Type, Abstract_Present (Type_Def));
 
          if Has_Discriminants (Derived_Type)
@@ -7279,10 +7326,13 @@ package body Sem_Ch3 is
          end if;
       end if;
 
-      --  Update the class_wide type, which shares the now-completed
-      --  entity list with its specific type.
+      --  Update the class_wide type, which shares the now-completed entity
+      --  list with its specific type. In case of underlying record views
+      --  we do not generate the corresponding class wide entity.
 
-      if Is_Tagged then
+      if Is_Tagged
+        and then not Is_Underlying_Record_View (Derived_Type)
+      then
          Set_First_Entity
            (Class_Wide_Type (Derived_Type), First_Entity (Derived_Type));
          Set_Last_Entity
@@ -13143,7 +13193,10 @@ package body Sem_Ch3 is
          Error_Msg_N ("null exclusion can only apply to an access type", N);
       end if;
 
-      Build_Derived_Type (N, Parent_Type, T, Is_Completion);
+      --  Avoid deriving parent primitives in underlying record views
+
+      Build_Derived_Type (N, Parent_Type, T, Is_Completion,
+        Derive_Subps => not Is_Underlying_Record_View (T));
 
       --  AI-419: The parent type of an explicitly limited derived type must
       --  be a limited type or a limited interface.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 17103e1e3b5..2670c3d2531 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -584,11 +584,19 @@ package body Sem_Ch6 is
             end if;
 
          --  Subtype_indication case; check that the types are the same, and
-         --  statically match if appropriate. A null exclusion may be present
-         --  on the return type, on the function specification, on the object
-         --  declaration or on the subtype itself.
+         --  statically match if appropriate. Handle also record types with
+         --  unknown discriminants for which we have built the underlying
+         --  record view.
+
+         elsif Base_Type (R_Stm_Type) = Base_Type (R_Type)
+           or else (Is_Underlying_Record_View (Base_Type (R_Stm_Type))
+                      and then Underlying_Record_View (Base_Type (R_Stm_Type))
+                                 = Base_Type (R_Type))
+         then
+            --  A null exclusion may be present on the return type, on the
+            --  function specification, on the object declaration or on the
+            --  subtype itself.
 
-         elsif Base_Type (R_Stm_Type) = Base_Type (R_Type) then
             if Is_Access_Type (R_Type)
               and then
                (Can_Never_Be_Null (R_Type)
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 4e03642b2c6..e5f790011c1 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -745,6 +745,18 @@ package body Sem_Type is
       else
          BT1 := Base_Type (T1);
          BT2 := Base_Type (T2);
+
+         --  Handle underlying view of records with unknown discriminants
+         --  using the original entity that motivated the construction of
+         --  this underlying record view (see Build_Derived_Private_Type).
+
+         if Is_Underlying_Record_View (BT1) then
+            BT1 := Underlying_Record_View (BT1);
+         end if;
+
+         if Is_Underlying_Record_View (BT2) then
+            BT2 := Underlying_Record_View (BT2);
+         end if;
       end if;
 
       --  Simplest case: same types are compatible, and types that have the
@@ -2486,20 +2498,37 @@ package body Sem_Type is
    -----------------
 
    function Is_Ancestor (T1, T2 : Entity_Id) return Boolean is
+      BT1 : Entity_Id;
+      BT2 : Entity_Id;
       Par : Entity_Id;
 
    begin
-      if Base_Type (T1) = Base_Type (T2) then
+      BT1 := Base_Type (T1);
+      BT2 := Base_Type (T2);
+
+      --  Handle underlying view of records with unknown discriminants
+      --  using the original entity that motivated the construction of
+      --  this underlying record view (see Build_Derived_Private_Type).
+
+      if Is_Underlying_Record_View (BT1) then
+         BT1 := Underlying_Record_View (BT1);
+      end if;
+
+      if Is_Underlying_Record_View (BT2) then
+         BT2 := Underlying_Record_View (BT2);
+      end if;
+
+      if BT1 = BT2 then
          return True;
 
       elsif Is_Private_Type (T1)
         and then Present (Full_View (T1))
-        and then Base_Type (T2) = Base_Type (Full_View (T1))
+        and then BT2 = Base_Type (Full_View (T1))
       then
          return True;
 
       else
-         Par := Etype (T2);
+         Par := Etype (BT2);
 
          loop
             --  If there was a error on the type declaration, do not recurse
@@ -2507,7 +2536,7 @@ package body Sem_Type is
             if Error_Posted (Par) then
                return False;
 
-            elsif Base_Type (T1) = Base_Type (Par)
+            elsif BT1 = Base_Type (Par)
               or else (Is_Private_Type (T1)
                          and then Present (Full_View (T1))
                          and then Base_Type (Par) = Base_Type (Full_View (T1)))
@@ -2516,7 +2545,7 @@ package body Sem_Type is
 
             elsif Is_Private_Type (Par)
               and then Present (Full_View (Par))
-              and then Full_View (Par) = Base_Type (T1)
+              and then Full_View (Par) = BT1
             then
                return True;
 
diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c
index 33a06397467..5ddaa39d6a2 100644
--- a/gcc/ada/socket.c
+++ b/gcc/ada/socket.c
@@ -62,8 +62,11 @@ extern void __gnat_insert_socket_in_set (fd_set *, int);
 extern int __gnat_is_socket_in_set (fd_set *, int);
 extern fd_set *__gnat_new_socket_set (fd_set *);
 extern void __gnat_remove_socket_from_set (fd_set *, int);
-extern void __gnat_reset_socket_set (fd_set *set);
+extern void __gnat_reset_socket_set (fd_set *);
 extern int  __gnat_get_h_errno (void);
+#if defined (__vxworks) || defined (_WIN32)
+extern int  __gnat_inet_pton (int, const char *, void *);
+#endif
 
 /* Disable the sending of SIGPIPE for writes on a broken stream */
 
@@ -397,6 +400,46 @@ __gnat_get_h_errno (void) {
 #endif
 }
 
+#if defined (__vxworks) || defined (_WIN32)
+int
+__gnat_inet_pton (int af, const char *src, void *dst) {
+  switch (af) {
+#if defined (_WIN32) && defined (AF_INET6)
+    case AF_INET6:
+#endif
+    case AF_INET:
+      break;
+    default:
+      errno = EAFNOSUPPORT;
+      return -1;
+  }
+
+#ifdef __vxworks
+  return (inet_aton (src, dst) == OK);
+#else
+  struct sockaddr_storage ss;
+  int sslen = sizeof ss;
+  int rc;
+
+  ss.ss_family = af;
+  rc = WSAStringToAddress (src, af, NULL, (struct sockaddr *)&ss, &sslen);
+  if (rc > 0) {
+    switch (af) {
+      case AF_INET:
+        *(struct in_addr *)dst = ((struct sockaddr_in *)&ss)->sin_addr;
+        break;
+#ifdef AF_INET6
+      case AF_INET6:
+        *(struct in6_addr *)dst = ((struct sockaddr_in6 *)&ss)->sin6_addr;
+        break;
+#endif
+    }
+  }
+  return rc;
+#endif
+}
+#endif
+
 #else
 #warning Sockets are not supported on this platform
 #endif /* defined(HAVE_SOCKETS) */
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 35ecce93fc9..3ae79182c8c 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -961,12 +961,16 @@ package body Sprint is
                if Present (Expressions (Node)) then
                   Sprint_Comma_List (Expressions (Node));
 
-                  if Present (Component_Associations (Node)) then
+                  if Present (Component_Associations (Node))
+                    and then not Is_Empty_List (Component_Associations (Node))
+                  then
                      Write_Str (", ");
                   end if;
                end if;
 
-               if Present (Component_Associations (Node)) then
+               if Present (Component_Associations (Node))
+                 and then not Is_Empty_List (Component_Associations (Node))
+               then
                   Indent_Begin;
 
                   declare