OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Thomas Quinot 2010-06-14 12:56:35 +00:00 committed by Arnaud Charlet
parent 001c7783c4
commit 3a13e78582
4 changed files with 50 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/ada/ChangeLog
View File

@ -1,3 +1,12 @@
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>
* sem_util (Is_VMS_Operator): New predicate to determine whether an

37
gcc/ada/g-socket.adb
View File

@ -175,6 +175,10 @@ package body GNAT.Sockets is
function To_Service_Entry (E : Servent_Access) return Service_Entry_Type;
-- 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;
-- Separate Val in seconds and microseconds
@ -1318,7 +1322,6 @@ package body GNAT.Sockets is
use Interfaces.C.Strings;
Img : aliased char_array := To_C (Image);
Cp : constant chars_ptr := To_Chars_Ptr (Img'Unchecked_Access);
Addr : aliased C.int;
Res : C.int;
Result : Inet_Addr_Type;
@ -1331,7 +1334,7 @@ package body GNAT.Sockets is
Raise_Socket_Error (SOSC.EINVAL);
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
Raise_Socket_Error (Socket_Errno);
@ -2342,12 +2345,12 @@ package body GNAT.Sockets is
begin
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;
end loop;
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;
end loop;
@ -2366,11 +2369,8 @@ package body GNAT.Sockets is
for J in Result.Addresses'Range loop
declare
Addr : In_Addr;
function To_Address is
new Ada.Unchecked_Conversion (chars_ptr, System.Address);
for Addr'Address use
To_Address (Hostent_H_Addr
(E, C.int (J - Result.Addresses'First)));
Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
pragma Import (Ada, Addr);
begin
To_Inet_Addr (Addr, Result.Addresses (J));
@ -2457,7 +2457,7 @@ package body GNAT.Sockets is
begin
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;
end loop;
@ -2510,6 +2510,25 @@ package body GNAT.Sockets is
return (S, uS);
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 --
-----------

20
gcc/ada/g-sothco.ads
View File

@ -38,7 +38,6 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
with Interfaces.C.Pointers;
with Interfaces.C.Strings;
package GNAT.Sockets.Thin_Common is
@ -215,11 +214,16 @@ package GNAT.Sockets.Thin_Common is
pragma Convention (C, Hostent_Access);
-- 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
(E : Hostent_Access) return C.Strings.chars_ptr;
(E : Hostent_Access) return System.Address;
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
(E : Hostent_Access) return C.int;
@ -228,7 +232,7 @@ package GNAT.Sockets.Thin_Common is
(E : Hostent_Access) return C.int;
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 --
@ -246,16 +250,16 @@ package GNAT.Sockets.Thin_Common is
-- Access to service entry
function Servent_S_Name
(E : Servent_Access) return C.Strings.chars_ptr;
(E : Servent_Access) return System.Address;
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
(E : Servent_Access) return C.unsigned_short;
function Servent_S_Proto
(E : Servent_Access) return C.Strings.chars_ptr;
(E : Servent_Access) return System.Address;
------------------
-- NetDB access --
@ -378,7 +382,7 @@ package GNAT.Sockets.Thin_Common is
function Inet_Pton
(Af : C.int;
Cp : C.Strings.chars_ptr;
Cp : System.Address;
Inp : System.Address) return C.int;
function C_Ioctl

16
gcc/ada/socket.c
View File

@ -50,21 +50,7 @@
*/
typedef char *__netdb_char_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 {
__netdb_char_ptr h_name;
__netdb_char_ptr_ptr h_aliases;
@ -125,7 +111,7 @@ extern int __gnat_hostent_h_addrtype (struct hostent *);
extern int __gnat_hostent_h_length (struct hostent *);
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 *);
#endif