[Ada] Fix 32/64bit mistake on SYSTEM_INFO component in s-win32
The dwActiveProcessorMask field in a SYSTEM_INFO structure on Windows should be DWORD_PTR, an integer the size of a pointer. In s-win32, it is currently declared as DWORD. This happens to work on 32bit hosts and is wrong on 64bit hosts, causing mishaps in accesses to this component and all the following ones. The proposed correction adds a definition for DWORD_PTR and uses it for dwActiveProcessorMask in System.Win32.SYSTEM_INFO. 2019-09-18 Olivier Hainque <hainque@adacore.com> gcc/ada/ * libgnat/s-win32.ads (DWORD_PTR): New type, pointer size unsigned int. (SYSTEM_INFO): Use it for dwActiveProcessorMask. gcc/testsuite/ * gnat.dg/system_info1.adb: New testcase. From-SVN: r275843
This commit is contained in:
parent
6f934861c1
commit
600db6ca89
|
@ -1,3 +1,9 @@
|
|||
2019-09-18 Olivier Hainque <hainque@adacore.com>
|
||||
|
||||
* libgnat/s-win32.ads (DWORD_PTR): New type, pointer size
|
||||
unsigned int.
|
||||
(SYSTEM_INFO): Use it for dwActiveProcessorMask.
|
||||
|
||||
2019-09-18 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* doc/gnat_rm/implementation_defined_pragmas.rst: Improve doc on
|
||||
|
|
|
@ -57,15 +57,16 @@ package System.Win32 is
|
|||
INVALID_HANDLE_VALUE : constant HANDLE := -1;
|
||||
INVALID_FILE_SIZE : constant := 16#FFFFFFFF#;
|
||||
|
||||
type ULONG is new Interfaces.C.unsigned_long;
|
||||
type DWORD is new Interfaces.C.unsigned_long;
|
||||
type WORD is new Interfaces.C.unsigned_short;
|
||||
type BYTE is new Interfaces.C.unsigned_char;
|
||||
type LONG is new Interfaces.C.long;
|
||||
type CHAR is new Interfaces.C.char;
|
||||
type SIZE_T is new Interfaces.C.size_t;
|
||||
type ULONG is new Interfaces.C.unsigned_long;
|
||||
type DWORD is new Interfaces.C.unsigned_long;
|
||||
type WORD is new Interfaces.C.unsigned_short;
|
||||
type BYTE is new Interfaces.C.unsigned_char;
|
||||
type LONG is new Interfaces.C.long;
|
||||
type CHAR is new Interfaces.C.char;
|
||||
type SIZE_T is new Interfaces.C.size_t;
|
||||
type DWORD_PTR is mod 2 ** Standard'Address_Size;
|
||||
|
||||
type BOOL is new Interfaces.C.int;
|
||||
type BOOL is new Interfaces.C.int;
|
||||
for BOOL'Size use Interfaces.C.int'Size;
|
||||
|
||||
type Bits1 is range 0 .. 2 ** 1 - 1;
|
||||
|
@ -265,7 +266,7 @@ package System.Win32 is
|
|||
dwPageSize : DWORD;
|
||||
lpMinimumApplicationAddress : PVOID;
|
||||
lpMaximumApplicationAddress : PVOID;
|
||||
dwActiveProcessorMask : DWORD;
|
||||
dwActiveProcessorMask : DWORD_PTR;
|
||||
dwNumberOfProcessors : DWORD;
|
||||
dwProcessorType : DWORD;
|
||||
dwAllocationGranularity : DWORD;
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2019-09-18 Olivier Hainque <hainque@adacore.com>
|
||||
|
||||
* gnat.dg/system_info1.adb: New testcase.
|
||||
|
||||
2019-09-18 Bob Duff <duff@adacore.com>
|
||||
|
||||
* gnat.dg/containers1.adb, gnat.dg/containers1.ads: New
|
||||
|
|
|
@ -0,0 +1,23 @@
|
|||
-- { dg-do run }
|
||||
|
||||
with System.Multiprocessors;
|
||||
with System.Task_Info;
|
||||
|
||||
procedure System_Info1 is
|
||||
Ncpus : constant System.Multiprocessors.CPU :=
|
||||
System.Multiprocessors.Number_Of_CPUS;
|
||||
Nprocs : constant Integer :=
|
||||
System.Task_Info.Number_Of_Processors;
|
||||
|
||||
use type System.Multiprocessors.CPU;
|
||||
begin
|
||||
if Nprocs <= 0 or else Nprocs > 1024 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
if Ncpus <= 0 or else Ncpus > 1024 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
if Nprocs /= Integer (Ncpus) then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
end;
|
Loading…
Reference in New Issue