[multiple changes]

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

	* g-sothco.ads (Int_Access): Remove extraneous access type (use
	anonymous access instead).
	(Get_Socket_From_Set): Fix incorrectly reverted formals
	Last and Socket to match the underlying C routine.

	* g-socket.adb
	(Get): Use named parameter associations instead of positional ones in
	call go Get_Socket_From_Set, since this routine has two formals of the
	same type.

	* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
	g-socthi-vxworks.ads, g-socthi-mingw.ads, g-socthi.adb, g-socthi.ads:
	(C_Ioctl, Syscall_Ioctl): use "access C.int" instead of "Int_Access"
	for type of Arg formal.

	* sem_warn.adb: Minor reformatting

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

	* sem_util.adb (Has_Tagged_Component): Fix typo in loop that iterates
	over record components.

2009-04-07  Nicolas Roche  <roche@adacore.com>

	* gsocket.h:
	Don't include resolvLib.h on VxWorks 6 (kernel and rtp). This library
	has disappeared between VxWorks 6.4 and VxWorks 6.5
	In RTP mode use time.h instead of times.h

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

	* exp_ch4.adb (Expand_N_Op_Concat): Improve lower bound handling

2009-04-07  Kevin Pouget  <pouget@adacore.com>

	* exp_dist.adb: Modify Build_From_Any_Fonction procedure to correct
	expanded code for constrained types.

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

	* sem_ch4.adb (Analyze_Overloaded_Selected_Component): implement
	AI05-105: in an object renaming declaration, anonymousness is a name
	resolution rule.

	sem_ch8.adb (Analyze_Object_Renaming): Ditto.

2009-04-07  Arnaud Charlet  <charlet@adacore.com>

	* g-comlin.adb (Expansion): Fix old regression: also return directory
	names when matching.

From-SVN: r145689

18 files changed, 319 insertions, 125 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 664dfa8..ba39538 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,56 @@
+2009-04-07  Thomas Quinot  <quinot@adacore.com>
+
+	* g-sothco.ads (Int_Access): Remove extraneous access type (use
+	anonymous access instead).
+	(Get_Socket_From_Set): Fix incorrectly reverted formals
+	Last and Socket to match the underlying C routine.
+
+	* g-socket.adb
+	(Get): Use named parameter associations instead of positional ones in
+	call go Get_Socket_From_Set, since this routine has two formals of the
+	same type.
+
+	* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
+	g-socthi-vxworks.ads, g-socthi-mingw.ads, g-socthi.adb, g-socthi.ads:
+	(C_Ioctl, Syscall_Ioctl): use "access C.int" instead of "Int_Access"
+	for type of Arg formal.
+
+	* sem_warn.adb: Minor reformatting
+
+2009-04-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Has_Tagged_Component): Fix typo in loop that iterates
+	over record components.
+
+2009-04-07  Nicolas Roche  <roche@adacore.com>
+
+	* gsocket.h:
+	Don't include resolvLib.h on VxWorks 6 (kernel and rtp). This library
+	has disappeared between VxWorks 6.4 and VxWorks 6.5
+	In RTP mode use time.h instead of times.h
+
+2009-04-07  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Op_Concat): Improve lower bound handling
+
+2009-04-07  Kevin Pouget  <pouget@adacore.com>
+
+	* exp_dist.adb: Modify Build_From_Any_Fonction procedure to correct
+	expanded code for constrained types.
+
+2009-04-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Analyze_Overloaded_Selected_Component): implement
+	AI05-105: in an object renaming declaration, anonymousness is a name
+	resolution rule.
+
+	* sem_ch8.adb (Analyze_Object_Renaming): Ditto.
+
+2009-04-07  Arnaud Charlet  <charlet@adacore.com>
+
+	* g-comlin.adb (Expansion): Fix old regression: also return directory
+	names when matching.
+
 2009-04-07  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch4.adb:
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 27c450d..fb11644 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2368,7 +2368,14 @@ package body Exp_Ch4 is
             --  Set lower bound to lower bound of index subtype. This is not
             --  right where the index subtype bound is dynamic ???
 
-            Fixed_Low_Bound (NN) := Expr_Value (Type_Low_Bound (Ityp));
+            if Compile_Time_Known_Value (Type_Low_Bound (Ityp)) then
+               Fixed_Low_Bound (NN) :=
+                 Expr_Value (Type_Low_Bound (Ityp));
+            else
+               Fixed_Low_Bound (NN) :=
+                 Expr_Value (Type_Low_Bound (Base_Type (Ityp)));
+            end if;
+
             Set := True;
 
          --  String literal case (can only occur for strings of course)
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 546bbcc..14136fd 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -9114,39 +9114,82 @@ package body Exp_Dist is
                         New_Occurrence_Of (Any_Parameter, Loc),
                         New_Occurrence_Of (Strm, Loc))));
 
-                  --  declare
-                  --     Res : constant T := T'Input (Strm);
-                  --  begin
-                  --     Release_Buffer (Strm);
-                  --     return Res;
-                  --  end;
-
-                  Append_To (Stms, Make_Block_Statement (Loc,
-                    Declarations => New_List (
-                      Make_Object_Declaration (Loc,
-                        Defining_Identifier => Res,
-                        Constant_Present    => True,
-                        Object_Definition   => New_Occurrence_Of (Typ, Loc),
-                        Expression          =>
-                            Make_Attribute_Reference (Loc,
-                              Prefix         => New_Occurrence_Of (Typ, Loc),
-                              Attribute_Name => Name_Input,
-                              Expressions => New_List (
-                                Make_Attribute_Reference (Loc,
-                                  Prefix => New_Occurrence_Of (Strm, Loc),
-                                  Attribute_Name => Name_Access))))),
+                  if Transmit_As_Unconstrained (Typ) then
+
+                     --  declare
+                     --     Res : constant T := T'Input (Strm);
+                     --  begin
+                     --     Release_Buffer (Strm);
+                     --     return Res;
+                     --  end;
+
+                     Append_To (Stms, Make_Block_Statement (Loc,
+                       Declarations               => New_List (
+                         Make_Object_Declaration (Loc,
+                           Defining_Identifier => Res,
+                           Constant_Present    => True,
+                           Object_Definition   => New_Occurrence_Of (Typ, Loc),
+                           Expression          =>
+                             Make_Attribute_Reference (Loc,
+                               Prefix         => New_Occurrence_Of (Typ, Loc),
+                               Attribute_Name => Name_Input,
+                               Expressions    => New_List (
+                                 Make_Attribute_Reference (Loc,
+                                   Prefix         =>
+                                     New_Occurrence_Of (Strm, Loc),
+                                   Attribute_Name => Name_Access))))),
+
+                       Handled_Statement_Sequence =>
+                         Make_Handled_Sequence_Of_Statements (Loc,
+                           Statements => New_List (
+                             Make_Procedure_Call_Statement (Loc,
+                               Name                   =>
+                                 New_Occurrence_Of
+                                   (RTE (RE_Release_Buffer), Loc),
+                               Parameter_Associations =>
+                                 New_List (New_Occurrence_Of (Strm, Loc))),
+                             Make_Simple_Return_Statement (Loc,
+                               Expression => New_Occurrence_Of (Res, Loc))))));
+                  else
 
-                    Handled_Statement_Sequence =>
-                      Make_Handled_Sequence_Of_Statements (Loc,
-                        Statements => New_List (
-                          Make_Procedure_Call_Statement (Loc,
-                            Name =>
-                              New_Occurrence_Of (RTE (RE_Release_Buffer), Loc),
-                            Parameter_Associations =>
-                              New_List (New_Occurrence_Of (Strm, Loc))),
-                          Make_Simple_Return_Statement (Loc,
-                            Expression => New_Occurrence_Of (Res, Loc))))));
+                     --  declare
+                     --     Res : T;
+                     --  begin
+                     --     T'Read (Strm, Res);
+                     --     Release_Buffer (Strm);
+                     --     return Res;
+                     --  end;
+
+                     Append_To (Stms, Make_Block_Statement (Loc,
+                       Declarations               => New_List (
+                         Make_Object_Declaration (Loc,
+                           Defining_Identifier => Res,
+                           Constant_Present    => False,
+                           Object_Definition   =>
+                             New_Occurrence_Of (Typ, Loc))),
+
+                       Handled_Statement_Sequence =>
+                         Make_Handled_Sequence_Of_Statements (Loc,
+                           Statements => New_List (
+                             Make_Attribute_Reference (Loc,
+                               Prefix         => New_Occurrence_Of (Typ, Loc),
+                               Attribute_Name => Name_Read,
+                               Expressions    => New_List (
+                                 Make_Attribute_Reference (Loc,
+                                   Prefix         =>
+                                     New_Occurrence_Of (Strm, Loc),
+                                   Attribute_Name => Name_Access),
+                                New_Occurrence_Of (Res, Loc))),
+                             Make_Procedure_Call_Statement (Loc,
+                               Name                   =>
+                                 New_Occurrence_Of
+                                   (RTE (RE_Release_Buffer), Loc),
+                               Parameter_Associations =>
+                                 New_List (New_Occurrence_Of (Strm, Loc))),
+                             Make_Simple_Return_Statement (Loc,
+                               Expression => New_Occurrence_Of (Res, Loc))))));
 
+                  end if;
                end;
             end if;
 
diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index b67d4fe..ba8ed16 100644
--- a/gcc/ada/g-comlin.adb
+++ b/gcc/ada/g-comlin.adb
@@ -263,24 +263,25 @@ package body GNAT.Command_Line is
                     (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
                end if;
             end if;
+         end if;
 
-         --  If not a directory, check the relative path against the pattern
+         --  Check the relative path against the pattern.
+         --  Note that we try to match also against directory names, since
+         --  clients of this function may expect to retrieve directories.
 
-         else
-            declare
-               Name : String :=
-                        It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
-                          & S (1 .. Last);
-            begin
-               Canonical_Case_File_Name (Name);
+         declare
+            Name : String :=
+                     It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
+                       & S (1 .. Last);
+         begin
+            Canonical_Case_File_Name (Name);
 
-               --  If it matches return the relative path
+            --  If it matches return the relative path
 
-               if GNAT.Regexp.Match (Name, Iterator.Regexp) then
-                  return Name;
-               end if;
-            end;
-         end if;
+            if GNAT.Regexp.Match (Name, Iterator.Regexp) then
+               return Name;
+            end if;
+         end;
       end loop;
    end Expansion;
 
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index d14fae8..e586a2d 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -58,6 +58,10 @@ package body GNAT.Sockets is
 
    ENOERROR : constant := 0;
 
+   Empty_Socket_Set : Socket_Set_Type;
+   --  Variable set in Initialize, and then used internally to provide an
+   --  initial value for Socket_Set_Type objects.
+
    Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
    --  The network database functions gethostbyname, gethostbyaddr,
    --  getservbyname and getservbyport can either be guaranteed task safe by
@@ -426,7 +430,7 @@ package body GNAT.Sockets is
       Status       : out Selector_Status;
       Timeout      : Selector_Duration := Forever)
    is
-      E_Socket_Set : Socket_Set_Type; --  (No_Socket, No_Fd_Set_Access)
+      E_Socket_Set : Socket_Set_Type := Empty_Socket_Set;
    begin
       Check_Selector
         (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
@@ -813,7 +817,7 @@ package body GNAT.Sockets is
    begin
       if Item.Last /= No_Socket then
          Get_Socket_From_Set
-           (Item.Set'Access, L'Unchecked_Access, S'Unchecked_Access);
+           (Item.Set'Access, Last => L'Access, Socket => S'Access);
          Item.Last := Socket_Type (L);
          Socket    := Socket_Type (S);
       else
@@ -1208,6 +1212,33 @@ package body GNAT.Sockets is
       return Socket'Img;
    end Image;
 
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Item : Socket_Set_Type) return String is
+      Socket_Set : Socket_Set_Type := Item;
+   begin
+      declare
+         Last_Img : constant String := Socket_Set.Last'Img;
+         Buffer   : String
+                      (1 .. (Integer (Socket_Set.Last) + 1) * Last_Img'Length);
+         Index    : Positive := 1;
+         Socket   : Socket_Type;
+      begin
+         while not Is_Empty (Socket_Set) loop
+            Get (Socket_Set, Socket);
+            declare
+               Socket_Img : constant String := Socket'Img;
+            begin
+               Buffer (Index .. Index + Socket_Img'Length - 1) := Socket_Img;
+               Index := Index + Socket_Img'Length;
+            end;
+         end loop;
+         return "[" & Last_Img & "]" & Buffer (1 .. Index - 1);
+      end;
+   end Image;
+
    ---------------
    -- Inet_Addr --
    ---------------
@@ -1270,6 +1301,8 @@ package body GNAT.Sockets is
    begin
       if not Initialized then
          Initialized := True;
+         Empty_Socket_Set.Last := No_Socket;
+         Reset_Socket_Set (Empty_Socket_Set.Set'Access);
          Thin.Initialize;
       end if;
    end Initialize;
diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads
index ae4aeea..408d789 100644
--- a/gcc/ada/g-socthi-mingw.ads
+++ b/gcc/ada/g-socthi-mingw.ads
@@ -121,7 +121,7 @@ package GNAT.Sockets.Thin is
    function C_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
 
    function C_Listen
      (S       : C.int;
diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb
index 77c61cc..389c256 100644
--- a/gcc/ada/g-socthi-vms.adb
+++ b/gcc/ada/g-socthi-vms.adb
@@ -73,7 +73,7 @@ package body GNAT.Sockets.Thin is
    function Syscall_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
    pragma Import (C, Syscall_Ioctl, "ioctl");
 
    function Syscall_Recv
@@ -148,7 +148,7 @@ package body GNAT.Sockets.Thin is
          --  tracks sockets set in non-blocking mode by user.
 
          Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
-         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
       end if;
 
       return R;
@@ -219,7 +219,7 @@ package body GNAT.Sockets.Thin is
    function C_Ioctl
      (S   : C.int;
       Req : C.int;
-      Arg : Int_Access) return C.int
+      Arg : access C.int) return C.int
    is
    begin
       if not SOSC.Thread_Blocking_IO
@@ -361,7 +361,7 @@ package body GNAT.Sockets.Thin is
          --  Do not use C_Ioctl as this subprogram tracks sockets set
          --  in non-blocking mode by user.
 
-         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
          Set_Non_Blocking_Socket (R, False);
       end if;
 
diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads
index 47ccf65..dd317bf 100644
--- a/gcc/ada/g-socthi-vms.ads
+++ b/gcc/ada/g-socthi-vms.ads
@@ -124,7 +124,7 @@ package GNAT.Sockets.Thin is
    function C_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
 
    function C_Listen
      (S       : C.int;
diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb
index d9d436f..81a8d96 100644
--- a/gcc/ada/g-socthi-vxworks.adb
+++ b/gcc/ada/g-socthi-vxworks.adb
@@ -83,7 +83,7 @@ package body GNAT.Sockets.Thin is
    function Syscall_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
    pragma Import (C, Syscall_Ioctl, "ioctl");
 
    function Syscall_Recv
@@ -160,7 +160,7 @@ package body GNAT.Sockets.Thin is
          --  tracks sockets set in non-blocking mode by user.
 
          Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
-         Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
          --  Is it OK to ignore result ???
       end if;
 
@@ -232,7 +232,7 @@ package body GNAT.Sockets.Thin is
    function C_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int
+      Arg  : access C.int) return C.int
    is
    begin
       if not SOSC.Thread_Blocking_IO
@@ -374,7 +374,7 @@ package body GNAT.Sockets.Thin is
          --  Do not use C_Ioctl as this subprogram tracks sockets set
          --  in non-blocking mode by user.
 
-         Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
          --  Is it OK to ignore result ???
          Set_Non_Blocking_Socket (R, False);
       end if;
diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads
index 5c74e88..06b75e3 100644
--- a/gcc/ada/g-socthi-vxworks.ads
+++ b/gcc/ada/g-socthi-vxworks.ads
@@ -122,7 +122,7 @@ package GNAT.Sockets.Thin is
    function C_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
 
    function C_Listen
      (S       : C.int;
diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb
index 289adbe..1062354 100644
--- a/gcc/ada/g-socthi.adb
+++ b/gcc/ada/g-socthi.adb
@@ -79,7 +79,7 @@ package body GNAT.Sockets.Thin is
    function Syscall_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
    pragma Import (C, Syscall_Ioctl, "ioctl");
 
    function Syscall_Recv
@@ -164,7 +164,7 @@ package body GNAT.Sockets.Thin is
          --  tracks sockets set in non-blocking mode by user.
 
          Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
-         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
       end if;
 
       Disable_SIGPIPE (R);
@@ -237,7 +237,7 @@ package body GNAT.Sockets.Thin is
    function C_Ioctl
      (S   : C.int;
       Req : C.int;
-      Arg : Int_Access) return C.int
+      Arg : access C.int) return C.int
    is
    begin
       if not SOSC.Thread_Blocking_IO
@@ -379,7 +379,7 @@ package body GNAT.Sockets.Thin is
          --  Do not use C_Ioctl as this subprogram tracks sockets set
          --  in non-blocking mode by user.
 
-         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
          Set_Non_Blocking_Socket (R, False);
       end if;
       Disable_SIGPIPE (R);
diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads
index eb11193..8eae6c6 100644
--- a/gcc/ada/g-socthi.ads
+++ b/gcc/ada/g-socthi.ads
@@ -123,7 +123,7 @@ package GNAT.Sockets.Thin is
    function C_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
 
    function C_Listen
      (S       : C.int;
diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads
index cb0bc09..5c886b5 100644
--- a/gcc/ada/g-sothco.ads
+++ b/gcc/ada/g-sothco.ads
@@ -247,14 +247,10 @@ package GNAT.Sockets.Thin_Common is
    -- Socket sets management --
    ----------------------------
 
-   type Int_Access is access all C.int;
-   pragma Convention (C, Int_Access);
-   --  Access to C integers
-
    procedure Get_Socket_From_Set
      (Set    : access Fd_Set;
-      Socket : Int_Access;
-      Last   : Int_Access);
+      Last   : access C.int;
+      Socket : access C.int);
    --  Get last socket in Socket and remove it from the socket set. The
    --  parameter Last is a maximum value of the largest socket. This hint is
    --  used to avoid scanning very large socket sets. After a call to
@@ -274,7 +270,7 @@ package GNAT.Sockets.Thin_Common is
 
    procedure Last_Socket_In_Set
      (Set  : access Fd_Set;
-      Last : Int_Access);
+      Last : access C.int);
    --  Find the largest socket in the socket set. This is needed for select().
    --  When Last_Socket_In_Set is called, parameter Last is a maximum value of
    --  the largest socket. This hint is used to avoid scanning very large
diff --git a/gcc/ada/gsocket.h b/gcc/ada/gsocket.h
index 5d866e0..bbb19da 100644
--- a/gcc/ada/gsocket.h
+++ b/gcc/ada/gsocket.h
@@ -66,7 +66,7 @@
 #include <vxWorks.h>
 #include <ioLib.h>
 #include <hostLib.h>
-#ifndef __RTP__
+#if (_WRS_VXWORKS_MAJOR != 6) && ! defined (__RTP__)
 #include <resolvLib.h>
 #endif
 #define SHUT_RD		0
@@ -176,7 +176,7 @@
 
 #endif
 
-#ifdef __vxworks
+#if defined (__vxworks) && ! defined (__RTP__)
 #include <sys/times.h>
 #else
 #include <sys/time.h>
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 47fd4e6..0808288 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2638,14 +2638,36 @@ package body Sem_Ch4 is
                if Chars (Comp) = Chars (Sel)
                  and then Is_Visible_Component (Comp)
                then
-                  Set_Entity (Sel, Comp);
-                  Set_Etype (Sel, Etype (Comp));
-                  Add_One_Interp (N, Etype (Comp), Etype (Comp));
 
-                  --  This also specifies a candidate to resolve the name.
-                  --  Further overloading will be resolved from context.
+                  --  AI05-105:  if the context is an object renaming with
+                  --  an anonymous access type, the expected type of the
+                  --  object must be anonymous. This is a name resolution rule.
 
-                  Set_Etype (Nam, It.Typ);
+                  if Nkind (Parent (N)) /= N_Object_Renaming_Declaration
+                    or else No (Access_Definition (Parent (N)))
+                    or else Ekind (Etype (Comp)) = E_Anonymous_Access_Type
+                    or else
+                      Ekind (Etype (Comp)) = E_Anonymous_Access_Subprogram_Type
+                  then
+                     Set_Entity (Sel, Comp);
+                     Set_Etype (Sel, Etype (Comp));
+                     Add_One_Interp (N, Etype (Comp), Etype (Comp));
+
+                     --  This also specifies a candidate to resolve the name.
+                     --  Further overloading will be resolved from context.
+                     --  The selector name itself does not carry overloading
+                     --  information.
+
+                     Set_Etype (Nam, It.Typ);
+
+                  else
+
+                     --  Nnamed access type in the context of a renaming
+                     --  declaration with an access definition. Remove
+                     --  inapplicable candidate.
+
+                     Remove_Interp (I);
+                  end if;
                end if;
 
                Next_Entity (Comp);
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 0ff2df4..1930c79 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -767,7 +767,46 @@ package body Sem_Ch8 is
                 (Related_Nod => N,
                  N           => Access_Definition (N));
 
-         Analyze_And_Resolve (Nam, T);
+         Analyze (Nam);
+
+         --  Ada 2005 AI05-105: if the declaration has an anonymous access
+         --  type, the renamed object must also have an anonymous type, and
+         --  this is a name resolution rule. This was implicit in the last
+         --  part of the first sentence in 8.5.1.(3/2), and is made explicit
+         --  by this recent AI.
+
+         if not Is_Overloaded (Nam) then
+            if Ekind (Etype (Nam)) /= Ekind (T) then
+               Error_Msg_N
+                 ("Expect anonymous access type is object renaming", N);
+            end if;
+         else
+            declare
+               I   : Interp_Index;
+               It  : Interp;
+               Typ : Entity_Id := Empty;
+
+            begin
+               Get_First_Interp (Nam, I, It);
+               while Present (It.Typ) loop
+                  if No (Typ) then
+                     if Ekind (It.Typ) = Ekind (T)
+                       and then Covers (T, It.Typ)
+                     then
+                        Typ := It.Typ;
+                        Set_Etype (Nam, Typ);
+                        Set_Is_Overloaded (Nam, False);
+                     end if;
+                  else
+                     Error_Msg_N ("ambiguous expression in renaming", N);
+                  end if;
+
+                  Get_Next_Interp (I, It);
+               end loop;
+            end;
+         end if;
+
+         Resolve (Nam, T);
 
          --  Ada 2005 (AI-231): "In the case where the type is defined by an
          --  access_definition, the renamed entity shall be of an access-to-
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4adaa56..7535808 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4831,7 +4831,7 @@ package body Sem_Util is
                return True;
             end if;
 
-            Comp := Next_Component (Typ);
+            Next_Component (Comp);
          end loop;
 
          return False;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index c29c625..5e420c6 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1004,7 +1004,7 @@ package body Sem_Warn is
                   --  Do not output complaint about never being assigned a
                   --  value if a pragma Unmodified applies to the variable
                   --  we are examining, or if it is a parameter, if there is
-                  --  a pragma Unreferenced for the corresponding spec, of
+                  --  a pragma Unreferenced for the corresponding spec, or
                   --  if the type is marked as having unreferenced objects.
                   --  The last is a little peculiar, but better too few than
                   --  too many warnings in this situation.
@@ -1026,7 +1026,7 @@ package body Sem_Warn is
                      --  has a separate declaration in a different unit. This
                      --  is the case where the client of a package sees only
                      --  the private type, and it may be quite reasonable
-                     --  for the logical view to be in out, even if the
+                     --  for the logical view to be IN OUT, even if the
                      --  implementation ends up using access types or some
                      --  other method to achieve the local effect of a
                      --  modification. On the other hand if the spec and body
@@ -1050,10 +1050,10 @@ package body Sem_Warn is
                      then
                         null;
 
-                     --  Suppress warning if composite type containing any
-                     --  access element component, since the logical effect
-                     --  of modifying a parameter may be achieved by modifying
-                     --  a referenced entity.
+                     --  Suppress warning if composite type contains any access
+                     --  component, since the logical effect of modifying a
+                     --  parameter may be achieved by modifying a referenced
+                     --  object.
 
                      elsif Is_Composite_Type (E1T)
                        and then Has_Access_Values (E1T)
@@ -1237,7 +1237,7 @@ package body Sem_Warn is
 
                --  If Referenced_As_LHS is set, then that's still interesting
                --  (potential "assigned but never read" case), but not if we
-               --  have pragma Unreferenced, which cancels this error.
+               --  have pragma Unreferenced, which cancels this warning.
 
               and then (not Referenced_As_LHS_Check_Spec (E1)
                           or else not Has_Unreferenced (E1))
@@ -1253,13 +1253,13 @@ package body Sem_Warn is
                       (Check_Unreferenced_Formals and then Is_Formal (E1))
 
                      --  Case of warning on unread variables modified by an
-                     --  assignment, or an out parameter if it is the only one.
+                     --  assignment, or an OUT parameter if it is the only one.
 
                      or else
                        (Warn_On_Modified_Unread
                           and then Referenced_As_LHS_Check_Spec (E1))
 
-                     --  Case of warning on any unread out parameter (note
+                     --  Case of warning on any unread OUT parameter (note
                      --  such indications are only set if the appropriate
                      --  warning options were set, so no need to recheck here.
 
@@ -1285,11 +1285,11 @@ package body Sem_Warn is
                            or else
                          Is_Overloadable (E1)
 
-                           --  Package case, if the main unit is a package
-                           --  spec or generic package spec, then there may
-                           --  be a corresponding body that references this
-                           --  package in some other file. Otherwise we can
-                           --  be sure that there is no other reference.
+                           --  Package case, if the main unit is a package spec
+                           --  or generic package spec, then there may be a
+                           --  corresponding body that references this package
+                           --  in some other file. Otherwise we can be sure
+                           --  that there is no other reference.
 
                            or else
                              (Ekind (E1) = E_Package
@@ -1314,7 +1314,7 @@ package body Sem_Warn is
                                and then
                              Referenced (Spec_Entity (E1)))
 
-               --  Consider private type referenced if full view is referenced
+               --  Consider private type referenced if full view is referenced.
                --  If there is not full view, this is a generic type on which
                --  warnings are also useful.
 
@@ -1330,7 +1330,7 @@ package body Sem_Warn is
 
                --  Eliminate dispatching operations from consideration, we
                --  cannot tell if these are referenced or not in any easy
-               --  manner (note this also catches Adjust/Finalize/Initialize)
+               --  manner (note this also catches Adjust/Finalize/Initialize).
 
                and then not Is_Dispatching_Operation (E1)
 
@@ -1356,7 +1356,7 @@ package body Sem_Warn is
                            or else not Is_Task_Type (E1T))
 
                --  For subunits, only place warnings on the main unit itself,
-               --  since parent units are not completely compiled
+               --  since parent units are not completely compiled.
 
                and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit
                            or else
@@ -1372,7 +1372,7 @@ package body Sem_Warn is
             then
                --  Suppress warnings in internal units if not in -gnatg mode
                --  (these would be junk warnings for an applications program,
-               --  since they refer to problems in internal units)
+               --  since they refer to problems in internal units).
 
                if GNAT_Mode
                  or else not
@@ -1425,8 +1425,8 @@ package body Sem_Warn is
             end if;
          end if;
 
-         --  Recurse into nested package or block. Do not recurse into a
-         --  formal package, because the corresponding body is not analyzed.
+         --  Recurse into nested package or block. Do not recurse into a formal
+         --  package, because the corresponding body is not analyzed.
 
          <<Continue>>
             if (Is_Package_Or_Generic_Package (E1)
@@ -1484,7 +1484,7 @@ package body Sem_Warn is
 
       function Prefix_Has_Dereference (Pref : Node_Id) return Boolean is
       begin
-         --  If prefix is of an access type, certainly need a dereference
+         --  If prefix is of an access type, it certainly needs a dereference
 
          if Is_Access_Type (Etype (Pref)) then
             return True;
@@ -1526,13 +1526,13 @@ package body Sem_Warn is
          return;
       end if;
 
-      --  Otherwise see what kind of node we have. If the entity already
-      --  has an unset reference, it is not necessarily the earliest in
-      --  the text, because resolution of the prefix of selected components
-      --  is completed before the resolution of the selected component itself.
-      --  as a result, given  (R /= null and then R.X > 0), the occurrences
-      --  of R are examined in right-to-left order. If there is already an
-      --  unset reference, we check whether N is earlier before proceeding.
+      --  Otherwise see what kind of node we have. If the entity already has an
+      --  unset reference, it is not necessarily the earliest in the text,
+      --  because resolution of the prefix of selected components is completed
+      --  before the resolution of the selected component itself. As a result,
+      --  given (R /= null and then R.X > 0), the occurrences of R are examined
+      --  in right-to-left order. If there is already an unset reference, we
+      --  check whether N is earlier before proceeding.
 
       case Nkind (N) is
 
@@ -1560,11 +1560,11 @@ package body Sem_Warn is
                   --  component with default initialization. Both of these
                   --  cases can be ignored, since the actual object that is
                   --  referenced is definitely initialized. Note that this
-                  --  covers the case of reading discriminants of an out
+                  --  covers the case of reading discriminants of an OUT
                   --  parameter, which is OK even in Ada 83.
 
                   --  Note that we are only interested in a direct reference to
-                  --  a record component here. If the reference is via an
+                  --  a record component here. If the reference is through an
                   --  access type, then the access object is being referenced,
                   --  not the record, and still deserves an unset reference.
 
@@ -1622,9 +1622,9 @@ package body Sem_Warn is
                         SR := Scope (SR);
                      end loop;
 
-                     --  Case of reference has an access type. This is special
-                     --  case since access types are always set to null so
-                     --  cannot be truly uninitialized, but we still want to
+                     --  Case of reference has an access type. This is a
+                     --  special case since access types are always set to null
+                     --  so cannot be truly uninitialized, but we still want to
                      --  warn about cases of obvious null dereference.
 
                      if Is_Access_Type (Typ) then
@@ -1634,7 +1634,7 @@ package body Sem_Warn is
                            function Process
                              (N : Node_Id) return Traverse_Result;
                            --  Process function for instantiation of Traverse
-                           --  below. Checks if N contains reference to other
+                           --  below. Checks if N contains reference to E other
                            --  than a dereference.
 
                            function Ref_In (Nod : Node_Id) return Boolean;
@@ -1699,7 +1699,7 @@ package body Sem_Warn is
                            end if;
 
                            --  One more check, don't bother with references
-                           --  that are inside conditional statements or while
+                           --  that are inside conditional statements or WHILE
                            --  loops if the condition references the entity in
                            --  question. This avoids most false positives.
 
@@ -1864,22 +1864,22 @@ package body Sem_Warn is
          Pack                : Entity_Id;
 
          procedure Check_Inner_Package (Pack : Entity_Id);
-         --  Pack is a package local to a unit in a with_clause. Both the
-         --  unit and Pack are referenced. If none of the entities in Pack
-         --  are referenced, then the only occurrence of Pack is in a use
-         --  clause or a pragma, and a warning is worthwhile as well.
+         --  Pack is a package local to a unit in a with_clause. Both the unit
+         --  and Pack are referenced. If none of the entities in Pack are
+         --  referenced, then the only occurrence of Pack is in a USE clause
+         --  or a pragma, and a warning is worthwhile as well.
 
          function Check_System_Aux return Boolean;
-         --  Before giving a warning on a with_clause for System, check
-         --  whether a system extension is present.
+         --  Before giving a warning on a with_clause for System, check wheter
+         --  a system extension is present.
 
          function Find_Package_Renaming
            (P : Entity_Id;
             L : Entity_Id) return Entity_Id;
          --  The only reference to a context unit may be in a renaming
-         --  declaration. If this renaming declares a visible entity, do
-         --  not warn that the context clause could be moved to the body,
-         --  because the renaming may be intended to re-export the unit.
+         --  declaration. If this renaming declares a visible entity, do not
+         --  warn that the context clause could be moved to the body, because
+         --  the renaming may be intended to re-export the unit.
 
          -------------------------
          -- Check_Inner_Package --