[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 77089ccf1f79e25db8229062e06380dde5d88381..02628c9a154fde0d2b10ef0cb889278d97df3d7d 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/libgnat/s-win32.ads b/gcc/ada/libgnat/s-win32.ads
index ab832cdf89cda253d72b3b20f4fb7816395dba72..853cef0ace000c6412101e288674ce8f44ef0f8b 100644 (file)
--- a/gcc/ada/libgnat/s-win32.ads
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5e143b57456799b1c23bf29a734cd1e6701308d4..1db62e260977f4a54b7b9abca3eba872e0353a00 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gnat.dg/system_info1.adb b/gcc/testsuite/gnat.dg/system_info1.adb
new file mode 100644 (file)
index 0000000..493a18e
--- /dev/null
+++ b/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