Commit 5e39baa6 by Thomas Quinot Committed by Arnaud Charlet

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

	* g-socket.adb, g-socket.ads, g-socthi-mingw.ads, g-socthi-vms.adb,
	g-socthi-vms.ads, g-socthi-vxworks.ads, g-socthi.ads
	(GNAT.Sockets.Thin.C_Inet_Addr): Remove.
	(GNAT.Sockets.Thin.Inet_Aton): New function, imported from C library
	except for VMS where it is reimplemented in Ada using DECC$INET_ADDR.
	(GNAT.Sockets.Inet_Addr): Use inet_aton(3) instead of inet_addr(3).

	* debug.adb: Fix typo

	* gnat_rm.texi: Minor doc fix.

	* sem_ch7.adb, freeze.adb: Minor reformatting

From-SVN: r146387
parent 3568b271
2009-04-20 Thomas Quinot <quinot@adacore.com> 2009-04-20 Thomas Quinot <quinot@adacore.com>
* g-socket.adb, g-socket.ads, g-socthi-mingw.ads, g-socthi-vms.adb,
g-socthi-vms.ads, g-socthi-vxworks.ads, g-socthi.ads
(GNAT.Sockets.Thin.C_Inet_Addr): Remove.
(GNAT.Sockets.Thin.Inet_Aton): New function, imported from C library
except for VMS where it is reimplemented in Ada using DECC$INET_ADDR.
(GNAT.Sockets.Inet_Addr): Use inet_aton(3) instead of inet_addr(3).
* debug.adb: Fix typo
* gnat_rm.texi: Minor doc fix.
* sem_ch7.adb, freeze.adb: Minor reformatting
2009-04-20 Thomas Quinot <quinot@adacore.com>
* g-socket.ads: Add new constants: * g-socket.ads: Add new constants:
Loopback_Inet_Addr Loopback_Inet_Addr
Unspecified_Group_Inet_Addr Unspecified_Group_Inet_Addr
...@@ -283,7 +283,7 @@ package body Debug is ...@@ -283,7 +283,7 @@ package body Debug is
-- list header is allocated, a line of output is generated. Certain -- list header is allocated, a line of output is generated. Certain
-- other basic tree operations also cause a line of output to be -- other basic tree operations also cause a line of output to be
-- generated. This option is useful in seeing where the parser is -- generated. This option is useful in seeing where the parser is
-- blowing up.; -- blowing up.
-- do Print the source recreated from the generated tree. In the case -- do Print the source recreated from the generated tree. In the case
-- where the tree has been rewritten, this output includes only the -- where the tree has been rewritten, this output includes only the
......
...@@ -2503,7 +2503,7 @@ package body Freeze is ...@@ -2503,7 +2503,7 @@ package body Freeze is
Next_Formal (Formal); Next_Formal (Formal);
end loop; end loop;
-- Case of function: similar checks on return type. -- Case of function: similar checks on return type
if Ekind (E) = E_Function then if Ekind (E) = E_Function then
......
...@@ -179,10 +179,6 @@ package body GNAT.Sockets is ...@@ -179,10 +179,6 @@ package body GNAT.Sockets is
-- Reconstruct a Duration value from a Timeval record (seconds and -- Reconstruct a Duration value from a Timeval record (seconds and
-- microseconds). -- microseconds).
procedure Raise_Socket_Error (Error : Integer);
-- Raise Socket_Error with an exception message describing the error code
-- from errno.
procedure Raise_Host_Error (H_Error : Integer); procedure Raise_Host_Error (H_Error : Integer);
-- Raise Host_Error exception with message describing error code (note -- Raise Host_Error exception with message describing error code (note
-- hstrerror seems to be obsolete) from h_errno. -- hstrerror seems to be obsolete) from h_errno.
...@@ -1274,36 +1270,29 @@ package body GNAT.Sockets is ...@@ -1274,36 +1270,29 @@ package body GNAT.Sockets is
--------------- ---------------
function Inet_Addr (Image : String) return Inet_Addr_Type is function Inet_Addr (Image : String) return Inet_Addr_Type is
use Interfaces.C;
use Interfaces.C.Strings; use Interfaces.C.Strings;
Img : chars_ptr; Img : aliased char_array := To_C (Image);
Addr : aliased C.int;
Res : C.int; Res : C.int;
Result : Inet_Addr_Type; Result : Inet_Addr_Type;
begin begin
-- Special case for the all-ones broadcast address: this address has the
-- same in_addr_t value as Failure, and thus cannot be properly returned
-- by inet_addr(3).
if Image = "255.255.255.255" then
return Broadcast_Inet_Addr;
-- Special case for an empty Image as on some platforms (e.g. Windows) -- Special case for an empty Image as on some platforms (e.g. Windows)
-- calling Inet_Addr("") will not return an error. -- calling Inet_Addr("") will not return an error.
elsif Image = "" then if Image = "" then
Raise_Socket_Error (SOSC.EINVAL); Raise_Socket_Error (SOSC.EINVAL);
end if; end if;
Img := New_String (Image); Res := Inet_Aton (To_Chars_Ptr (Img'Unchecked_Access), Addr'Address);
Res := C_Inet_Addr (Img);
Free (Img);
if Res = Failure then if Res = Failure then
Raise_Socket_Error (SOSC.EINVAL); Raise_Socket_Error (SOSC.EINVAL);
end if; end if;
To_Inet_Addr (To_In_Addr (Res), Result); To_Inet_Addr (To_In_Addr (Addr), Result);
return Result; return Result;
end Inet_Addr; end Inet_Addr;
......
...@@ -1108,6 +1108,10 @@ package GNAT.Sockets is ...@@ -1108,6 +1108,10 @@ package GNAT.Sockets is
private private
procedure Raise_Socket_Error (Error : Integer);
-- Raise Socket_Error with an exception message describing the error code
-- from errno.
type Socket_Type is new Integer; type Socket_Type is new Integer;
No_Socket : constant Socket_Type := -1; No_Socket : constant Socket_Type := -1;
......
...@@ -115,8 +115,9 @@ package GNAT.Sockets.Thin is ...@@ -115,8 +115,9 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Inet_Addr function Inet_Aton
(Cp : C.Strings.chars_ptr) return C.int; (Cp : C.Strings.chars_ptr;
Inp : System.Address) return C.int;
function C_Ioctl function C_Ioctl
(S : C.int; (S : C.int;
...@@ -232,7 +233,7 @@ private ...@@ -232,7 +233,7 @@ private
pragma Import (Stdcall, C_Getpeername, "getpeername"); pragma Import (Stdcall, C_Getpeername, "getpeername");
pragma Import (Stdcall, C_Getsockname, "getsockname"); pragma Import (Stdcall, C_Getsockname, "getsockname");
pragma Import (Stdcall, C_Getsockopt, "getsockopt"); pragma Import (Stdcall, C_Getsockopt, "getsockopt");
pragma Import (Stdcall, C_Inet_Addr, "inet_addr"); pragma Import (Stdcall, Inet_Aton, "inet_aton");
pragma Import (Stdcall, C_Ioctl, "ioctlsocket"); pragma Import (Stdcall, C_Ioctl, "ioctlsocket");
pragma Import (Stdcall, C_Listen, "listen"); pragma Import (Stdcall, C_Listen, "listen");
pragma Import (Stdcall, C_Recv, "recv"); pragma Import (Stdcall, C_Recv, "recv");
......
...@@ -38,6 +38,8 @@ with GNAT.Task_Lock; ...@@ -38,6 +38,8 @@ with GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C; with Interfaces.C; use Interfaces.C;
with System.Address_To_Access_Conversions;
package body GNAT.Sockets.Thin is package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : aliased Fd_Set; Non_Blocking_Sockets : aliased Fd_Set;
...@@ -351,6 +353,47 @@ package body GNAT.Sockets.Thin is ...@@ -351,6 +353,47 @@ package body GNAT.Sockets.Thin is
package body Host_Error_Messages is separate; package body Host_Error_Messages is separate;
---------------
-- Inet_Aton --
---------------
-- VMS does not support inet_aton(3), so emulate it here in terms of
-- inet_addr(3).
function Inet_Aton
(Cp : C.Strings.chars_ptr;
Inp : System.Address) return C.int
is
use C.Strings;
use System;
Res : aliased C.int;
package Conv is new System.Address_To_Access_Conversions (C.int);
function C_Inet_Addr (Cp : C.Strings.chars_ptr) return C.int;
pragma Import (C, C_Inet_Addr, "DECC$INET_ADDR");
begin
if Cp = Null_Ptr or else Inp = Null_Address then
Raise_Socket_Error (SOSC.EINVAL);
end if;
-- Special case for the all-ones broadcast address: this address has the
-- same in_addr_t value as Failure, and thus cannot be properly returned
-- by inet_addr(3).
if String'(Value (Cp)) = "255.255.255.255" then
Conv.To_Pointer (Inp).all := -1;
return 0;
end if;
Res := C_Inet_Addr (Cp);
if Res = -1 then
return Res;
end if;
Conv.To_Pointer (Inp).all := Res;
return 0;
end Inet_Aton;
---------------- ----------------
-- Initialize -- -- Initialize --
---------------- ----------------
......
...@@ -118,8 +118,9 @@ package GNAT.Sockets.Thin is ...@@ -118,8 +118,9 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Inet_Addr function Inet_Aton
(Cp : C.Strings.chars_ptr) return C.int; (Cp : C.Strings.chars_ptr;
Inp : System.Address) return C.int;
function C_Ioctl function C_Ioctl
(S : C.int; (S : C.int;
...@@ -249,7 +250,6 @@ private ...@@ -249,7 +250,6 @@ private
pragma Import (C, C_Getpeername, "DECC$GETPEERNAME"); pragma Import (C, C_Getpeername, "DECC$GETPEERNAME");
pragma Import (C, C_Getsockname, "DECC$GETSOCKNAME"); pragma Import (C, C_Getsockname, "DECC$GETSOCKNAME");
pragma Import (C, C_Getsockopt, "DECC$GETSOCKOPT"); pragma Import (C, C_Getsockopt, "DECC$GETSOCKOPT");
pragma Import (C, C_Inet_Addr, "DECC$INET_ADDR");
pragma Import (C, C_Listen, "DECC$LISTEN"); pragma Import (C, C_Listen, "DECC$LISTEN");
pragma Import (C, C_Select, "DECC$SELECT"); pragma Import (C, C_Select, "DECC$SELECT");
pragma Import (C, C_Setsockopt, "DECC$SETSOCKOPT"); pragma Import (C, C_Setsockopt, "DECC$SETSOCKOPT");
......
...@@ -116,8 +116,9 @@ package GNAT.Sockets.Thin is ...@@ -116,8 +116,9 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Inet_Addr function Inet_Aton
(Cp : C.Strings.chars_ptr) return C.int; (Cp : C.Strings.chars_ptr;
Inp : System.Address) return C.int;
function C_Ioctl function C_Ioctl
(S : C.int; (S : C.int;
...@@ -226,7 +227,7 @@ private ...@@ -226,7 +227,7 @@ private
pragma Import (C, C_Getpeername, "getpeername"); pragma Import (C, C_Getpeername, "getpeername");
pragma Import (C, C_Getsockname, "getsockname"); pragma Import (C, C_Getsockname, "getsockname");
pragma Import (C, C_Getsockopt, "getsockopt"); pragma Import (C, C_Getsockopt, "getsockopt");
pragma Import (C, C_Inet_Addr, "inet_addr"); pragma Import (C, Inet_Aton, "inet_aton");
pragma Import (C, C_Listen, "listen"); pragma Import (C, C_Listen, "listen");
pragma Import (C, C_Readv, "readv"); pragma Import (C, C_Readv, "readv");
pragma Import (C, C_Select, "select"); pragma Import (C, C_Select, "select");
......
...@@ -117,8 +117,9 @@ package GNAT.Sockets.Thin is ...@@ -117,8 +117,9 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Inet_Addr function Inet_Aton
(Cp : C.Strings.chars_ptr) return C.int; (Cp : C.Strings.chars_ptr;
Inp : System.Address) return C.int;
function C_Ioctl function C_Ioctl
(S : C.int; (S : C.int;
...@@ -251,7 +252,7 @@ private ...@@ -251,7 +252,7 @@ private
pragma Import (C, C_Getpeername, "getpeername"); pragma Import (C, C_Getpeername, "getpeername");
pragma Import (C, C_Getsockname, "getsockname"); pragma Import (C, C_Getsockname, "getsockname");
pragma Import (C, C_Getsockopt, "getsockopt"); pragma Import (C, C_Getsockopt, "getsockopt");
pragma Import (C, C_Inet_Addr, "inet_addr"); pragma Import (C, Inet_Aton, "inet_aton");
pragma Import (C, C_Listen, "listen"); pragma Import (C, C_Listen, "listen");
pragma Import (C, C_Readv, "readv"); pragma Import (C, C_Readv, "readv");
pragma Import (C, C_Select, "select"); pragma Import (C, C_Select, "select");
......
...@@ -10478,7 +10478,7 @@ On a typical 32-bit architecture, the X component will be four bytes, and ...@@ -10478,7 +10478,7 @@ On a typical 32-bit architecture, the X component will be four bytes, and
require four-byte alignment, and the Y component will be one byte. In this require four-byte alignment, and the Y component will be one byte. In this
case @code{R'Value_Size} will be 40 (bits) since this is the minimum size case @code{R'Value_Size} will be 40 (bits) since this is the minimum size
required to store a value of this type, and for example, it is permissible required to store a value of this type, and for example, it is permissible
to have a component of type R in an outer record whose component size is to have a component of type R in an outer array whose component size is
specified to be 48 bits. However, @code{R'Object_Size} will be 64 (bits), specified to be 48 bits. However, @code{R'Object_Size} will be 64 (bits),
since it must be rounded up so that this value is a multiple of the since it must be rounded up so that this value is a multiple of the
alignment (4 bytes = 32 bits). alignment (4 bytes = 32 bits).
......
...@@ -1510,9 +1510,9 @@ package body Sem_Ch7 is ...@@ -1510,9 +1510,9 @@ package body Sem_Ch7 is
Next_Elmt (Op_Elmt_2); Next_Elmt (Op_Elmt_2);
end loop; end loop;
-- Case 2: We have not found any explicit overriding and -- Case 2: We have not found any explicit overriding and
-- hence we need to declare the operation (i.e., make it -- hence we need to declare the operation (i.e., make it
-- visible). -- visible).
Derive_Subprogram (New_Op, Alias (Prim_Op), E, Etype (E)); Derive_Subprogram (New_Op, Alias (Prim_Op), E, Etype (E));
...@@ -1555,8 +1555,8 @@ package body Sem_Ch7 is ...@@ -1555,8 +1555,8 @@ package body Sem_Ch7 is
end if; end if;
else else
-- Non-tagged type, scan forward to locate inherited hidden -- Non-tagged type, scan forward to locate inherited hidden
-- operations. -- operations.
Prim_Op := Next_Entity (E); Prim_Op := Next_Entity (E);
while Present (Prim_Op) loop while Present (Prim_Op) loop
...@@ -2296,7 +2296,7 @@ package body Sem_Ch7 is ...@@ -2296,7 +2296,7 @@ package body Sem_Ch7 is
and then No (Full_View (Id)) and then No (Full_View (Id))
then then
-- Mark Taft amendment types. Verify that there are no primitive -- Mark Taft amendment types. Verify that there are no primitive
-- operations declared for the type (3.10.1 (9)). -- operations declared for the type (3.10.1(9)).
Set_Has_Completion_In_Body (Id); Set_Has_Completion_In_Body (Id);
......
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