diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-30 15:21:46 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-30 15:21:46 +0000 |
| commit | 1094a5ca9023daee0ba99e838c4b718610774080 (patch) | |
| tree | 84b44adda5548733a0ba71ebd9458374b667579b /gcc/ada/g-socket.adb | |
| parent | 50b3164db09945691ae3893177f827c1839e639b (diff) | |
| download | gcc-1094a5ca9023daee0ba99e838c4b718610774080.tar.gz | |
2012-07-30 Robert Dewar <dewar@adacore.com>
* bindusg.adb: Clarify file in -A lines.
2012-07-30 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor reformatting.
2012-07-30 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb, makeutl.adb, makeutl.ads: Minor code reorganization.
2012-07-30 Vincent Pucci <pucci@adacore.com>
* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): Minor
reformatting.
* sem_ch9.adb (Allows_Lock_Free_Implementation): Minor reformatting.
Capture the correct error message in case of a quantified expression.
2012-07-30 Thomas Quinot <quinot@adacore.com>
* g-socket.adb (Get_Socket_Option, Set_Socket_Option): On Windows, the
value is a milliseconds count in a DWORD, not a struct timeval.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189979 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/g-socket.adb')
| -rw-r--r-- | gcc/ada/g-socket.adb | 70 |
1 files changed, 63 insertions, 7 deletions
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index d48065a23f5..d84c28f0732 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2011, AdaCore -- +-- Copyright (C) 2001-2012, 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- -- @@ -1112,6 +1112,7 @@ package body GNAT.Sockets is Level : Level_Type := Socket_Level; Name : Option_Name) return Option_Type is + use SOSC; use type C.unsigned_char; V8 : aliased Two_Ints; @@ -1144,8 +1145,22 @@ package body GNAT.Sockets is when Send_Timeout | Receive_Timeout => - Len := VT'Size / 8; - Add := VT'Address; + + -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a + -- struct timeval, but on Windows it is a milliseconds count in + -- a DWORD. + + pragma Warnings (Off); + if Target_OS = Windows then + pragma Warnings (On); + + Len := V4'Size / 8; + Add := V4'Address; + + else + Len := VT'Size / 8; + Add := VT'Address; + end if; when Linger | Add_Membership | @@ -1201,7 +1216,23 @@ package body GNAT.Sockets is when Send_Timeout | Receive_Timeout => - Opt.Timeout := To_Duration (VT); + + pragma Warnings (Off); + if Target_OS = Windows then + pragma Warnings (On); + + -- Timeout is in milliseconds, actual value is 500 ms + + -- returned value (unless it is 0). + + if V4 = 0 then + Opt.Timeout := 0.0; + else + Opt.Timeout := Natural (V4) * 0.001 + 0.500; + end if; + + else + Opt.Timeout := To_Duration (VT); + end if; end case; return Opt; @@ -2176,6 +2207,8 @@ package body GNAT.Sockets is Level : Level_Type := Socket_Level; Option : Option_Type) is + use SOSC; + V8 : aliased Two_Ints; V4 : aliased C.int; V1 : aliased C.unsigned_char; @@ -2236,9 +2269,32 @@ package body GNAT.Sockets is when Send_Timeout | Receive_Timeout => - VT := To_Timeval (Option.Timeout); - Len := VT'Size / 8; - Add := VT'Address; + + pragma Warnings (Off); + if Target_OS = Windows then + pragma Warnings (On); + + -- On Windows, the timeout is a DWORD in milliseconds, and + -- the actual timeout is 500 ms + the given value (unless it + -- is 0). + + V4 := C.int (Option.Timeout / 0.001); + + if V4 > 500 then + V4 := V4 - 500; + + elsif V4 > 0 then + V4 := 1; + end if; + + Len := V4'Size / 8; + Add := V4'Address; + + else + VT := To_Timeval (Option.Timeout); + Len := VT'Size / 8; + Add := VT'Address; + end if; end case; |