From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 100231 invoked by alias); 18 Sep 2019 08:39:47 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 100204 invoked by uid 89); 18 Sep 2019 08:39:47 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.4 required=5.0 tests=BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_NUMSUBJECT,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.1 spammy= X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 18 Sep 2019 08:39:46 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id C67EE117C8B; Wed, 18 Sep 2019 04:39:44 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id iz4Ykn3yw-qC; Wed, 18 Sep 2019 04:39:44 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id B4A8A117BD9; Wed, 18 Sep 2019 04:39:44 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id B1C4C702; Wed, 18 Sep 2019 04:39:44 -0400 (EDT) Date: Wed, 18 Sep 2019 08:40:00 -0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Olivier Hainque Subject: [Ada] Fix 32/64bit mistake on SYSTEM_INFO component in s-win32 Message-ID: <20190918083944.GA145030@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="2oS5YaxWCcQjTEyO" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes X-SW-Source: 2019-09/txt/msg01070.txt.bz2 --2oS5YaxWCcQjTEyO Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 733 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 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. --2oS5YaxWCcQjTEyO Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" Content-length: 2239 --- 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 --2oS5YaxWCcQjTEyO--