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

[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:
Olivier Hainque 2019-09-18 08:31:56 +00:00 committed by Pierre-Marie de Rodat
parent 6f934861c1
commit 600db6ca89
4 changed files with 43 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -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

19
gcc/ada/libgnat/s-win32.ads
View File

@ -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;

4
gcc/testsuite/ChangeLog
View File

@ -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

23
gcc/testsuite/gnat.dg/system_info1.adb Normal file
View File

@ -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;