Skip to content

R
riscv-gcc-1
Commit aed6fda8 by Thomas Quinot Committed by Arnaud Charlet
Options

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
parent c5d91669
Showing with 126 additions and 195 deletions
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment