re PR ada/35953 (Socket stream subprograms incorrectly handling null arrays)

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

	PR ada/35953

	* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
	g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads,
	g-socthi.adb, g-stsifd-sockets.adb, g-socthi.ads, g-socket.adb,
	g-socket.ads (GNAT.Sockets.Thin.C_Send,
	GNAT.Sockets.Thin.Syscall_Send): Remove unused subprograms.
	Replace calls to send(2) with equivalent sendto(2) calls.
	(GNAT.Sockets.Send_Socket): Factor common code in inlined subprogram.
	(GNAT.Sockets.Write): Account for the case of hyper-empty arrays, do not
	report an error in that case. Factor code common to the two versions
	(datagram and stream) in common routine Stream_Write.

From-SVN: r146267

gcc/ada/ChangeLog

+2009-04-17  Thomas Quinot  <quinot@adacore.com>
+
+	PR ada/35953
+
+	* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
+	g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads,
+	g-socthi.adb, g-stsifd-sockets.adb, g-socthi.ads, g-socket.adb,
+	g-socket.ads (GNAT.Sockets.Thin.C_Send,
+	GNAT.Sockets.Thin.Syscall_Send): Remove unused subprograms.
+	Replace calls to send(2) with equivalent sendto(2) calls.
+	(GNAT.Sockets.Send_Socket): Factor common code in inlined subprogram.
+	(GNAT.Sockets.Write): Account for the case of hyper-empty arrays, do not
+	report an error in that case. Factor code common to the two versions
+	(datagram and stream) in common routine Stream_Write.
+
 2009-04-17  Robert Dewar  <dewar@adacore.com>
 
 	* exp_disp.adb: Minor reformatting

gcc/ada/g-socket.adb

@@ -228,6 +228,13 @@ package body GNAT.Sockets is
      (Stream : in out Stream_Socket_Stream_Type;
       Item   : Ada.Streams.Stream_Element_Array);
 
+   procedure Stream_Write
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      To     : access Sock_Addr_Type);
+   --  Common implementation for the Write operation of Datagram_Socket_Stream_
+   --  Type and Stream_Socket_Stream_Type.
+
    procedure Wait_On_Socket
      (Socket    : Socket_Type;
       For_Read  : Boolean;
@@ -1801,21 +1808,24 @@ package body GNAT.Sockets is
       Last   : out Ada.Streams.Stream_Element_Offset;
       Flags  : Request_Flag_Type := No_Request_Flag)
    is
-      Res : C.int;
-
    begin
-      Res :=
-        C_Send
-          (C.int (Socket),
-           Item'Address,
-           Item'Length,
-           Set_Forced_Flags (To_Int (Flags)));
+      Send_Socket (Socket, Item, Last, To => null, Flags => Flags);
+   end Send_Socket;
 
-      if Res = Failure then
-         Raise_Socket_Error (Socket_Errno);
-      end if;
+   -----------------
+   -- Send_Socket --
+   -----------------
 
-      Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
+   procedure Send_Socket
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset;
+      To     : Sock_Addr_Type;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+   begin
+      Send_Socket
+        (Socket, Item, Last, To => To'Unrestricted_Access, Flags => Flags);
    end Send_Socket;
 
    -----------------
@@ -1826,26 +1836,36 @@ package body GNAT.Sockets is
      (Socket : Socket_Type;
       Item   : Ada.Streams.Stream_Element_Array;
       Last   : out Ada.Streams.Stream_Element_Offset;
-      To     : Sock_Addr_Type;
+      To     : access Sock_Addr_Type;
       Flags  : Request_Flag_Type := No_Request_Flag)
    is
-      Res : C.int;
-      Sin : aliased Sockaddr_In;
-      Len : constant C.int := Sin'Size / 8;
+      Res  : C.int;
+
+      Sin  : aliased Sockaddr_In;
+      C_To : Sockaddr_In_Access;
+      Len  : C.int;
 
    begin
-      Set_Family  (Sin.Sin_Family, To.Family);
-      Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
-      Set_Port
-        (Sin'Unchecked_Access,
-         Short_To_Network (C.unsigned_short (To.Port)));
+      if To /= null then
+         Set_Family  (Sin.Sin_Family, To.Family);
+         Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
+         Set_Port
+           (Sin'Unchecked_Access,
+            Short_To_Network (C.unsigned_short (To.Port)));
+         C_To := Sin'Unchecked_Access;
+         Len := Sin'Size / 8;
+
+      else
+         C_To := null;
+         Len := 0;
+      end if;
 
       Res := C_Sendto
         (C.int (Socket),
          Item'Address,
          Item'Length,
          Set_Forced_Flags (To_Int (Flags)),
-         Sin'Unchecked_Access,
+         C_To,
          Len);
 
       if Res = Failure then
@@ -2094,6 +2114,43 @@ package body GNAT.Sockets is
       return Stream_Access (S);
    end Stream;
 
+   ------------------
+   -- Stream_Write --
+   ------------------
+
+   procedure Stream_Write
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      To     : access Sock_Addr_Type)
+   is
+      First : Ada.Streams.Stream_Element_Offset;
+      Index : Ada.Streams.Stream_Element_Offset;
+      Max   : constant Ada.Streams.Stream_Element_Offset := Item'Last;
+
+   begin
+      First := Item'First;
+      Index := First - 1;
+      while First <= Max loop
+         Send_Socket (Socket, Item (First .. Max), Index, To);
+
+         --  Exit when all or zero data sent. Zero means that the socket has
+         --  been closed by peer.
+
+         exit when Index < First or else Index = Max;
+
+         First := Index + 1;
+      end loop;
+
+      --  For an empty array, we have First > Max, and hence Index >= Max (no
+      --  error, the loop above is never executed). After a succesful send,
+      --  Index = Max. The only remaining case, Index < Max, is therefore
+      --  always an actual send failure.
+
+      if Index < Max then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Stream_Write;
+
    ----------
    -- To_C --
    ----------
@@ -2315,31 +2372,8 @@ package body GNAT.Sockets is
      (Stream : in out Datagram_Socket_Stream_Type;
       Item   : Ada.Streams.Stream_Element_Array)
    is
-      pragma Warnings (Off, Stream);
-
-      First : Ada.Streams.Stream_Element_Offset          := Item'First;
-      Index : Ada.Streams.Stream_Element_Offset          := First - 1;
-      Max   : constant Ada.Streams.Stream_Element_Offset := Item'Last;
-
    begin
-      loop
-         Send_Socket
-           (Stream.Socket,
-            Item (First .. Max),
-            Index,
-            Stream.To);
-
-         --  Exit when all or zero data sent. Zero means that the socket has
-         --  been closed by peer.
-
-         exit when Index < First or else Index = Max;
-
-         First := Index + 1;
-      end loop;
-
-      if Index /= Max then
-         raise Socket_Error;
-      end if;
+      Stream_Write (Stream.Socket, Item, To => Stream.To'Unrestricted_Access);
    end Write;
 
    -----------
@@ -2350,27 +2384,8 @@ package body GNAT.Sockets is
      (Stream : in out Stream_Socket_Stream_Type;
       Item   : Ada.Streams.Stream_Element_Array)
    is
-      pragma Warnings (Off, Stream);
-
-      First : Ada.Streams.Stream_Element_Offset          := Item'First;
-      Index : Ada.Streams.Stream_Element_Offset          := First - 1;
-      Max   : constant Ada.Streams.Stream_Element_Offset := Item'Last;
-
    begin
-      loop
-         Send_Socket (Stream.Socket, Item (First .. Max), Index);
-
-         --  Exit when all or zero data sent. Zero means that the socket has
-         --  been closed by peer.
-
-         exit when Index < First or else Index = Max;
-
-         First := Index + 1;
-      end loop;
-
-      if Index /= Max then
-         raise Socket_Error;
-      end if;
+      Stream_Write (Stream.Socket, Item, To => null);
    end Write;
 
    Sockets_Library_Controller_Object : Sockets_Library_Controller;

gcc/ada/g-socket.ads

@@ -917,8 +917,21 @@ package GNAT.Sockets is
      (Socket : Socket_Type;
       Item   : Ada.Streams.Stream_Element_Array;
       Last   : out Ada.Streams.Stream_Element_Offset;
+      To     : access Sock_Addr_Type;
       Flags  : Request_Flag_Type := No_Request_Flag);
-   --  Transmit a message to another socket. Note that Last is set to
+   pragma Inline (Send_Socket);
+   --  Transmit a message over a socket. For a datagram socket, the address is
+   --  given by To.all. For a stream socket, To must be null. Flags
+   --  allows to control the transmission. Raises Socket_Error on error.
+   --  Note: this subprogram is inlined because it is also used to implement
+   --  the two variants below.
+
+   procedure Send_Socket
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset;
+      Flags  : Request_Flag_Type := No_Request_Flag);
+   --  Transmit a message over a socket. Note that Last is set to
    --  Item'First-1 when socket has been closed by peer. This is not
    --  considered an error and no exception is raised. Flags allows to control
    --  the transmission. Raises Socket_Error on any other error condition.
@@ -929,8 +942,9 @@ package GNAT.Sockets is
       Last   : out Ada.Streams.Stream_Element_Offset;
       To     : Sock_Addr_Type;
       Flags  : Request_Flag_Type := No_Request_Flag);
-   --  Transmit a message to another socket. The address is given by To. Flags
-   --  allows to control the transmission. Raises Socket_Error on error.
+   --  Transmit a message over a datagram socket. The destination address is
+   --  To. Flags allows to control the transmission. Raises Socket_Error on
+   --  error.
 
    procedure Send_Vector
      (Socket : Socket_Type;

gcc/ada/g-socthi-mingw.adb

@@ -390,11 +390,13 @@ package body GNAT.Sockets.Thin is
 
    begin
       for J in Iovec'Range loop
-         Res := C_Send
+         Res := C_Sendto
            (Fd,
             Iovec (J).Base.all'Address,
             C.int (Iovec (J).Length),
-            0);
+            Flags => 0,
+            To    => null,
+            Tolen => 0);
 
          if Res < 0 then
             return Res;

gcc/ada/g-socthi-mingw.ads

@@ -153,12 +153,6 @@ package GNAT.Sockets.Thin is
       Exceptfds : access Fd_Set;
       Timeout   : Timeval_Access) return C.int;
 
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;
@@ -243,7 +237,6 @@ private
    pragma Import (Stdcall, C_Listen, "listen");
    pragma Import (Stdcall, C_Recv, "recv");
    pragma Import (Stdcall, C_Recvfrom, "recvfrom");
-   pragma Import (Stdcall, C_Send, "send");
    pragma Import (Stdcall, C_Sendto, "sendto");
    pragma Import (Stdcall, C_Setsockopt, "setsockopt");
    pragma Import (Stdcall, C_Shutdown, "shutdown");

gcc/ada/g-socthi-vms.adb

@@ -92,13 +92,6 @@ package body GNAT.Sockets.Thin is
       Fromlen : not null access C.int) return C.int;
    pragma Import (C, Syscall_Recvfrom, "recvfrom");
 
-   function Syscall_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-   pragma Import (C, Syscall_Send, "send");
-
    function Syscall_Sendto
      (S     : C.int;
       Msg   : System.Address;
@@ -285,31 +278,6 @@ package body GNAT.Sockets.Thin is
       return Res;
    end C_Recvfrom;
 
-   ------------
-   -- C_Send --
-   ------------
-
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int
-   is
-      Res : C.int;
-
-   begin
-      loop
-         Res := Syscall_Send (S, Msg, Len, Flags);
-         exit when SOSC.Thread_Blocking_IO
-           or else Res /= Failure
-           or else Non_Blocking_Socket (S)
-           or else Errno /= SOSC.EWOULDBLOCK;
-         delay Quantum;
-      end loop;
-
-      return Res;
-   end C_Send;
-
    --------------
    -- C_Sendto --
    --------------
@@ -500,11 +468,13 @@ package body GNAT.Sockets.Thin is
 
    begin
       for J in Iovec'Range loop
-         Res := C_Send
+         Res := C_Sendto
            (Fd,
             Iovec (J).Base.all'Address,
             Interfaces.C.int (Iovec (J).Length),
-            SOSC.MSG_Forced_Flags);
+            SOSC.MSG_Forced_Flags,
+            To    => null,
+            Tolen => 0);
 
          if Res < 0 then
             return Res;

gcc/ada/g-socthi-vms.ads

@@ -156,12 +156,6 @@ package GNAT.Sockets.Thin is
       Exceptfds : access Fd_Set;
       Timeout   : Timeval_Access) return C.int;
 
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;

gcc/ada/g-socthi-vxworks.adb

@@ -102,13 +102,6 @@ package body GNAT.Sockets.Thin is
       Fromlen : not null access C.int) return C.int;
    pragma Import (C, Syscall_Recvfrom, "recvfrom");
 
-   function Syscall_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-   pragma Import (C, Syscall_Send, "send");
-
    function Syscall_Sendto
      (S     : C.int;
       Msg   : System.Address;
@@ -298,31 +291,6 @@ package body GNAT.Sockets.Thin is
       return Res;
    end C_Recvfrom;
 
-   ------------
-   -- C_Send --
-   ------------
-
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int
-   is
-      Res : C.int;
-
-   begin
-      loop
-         Res := Syscall_Send (S, Msg, Len, Flags);
-         exit when SOSC.Thread_Blocking_IO
-           or else Res /= Failure
-           or else Non_Blocking_Socket (S)
-           or else Errno /= SOSC.EWOULDBLOCK;
-         delay Quantum;
-      end loop;
-
-      return Res;
-   end C_Send;
-
    --------------
    -- C_Sendto --
    --------------

gcc/ada/g-socthi-vxworks.ads

@@ -154,12 +154,6 @@ package GNAT.Sockets.Thin is
       Exceptfds : access Fd_Set;
       Timeout   : Timeval_Access) return C.int;
 
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;

gcc/ada/g-socthi.adb

@@ -98,13 +98,6 @@ package body GNAT.Sockets.Thin is
       Fromlen : not null access C.int) return C.int;
    pragma Import (C, Syscall_Recvfrom, "recvfrom");
 
-   function Syscall_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-   pragma Import (C, Syscall_Send, "send");
-
    function Syscall_Sendto
      (S     : C.int;
       Msg   : System.Address;
@@ -303,31 +296,6 @@ package body GNAT.Sockets.Thin is
       return Res;
    end C_Recvfrom;
 
-   ------------
-   -- C_Send --
-   ------------
-
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int
-   is
-      Res : C.int;
-
-   begin
-      loop
-         Res := Syscall_Send (S, Msg, Len, Flags);
-         exit when SOSC.Thread_Blocking_IO
-           or else Res /= Failure
-           or else Non_Blocking_Socket (S)
-           or else Errno /= SOSC.EWOULDBLOCK;
-         delay Quantum;
-      end loop;
-
-      return Res;
-   end C_Send;
-
    --------------
    -- C_Sendto --
    --------------

gcc/ada/g-socthi.ads

@@ -155,12 +155,6 @@ package GNAT.Sockets.Thin is
       Exceptfds : access Fd_Set;
       Timeout   : Timeval_Access) return C.int;
 
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;

gcc/ada/g-stsifd-sockets.adb

@@ -226,7 +226,11 @@ package body Signalling_Fds is
    function Write (Wsig : C.int) return C.int is
       Buf : aliased Character := ASCII.NUL;
    begin
-      return C_Send (Wsig, Buf'Address, 1, SOSC.MSG_Forced_Flags);
+      return C_Sendto
+        (Wsig, Buf'Address, 1,
+         Flags => SOSC.MSG_Forced_Flags,
+         To    => null,
+         Tolen =>  0);
    end Write;
 
 end Signalling_Fds;