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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-09-18 Olivier Hainque <hain...@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.--- gcc/ada/libgnat/s-win32.ads
+++ gcc/ada/libgnat/s-win32.ads
@@ -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 BOOL is new Interfaces.C.int;
+ 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;
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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/system_info1.adb
@@ -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;
\ No newline at end of file
