Skip to content

R
riscv-gcc-1
Commit 2366e7c6 by Pascal Obry Committed by Arnaud Charlet
Options

g-socthi-mingw.adb (C_Inet_Addr): New body used to convert the returned type on Windows. 

2005-07-07  Pascal Obry  <obry@adacore.com>

	* g-socthi-mingw.adb (C_Inet_Addr): New body used to convert the
	returned type on Windows.

	* g-socthi-mingw.ads (C_Inet_Addr): Remove pragma Import for this
	routine.

	* g-socket.adb (Inet_Addr): Check for empty Image and raises an
	exception in this case.
	Simplify the code as "Image (Image'Range)" = "Image".

From-SVN: r101691
parent 41f12ed0
Showing with 61 additions and 41 deletions
gcc/ada/g-socket.adb
......@@ -117,8 +117,8 @@ package body GNAT.Sockets is
function Resolve_Error
(Error_Value : Integer;
From_Errno : Boolean := True) return Error_Type;
-- Associate an enumeration value (error_type) to en error value
-- (errno). From_Errno prevents from mixing h_errno with errno.
-- Associate an enumeration value (error_type) to en error value (errno).
-- From_Errno prevents from mixing h_errno with errno.
function To_Name (N : String) return Name_Type;
function To_String (HN : Name_Type) return String;
......@@ -143,11 +143,10 @@ package body GNAT.Sockets is
function Image
(Val : Inet_Addr_VN_Type;
Hex : Boolean := False) return String;
-- Output an array of inet address components either in
-- hexadecimal or in decimal mode.
-- Output an array of inet address components in hex or decimal mode
function Is_IP_Address (Name : String) return Boolean;
-- Return true when Name is an IP address in standard dot notation.
-- Return true when Name is an IP address in standard dot notation
function To_In_Addr (Addr : Inet_Addr_Type) return Thin.In_Addr;
function To_Inet_Addr (Addr : In_Addr) return Inet_Addr_Type;
......@@ -163,12 +162,11 @@ package body GNAT.Sockets is
-- Separate Val in seconds and microseconds
procedure Raise_Socket_Error (Error : Integer);
-- Raise Socket_Error with an exception message describing
-- the error code.
-- Raise Socket_Error with an exception message describing the error code
procedure Raise_Host_Error (Error : Integer);
-- Raise Host_Error exception with message describing error code
-- (note hstrerror seems to be obsolete).
-- Raise Host_Error exception with message describing error code (note
-- hstrerror seems to be obsolete).
procedure Narrow (Item : in out Socket_Set_Type);
-- Update Last as it may be greater than the real last socket
......@@ -434,8 +432,8 @@ package body GNAT.Sockets is
Raise_Socket_Error (Socket_Errno);
end if;
-- If Select was resumed because of read signalling socket,
-- read this data and remove socket from set.
-- If Select was resumed because of read signalling socket, read this
-- data and remove socket from set.
if Is_Set (RSet, Selector.R_Sig_Socket) then
Clear (RSet, Selector.R_Sig_Socket);
......@@ -457,8 +455,7 @@ package body GNAT.Sockets is
Status := Expired;
end if;
-- Update RSet, WSet and ESet in regard to their new socket
-- sets.
-- Update RSet, WSet and ESet in regard to their new socket sets
Narrow (RSet);
Narrow (WSet);
......@@ -499,7 +496,6 @@ package body GNAT.Sockets is
Socket : Socket_Type)
is
Last : aliased C.int := C.int (Item.Last);
begin
if Item.Last /= No_Socket then
Remove_Socket_From_Set (Item.Set, C.int (Socket));
......@@ -519,7 +515,6 @@ package body GNAT.Sockets is
begin
begin
Close_Socket (Selector.R_Sig_Socket);
exception
when Socket_Error =>
null;
......@@ -527,7 +522,6 @@ package body GNAT.Sockets is
begin
Close_Socket (Selector.W_Sig_Socket);
exception
when Socket_Error =>
null;
......@@ -616,7 +610,6 @@ package body GNAT.Sockets is
when N_Bytes_To_Read =>
Request.Size := Natural (Arg);
end case;
end Control_Socket;
......@@ -651,13 +644,14 @@ package body GNAT.Sockets is
begin
-- We open two signalling sockets. One of them is used to send data to
-- send data to the other, which is included in a C_Select socket set.
-- The communication is used to force the call to C_Select to complete,
-- and the waiting task to resume its execution.
-- the other, which is included in a C_Select socket set. The
-- communication is used to force the call to C_Select to complete, and
-- the waiting task to resume its execution.
-- Create a listening socket
S0 := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
if S0 = Failure then
Raise_Socket_Error (Socket_Errno);
end if;
......@@ -671,6 +665,7 @@ package body GNAT.Sockets is
Sin.Sin_Port := 0;
Res := C_Bind (S0, Sin'Address, Len);
if Res = Failure then
Err := Socket_Errno;
Res := C_Close (S0);
......@@ -819,10 +814,8 @@ package body GNAT.Sockets is
begin
if Stream = null then
raise Socket_Error;
elsif Stream.all in Datagram_Socket_Stream_Type then
return Datagram_Socket_Stream_Type (Stream.all).From;
else
return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket);
end if;
......@@ -898,7 +891,6 @@ package body GNAT.Sockets is
declare
HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
begin
Task_Lock.Unlock;
return HE;
......@@ -1154,7 +1146,6 @@ package body GNAT.Sockets is
procedure Img10 (V : Inet_Addr_Comp_Type) is
Img : constant String := V'Img;
Len : constant Natural := Img'Length - 1;
begin
Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last);
Length := Length + Len;
......@@ -1243,8 +1234,14 @@ package body GNAT.Sockets is
-- has the same in_addr_t value as Failure, and thus cannot be
-- properly returned by inet_addr(3).
if Image (Image'Range) = "255.255.255.255" then
if Image = "255.255.255.255" then
return Broadcast_Inet_Addr;
-- Special case for an empty Image as on some platforms (e.g. Windows)
-- calling Inet_Addr("") will not return an error.
elsif Image = "" then
Raise_Socket_Error (Constants.EINVAL);
end if;
Img := New_String (Image);
......@@ -1457,8 +1454,8 @@ package body GNAT.Sockets is
Last := Index;
-- Exit when all or zero data received. Zero means that
-- the socket peer is closed.
-- Exit when all or zero data received. Zero means that the socket
-- peer is closed.
exit when Index < First or else Index = Max;
......@@ -1484,8 +1481,8 @@ package body GNAT.Sockets is
Receive_Socket (Stream.Socket, Item (First .. Max), Index);
Last := Index;
-- Exit when all or zero data received. Zero means that
-- the socket peer is closed.
-- Exit when all or zero data received. Zero means that the socket
-- peer is closed.
exit when Index < First or else Index = Max;
......@@ -1964,7 +1961,6 @@ package body GNAT.Sockets is
function Stream (Socket : Socket_Type) return Stream_Access is
S : Stream_Socket_Stream_Access;
begin
S := new Stream_Socket_Stream_Type;
S.Socket := Socket;
......@@ -1992,13 +1988,13 @@ package body GNAT.Sockets is
Aliases : constant Chars_Ptr_Array :=
Chars_Ptr_Pointers.Value (E.H_Aliases);
-- H_Aliases points to a list of name aliases. The list is
-- terminated by a NULL pointer.
-- H_Aliases points to a list of name aliases. The list is terminated by
-- a NULL pointer.
Addresses : constant In_Addr_Access_Array :=
In_Addr_Access_Pointers.Value (E.H_Addr_List);
-- H_Addr_List points to a list of binary addresses (in network
-- byte order). The list is terminated by a NULL pointer.
-- H_Addr_List points to a list of binary addresses (in network byte
-- order). The list is terminated by a NULL pointer.
--
-- H_Length is not used because it is currently only set to 4.
-- H_Addrtype is always AF_INET
......@@ -2201,8 +2197,8 @@ package body GNAT.Sockets is
Index,
Stream.To);
-- Exit when all or zero data sent. Zero means that the
-- socket has been closed by peer.
-- 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;
......@@ -2230,8 +2226,8 @@ package body GNAT.Sockets is
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 all or zero data sent. Zero means that the socket has
-- been closed by peer.
exit when Index < First or else Index = Max;
......
gcc/ada/g-socthi-mingw.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005 AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -409,6 +409,31 @@ package body GNAT.Sockets.Thin is
return Res;
end C_Select;
-----------------
-- C_Inet_Addr --
-----------------
function C_Inet_Addr
(Cp : C.Strings.chars_ptr) return C.int
is
use type C.unsigned_long;
function Internal_Inet_Addr
(Cp : C.Strings.chars_ptr) return C.unsigned_long;
pragma Import (Stdcall, Internal_Inet_Addr, "inet_addr");
Res : C.unsigned_long;
begin
Res := Internal_Inet_Addr (Cp);
if Res = C.unsigned_long'Last then
-- This value is returned in case of error
return -1;
else
return C.int (Internal_Inet_Addr (Cp));
end if;
end C_Inet_Addr;
--------------
-- C_Writev --
--------------
......
gcc/ada/g-socthi-mingw.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005 AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -395,7 +395,6 @@ private
pragma Import (Stdcall, C_Getservbyport, "getservbyport");
pragma Import (Stdcall, C_Getsockname, "getsockname");
pragma Import (Stdcall, C_Getsockopt, "getsockopt");
pragma Import (Stdcall, C_Inet_Addr, "inet_addr");
pragma Import (Stdcall, C_Ioctl, "ioctlsocket");
pragma Import (Stdcall, C_Listen, "listen");
pragma Import (Stdcall, C_Recv, "recv");
......
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