diff options
Diffstat (limited to 'gcc/ada/g-socthi-mingw.adb')
| -rw-r--r-- | gcc/ada/g-socthi-mingw.adb | 105 |
1 files changed, 49 insertions, 56 deletions
diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index 1b74d907670..a99db4bb0a0 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, AdaCore -- +-- Copyright (C) 2001-2007, 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- -- @@ -37,10 +37,8 @@ -- This version is for NT -with GNAT.Sockets.Constants; use GNAT.Sockets.Constants; -with Interfaces.C.Strings; use Interfaces.C.Strings; - -with System; use System; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with System; use System; package body GNAT.Sockets.Thin is @@ -51,11 +49,6 @@ package body GNAT.Sockets.Thin is WS_Version : constant := 16#0202#; Initialized : Boolean := False; - SYSNOTREADY : constant := 10091; - VERNOTSUPPORTED : constant := 10092; - NOTINITIALISED : constant := 10093; - EDISCON : constant := 10101; - function Standard_Connect (S : C.int; Name : System.Address; @@ -108,10 +101,10 @@ package body GNAT.Sockets.Thin is N_ENAMETOOLONG, N_EHOSTDOWN, N_EHOSTUNREACH, - N_SYSNOTREADY, - N_VERNOTSUPPORTED, - N_NOTINITIALISED, - N_EDISCON, + N_WSASYSNOTREADY, + N_WSAVERNOTSUPPORTED, + N_WSANOTINITIALISED, + N_WSAEDISCON, N_HOST_NOT_FOUND, N_TRY_AGAIN, N_NO_RECOVERY, @@ -199,20 +192,20 @@ package body GNAT.Sockets.Thin is New_String ("Host is down"), N_EHOSTUNREACH => New_String ("No route to host"), - N_SYSNOTREADY => + N_WSASYSNOTREADY => New_String ("Returned by WSAStartup(), indicating that " & "the network subsystem is unusable"), - N_VERNOTSUPPORTED => + N_WSAVERNOTSUPPORTED => New_String ("Returned by WSAStartup(), indicating that " & "the Windows Sockets DLL cannot support " & "this application"), - N_NOTINITIALISED => + N_WSANOTINITIALISED => New_String ("Winsock not initialized. This message is " & "returned by any function except WSAStartup(), " & "indicating that a successful WSAStartup() has " & "not yet been performed"), - N_EDISCON => - New_String ("Disconnect"), + N_WSAEDISCON => + New_String ("Disconnected"), N_HOST_NOT_FOUND => New_String ("Host not found. This message indicates " & "that the key (name, address, and so on) was not found"), @@ -245,8 +238,8 @@ package body GNAT.Sockets.Thin is Res := Standard_Connect (S, Name, Namelen); if Res = -1 then - if Socket_Errno = EWOULDBLOCK then - Set_Socket_Errno (EINPROGRESS); + if Socket_Errno = Constants.EWOULDBLOCK then + Set_Socket_Errno (Constants.EINPROGRESS); end if; end if; @@ -347,7 +340,7 @@ package body GNAT.Sockets.Thin is if EFS /= No_Fd_Set then declare EFSC : constant Fd_Set_Access := New_Socket_Set (EFS); - Flag : constant C.int := MSG_PEEK + MSG_OOB; + Flag : constant C.int := Constants.MSG_PEEK + Constants.MSG_OOB; Buffer : Character; Length : C.int; Fromlen : aliased C.int; @@ -404,31 +397,6 @@ 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 -- -------------- @@ -474,19 +442,34 @@ package body GNAT.Sockets.Thin is end if; end Finalize; + ------------------------- + -- Host_Error_Messages -- + ------------------------- + + package body Host_Error_Messages is + + -- On Windows, socket and host errors share the same code space, and + -- error messages are provided by Socket_Error_Message. The default + -- separate body for Host_Error_Messages is therefore not used in + -- this case. + + function Host_Error_Message + (H_Errno : Integer) return C.Strings.chars_ptr + renames Socket_Error_Message; + + end Host_Error_Messages; + ---------------- -- Initialize -- ---------------- - procedure Initialize (Process_Blocking_IO : Boolean) is - pragma Unreferenced (Process_Blocking_IO); - + procedure Initialize is + use type Interfaces.C.int; Return_Value : Interfaces.C.int; - begin if not Initialized then Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address); - pragma Assert (Interfaces.C."=" (Return_Value, 0)); + pragma Assert (Return_Value = 0); Initialized := True; end if; end Initialize; @@ -555,6 +538,7 @@ package body GNAT.Sockets.Thin is function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr is + use GNAT.Sockets.Constants; begin case Errno is when EINTR => return Error_Messages (N_EINTR); @@ -594,14 +578,23 @@ package body GNAT.Sockets.Thin is when ENAMETOOLONG => return Error_Messages (N_ENAMETOOLONG); when EHOSTDOWN => return Error_Messages (N_EHOSTDOWN); when EHOSTUNREACH => return Error_Messages (N_EHOSTUNREACH); - when SYSNOTREADY => return Error_Messages (N_SYSNOTREADY); - when VERNOTSUPPORTED => return Error_Messages (N_VERNOTSUPPORTED); - when NOTINITIALISED => return Error_Messages (N_NOTINITIALISED); - when EDISCON => return Error_Messages (N_EDISCON); + + -- Windows-specific error codes + + when WSASYSNOTREADY => return Error_Messages (N_WSASYSNOTREADY); + when WSAVERNOTSUPPORTED => + return Error_Messages (N_WSAVERNOTSUPPORTED); + when WSANOTINITIALISED => + return Error_Messages (N_WSANOTINITIALISED); + when WSAEDISCON => return Error_Messages (N_WSAEDISCON); + + -- h_errno values + when HOST_NOT_FOUND => return Error_Messages (N_HOST_NOT_FOUND); when TRY_AGAIN => return Error_Messages (N_TRY_AGAIN); when NO_RECOVERY => return Error_Messages (N_NO_RECOVERY); when NO_DATA => return Error_Messages (N_NO_DATA); + when others => return Error_Messages (N_OTHERS); end case; end Socket_Error_Message; |