[Ada] Handling of hyper empty arrays in GNAT.Sockets.Write (PR 35953)
Arnaud Charlet
charlet@adacore.com
Fri Apr 17 13:39:00 GMT 2009
This change fixes the behaviour of the Write primitive of the socket-based
stream types provided by GNAT.Sockets to avoid raising an exception when
writing an empty array with 'Last < 'First - 1.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
-------------- next part --------------
Index: g-socthi-vms.adb
===================================================================
--- g-socthi-vms.adb (revision 146005)
+++ g-socthi-vms.adb (working copy)
@@ -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;
Index: g-socthi-vms.ads
===================================================================
--- g-socthi-vms.ads (revision 146005)
+++ g-socthi-vms.ads (working copy)
@@ -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;
Index: g-socthi-vxworks.adb
===================================================================
--- g-socthi-vxworks.adb (revision 146005)
+++ g-socthi-vxworks.adb (working copy)
@@ -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 --
--------------
Index: g-socthi-vxworks.ads
===================================================================
--- g-socthi-vxworks.ads (revision 146005)
+++ g-socthi-vxworks.ads (working copy)
@@ -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;
Index: g-socthi-mingw.adb
===================================================================
--- g-socthi-mingw.adb (revision 146005)
+++ g-socthi-mingw.adb (working copy)
@@ -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;
Index: g-socthi-mingw.ads
===================================================================
--- g-socthi-mingw.ads (revision 146005)
+++ g-socthi-mingw.ads (working copy)
@@ -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");
Index: g-socthi.adb
===================================================================
--- g-socthi.adb (revision 146005)
+++ g-socthi.adb (working copy)
@@ -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 --
--------------
Index: g-stsifd-sockets.adb
===================================================================
--- g-stsifd-sockets.adb (revision 146263)
+++ g-stsifd-sockets.adb (working copy)
@@ -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;
Index: g-socthi.ads
===================================================================
--- g-socthi.ads (revision 146005)
+++ g-socthi.ads (working copy)
@@ -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;
Index: g-socket.adb
===================================================================
--- g-socket.adb (revision 146005)
+++ g-socket.adb (working copy)
@@ -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;
Index: g-socket.ads
===================================================================
--- g-socket.ads (revision 146005)
+++ g-socket.ads (working copy)
@@ -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;
More information about the Gcc-patches
mailing list