Commit 3a13e785 by Thomas Quinot Committed by Arnaud Charlet

socket.c: Fix wrong condition in #ifdef

2010-06-14  Thomas Quinot  <quinot@adacore.com>

	* socket.c: Fix wrong condition in #ifdef
	* g-socket.adb, g-sothco.ads: Functions imported from socket.c that
	take or return char* values can't use Interfaces.C.Strings.chars_ptr,
	because on VMS this type is a 32-bit pointer which is not compatible
	with the default for C pointers for code compiled with gcc on that
	platform.

From-SVN: r160735
parent 001c7783
2010-06-14 Thomas Quinot <quinot@adacore.com>
* socket.c: Fix wrong condition in #ifdef
* g-socket.adb, g-sothco.ads: Functions imported from socket.c that
take or return char* values can't use Interfaces.C.Strings.chars_ptr,
because on VMS this type is a 32-bit pointer which is not compatible
with the default for C pointers for code compiled with gcc on that
platform.
2010-06-14 Ed Schonberg <schonberg@adacore.com> 2010-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_util (Is_VMS_Operator): New predicate to determine whether an * sem_util (Is_VMS_Operator): New predicate to determine whether an
......
...@@ -175,6 +175,10 @@ package body GNAT.Sockets is ...@@ -175,6 +175,10 @@ package body GNAT.Sockets is
function To_Service_Entry (E : Servent_Access) return Service_Entry_Type; function To_Service_Entry (E : Servent_Access) return Service_Entry_Type;
-- Conversion function -- Conversion function
function Value (S : System.Address) return String;
-- Same as Interfaces.C.Strings.Value but taking a System.Address (on VMS,
-- chars_ptr is a 32-bit pointer, and here we need a 64-bit version).
function To_Timeval (Val : Timeval_Duration) return Timeval; function To_Timeval (Val : Timeval_Duration) return Timeval;
-- Separate Val in seconds and microseconds -- Separate Val in seconds and microseconds
...@@ -1318,7 +1322,6 @@ package body GNAT.Sockets is ...@@ -1318,7 +1322,6 @@ package body GNAT.Sockets is
use Interfaces.C.Strings; use Interfaces.C.Strings;
Img : aliased char_array := To_C (Image); Img : aliased char_array := To_C (Image);
Cp : constant chars_ptr := To_Chars_Ptr (Img'Unchecked_Access);
Addr : aliased C.int; Addr : aliased C.int;
Res : C.int; Res : C.int;
Result : Inet_Addr_Type; Result : Inet_Addr_Type;
...@@ -1331,7 +1334,7 @@ package body GNAT.Sockets is ...@@ -1331,7 +1334,7 @@ package body GNAT.Sockets is
Raise_Socket_Error (SOSC.EINVAL); Raise_Socket_Error (SOSC.EINVAL);
end if; end if;
Res := Inet_Pton (SOSC.AF_INET, Cp, Addr'Address); Res := Inet_Pton (SOSC.AF_INET, Img'Address, Addr'Address);
if Res < 0 then if Res < 0 then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
...@@ -2342,12 +2345,12 @@ package body GNAT.Sockets is ...@@ -2342,12 +2345,12 @@ package body GNAT.Sockets is
begin begin
Aliases_Count := 0; Aliases_Count := 0;
while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
Aliases_Count := Aliases_Count + 1; Aliases_Count := Aliases_Count + 1;
end loop; end loop;
Addresses_Count := 0; Addresses_Count := 0;
while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Ptr loop while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Address loop
Addresses_Count := Addresses_Count + 1; Addresses_Count := Addresses_Count + 1;
end loop; end loop;
...@@ -2366,11 +2369,8 @@ package body GNAT.Sockets is ...@@ -2366,11 +2369,8 @@ package body GNAT.Sockets is
for J in Result.Addresses'Range loop for J in Result.Addresses'Range loop
declare declare
Addr : In_Addr; Addr : In_Addr;
function To_Address is
new Ada.Unchecked_Conversion (chars_ptr, System.Address);
for Addr'Address use for Addr'Address use
To_Address (Hostent_H_Addr Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
(E, C.int (J - Result.Addresses'First)));
pragma Import (Ada, Addr); pragma Import (Ada, Addr);
begin begin
To_Inet_Addr (Addr, Result.Addresses (J)); To_Inet_Addr (Addr, Result.Addresses (J));
...@@ -2457,7 +2457,7 @@ package body GNAT.Sockets is ...@@ -2457,7 +2457,7 @@ package body GNAT.Sockets is
begin begin
Aliases_Count := 0; Aliases_Count := 0;
while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
Aliases_Count := Aliases_Count + 1; Aliases_Count := Aliases_Count + 1;
end loop; end loop;
...@@ -2511,6 +2511,25 @@ package body GNAT.Sockets is ...@@ -2511,6 +2511,25 @@ package body GNAT.Sockets is
end To_Timeval; end To_Timeval;
----------- -----------
-- Value --
-----------
function Value (S : System.Address) return String is
Str : String (1 .. Positive'Last);
for Str'Address use S;
pragma Import (Ada, Str);
Terminator : Positive := Str'First;
begin
while Str (Terminator) /= ASCII.NUL loop
Terminator := Terminator + 1;
end loop;
return Str (1 .. Terminator - 1);
end Value;
-----------
-- Write -- -- Write --
----------- -----------
......
...@@ -38,7 +38,6 @@ with Ada.Unchecked_Conversion; ...@@ -38,7 +38,6 @@ with Ada.Unchecked_Conversion;
with Interfaces.C; with Interfaces.C;
with Interfaces.C.Pointers; with Interfaces.C.Pointers;
with Interfaces.C.Strings;
package GNAT.Sockets.Thin_Common is package GNAT.Sockets.Thin_Common is
...@@ -215,11 +214,16 @@ package GNAT.Sockets.Thin_Common is ...@@ -215,11 +214,16 @@ package GNAT.Sockets.Thin_Common is
pragma Convention (C, Hostent_Access); pragma Convention (C, Hostent_Access);
-- Access to host entry -- Access to host entry
-- Note: the hostent and servent accessors that return char*
-- values are compiled with GCC, and on VMS they always return
-- 64-bit pointers, so we can't use C.Strings.chars_ptr, which
-- on VMS is 32 bits.
function Hostent_H_Name function Hostent_H_Name
(E : Hostent_Access) return C.Strings.chars_ptr; (E : Hostent_Access) return System.Address;
function Hostent_H_Alias function Hostent_H_Alias
(E : Hostent_Access; I : C.int) return C.Strings.chars_ptr; (E : Hostent_Access; I : C.int) return System.Address;
function Hostent_H_Addrtype function Hostent_H_Addrtype
(E : Hostent_Access) return C.int; (E : Hostent_Access) return C.int;
...@@ -228,7 +232,7 @@ package GNAT.Sockets.Thin_Common is ...@@ -228,7 +232,7 @@ package GNAT.Sockets.Thin_Common is
(E : Hostent_Access) return C.int; (E : Hostent_Access) return C.int;
function Hostent_H_Addr function Hostent_H_Addr
(E : Hostent_Access; Index : C.int) return C.Strings.chars_ptr; (E : Hostent_Access; Index : C.int) return System.Address;
--------------------- ---------------------
-- Service entries -- -- Service entries --
...@@ -246,16 +250,16 @@ package GNAT.Sockets.Thin_Common is ...@@ -246,16 +250,16 @@ package GNAT.Sockets.Thin_Common is
-- Access to service entry -- Access to service entry
function Servent_S_Name function Servent_S_Name
(E : Servent_Access) return C.Strings.chars_ptr; (E : Servent_Access) return System.Address;
function Servent_S_Alias function Servent_S_Alias
(E : Servent_Access; Index : C.int) return C.Strings.chars_ptr; (E : Servent_Access; Index : C.int) return System.Address;
function Servent_S_Port function Servent_S_Port
(E : Servent_Access) return C.unsigned_short; (E : Servent_Access) return C.unsigned_short;
function Servent_S_Proto function Servent_S_Proto
(E : Servent_Access) return C.Strings.chars_ptr; (E : Servent_Access) return System.Address;
------------------ ------------------
-- NetDB access -- -- NetDB access --
...@@ -378,7 +382,7 @@ package GNAT.Sockets.Thin_Common is ...@@ -378,7 +382,7 @@ package GNAT.Sockets.Thin_Common is
function Inet_Pton function Inet_Pton
(Af : C.int; (Af : C.int;
Cp : C.Strings.chars_ptr; Cp : System.Address;
Inp : System.Address) return C.int; Inp : System.Address) return C.int;
function C_Ioctl function C_Ioctl
......
...@@ -50,21 +50,7 @@ ...@@ -50,21 +50,7 @@
*/ */
typedef char *__netdb_char_ptr __attribute__ (( mode (SI) )); typedef char *__netdb_char_ptr __attribute__ (( mode (SI) ));
typedef __netdb_char_ptr *__netdb_char_ptr_ptr __attribute__ (( mode (SI) )); typedef __netdb_char_ptr *__netdb_char_ptr_ptr __attribute__ (( mode (SI) ));
# define NEED_STRUCT_xxxENT
#elif defined (__vxworks)
/*
* For VxWorks we emulate getXXXbyYYY using the proprietary VxWorks API.
*/
typedef char *__netdb_char_ptr;
typedef __netdb_char_ptr *__netdb_char_ptr_ptr;
# define NEED_STRUCT_xxxENT
#else
# undef NEED_STRUCT_xxxENT
#endif
#ifdef NEED_STRUCT_xxxENT
struct hostent { struct hostent {
__netdb_char_ptr h_name; __netdb_char_ptr h_name;
__netdb_char_ptr_ptr h_aliases; __netdb_char_ptr_ptr h_aliases;
...@@ -125,7 +111,7 @@ extern int __gnat_hostent_h_addrtype (struct hostent *); ...@@ -125,7 +111,7 @@ extern int __gnat_hostent_h_addrtype (struct hostent *);
extern int __gnat_hostent_h_length (struct hostent *); extern int __gnat_hostent_h_length (struct hostent *);
extern char * __gnat_hostent_h_addr (struct hostent *, int); extern char * __gnat_hostent_h_addr (struct hostent *, int);
#if defined (__vxworks) || defined (_WIN32) #ifndef HAVE_INET_PTON
extern int __gnat_inet_pton (int, const char *, void *); extern int __gnat_inet_pton (int, const char *, void *);
#endif #endif
......
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