aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorOlivier Hainque <hainque@adacore.com>2019-09-18 08:31:56 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-09-18 08:31:56 +0000
commit600db6ca89bc1f93d9f6f72c629e1c5d5c176068 (patch)
tree8a406b36529cc4fc49603e29d850cb18e1e17b8b
parent6f934861c1eb93234e63483e04975bf0cd612da7 (diff)
downloadgcc-600db6ca89bc1f93d9f6f72c629e1c5d5c176068.zip
gcc-600db6ca89bc1f93d9f6f72c629e1c5d5c176068.tar.gz
gcc-600db6ca89bc1f93d9f6f72c629e1c5d5c176068.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/libgnat/s-win32.ads21
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/system_info1.adb23
4 files changed, 44 insertions, 10 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 77089cc..02628c9 100644
--- 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 ab832cd..853cef0 100644
--- 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 5e143b57..1db62e2 100644
--- 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
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