From patchwork Mon Sep 15 13:01:07 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120257 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 953AD385DC05 for ; Mon, 15 Sep 2025 13:04:33 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 953AD385DC05 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=eIgatmMN X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42a.google.com (mail-wr1-x42a.google.com [IPv6:2a00:1450:4864:20::42a]) by sourceware.org (Postfix) with ESMTPS id 4C5A3385694A for ; Mon, 15 Sep 2025 13:01:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4C5A3385694A Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 4C5A3385694A Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941312; cv=none; b=H6J/8u2EOBIv6dyhqOeVfDqYG+cQ37yYOYwpO2JqjUGMGi2XCtXvQhY+Aeg2mLhpnZZWjZ9tZfbc2iHiPA6gqWO+JNMAh+IXpqWFB3gHLvLyrgJKeyfwegJFQsInVCGXwp4WEkcL1ADnA2hASJr/l5FqBK2ICf7YIoCQUMad5Dc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941312; c=relaxed/simple; bh=UMGtKhfvgC1zp3OJHnd3gTAYM1iZaoEwjfeirCRa8/U=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Pp3mzf0icm9lW6weh40RwLxI/Ae66584SCx3A6elORbmR4Qy5q+1vEtU7fn+RccYNvPxaYNYYWlU66/W2X+inbpCeU1a0JBl8ifyVrQaduxTP/7WnwsViYdp3dNVXkAGLoIqR33yEr3JySUtnrDHCVuR9oJwFb79RiQXKAhj9S8= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 4C5A3385694A Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-3df15fdf0caso3357103f8f.0 for ; Mon, 15 Sep 2025 06:01:52 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941311; x=1758546111; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=98WFmgC1ISghQN+aNIrIGW2rvoJTmAPmmctVuySZKJM=; b=eIgatmMNLcwa5YJXTOWRTmG9wI0qO6E9xVi8M2sNEZf2uSDL67DbRsMebpVnU/oasS 60CG6ozLUfehdh2UBb4O9CZwW61ba1p5oEAexxUUNlQ+ySnEuMJXM2gzO5zsRs/JKw88 d4jEU3tfkcRiV/tYu2PmaJy3Q06Qa9z03L7214XfdpMbzXrs9T/ELj9HVJ+P9mU5kv/O 5mgUg6df7SRsVE4RnPYkG7ZiSJYwcEzOhqfxpoZY2N+F+vAQXJl8+9t7UvbtrqhDmyQJ TOXuYoTWQmv/+g8yvBseD7eQMJpc2PGBKRJqZkCFKBt783in+MVlj3J+t1/zVFPqPNUg d8RA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941311; x=1758546111; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=98WFmgC1ISghQN+aNIrIGW2rvoJTmAPmmctVuySZKJM=; b=oo2lgPQCu3NeComNYCHMKN/hBb0oQ1m/OzpIj4TZ1gv1Phs+D0/hdvgfoAuT/IlOTG DigDOYy/AVvCsihUTBQhdUkLRO4HVEiULzkT2reW6nAesr4bOYP+Ge9hJw3JkIdiI2Fl e7fhq8it0Ji+ZFYN/Th8u14GyLj4XZazwmY0Rkd59Tc0ctHlMTTCq1IER7slnOS+/b5H f+XlsjGWsq/7jy3ffR/6UHaiVZput2bbmfqhpDDEcclDfGssYwW7xhcitH/hz2jWpHnp kP6nPprNLjruTOl3fZ/s7/hyn4YZvSl+PvHGk5XnyuZUEMysBhz+QIp+1zdVTmU/InO1 9R4w== X-Gm-Message-State: AOJu0Yyx0hutyjJ9+2zc3v5jK1u81CTYuYt2mOb5c0IS9sQg/ZBrvLh4 6ZK5Ip35XRwBVsNDeOY5BE9jZcVJStBqlsqhD6Z+jhaAaWnNgXQT5zN9T4eGeIcDcq5u5Xl2szz wtIQ= X-Gm-Gg: ASbGncvKAKbL+ymze1qHZUGs92yKTci22kIk+LcTfno11SubGdyrD/b7UYVLF0KYWu/ spQyDLgjeTlEkGupnSsnBndd1qWQZsmoiR3bcQquZAjBRXIiRUEw1GM5jTUzZq6DkRDThUDj59A QzgicsRN2RLM5DeWRaCRXGzz2UVshCJIsYgvuiLl/bkrbZwEd87DifOX7jByuPKkHBg6ADGQqSg ovyBZ2ESz8NFL4MKUpD0x1jQgHyF2dbowzYR2e4XkbCuiVZ2REwE6PR2FLwrm8o/oN0Ez/kjNDt Bm84j32hDA7BT96xT69Kx7VoWcLAlBQztxxqZav0fuHjxNGDlGh7pXJ82lH6j75PoQYEJFhPoy9 pf4iEGfgORSsozV4+5IoU48Y5Ta7YB527tpi4TRBOFWS975/rQHrVuusfPWV3rPXt8g61Jr3tno Ajw8NdZn/MiZREaQks28zIGOFHE5FWKegz3seouQ== X-Google-Smtp-Source: AGHT+IEfuYUfrBAob6bCyfrS0icqxOzTG0p1f2VF8sZ6ZDnVoasEkyAETFkCnTNV9mIyiSAIsVHnJg== X-Received: by 2002:a05:6000:4029:b0:3ea:71c4:8e1b with SMTP id ffacd0b85a97d-3ea71c49295mr3628624f8f.63.1757941309548; Mon, 15 Sep 2025 06:01:49 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.48 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:49 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Ronan Desplanques Subject: [COMMITTED 01/27] ada: Fix documentation of Is_Ancestor_Package Date: Mon, 15 Sep 2025 15:01:07 +0200 Message-ID: <20250915130135.2720894-1-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Ronan Desplanques "Is_Ancestor_Package (E, E)" returns True and this patch fixes a comment that claimed otherwise. This patch also renames an object local to Is_Ancestor_Package that was misleadingly named "Par", a common abbreviation of "Parent". gcc/ada/ChangeLog: * sem_util.ads (Is_Ancestor_Package): Fix documentation comment. * sem_util.adb (Is_Ancestor_Package): Rename local object. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_util.adb | 8 ++++---- gcc/ada/sem_util.ads | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 8a3998d7d123..432b036396d7 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15991,14 +15991,14 @@ package body Sem_Util is (E1 : Entity_Id; E2 : Entity_Id) return Boolean is - Par : Entity_Id := E2; + Cursor : Entity_Id := E2; begin - while Present (Par) and then Par /= Standard_Standard loop - if Par = E1 then + while Present (Cursor) and then Cursor /= Standard_Standard loop + if Cursor = E1 then return True; end if; - Par := Scope (Par); + Cursor := Scope (Cursor); end loop; return False; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 04caed575065..88a1841cb389 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1849,7 +1849,7 @@ package Sem_Util is function Is_Ancestor_Package (E1 : Entity_Id; E2 : Entity_Id) return Boolean; - -- True if package E1 is an ancestor of E2 other than E2 itself + -- True if package E1 is an ancestor of E2 function Is_Atomic_Object (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to an atomic From patchwork Mon Sep 15 13:01:08 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120263 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BE2DA3858C52 for ; Mon, 15 Sep 2025 13:11:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BE2DA3858C52 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=hAM50l5L X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42c.google.com (mail-wr1-x42c.google.com [IPv6:2a00:1450:4864:20::42c]) by sourceware.org (Postfix) with ESMTPS id D8D2038560A3 for ; Mon, 15 Sep 2025 13:01:51 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D8D2038560A3 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org D8D2038560A3 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42c ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941312; cv=none; b=EQC1V+CMJMgiJuejtHeSH+ECAfwxoOqN1hLUI1kL9QHWc+BAagax3u86aqv8jM/piR93sbxDpN+CgPtpfqgyacAnyuDEqmd6r8/GjAG+NMjgbBNxq+MHRanqwWHYz8TprRxcXZLT94ZKjsNFKyM6nj+6Xjg8925fjOBfhzXjNbA= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941312; c=relaxed/simple; bh=lbr7nmQ7gXDNQnVUJVfRiHM7Yjcj4C+DYiClDoEe4T4=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=HrTUtu4T1x+wcSU4htFkn9llMydK2ug1xyiyAPuum2fJ9kfRd/uifu/EXnwaqnVFvU3GUqtKM9Q1WaDX/o+XZbHXykexGgGLe9ML3znkoUPfiBpU9pIn/HVA7mFI8fQAYBXTIAAndBAol76K4wH8KpKW0m/4MJTLXcDcYYO++cs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org D8D2038560A3 Received: by mail-wr1-x42c.google.com with SMTP id ffacd0b85a97d-3dae49b1293so2358300f8f.1 for ; Mon, 15 Sep 2025 06:01:51 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941310; x=1758546110; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=m62vQD+ZYXUBUV1IH18DNxS1USPQAZbxWZ4FZrkdVS8=; b=hAM50l5LdIMF3wtneW2cuqxX9KmNzimBPeksl/S3zeZe3dZpM9XOkVvh8U35D6ZiC7 kbA6dpyOGgBOclqecErHjCyQnLWfnNNRncxrJVM0u1WGcV0f069kk3OfwSlpwBDb+L63 MsYi0GIRfKpsDN4mil0DqBCyd+FPovwxR2kiLSylirEndUVSwyU8eDCjkW0Mh1BSL/a+ cyKaholRCTUQ9lOHMl1eIL9K1EUw57IKy288UPkKn4D7GGQC/dglLfY4UGWlxUBS+kql 0KR6KveQAo1EuQmESpbxJpoMvHhNGtEq5ypQyKtMCTsRfJI5t7LQTEv7vL8pnvl3K574 t2fA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941310; x=1758546110; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=m62vQD+ZYXUBUV1IH18DNxS1USPQAZbxWZ4FZrkdVS8=; b=cviu2c1cyVuG1EjNHqUW5ga0Dw40fCb53J9qPjlEPZr+l0lOnQy/f1aASPdc5kSGm7 6MKS3w9lAxHpqkj6NaeBVOgmacMlSfLACGi/yglVnIiQHM0L1WWdxrvNgSxFKO6P0xR4 F6VKjOZdW4c15BQETEtUN2pDIq7hiuoz2X//8V50D2xRYJNPPK2fmG4KsOGEY+EihIFN q1U8JlbJr4nli2Ha58fN6vvfvg92UOYxCQBPshxrLDQdcIv7rCUAcVUdUUyIXCkpNKTB c9kmCFMmLbzlCDfCPqKFsIzWQ50lWKWyHX2CWBfPgYDXMqc0Z53LfhHSk8+pq1wZfug4 vhyw== X-Gm-Message-State: AOJu0Yw3kfLS+J5JJC5CGvLXbnCGVvROSYv88y6rjOkh4YjJIZzIWqIV Szb6nFKBM+Q8DRkYZJduROkJTNAHRjshkScReZX4x5xxdha4pC0y85tT6LIyxZYdk++PBmlOD1v VzIM= X-Gm-Gg: ASbGncs2+CkLgGNBNYhJjDab3yCa3xLQ2y4lNtCYZY6wDVqe5V8jP5Z+Yzy+zDsyN72 nucQe/4Fr/0kC78IKtbGLbar0J8Uig1re00cwvE/f8dyJWZgy6M7xr/LVxLdp7SCwHgfTpKnR8F Q6kkH3uC5skl1t5EM9/qq1yAGuzEwH4/63sgcubZDRoXx79NBkSAzZFsPTgx29NtX3ITQopUoMx lsxRnVJfh5ckowopuZWvBMV0M0eV0RnQ031sPDui6XrNVPLPRlhDYMDN1H2ixdZAZfV4Ml23yBT gqtatfo+Odh00ktUOOrdIbdyJOKWQX59Kisk++/eYO9tdyx7OSLQ8yvfqlKJqTf1iBGjbNg4/y+ A9maNH5iCugdxY8wqe8q5M3keiVV6DojaXsowEccQP2c8I4RD2wlhF5cuvkV/wqLRHEMaWYyS1U bHCXJtIP21lWPmWnblspjScAnK1f1UPLg+7OvxCPSNbmkCBO84 X-Google-Smtp-Source: AGHT+IEpN6zPaS+eNXciILsr/NvOZc4zKJGHQfXRxDIGklhg6MGvmPLCqY9IPgnMznnxT4C21gBF4Q== X-Received: by 2002:a05:6000:2004:b0:3e9:9282:cfdf with SMTP id ffacd0b85a97d-3e99282d44bmr3795550f8f.41.1757941310424; Mon, 15 Sep 2025 06:01:50 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.49 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:49 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 02/27] ada: Disable ghost context checks before context is set Date: Mon, 15 Sep 2025 15:01:08 +0200 Message-ID: <20250915130135.2720894-2-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus There are cases where we need to analyze the argument of the pragma in order to determine the ghostliness of the pragma. However during that analysis the ghost region of the pragma is not set yet so we cannot perform the ghost context checks at that moment. This patch provides the mechanism for disabling ghost context checks and disables them for pragma arguments that determine the ghostliness of the pragma. gcc/ada/ChangeLog: * ghost.adb (Check_Ghost_Context): Avoid context checks when they are globally disabled. * sem.ads (Ghost_Context_Checks_Disabled): New flag to control whether ghost context checks are activated or not. * sem_prag.adb (Analyze_Pragma): Disable ghost context checks for pragmas that determine their ghostliness based on one of its arguments. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/ghost.adb | 4 ++++ gcc/ada/sem.ads | 12 ++++++++++++ gcc/ada/sem_prag.adb | 39 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 55 insertions(+) diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 4f1a0d9d6a46..ae20ef972c82 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -932,6 +932,10 @@ package body Ghost is -- Start of processing for Check_Ghost_Context begin + if Ghost_Context_Checks_Disabled then + return; + end if; + -- Class-wide pre/postconditions of ignored pragmas are preanalyzed -- to report errors on wrong conditions; however, ignored pragmas may -- also have references to ghost entities and we must disable checking diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 611309775279..63cf1daad37d 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -307,6 +307,18 @@ package Sem is -- case. We could perhaps do a more accurate job and retain some of the -- warnings, but it is quite a tricky job. + Ghost_Context_Checks_Disabled : Boolean := False; + -- This flag controls whether ghost context related checks are enabled or + -- disabled. Typically they are enabled however they need to be disabled in + -- instances where the ghost region context has not been set. + -- + -- Typically this is done for pragmas where the ghostliness of the pragma + -- is determined by an entity specified as one of the arguments. In these + -- cases we need to analyze that argument before the pragma itself to + -- determine the ghostliness of the pragma. However at that point we have + -- not set the ghost region for the pragma in order to determine the ghost + -- context of the argument. + ----------------------------------- -- Handling of Check Suppression -- ----------------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 661d4401d7a2..00c9b17ff6ee 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -6439,7 +6439,14 @@ package body Sem_Prag is end if; end if; + -- We are going to check the entity that determines the ghost + -- region of that pragma. We need to disable the checks for ghost + -- context since the ghost region can only be set after analyzing + -- this entity. + + Ghost_Context_Checks_Disabled := True; Analyze (Argx); + Ghost_Context_Checks_Disabled := False; if Nkind (Argx) not in N_Direct_Name and then (Nkind (Argx) /= N_Attribute_Reference @@ -9221,8 +9228,15 @@ package body Sem_Prag is Check_Optional_Identifier (Arg2, Name_Entity); Check_Arg_Is_Local_Name (Arg2); + -- We are going to check the entity that determines the ghost + -- region of that pragma. We need to disable the checks for ghost + -- context since the ghost region can only be set after analyzing + -- this entity. + + Ghost_Context_Checks_Disabled := True; Id := Get_Pragma_Arg (Arg2); Analyze (Id); + Ghost_Context_Checks_Disabled := False; if not Is_Entity_Name (Id) then Error_Pragma_Arg ("entity name required", Arg2); @@ -12022,7 +12036,15 @@ package body Sem_Prag is Check_Optional_Identifier (Arg2, Name_On); E_Id := Get_Pragma_Arg (Arg2); + + -- We are going to check the entity that determines the ghost + -- region of that pragma. We need to disable the checks for ghost + -- context since the ghost region can only be set after analyzing + -- this entity. + + Ghost_Context_Checks_Disabled := True; Analyze (E_Id); + Ghost_Context_Checks_Disabled := False; if not Is_Entity_Name (E_Id) then Error_Pragma_Arg @@ -15041,6 +15063,7 @@ package body Sem_Prag is Check_Ada_83_Warning; Check_No_Identifiers; Check_Arg_Count (1); + Check_Arg_Is_Local_Name (Arg1); if Debug_Flag_U then @@ -15048,8 +15071,16 @@ package body Sem_Prag is end if; C_Ent := Cunit_Entity (Current_Sem_Unit); + + -- We are going to check the entity that determines the ghost + -- region of that pragma. We need to disable the checks for ghost + -- context since the ghost region can only be set after analyzing + -- this entity. + + Ghost_Context_Checks_Disabled := True; Analyze (Get_Pragma_Arg (Arg1)); Nm := Entity (Get_Pragma_Arg (Arg1)); + Ghost_Context_Checks_Disabled := False; -- A pragma that applies to a Ghost entity becomes Ghost for the -- purposes of legality checks and removal of ignored Ghost code. @@ -22359,7 +22390,15 @@ package body Sem_Prag is while Present (Arg) loop Check_Arg_Is_Local_Name (Arg); Id := Get_Pragma_Arg (Arg); + + -- We are going to check the entity that determines the ghost + -- region of that pragma. We need to disable the checks for + -- ghost context since the ghost region can only be set after + -- analyzing this entity. + + Ghost_Context_Checks_Disabled := True; Analyze (Id); + Ghost_Context_Checks_Disabled := False; if not Is_Entity_Name (Id) then Error_Pragma_Arg ("entity name required", Arg); From patchwork Mon Sep 15 13:01:09 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120261 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D39E63856951 for ; Mon, 15 Sep 2025 13:07:38 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org D39E63856951 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=jdfd7Mnm X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x430.google.com (mail-wr1-x430.google.com [IPv6:2a00:1450:4864:20::430]) by sourceware.org (Postfix) with ESMTPS id 440D73857706 for ; Mon, 15 Sep 2025 13:01:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 440D73857706 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 440D73857706 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::430 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941313; cv=none; b=F8AxvnPkW8LtewtNftUGdyQGJ5vovBMPrAjXjKRZMXSXSBEwZ1jJAy5SX6mE+PctbDuoiLhzv8y6Diha6uW89NOokE4k8kl0YYLAJJMos2mCq/Vl+eUW3UDv+K9p2+vH/W9w1OlVftZWEnaG/18gn46+DfmrJtzaSFhBF6i/gNo= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941313; c=relaxed/simple; bh=5oEYMXRWXNQfZHK1/FcWapa0nl1NSDr79ijsM1BXoYI=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=YMQ2vNHDe18VJ+s0t8DgYP2jQPTcO0oFEbJixClIZUvl52HTeF/Y45+TPj+Wf4vwgOOgiOFzIiXETLSA8ppVp8Tb4cyjzOYkuMporTwUtd01PfKIf2+5P8yrJRaeXner0N1zGLJ5bHnzeu70JjTTIaW/C2j9LAGIsaKthBo9IKY= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 440D73857706 Received: by mail-wr1-x430.google.com with SMTP id ffacd0b85a97d-3e8123c07d7so1020363f8f.0 for ; Mon, 15 Sep 2025 06:01:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941312; x=1758546112; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=Wh27NC0kJC2oYGcCjFBkjiA3/Kyi3WorVtGI5R0g98U=; b=jdfd7MnmNyoRzxLwachk2lxrNPxRV+rv55sPAPbTsFTK8XpLbGYEQ3wleT1kXNlEFn wM+xo4PBkwfEQIEL77kNFAk/2GtinrceuhFms3N5hEKKrh1uQ0LDWdetk1JaERaXpTFU m4AVO3IBx7F3iKpx0GOrCjr2J3+fda54EwQRzLD6mAmQZifgTSkHlCsEdrbHMvKLeZYe j8hKoD2auZCN4PTdvQhfvhwGkGxLOKSNzuQoyLyBEZATulTnK876wJMK4oFZf+litQXJ aPEB0l4ap4n4kNtg26y+qn1bSrRoL9FwN3JznXYdP20NQyTnoMZuwQXzZwFF7S6QkGwE Mydw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941312; x=1758546112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=Wh27NC0kJC2oYGcCjFBkjiA3/Kyi3WorVtGI5R0g98U=; b=A4E/opZKc9YekAU5PTmHfVVsRVNn+T9tGeOiy7gJfBDrgGu31m/ybcnn5NKbyhAC6N QOwf++5UhJzbfNjqmXo/su37lsUlI2g9g/Ns87P75F6M7/zPu82iacFWG0PWzkIlt69i Io+d11NFTWYtAz2Ux1sn7+S645V9V21ZAFFtbkekIdicqhHyHhMDncNUu4Mzpla4qG6K rv7b6C/AwpS4nBgakYVWNg0TCeO/pZLMWv1Ye3bXBJmiFt6//cWI1BA2HV+UY914ExJ0 jKwMnlZn1LjTJtdy6rAqYpcrxN8J3k0c4l7BmYa3O8c31B50+FUIhMhfqN0BcxTk3rqp v7Hg== X-Gm-Message-State: AOJu0Yx5D/XvnbDYfquA25NTBb/++aDXTgk8yFby9lH5oIoXdXTBXV5w 9k1eFPuD89tYgoq9NB012E2shOKy9+d9P59Oc7mXfZtt83tRRsk6pJc0DzOiIKG1nqN22DKNkkd fEEo= X-Gm-Gg: ASbGncukP5a4qTponzYu/nGXTEyMR1y496FB6mewzMsbdry9xT7YpditiCmjEnsKBjj A3Im7PbgP444oZYyw3hgxhRvGxYCR0gqkHezuZ4wX3CoT+QEpXqNtzIiYKMSAjLTb9BerDBUA8f sv/EZXpg10PxMNGxrugG4C1bfuiiQ4jxfFrpI3TFMY/3+dOrLRcqgD80qO1+nba4YloLFwPfZIc 4a5fHK1Ixchhdnkm+TqrWXmhlttgPJPRIkH1ryPUKg+NPpl8OPngeM6THQ60R36utq7E7n7QpAS 8hT5b5DBdtzVEfLhe+R9oul+PYi+TfgDgjfZzy0qdIYgPMmifwuVWtGF+MyvflQZyOtHHlbCzR1 eC5via+az63HvQt22U4+yjlzBzdcIWSbRxQOSDtn/y8ujcqw31uKPfaRVKhXyYe2w2CKU2j7UWO RQ7+mWsbEYbwNimmKETQoXBfWmCMlvTqzB4TWeng== X-Google-Smtp-Source: AGHT+IG5qMhqH+b/XBfY+fhOC6g7EAhaeDCm+zJ/zk7eI25Ljtrjt13YNf/SyROFyY9DnSJEihmCwg== X-Received: by 2002:a5d:5f42:0:b0:3e8:6b2b:25e0 with SMTP id ffacd0b85a97d-3e86b2b278bmr6554193f8f.25.1757941311251; Mon, 15 Sep 2025 06:01:51 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.50 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:50 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Vadim Godunko Subject: [COMMITTED 03/27] ada: Add `Set_[Wide_]Wide_String` subprograms to auxiliary packages. Date: Mon, 15 Sep 2025 15:01:09 +0200 Message-ID: <20250915130135.2720894-3-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Vadim Godunko gcc/ada/ChangeLog: * libgnat/a-swunau.ads (Set_Wide_String): New subprogram. * libgnat/a-swunau.adb (Set_Wide_String): Likewise. * libgnat/a-swunau__shared.adb (Set_Wide_String): Likewise. * libgnat/a-szunau.ads (Set_Wide_Wide_String): Likewise. * libgnat/a-szunau.adb (Set_Wide_Wide_String): Likewise. * libgnat/a-szunau__shared.adb (Set_Wide_Wide_String): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-swunau.adb | 13 +++++++++++++ gcc/ada/libgnat/a-swunau.ads | 8 ++++++++ gcc/ada/libgnat/a-swunau__shared.adb | 26 ++++++++++++++++++++++++++ gcc/ada/libgnat/a-szunau.adb | 13 +++++++++++++ gcc/ada/libgnat/a-szunau.ads | 8 ++++++++ gcc/ada/libgnat/a-szunau__shared.adb | 26 ++++++++++++++++++++++++++ 6 files changed, 94 insertions(+) diff --git a/gcc/ada/libgnat/a-swunau.adb b/gcc/ada/libgnat/a-swunau.adb index acb9b6df4fe5..1ae8e19d0d6e 100644 --- a/gcc/ada/libgnat/a-swunau.adb +++ b/gcc/ada/libgnat/a-swunau.adb @@ -62,4 +62,17 @@ package body Ada.Strings.Wide_Unbounded.Aux is UP.Last := UP.Reference'Length; end Set_Wide_String; + procedure Set_Wide_String + (U : out Unbounded_Wide_String; + Length : Positive; + Set : not null access procedure (S : out Wide_String)) + is + Old : Wide_String_Access := U.Reference; + begin + U.Last := Length; + U.Reference := new Wide_String (1 .. Length); + Set (U.Reference.all); + Free (Old); + end Set_Wide_String; + end Ada.Strings.Wide_Unbounded.Aux; diff --git a/gcc/ada/libgnat/a-swunau.ads b/gcc/ada/libgnat/a-swunau.ads index ba4ccaa3af95..ea33db01a11e 100644 --- a/gcc/ada/libgnat/a-swunau.ads +++ b/gcc/ada/libgnat/a-swunau.ads @@ -73,4 +73,12 @@ package Ada.Strings.Wide_Unbounded.Aux is -- than string. The lower bound of the string value is required to be one, -- and this requirement is not checked. + procedure Set_Wide_String + (U : out Unbounded_Wide_String; + Length : Positive; + Set : not null access procedure (S : out Wide_String)); + pragma Inline (Set_Wide_String); + -- Create an unbounded string U with the given Length, using Set to fill + -- the contents of U. + end Ada.Strings.Wide_Unbounded.Aux; diff --git a/gcc/ada/libgnat/a-swunau__shared.adb b/gcc/ada/libgnat/a-swunau__shared.adb index fdaf8467e606..2d3366401f16 100644 --- a/gcc/ada/libgnat/a-swunau__shared.adb +++ b/gcc/ada/libgnat/a-swunau__shared.adb @@ -62,4 +62,30 @@ package body Ada.Strings.Wide_Unbounded.Aux is Free (X); end Set_Wide_String; + procedure Set_Wide_String + (U : out Unbounded_Wide_String; + Length : Positive; + Set : not null access procedure (S : out Wide_String)) + is + TR : constant Shared_Wide_String_Access := U.Reference; + DR : Shared_Wide_String_Access; + begin + -- Try to reuse existing shared string + + if Can_Be_Reused (TR, Length) then + Reference (TR); + DR := TR; + + -- Otherwise allocate new shared string + + else + DR := Allocate (Length); + U.Reference := DR; + end if; + + Set (DR.Data (1 .. Length)); + DR.Last := Length; + Unreference (TR); + end Set_Wide_String; + end Ada.Strings.Wide_Unbounded.Aux; diff --git a/gcc/ada/libgnat/a-szunau.adb b/gcc/ada/libgnat/a-szunau.adb index 5436e2f0d7ea..903b2c9e4df0 100644 --- a/gcc/ada/libgnat/a-szunau.adb +++ b/gcc/ada/libgnat/a-szunau.adb @@ -62,4 +62,17 @@ package body Ada.Strings.Wide_Wide_Unbounded.Aux is UP.Last := UP.Reference'Length; end Set_Wide_Wide_String; + procedure Set_Wide_Wide_String + (U : out Unbounded_Wide_Wide_String; + Length : Positive; + Set : not null access procedure (S : out Wide_Wide_String)) + is + Old : Wide_Wide_String_Access := U.Reference; + begin + U.Last := Length; + U.Reference := new Wide_Wide_String (1 .. Length); + Set (U.Reference.all); + Free (Old); + end Set_Wide_Wide_String; + end Ada.Strings.Wide_Wide_Unbounded.Aux; diff --git a/gcc/ada/libgnat/a-szunau.ads b/gcc/ada/libgnat/a-szunau.ads index 3f90d2802988..486ac137bfcd 100644 --- a/gcc/ada/libgnat/a-szunau.ads +++ b/gcc/ada/libgnat/a-szunau.ads @@ -75,4 +75,12 @@ package Ada.Strings.Wide_Wide_Unbounded.Aux is -- than string. The lower bound of the string value is required to be one, -- and this requirement is not checked. + procedure Set_Wide_Wide_String + (U : out Unbounded_Wide_Wide_String; + Length : Positive; + Set : not null access procedure (S : out Wide_Wide_String)); + pragma Inline (Set_Wide_Wide_String); + -- Create an unbounded string U with the given Length, using Set to fill + -- the contents of U. + end Ada.Strings.Wide_Wide_Unbounded.Aux; diff --git a/gcc/ada/libgnat/a-szunau__shared.adb b/gcc/ada/libgnat/a-szunau__shared.adb index dc9b2984883a..9fa937e74654 100644 --- a/gcc/ada/libgnat/a-szunau__shared.adb +++ b/gcc/ada/libgnat/a-szunau__shared.adb @@ -62,4 +62,30 @@ package body Ada.Strings.Wide_Wide_Unbounded.Aux is Free (X); end Set_Wide_Wide_String; + procedure Set_Wide_Wide_String + (U : out Unbounded_Wide_Wide_String; + Length : Positive; + Set : not null access procedure (S : out Wide_Wide_String)) + is + TR : constant Shared_Wide_Wide_String_Access := U.Reference; + DR : Shared_Wide_Wide_String_Access; + begin + -- Try to reuse existing shared string + + if Can_Be_Reused (TR, Length) then + Reference (TR); + DR := TR; + + -- Otherwise allocate new shared string + + else + DR := Allocate (Length); + U.Reference := DR; + end if; + + Set (DR.Data (1 .. Length)); + DR.Last := Length; + Unreference (TR); + end Set_Wide_Wide_String; + end Ada.Strings.Wide_Wide_Unbounded.Aux; From patchwork Mon Sep 15 13:01:10 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120268 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D41BF3857C6E for ; Mon, 15 Sep 2025 13:20:05 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org D41BF3857C6E Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=demOkHG/ X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x329.google.com (mail-wm1-x329.google.com [IPv6:2a00:1450:4864:20::329]) by sourceware.org (Postfix) with ESMTPS id CFE1C3858407 for ; Mon, 15 Sep 2025 13:01:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org CFE1C3858407 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org CFE1C3858407 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::329 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941314; cv=none; b=A9pD1YUAdFNSlfEHznkr5JWrzvDNOHoSaUUWyPtUzTjp4EqvvznvRbchJdSMtsIq310tdLRKliXEnKJl9emD+T3IPsDDd1VyQWqMDLLAL/t8Rzeeb3ot62ttqo7X2XeL3jGJ1bZOZh5sCVzcs1kZD0MtFJA/abCoBPaso/cSzHA= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941314; c=relaxed/simple; bh=YpbXcQjtmGgmHX3vIAafTbc64m5mIQMrtj+FLY6ToW4=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=PR1zsQYx89euUvUsUTauy4RqYdivYK9J4SxnwHg8dMjMbzOQ2+kgvHGQn57hEzdZ6xsKtrqH/3+whwnd+af9jVTKGJAGlixI0OUp9cWNL4fJjGMQYByNRhnYl1bGss8qAgEqGc2q5vgtFwTUuSBYqycxjYQD84raoJJsv04jO1A= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org CFE1C3858407 Received: by mail-wm1-x329.google.com with SMTP id 5b1f17b1804b1-45e03730f83so19215205e9.0 for ; Mon, 15 Sep 2025 06:01:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941312; x=1758546112; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=X3/8XzoJOkHHBEU/5PubZaRpvYev447ya8pSho9/ZXk=; b=demOkHG/tFgYN4CqHyBvXZQztJcBw4XxKLGUpn/RIWxwTcgvd2nobBjT+PTXIS+OY/ gZoSrGTtLgGdEwrPYUcx2aNDqLX15MdnFKzzBDBUEs442akbsQAM4BUKzRUX7NpKjODe RSiDl/3FIg7Rqbvl5IRHztWOGvWMBipbf0cb+ZQQZQy8h6a99JSE9Br5N7COomacQ5HO v0oLHsVlC2PASa7yfDV7wAJ7MCUvTusPzgQYHJQWhNypTOXxVocEjDJ2ZLKVxA5uQOos OyC7vdqkC0TpDz6U/18fW5oYlDZtQ1GxSR5N2i4sHBfUopiGeGe+j/RDxzn88eAtf4gv THiQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941312; x=1758546112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=X3/8XzoJOkHHBEU/5PubZaRpvYev447ya8pSho9/ZXk=; b=WQZvQkJgm60U0RdaA6bUerfoD4YWVuuSs9QaYQsz7AijPBaV5yFrNqfI8eBZFYe0sE BnEhhojeJVP0vLM12B6J56v21+cgTGgLEPKT7Xqi8B+Nv9ZVL8WkDmFHgC37evyAELDb 5MflTYXb8gM2BkLFIpHQfVebke0Zrj6YK4HARTEqqwM5y3DkGPN9ngJC0MxBDhjlMtUE XUQXcFAL8f9y3iZuclTjwH+nKe37Tfn0681/9t7LyDmm3YPIGYdSqvEe5xivj3lA1gp5 rBIcYy97Cjlf7wlPGAKiL7sFQ4rqMBpR4N1LXEruscZ09ImKDMIPq82EYUWcXsHTEurD PLLQ== X-Gm-Message-State: AOJu0YzuIS0mmTwNBa/bHgsBlD15fm58QLssYEsquCC3984jEzeH+iLP UdGF4LKheF+u8eTrR67Rd3OugMAXgv8F4cPj2GmQ50ugoPfLoz0HXSTS5cOYT6udpBUnV129iwa DsKM= X-Gm-Gg: ASbGncudB5SckZTsMBwVjf9XUGeWwdW/fos1NIcQ4yuY1i5U2BfC8A8bGQcJfnLB2s6 xaIv1041q8B7MOwylLjpxfxJ7IBjyz8l4lhDpawZc+FsXI6bz85LriXQQgo3ZVXDwqacMAWyB7i Z2ClyQYze82P7GPcR/nF5ov9rC6R0mjDuCdmjedBqilVouVCGwr2zJAwCNCUrZ8oVF0owtBpgBE 03W0OGxpRt4JBneLIIvgtKiJK4n3Cxc/X2QGeIv9m2BB6P6R29uE1YliP/ia3zT0GYZcK1izdbG dM/y4orSm7nMYzA9Vt7ypfPVKOvNFwX1JlVTgPvXrk67DOXsF4mivtdjBhweVpz12TROA+mp+X+ suhnk/pDgkRHeS41xJJOfZDsszAWwER0RNRMLAfnI7BugG+BWHGJuPDnMqw1NIJAkR6lQan9Yyf rMgQzKZH0I71j7EWNjyNlq3PNAuBIBIvb1YzTAt4NrxqANBAkU2D726Knv+Z4= X-Google-Smtp-Source: AGHT+IHyPDChleOMx8dDBKRM3RLP3z3sONsJzvk6yXjEXngdEtWBNNDY9KUXuLrPG4LwsTupcxtbzQ== X-Received: by 2002:a05:6000:2004:b0:3e9:9282:cfdf with SMTP id ffacd0b85a97d-3e99282d44bmr3795648f8f.41.1757941312125; Mon, 15 Sep 2025 06:01:52 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:51 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Vadim Godunko Subject: [COMMITTED 04/27] ada: Fix code generation when there is no No_Finalization restiction Date: Mon, 15 Sep 2025 15:01:10 +0200 Message-ID: <20250915130135.2720894-4-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Vadim Godunko Check whether library is elaborated is not generated when there is not standard library available on target. gcc/ada/ChangeLog: * bindgen.adb (Gen_Adafinal): Don't generate code when use of standard library suppressed. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/bindgen.adb | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index cb39af67f9a5..14367ebe97a7 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -490,7 +490,9 @@ package body Bindgen is WBI (""); WBI (" begin"); - if not CodePeer_Mode then + if not CodePeer_Mode + and not Suppress_Standard_Library_On_Target + then WBI (" if not Is_Elaborated then"); WBI (" return;"); WBI (" end if;"); From patchwork Mon Sep 15 13:01:11 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120258 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id B7359385EC04 for ; Mon, 15 Sep 2025 13:05:08 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B7359385EC04 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=S1l/QNzR X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x430.google.com (mail-wr1-x430.google.com [IPv6:2a00:1450:4864:20::430]) by sourceware.org (Postfix) with ESMTPS id B1C15385608D for ; Mon, 15 Sep 2025 13:01:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org B1C15385608D Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org B1C15385608D Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::430 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941315; cv=none; b=YBPvLVkVaV9mF8lCG3YLHnKecZNADoaBVhA2VyyibgLlUHjbodh+X1xWYBju75CMlYxD5E4gU3EZsR6dnwozDBQV3Os384hSGK9qxvBn4vAxNdJLhjjCDGrqS56JyS+8QiboeonIbdsV8giBrp+T4+9XalLoZQHWyKo+Khj+APk= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941315; c=relaxed/simple; bh=rykcJHoKz0xhuc5J6UZW+oBrqI9UOi9s+ogUrPNuruI=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=MPd2tidM22bSIo8q7Krdt6HvbW/eoLEcd3wEWFDjYJ6Vqk4ROK0mhTlbpU7rkzUfUXNqncMVv0QW/ejLM5ZePZoAKTxiYKZU/7Rl62UNaFwUkauqmBfF1qH3zCWoKA+Jz8RxRl4kUECBYbLkr1Xyv2eMZTSH2aaVxAy7CPWU9Yc= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B1C15385608D Received: by mail-wr1-x430.google.com with SMTP id ffacd0b85a97d-3d118d8fa91so1365787f8f.1 for ; Mon, 15 Sep 2025 06:01:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941313; x=1758546113; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=tGNmMRsqGBcb3cogwApJSkrioPdFUwmrhcAGraBRfDY=; b=S1l/QNzR7Qk/kvMOLIhszi0OU/a8BPPtKOpDCXlEXwNC2FJRllUg17vnujLIa8hw8r LxWoQQ7kaq7ClJkY5a/sK16qfIP8ZpISXeEcupeP0Rb8QjscsBsOvudwMyKUCdVIBIxm 4nSozuir5IK/+v669EY4yhqQQ3GTCjtEKdO12ZBep5Ge5I4ci4DkI3/qfIjmG81/TEMW Ubnrr/SoJkw6eugumaoMCL5FrH3yaGFUIw2chCrleMM8j+mYIPyaRpAPUJzZ9s9I0iVR s7HU3rG3ZqRkydjE/jtJj+H9wl0f618m15tH+mnmtRoVvrBZphjapVWbAdqgBESVgSQ7 y70w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941313; x=1758546113; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=tGNmMRsqGBcb3cogwApJSkrioPdFUwmrhcAGraBRfDY=; b=L/2//rsKdJc5dGbkdzI7kRMoJJgxXDfBOMI6/SeDS6/kxNr0X943r4n0fdsVvJ/ErM Bks/k/yn0KP5bK6OlpSi/PWytl+Y2hKKq17y28f8sPu/zzvmZrympq6QDIutCWnD5jRq 4/iwqJbih9gRKP1Oieh9oudDF4WIy2rfU93fWJ2Oxn4jcnpCQgAnGNBt2yEs6NzrAcro dTr6JH/QEQfRnsZPzWcmAD4MzqyXeozpnRUyDoEdHy4BO9SIv+asYJpONXI08EDJ7D1f hzwBp096V6E1QTlqU7NsfD+XNXKrUINI4ONwz88QGeIj6sZkbY3qK0+piU3HyE8KhG4D 4yJA== X-Gm-Message-State: AOJu0YxmhjOcpzk8snmN9WQSogT7D9IzCPwRjmPCQTB2bujUl1+DDEae QhaQg1uowtiuNcZi8QVzGGr3EW3E2KLU6JzV84onlcMM0djPC6YAdMsrYUMM1yESNOm92CoCZ+k JVco= X-Gm-Gg: ASbGncspTqvCXP6NnXeslcca3O33+a/Q1RxVmH0eTGzfdQAkdVV5DnbBy2iboo2ahL7 hQziAQ7T0DaE9dQ39iOpNsfA4LM7nlwPvdNNTzs3wKcWRLSxP6Bm49kMxEOAku7jekYTJtzNklR ERLciDYOS85ZTcJzmjKuYRvRhehJWEo+7DWvaMar/Uk1i0NvW1jrQA5CPlUpju4xhwLVQpXzroP 9JfVz9ndVJ6s2VEHBEGymPjSRsmZ8xvv9Vbhrx2oBdua8EP/hloIy4fPq5v6PJ1jj6qStdilrQ7 HwsvpBXLuk4j4ecTlB+UcgtoxjVpiDSb5MmarSah9RjT5rS9n9hQScKi/vw2UliidpmSBVcRwNe 9r9WCeSCzKoNtB4eJODNlT2FLzDgIQmVl6sjjnc3Z2W0/1uUdzxtnZu2k9F9sPZZtKClkAzuImP 1Y3IJuSWaNodE2On7qGRRzz1qO+m2uzcoJ90YX/QEfs6OXU1dB X-Google-Smtp-Source: AGHT+IHFKlZUWxCssPXxFBBVZnKIxJMdRwIpMIKrvc99Ye5I5rRpvmULX6E6FmGiDBEmv1AI+/4GLA== X-Received: by 2002:a05:6000:184b:b0:3ec:11a2:17f0 with SMTP id ffacd0b85a97d-3ec11a21a43mr194763f8f.5.1757941312894; Mon, 15 Sep 2025 06:01:52 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.52 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:52 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Vadim Godunko Subject: [COMMITTED 05/27] ada: Don't generate call of `System.Standard_Library.Adafinal` Date: Mon, 15 Sep 2025 15:01:11 +0200 Message-ID: <20250915130135.2720894-5-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Vadim Godunko `adafinal` is not available on targets without standard library. gcc/ada/ChangeLog: * bindgen.adb (Gen_Adafinal): Don't generate call of adafinal when use of standard library suppressed. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/bindgen.adb | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 14367ebe97a7..24cc8dfb8990 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -476,7 +476,10 @@ package body Bindgen is -- but False for mains in other languages.) We do not want to do this if -- we're binding a library. - if not Bind_For_Library and not CodePeer_Mode then + if not Bind_For_Library + and not CodePeer_Mode + and not Suppress_Standard_Library_On_Target + then WBI (" procedure s_stalib_adafinal;"); Set_String (" pragma Import (Ada, s_stalib_adafinal, "); Set_String ("""system__standard_library__adafinal"");"); @@ -505,7 +508,9 @@ package body Bindgen is -- on whether this is the main program or a library. if not CodePeer_Mode then - if not Bind_For_Library then + if not Bind_For_Library + and not Suppress_Standard_Library_On_Target + then WBI (" s_stalib_adafinal;"); elsif Lib_Final_Built then WBI (" finalize_library;"); From patchwork Mon Sep 15 13:01:12 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120264 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 776A53857823 for ; Mon, 15 Sep 2025 13:12:24 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 776A53857823 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=CjiGkOYm X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32a.google.com (mail-wm1-x32a.google.com [IPv6:2a00:1450:4864:20::32a]) by sourceware.org (Postfix) with ESMTPS id D3D25385C418 for ; Mon, 15 Sep 2025 13:01:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D3D25385C418 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org D3D25385C418 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941316; cv=none; b=bVL4cL+bAA/4ltWoBcWCCOlJYZBoQ0fWcV98w/+jKzmM7pCd4qpVDYNoIFvyPDHotlEGRqBLGvh7/8+FlWDM6Zr7yRZW9RyJcePhCsJxuq9XLsaEhjuErYVtxPUvJRjhY14Jxb1/sl+510ytVX3nn37AwC4QhsXRpZ+sVHZNG3I= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941316; c=relaxed/simple; bh=Ikg/ey+uVnPoYrIdJIlPOEhFDvD6vtV5sWaT6og8LWc=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=nHKr0kLPag02nSknA0xxoszHL4GeNzqg/cWcek5qNunj741NBUxJYuEIENbFFMxU8WxAjmPOuzR9SpuPbuLS/Is2KXq+Y/j26hjYnb+HSVm1wnU6Gski5Zmc1wgn/F79Mn0QH+O9MLW08Q/jAK7vAnrmb6+xKTvb8t1b5d3ClWs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org D3D25385C418 Received: by mail-wm1-x32a.google.com with SMTP id 5b1f17b1804b1-45f2a69d876so8780345e9.0 for ; Mon, 15 Sep 2025 06:01:55 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941314; x=1758546114; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=hP/USY90gzQYvGkpLVVoyUcJGF9hA8kH8WAJD2gS4/E=; b=CjiGkOYm2AKQ7l3rIicEo8o8uWjwJcBNemARr3gf0NJj/i0HkrNMCBrUDlFFEutcWK hmTbLrxyzyHoxXweiMxvKHLbuTVxPTx3oPfP42mjMu5s7G8A3Db/ipdJl3nkCDw+5aXm j1oEVfg+hImcVxHgms54VR7DV8ZEuTXNg5Jp/TfCm0z8M0SCOY57GLpiZNhd7AtH4ABW 35dMbnha5NRu4paSrUvZX23LaeRKQSz5mQiPS5SQ14vak93mEk8J6ZU08vLuty2EftxM CSpzvfgjMdxdOEQ+XJmm+CeQMd/7UyjJG/bnUVwn3Cx5yUpdtR2+m8XPFhW3gm/b/5lu b19Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941314; x=1758546114; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=hP/USY90gzQYvGkpLVVoyUcJGF9hA8kH8WAJD2gS4/E=; b=vkHPjPRNxu19ryXY2z1lKGp7NOTXTp5eWxkm4J6YL2DCd5XLe/ha717plKdRP4FWei 4oW/QI1BecadBVgDGcdkN6zlkxXW5xGnv75dVIG1iTXKft0Iq1Vxbudx663iPCw4WS4y 9niR65s4Gt31yLwQiMl4U5nvkZwVbIh0q1NzuoipbcBj9Vnl8weFDwjLYLYlLtMpWoBy QZOtEhLYK06tG4/ARlQVWoyPzbE7O5Yvei1x7LoccMOVs9Hj/af0soEqDbewHMZmUc1/ f+7Lelpvk65eD0OFRcuhLKKDk5okLFhwOQatxjqyNUf5CHt1/arhMhRrwgApAHS5ahH4 3YeA== X-Gm-Message-State: AOJu0YyQXvzac/KurAr95XzGPfutkPgUozWVKINo6mcJsSCG0W+pL2rq t1gPJkY2dTINWaEv6hAnpgKFS/pxSW9DLhjDyScoDNVhwvmolzom2fapS8d3Rx8tnQfsHkihtk7 1xKY= X-Gm-Gg: ASbGncv5lEHebL4jTCP7mmBjLo5Z83AA5O5hDkcs1JSeeIyMqZJMjLPC42FaitHrj7N ZrEBkzVn44gM+D3QLNsYWqEc9WrOSqDUQ5uM2uD/YyJwn/9o6vzBkxXv6QvLfrsDDuL+HsgWANl I5GvJ+hNNb2k9ZDJVS575wKAfxkp4T12Ur/FPk+bih2ihSTRGN47q3OeoQGzAUF7iIsWUD+uts4 B+nRARHd80VbXJLZJEHcncO/MgZGdFcJv22fqW3kjqkT2Rg73OqBRrRY3s3Qc9M/V7xSTureiCT djeS/2oF2dBh2E14n8sjI2e5mDBVfMgHYT5HLrl0uAG0YS98WKfl06Z4mQdhK+uYyOvG/OV/OlS HGVXwEmsGhuu0O7dikB1fHGs3t7IKSRDswfpBWbhsqRw26QbFRbJ3b4o68krM9A/whC/HDpoMmP D4sBgs/iyPiU0otJUi8ss3KGRtE6Ew98szCofGB28J7kw5JJSd X-Google-Smtp-Source: AGHT+IE0uzKlj8nRBInae4ojq2meqL0uCZ13pdZxoRZemDcaC67pymDJTYShHhUceApeG39+SVQXGA== X-Received: by 2002:a05:600c:6d45:b0:45d:e326:96ca with SMTP id 5b1f17b1804b1-45f21205905mr78567905e9.36.1757941313728; Mon, 15 Sep 2025 06:01:53 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.52 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:53 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Sebastian Poeplau Subject: [COMMITTED 06/27] ada: Recommend GPR's Toolchain_Name for GNAT LLVM more prominently Date: Mon, 15 Sep 2025 15:01:12 +0200 Message-ID: <20250915130135.2720894-6-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Sebastian Poeplau gcc/ada/ChangeLog: * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Move recommendation of Toolchain_Name up. * gnat_ugn.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- ...building_executable_programs_with_gnat.rst | 26 ++++++++-------- gcc/ada/gnat_ugn.texi | 30 +++++++++---------- 2 files changed, 26 insertions(+), 30 deletions(-) diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index fdf19481a6fc..2a26e4659b8b 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -8116,20 +8116,18 @@ We provide two options that you can use to build code with GNAT LLVM: * ``gprbuild`` can detect and use GNAT LLVM when it is installed. - ``gprbuild`` uses the first applicable compiler on the executable - search path, including GNAT LLVM. An easy way to build with GNAT - LLVM is to make it available on the operating system's search path - before any other Ada compiler (such as the GCC version of GNAT). To - avoid accidentally using a different compiler than the one you want - to use, we recommend generating an explicit toolchain configuration - file with ``gprconfig`` and using it with ``gprbuild``; see the - *GPRbuild and GPR Companion Tools User's Guide* for details. You - can determine from the first line of the :file:`.ali` file - which version of GNAT built that file because it contains either - :code:`GNAT` or :code:`GNAT-LLVM`. - - You can also explicitly select GNAT LLVM in your existing GPR project - file by adding :code:`for Toolchain_Name("Ada") use "GNAT_LLVM";` + ``gprbuild`` uses the first applicable compiler on the executable search + path, including GNAT LLVM. An easy way to build with GNAT LLVM is to make + it available on the operating system's search path before any other Ada + compiler (such as the GCC version of GNAT). To avoid accidentally using a + different compiler than the one you want to use, we recommend explicitly + selecting GNAT LLVM in your existing GPR project file by adding + :code:`for Toolchain_Name ("Ada") use "GNAT_LLVM";`. You can also + generate an explicit toolchain configuration file with ``gprconfig`` and + use it with ``gprbuild``; see the *GPRbuild and GPR Companion Tools + User's Guide* for details. You can determine from the first line of the + :file:`.ali` file which version of GNAT built that file because it + contains either :code:`GNAT` or :code:`GNAT-LLVM`. .. only:: PRO diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 48958f89256e..e0c2d2571f61 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -19,7 +19,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Sep 05, 2025 +GNAT User's Guide for Native Platforms , Sep 12, 2025 AdaCore @@ -17653,20 +17653,18 @@ version of GNAT. @item @code{gprbuild} can detect and use GNAT LLVM when it is installed. -@code{gprbuild} uses the first applicable compiler on the executable -search path, including GNAT LLVM. An easy way to build with GNAT -LLVM is to make it available on the operating system’s search path -before any other Ada compiler (such as the GCC version of GNAT). To -avoid accidentally using a different compiler than the one you want -to use, we recommend generating an explicit toolchain configuration -file with @code{gprconfig} and using it with @code{gprbuild}; see the -`GPRbuild and GPR Companion Tools User’s Guide' for details. You -can determine from the first line of the @code{.ali} file -which version of GNAT built that file because it contains either -@code{GNAT} or @code{GNAT-LLVM}. - -You can also explicitly select GNAT LLVM in your existing GPR project -file by adding @code{for Toolchain_Name("Ada") use "GNAT_LLVM";} +@code{gprbuild} uses the first applicable compiler on the executable search +path, including GNAT LLVM. An easy way to build with GNAT LLVM is to make +it available on the operating system’s search path before any other Ada +compiler (such as the GCC version of GNAT). To avoid accidentally using a +different compiler than the one you want to use, we recommend explicitly +selecting GNAT LLVM in your existing GPR project file by adding +@code{for Toolchain_Name ("Ada") use "GNAT_LLVM";}. You can also +generate an explicit toolchain configuration file with @code{gprconfig} and +use it with @code{gprbuild}; see the `GPRbuild and GPR Companion Tools +User’s Guide' for details. You can determine from the first line of the +@code{.ali} file which version of GNAT built that file because it +contains either @code{GNAT} or @code{GNAT-LLVM}. @end itemize @@ -30297,8 +30295,8 @@ to permit their use in free software. @printindex ge -@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @anchor{d2}@w{ } +@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @c %**end of body @bye From patchwork Mon Sep 15 13:01:13 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120272 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9B6AD3857B8F for ; Mon, 15 Sep 2025 13:26:16 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9B6AD3857B8F Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=VALi/lLG X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x435.google.com (mail-wr1-x435.google.com [IPv6:2a00:1450:4864:20::435]) by sourceware.org (Postfix) with ESMTPS id 3C13A38560BC for ; Mon, 15 Sep 2025 13:01:56 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3C13A38560BC Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 3C13A38560BC Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::435 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941316; cv=none; b=DO3x/ZpNQyE9XHYR7goW1TtyaxEXTK7l9Rps3jTpOVZ+dwiVefYFa2iW6+re3SEW9EeyqFz+G6Ttq/i2zIt1My+ijfjjo+rl2ZLhkV1hbKWLbd4Yt4VQDRpAtL+DW1sgtbep+vxkaIySvuwaBl/0GzOhg8lxs8tvZxV024Tk6sw= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941316; c=relaxed/simple; bh=Vm5b+WyzCmsKDmkk6wbFAFIXEzUEZsa5k6G6OVHNric=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Oa8T44khwezliTzlOQd1k4ehnFQ92kSPyShBWGdxilddKyo/VDlXuCfk4A0ZI7kR/+gkwGyoxC7KjjCTFpLN/wJZsrwxwyLc3kHUwBPGQmNZT6U18q1LVT+HlwI3ILdKv5TK8QQrQ0GOcDgvWswUAGhv7rBcTGSs6+sWQzqz/9o= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3C13A38560BC Received: by mail-wr1-x435.google.com with SMTP id ffacd0b85a97d-3e4b5aee522so2515812f8f.1 for ; Mon, 15 Sep 2025 06:01:56 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941315; x=1758546115; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=Bv834msUnz8GbMrouo53CBFSo3bwrUKpIuca2Q7gaOg=; b=VALi/lLGA6yEI5cCe5DfsQ3WkY03qMqMGlHg3fKkpYxdwBFS0ZDdw5Ly5t83QSF9N1 0mcUk23vFgQMuhCKu6JEWgjWtEzZT3lQgRoqoQj1mNlehF20d6y1BoIEAg16/sycrXrz jBlGMQfSpSSJXKsjVo5JbyY9MhkZFD8HP0jOxkQikjK5dZd0AIo6lRqBoWDaaH0PEEG2 8Rz1Y0s24aF8SXESz7kwppLFTfIhAL6RfmUM/edih5p4BtAhJZCiG79NQMeIEwHtRF2k iTRS0lbGzYQwvmMJlWIB+ovTrempFNr1U7G2w/BE4+D/uUR282t025mYPNy35wwjXQxv uHsw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941315; x=1758546115; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=Bv834msUnz8GbMrouo53CBFSo3bwrUKpIuca2Q7gaOg=; b=DNLhpRg32VH5vbRCso/sknwyffrg5oGkZ+hO3YJ4Bwh7ZRV7Dm575/Uz0EwgpXThdZ wVkVlAvhnV06ZyPdXzPx2jq1jH7yk9AIUlm4VD3KPJ7tmQQUStzLBHnfwLdDUT4DznsP 6sBYuytdtIoE6/UOopRFzLivGp6A4nJMaxb6ylvylREoX7klFBPyPOJP2c/q8iTuOWzz PQOMfxcNnJ4xyF0Uejbkj0gtwhYi/CYl5v/a6drp1beU3OCSidHgeoMgQg78JaNF9hJ9 A1F/VQJ/Nvnz4RLUhNY+fYs90+idr/FhD8ifLcaBLvQoppk2c0ZvwG3EzgMBIx7jz4O4 2Sgw== X-Gm-Message-State: AOJu0YxHMjf2POQ/IfmnT0sCKGzEl+HjF5JzHrMZIbwN2m2FUrJs9lJs 4fuVe69UdVt7tdjHn60gUtYTryLOBueGamP8d+tFiz1M35oPnk2jfvhTUDTxqaz0kNkZiXvJAoy 4PrQ= X-Gm-Gg: ASbGncvuLZ7hEN84DJ1NbkrpVMQVGK/INmiy/jEDyy+6z4XYIdo1z1+izQzczjWMOPW FvT8PaIisuW2khXc9AWxTjruFtPjJecOdD9/6NSWmXyjagacJjT5VtRr6GawIRS+mWj9l+PERqR BmSSqMVmJdDBm9SFXQ0iQGpCaCsbtX3qGLEz1BCAr/eRFhO2A15lQfbFtKhWzWkFyyrC261seT1 43Eyl33UP/E3ICPsZoQfLAW5K/dzIRHZUOS0jBjhvbzLyaASzRsK4apyfSVRL82ZCC6TE+CPLcY QRl+pvA8UABiWgL5eTaX2fDTk8umfJC6qxLD74LGQMBHThLziPOsXSNRx0rYYJd9frDRx8HH210 TgZrALz6RQo8s6Y3BFoTZHt7Lv+n0XVGhSkr7FIwM7xu0soTkNoROJZegjaCqG0ckVD78WIxKuW ksRUhYKnGxTh3H5gH8Hjl39xzwoHZMFV0xmYFPDNw/XyQtzC/r X-Google-Smtp-Source: AGHT+IFhxwd9wluPc73G2Cr+QSSz0uQkzNOdIFtFi8uWCUo9fEaHrvkhXLDK+4Iy/yi9cWXEUtZzhA== X-Received: by 2002:a05:6000:1a86:b0:3e7:490c:1b2 with SMTP id ffacd0b85a97d-3e7659c4d6dmr11557513f8f.36.1757941314622; Mon, 15 Sep 2025 06:01:54 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.53 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:54 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Sebastian Poeplau Subject: [COMMITTED 07/27] ada: Remove the note that GNAT LLVM doesn't ship the light runtime Date: Mon, 15 Sep 2025 15:01:13 +0200 Message-ID: <20250915130135.2720894-7-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Sebastian Poeplau gcc/ada/ChangeLog: * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Remove the note on light runtimes. Tested on x86_64-pc-linux-gnu, committed on master. --- .../doc/gnat_ugn/building_executable_programs_with_gnat.rst | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 2a26e4659b8b..fbd3202c3d65 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -8143,5 +8143,4 @@ GNAT. .. only:: PRO - It provides the same runtimes with the exception that light runtimes - are not currently included with the native compilers. + It provides the same runtimes. From patchwork Mon Sep 15 13:01:14 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120266 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id F16D23857823 for ; Mon, 15 Sep 2025 13:15:07 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org F16D23857823 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=HId1jnER X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42a.google.com (mail-wr1-x42a.google.com [IPv6:2a00:1450:4864:20::42a]) by sourceware.org (Postfix) with ESMTPS id 3F4E0385C6C7 for ; Mon, 15 Sep 2025 13:01:57 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3F4E0385C6C7 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 3F4E0385C6C7 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941317; cv=none; b=VXXSsNodhuhlx4RfkWWbsqtNoUvJSR4F/l3wyleyCrA6LNKqLvtOJN5ahZBxM2GbwM3JQS/L39U2tW8WEkDlcadKD669rpAvag7B0+onOKkTfU1eKDGpSxA78N7vpVmdiIAFRdx7NnE9mntgCi/HSOw304f0MvHobQWjuHGE0bc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941317; c=relaxed/simple; bh=UYqJkIzjBei7uQ09eGvfeB9/3MiVtW2taAkpQAATam4=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=bm1PdpqdYr38h+vysBhuFjwkoC9/ZCuXad8FCVs9hKzaJ7s5C5qNqsGr02XNltnxJtUiFqRspEVsinFkhpcrSnA3i7FNIVJg3oWPPOwkP1txNveVGpuvpda2g1XrDpFgmr4Si5Y4V/is/XTZKMN14q7/3NVb3VfAPVpa2T9Ewao= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3F4E0385C6C7 Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-3e957ca53d1so1294360f8f.0 for ; Mon, 15 Sep 2025 06:01:57 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941316; x=1758546116; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=kWS3zjN2UMMErw3jYRhZy9/DDEVLmKFuqXzrwC9jMrQ=; b=HId1jnERFPSzcHMfFWr2CN1ZbxldwfVTTNAVnc9BccBC5WYxksjEuijZviRkO7zDgc DjwCuojL+AHeoAVS+13jDxkE3l66rr6UV+AFcwvSOq+wwX6k8tr40shLnJPGgU/hjcz5 1yb77QX0EwGAIiekyKZGOmjNJjQumgyljDic0Sxd4eypike7nbjdBmNYZYaLPWG/fs9Q 54RyxIeQsQP9K3CB2RbqstPSP3zWNRU6osou5Z7/XQ0dE75nDqbb/4Jley7MDjdmeSbi EOetSQcPbiGx+9jzOeJMoBqGvn5h+jDIFaeIFlrhbe2KCEtTfXG/45O8GIoecJHTCa0n mcRg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941316; x=1758546116; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=kWS3zjN2UMMErw3jYRhZy9/DDEVLmKFuqXzrwC9jMrQ=; b=L0dPN0GTiBbEx2L79Wb3jCevhWcWHRgTdR4rd0AtE+gEKBAu5EtVKXGDyMp7vlXElL x8Qhhf3cHeJxjdBKXEPp9SAtdqRJwIo4QBlwaKRJJ1YguqqahqJcpDY75erHPkSBlr/+ XxTML9TcNtViPK/k4W2JzRROdvAHyU3rsteMPj4BQLreJcFSekGRrtEf4jKcjCLwJGgE 2Ehfb/2LH9tOw1wIo+g309/WR1n/y6bOdDY5CbyTvZSFOINLMiPcd0H5UwYn2IYt2GSm 8abhdCQ5VD5XCSW/+tKTtJA7LJvfT2UJd/u5nb7ooBbBj/2Ec0WMbVuUOR35CXwBAkWx AZOA== X-Gm-Message-State: AOJu0Yy0JrgUsqHSOlFgPYAZBsg9Qt0bGQs29EewB6ZhHsI+Te9xc458 agTUUCTTvsfz6QBRjtriP3+E+Y1LkYuDxMsK/KiG4QiUspuCOn0lhMfwGjDPO6KpCycTSEM6KOo YGyc= X-Gm-Gg: ASbGncs+INGqpmcEuYiA9WMTwTu54owvfoyAI4hGOYvoFFzOKxBMHjOkobntKF1wCg1 BwPNH4/gtMvVc2vsohPTeVonGPKWsppNW42WMjpshRQJMa4DR4m/yFPOFM8jrXfG4AeUpuvdVU/ rzkHdi1X/AImbEALgfdVCD4hWptgDP/lPHpewIMbAxwBMd4RoGaRs8lzzP8dqOQtR6upxnAJGo+ jixoxkBjaMjxAH36FGr7i5cxMcsUCSdL47nG/0S9FRYZz1tItH1uqpCWd0BpOH1dZS+NDMmRL/z hoMfUu8R/XOSKTATfitWFafdgOwBjh8cAPevYnkO7iwwtBlPabGNAM6NaX1G46naNUAy/D27TWl 5SEB+Sf0t5hJQsc1i00uUmsAYD+v5mWEzvQr6YGGkhn4pey9Nsn0mDh8K9ZiDpkDQxLl6NnNeJW Xr5Xu+a2QzknvpuEshLkwNl5lY9Mq5bf2v7tXHbQ== X-Google-Smtp-Source: AGHT+IGGEAw0gaOHYudeVNYimtgP+ZI557lo7lrIjPvjosmkmSVKpwCe/Odn7IslGQnWLsz9KtR9zg== X-Received: by 2002:a05:6000:4287:b0:3e9:b7a5:5dc9 with SMTP id ffacd0b85a97d-3e9b7a56e8emr4734021f8f.23.1757941315578; Mon, 15 Sep 2025 06:01:55 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.54 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:55 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 08/27] ada: Improve ghost region creation for pragmas Date: Mon, 15 Sep 2025 15:01:14 +0200 Message-ID: <20250915130135.2720894-8-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus gcc/ada/ChangeLog: * atree.adb (Mark_New_Ghost_Node): Set Is_Implicit_Ghost for all newly created nodes. * gen_il-fields.ads (Is_Implicit_Ghost): New attribute. * gen_il-gen-gen_entities.adb (Entity_Kind): Add Is_Implicit_Ghost attribute. * ghost.adb (Ghost_Policy_In_Effect): Implicit_Ghost_Entities inside pragmas get the ghost mode from the region isntead of the global ghost policy. (Ghost_Assertion_Level_In_Effect): New function that returns the applicable assertion level for the given entity in a similar manner as Ghost_Policy_In_Effect. (Install_Ghost_Region): Set Is_Inside_Statement_Or_Pragma attribute. (Mark_And_Set_Ghost_Body): Update the logic for deriving the ghost region. (Set_Ghost_Mode): Ignored pragmas attached to checked ghost entities now create an ignored ghost region. Pragmas attached to non-ghost entities create the ghost region based on the policy applied to the given pragma. * opt.ads (Ghost_Config_Type): add new attribute Is_Inside_Statement_Or_Pragama to track whether we should take the active ghost mode from the ghost region for implicit ghost entities. * sem_prag.adb (Analyze_Pragma): Mark entities that have an explicit ghost pragma as non-implicit ghost. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/atree.adb | 2 + gcc/ada/gen_il-fields.ads | 1 + gcc/ada/gen_il-gen-gen_entities.adb | 1 + gcc/ada/ghost.adb | 138 +++++++++++++++++++--------- gcc/ada/opt.ads | 6 ++ gcc/ada/sem_prag.adb | 1 + 6 files changed, 106 insertions(+), 43 deletions(-) diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 197d1ee51210..14d9ba4bb2fd 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -1807,6 +1807,7 @@ package body Atree is Set_Is_Checked_Ghost_Entity (N); Set_Ghost_Assertion_Level (N, Ghost_Config.Ghost_Mode_Assertion_Level); + Set_Is_Implicit_Ghost (N); end if; elsif Ghost_Config.Ghost_Mode = Ignore then @@ -1814,6 +1815,7 @@ package body Atree is Set_Is_Ignored_Ghost_Entity (N); Set_Ghost_Assertion_Level (N, Ghost_Config.Ghost_Mode_Assertion_Level); + Set_Is_Implicit_Ghost (N); end if; Set_Is_Ignored_Ghost_Node (N); diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index c9f9bc2c5ba6..6ff9866e6431 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -743,6 +743,7 @@ package Gen_IL.Fields is Is_Immediately_Visible, Is_Implementation_Defined, Is_Implicit_Full_View, + Is_Implicit_Ghost, Is_Imported, Is_Independent, Is_Initial_Condition_Procedure, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index dd07b7a6e6e5..476e69d22cc0 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -159,6 +159,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Is_Ignored_Ghost_Entity, Flag), Sm (Is_Immediately_Visible, Flag), Sm (Is_Implementation_Defined, Flag), + Sm (Is_Implicit_Ghost, Flag), Sm (Is_Imported, Flag), Sm (Is_Independent, Flag), Sm (Is_Inlined, Flag), diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index ae20ef972c82..bfe6bff0751e 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -94,15 +94,30 @@ package body Ghost is -- Returns the Assertion_Level entity if the node has a Ghost aspect and -- the Ghost aspect is using an Assertion_Level. + function Ghost_Assertion_Level_In_Effect (Id : Entity_Id) return Entity_Id; + -- Returns the ghost level applicable for the given entity Id in a similar + -- manner as Ghost_Policy_In_Effect. + function Ghost_Policy_In_Effect (Id : Entity_Id) return Name_Id; - -- Returns the first Assertion Policy in place for either Ghost or the - -- Assertion_Level associated with Ghost aspect on the the declaration node - -- Decl. + -- Returns the ghost policy applicable for the given entity Id. + -- + -- SPARK RM 6.9 (3): + -- + -- An object declaration which occurs inside an expression in a ghost + -- declaration, statement, assertion pragma or specification aspect + -- declaration is a ghost declaration. + -- + -- If this declaration does not have the Ghost aspect specified, the + -- assertion policy applicable to this declaration comes from the policy + -- applicable to the enclosing declaration, statement, assertion pragma + -- or specification aspect. + -- + -- Otherwise, the assertion policy applicable to an object declaration + -- comes either from its assertion level if any, or from the ghost + -- policy at the point of declaration. procedure Install_Ghost_Region - (Mode : Name_Id; - N : Node_Id; - Level : Entity_Id); + (Mode : Name_Id; N : Node_Id; Level : Entity_Id); pragma Inline (Install_Ghost_Region); -- Install a Ghost region comprised of mode Mode and ignored region start -- node N and Level as the Assertion_Level that was associated with it. @@ -1561,6 +1576,22 @@ package body Ghost is return Empty; end Get_Ghost_Assertion_Level; + ------------------------------------- + -- Ghost_Assertion_Level_In_Effect -- + ------------------------------------- + + function Ghost_Assertion_Level_In_Effect (Id : Entity_Id) return Entity_Id + is + begin + if Ghost_Config.Is_Inside_Statement_Or_Pragma + and then Is_Implicit_Ghost (Id) + then + return Ghost_Config.Ghost_Mode_Assertion_Level; + else + return Ghost_Assertion_Level (Id); + end if; + end Ghost_Assertion_Level_In_Effect; + ---------------------------- -- Ghost_Policy_In_Effect -- ---------------------------- @@ -1570,7 +1601,22 @@ package body Ghost is Level_Nam : constant Name_Id := (if No (Level) then No_Name else Chars (Level)); begin - return Policy_In_Effect (Name_Ghost, Level_Nam); + if Ghost_Config.Is_Inside_Statement_Or_Pragma + and then Is_Implicit_Ghost (Id) + then + case Ghost_Config.Ghost_Mode is + when Check => + return Name_Check; + + when Ignore => + return Name_Ignore; + + when None => + return No_Name; + end case; + else + return Policy_In_Effect (Name_Ghost, Level_Nam); + end if; end Ghost_Policy_In_Effect; -------------------------------- @@ -1642,12 +1688,18 @@ package body Ghost is Ghost_Config.Current_Region := N; Ghost_Config.Ghost_Mode := Mode; Ghost_Config.Ghost_Mode_Assertion_Level := Level; + + if Nkind (Ghost_Config.Current_Region) + in N_Statement_Other_Than_Procedure_Call + | N_Procedure_Call_Statement + | N_Pragma + then + Ghost_Config.Is_Inside_Statement_Or_Pragma := True; + end if; end Install_Ghost_Region; procedure Install_Ghost_Region - (Mode : Name_Id; - N : Node_Id; - Level : Entity_Id) is + (Mode : Name_Id; N : Node_Id; Level : Entity_Id) is begin Install_Ghost_Region (Name_To_Ghost_Mode (Mode), N, Level); end Install_Ghost_Region; @@ -1657,14 +1709,13 @@ package body Ghost is ------------------------- function Is_Assertion_Level_Dependent - (Self : Entity_Id; Other : Entity_Id) return Boolean - is + (Self : Entity_Id; Other : Entity_Id) return Boolean is begin return - Self = Standard_Level_Default - or else Other = Standard_Level_Default - or else Is_Same_Or_Depends_On_Level (Self, Other) - or else Is_Same_Or_Depends_On_Level (Self, Standard_Level_Static); + Self = Standard_Level_Default + or else Other = Standard_Level_Default + or else Is_Same_Or_Depends_On_Level (Self, Other) + or else Is_Same_Or_Depends_On_Level (Self, Standard_Level_Static); end Is_Assertion_Level_Dependent; ------------------------- @@ -1977,10 +2028,7 @@ package body Ghost is -- Mark_And_Set_Ghost_Body -- ----------------------------- - procedure Mark_And_Set_Ghost_Body - (N : Node_Id; - Spec_Id : Entity_Id) - is + procedure Mark_And_Set_Ghost_Body (N : Node_Id; Spec_Id : Entity_Id) is Body_Id : constant Entity_Id := Defining_Entity (N); Level : Entity_Id := Empty; Policy : Name_Id := No_Name; @@ -1991,10 +2039,10 @@ package body Ghost is if Is_Subject_To_Ghost (N) then if Present (Spec_Id) then Policy := Ghost_Policy_In_Effect (Spec_Id); - Level := Ghost_Assertion_Level (Spec_Id); + Level := Ghost_Assertion_Level_In_Effect (Spec_Id); else Policy := Ghost_Policy_In_Effect (Body_Id); - Level := Ghost_Assertion_Level (Body_Id); + Level := Ghost_Assertion_Level_In_Effect (Body_Id); end if; -- A body declared within a Ghost region is automatically Ghost @@ -2002,11 +2050,11 @@ package body Ghost is elsif Ghost_Config.Ghost_Mode = Check then Policy := Name_Check; - Level := Ghost_Config.Ghost_Mode_Assertion_Level; + Level := Ghost_Config.Ghost_Mode_Assertion_Level; elsif Ghost_Config.Ghost_Mode = Ignore then Policy := Name_Ignore; - Level := Ghost_Config.Ghost_Mode_Assertion_Level; + Level := Ghost_Config.Ghost_Mode_Assertion_Level; -- Inherit the "ghostness" of the previous declaration when the body -- acts as a completion. @@ -2025,13 +2073,7 @@ package body Ghost is -- The Ghost policy in effect at the point of declaration and at the -- point of completion must match (SPARK RM 6.9(16)). - Check_Ghost_Completion - (Prev_Id => Spec_Id, - Compl_Id => Body_Id); - - if Present (Level) then - Set_Ghost_Assertion_Level (Body_Id, Level); - end if; + Check_Ghost_Completion (Prev_Id => Spec_Id, Compl_Id => Body_Id); -- Mark the body as its formals as Ghost @@ -2441,16 +2483,15 @@ package body Ghost is end if; end Mark_Ghost_Pragma; - procedure Mark_Ghost_Pragma - (N : Node_Id; - Mode : Ghost_Mode_Type) - is + procedure Mark_Ghost_Pragma (N : Node_Id; Mode : Ghost_Mode_Type) is begin if Mode = Check then - Set_Is_Checked_Ghost_Pragma (N); + Set_Is_Checked_Ghost_Pragma (N, True); + Set_Is_Ignored_Ghost_Pragma (N, False); else - Set_Is_Ignored_Ghost_Pragma (N); + Set_Is_Checked_Ghost_Pragma (N, False); + Set_Is_Ignored_Ghost_Pragma (N, True); Set_Is_Ignored_Ghost_Node (N); Record_Ignored_Ghost_Node (N); end if; @@ -2460,10 +2501,7 @@ package body Ghost is -- Mark_Ghost_Renaming -- ------------------------- - procedure Mark_Ghost_Renaming - (N : Node_Id; - Id : Entity_Id) - is + procedure Mark_Ghost_Renaming (N : Node_Id; Id : Entity_Id) is Policy : Name_Id := No_Name; Level : constant Entity_Id := Ghost_Assertion_Level (Id); begin @@ -2661,12 +2699,26 @@ package body Ghost is elsif Nkind (N) = N_Pragma then Level := Pragma_Ghost_Assertion_Level (N); + if Is_Checked_Ghost_Pragma (N) then - Install_Ghost_Region (Check, N, Level); + + -- Still install an ignored ghost region if the pragma is attached + -- to a checked ghost entity, but the pragma itself is explicitly + -- ignored. + + if Is_Ignored (N) then + Install_Ghost_Region (Ignore, N, Level); + else + Install_Ghost_Region (Check, N, Level); + end if; elsif Is_Ignored_Ghost_Pragma (N) then Install_Ghost_Region (Ignore, N, Level); else - Install_Ghost_Region (None, N, Level); + if Is_Checked (N) then + Install_Ghost_Region (Check, N, Level); + else + Install_Ghost_Region (None, N, Level); + end if; end if; -- The Ghost mode of a procedure call depends on the Ghost mode of the diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 109d28245de9..ea3390e2b482 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -767,6 +767,12 @@ package Opt is Current_Region : Node_Id := Empty; -- Latest ghost region + + Is_Inside_Statement_Or_Pragma : Boolean := False; + -- A flag to tag whether we are currently in a region that originated + -- from a Statement or a pragma. Inside those regions the ghost policy + -- in effect for implicitly defined entities is not the policy for Ghost + -- but instead the policy for the region (SPARK RM 6.9 (3)). end record; Ghost_Config : Ghost_Config_Type; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 00c9b17ff6ee..a17d9d2b8138 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19428,6 +19428,7 @@ package body Sem_Prag is -- pragma Ghost (False). if Is_Ghost then + Set_Is_Implicit_Ghost (Id, False); Set_Is_Ghost_Entity (Id); end if; end Ghost; From patchwork Mon Sep 15 13:01:15 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120281 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E0E1E3857709 for ; Mon, 15 Sep 2025 13:39:54 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E0E1E3857709 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=B6k9VkHp X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32a.google.com (mail-wm1-x32a.google.com [IPv6:2a00:1450:4864:20::32a]) by sourceware.org (Postfix) with ESMTPS id 8D56A3856DF2 for ; Mon, 15 Sep 2025 13:01:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 8D56A3856DF2 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 8D56A3856DF2 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941319; cv=none; b=wwZO3AUP1X6T1PYWMHUEjUpgn8QLSEeCTE35o4asFArTrDHS8WrptQem6LU1/ZferDEK1T2Z95ABuUWgxon1/qSVrmn6/8geYmVfNvPkiri2srei/9AS77bhWil692IOFRzvd68oQzn8DR2zebpZgbKI1FfmsKgu5AuqEsgRsQg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941319; c=relaxed/simple; bh=qxBTzOz6ISJEAtW4y23A/9wzO4rEbOdgkH93Jjdr6kU=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=u6YMb7xlQ0uLOsaj85MQjtDWhUjqGkL4fEI+/gUVF+P25o4IS2n15TCgjESSznf4ZulgwBf/72MwBEGMlwxvGgOgR/uA/vnDh5UgvwM7Ijk1Mz1+E/G5U7lcpCq5xBEH7L7wUB3dgYX15LGSMhJtDgnN6gSK64sbBDWOU4iJtgk= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8D56A3856DF2 Received: by mail-wm1-x32a.google.com with SMTP id 5b1f17b1804b1-45dcff2f313so26232905e9.0 for ; Mon, 15 Sep 2025 06:01:58 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941317; x=1758546117; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=f79zIvUTZ4QiAdasr1T4pJG46+PWcjX0NkICfpFICWw=; b=B6k9VkHpRDMdcDtpGQE0KAzwzBEn9N5ujS7akjqD72JMCawOUIlWyZBKZt22ip0bJi REN9OolRlvCMkd3iZ4HPCwKFrGbHAjY0NLaKkd3qWEW5l/j2G+M2HHSoV25nc8n/EeVz Z4db1fYllG6/2gwM1t3uY1Rf9jGSwi44FvLOgeFjirwqmbPsrR0JQVIh9ikWJjVBJyk+ yardpcQBHeB3k65lBJr8VlOtmcXZ2bOwA0vXWkUqk+LT5puI/hIuJinpFGsrKCXjG6q6 Y80iB+Xt0UWX1bHNMD0/paiMtASk8v4tmr87B+1qNVDIrOPEWB04IwzFP6MKCRuTFGQX DAow== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941317; x=1758546117; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=f79zIvUTZ4QiAdasr1T4pJG46+PWcjX0NkICfpFICWw=; b=Ea1D1TgUr34wOgefVCEDXqPCTlZ2VTJz9cv6aCaFqchH1EThJUZl+JwemgkkPmjZUO 70Fyu6V0hVq/dc6NpltYjUxIOb1TBP7N2DB8hTexMEvJ7vaPNaQwrhePZ/4+KmM9OU/o DkHTl2LNSaG/ufRZyY3mlTPyDfnt5qvEx1VFvU/vXuXhBIYeQW4K8h7gITvFJip5pIYK eCTKumdnp7GemvjX/07FubUvDqtDVB/1tPr87nyiSQrAMhFNF0taARsrAZdQTlgAH7y6 uV9IZpvxbnjCWFFLFIRAjqYVlZ6GeEhAcW+/mqppbwRVSP0ch99n8xMfIKSQWVnNhrLX XUVg== X-Gm-Message-State: AOJu0YxHZOJ1eXFm3vj6zqGqXeDI5VMQAuHd/Rn2AcKr1oyu5JfFyOiQ q3f4muT22/V0rB6rxG1do/Q6aFCe4UwEFL13eX20Ge2g7QaO+vC66so+7pIJ4MnD3vY/LdkMjGM vAy0= X-Gm-Gg: ASbGncteNELeG4+zyYb+THu2MDNuU0RjFs02l3iZe52Lr7eso4Q0xmDEjPCffHETmB0 ntmqy8oc2dTLj/l5FdOSzMqWrRcwvrxIgr8qmEI5yS0owJET7DuCBuu/GFp0CHBN3XAg0UVvx/O +cuYEE2AgS2itSCDcwH32G1nKqRl44JpD7NbboUBQsZ/LYaBDdQpLbkoyDaQNL3GcKZq0Erfa6H FWQv7ohsmnI2X3arxcSDiRPXUergvCnMwx6nsoDFFe9oFbZM8U/RzhoMoTj1wEwuIw1JyCztlCz PEeonwWWuRRv8CFez7eX+efEMAb7A+XEI3NNqP1RgnsTQ3hTHqTsnzCYRU/MIzYBHFhLphK4O9g 2gCoyoM30iAJGhln+jwBZru5GxypYSHeFdf7mSprLyvsfdjun315WOpqMZ6JrTfBAmLdN61NpVd Xs8tUj2ZuqavV28uH/eWpTSKwgMVcW+GumH8RY8g== X-Google-Smtp-Source: AGHT+IE67VlryV1tfzDJ8z9YPQ5LgjUeu4iJlre+kFq2V2n/4pKtoWOOPQo1qj+Qptl3bl6heSArhw== X-Received: by 2002:a05:600c:6288:b0:45d:e326:96fb with SMTP id 5b1f17b1804b1-45f211ff89emr131853665e9.30.1757941316619; Mon, 15 Sep 2025 06:01:56 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.55 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:55 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [COMMITTED 09/27] ada: Implement Super aspect and improve implementation of related features. Date: Mon, 15 Sep 2025 15:01:15 +0200 Message-ID: <20250915130135.2720894-9-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Steve Baird Implement the GNAT-defined Super aspect (which should not be confused with with the Super attribute). For a two-part constructor procedure declaration, an Initialize aspect specification is permitted on the subprogram body, and not on the subprogram specification (this reverses was what was previously implemented). Improve the implementation of the Make attribute. gcc/ada/ChangeLog: * aspects.ads: Define Super aspect; allow Initialize aspect specification on a subprogram body. * exp_attr.adb (Expand_N_Attribute_Reference): Rewrite Make attribute implementation. * exp_ch3.adb (Initialization_Control): Delete Initialization_Mode and Make_Mode_Literal (those declarations were moved to the spec). (Build_Record_Init_Proc): For a constructor type, component initialization (other than for the tag component, if any) must be performed by calling the single-argument constructor procedure. (Requires_Init_Proc): Return True for a constructor type. * exp_ch3.ads (Make_Mode_Literal, Initialization_Mode): New, moved from the body of this package. * exp_ch6.adb (Expand_N_Subprogram_Body): Declare, implement, and call a new local procedure, Prepend_Constructor_Procedure_Prologue in order to generate component initialization for a constructor procedure. * sem_attr.adb (Analyze_Attribute): Improve the error message generated for a 'Make attribute reference if GNAT extensions are not all allowed. * sem_ch13.adb (Analyze_One_Aspect): Improved implementation of aspect specifications for Initialize, Constructor, and Super aspects. For Super, there was no previous implementation. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.ads | 9 +- gcc/ada/exp_attr.adb | 328 +++++-------------------------------------- gcc/ada/exp_ch3.adb | 79 ++++++----- gcc/ada/exp_ch3.ads | 27 ++++ gcc/ada/exp_ch6.adb | 309 ++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_attr.adb | 4 +- gcc/ada/sem_ch13.adb | 109 ++++++++++++-- 7 files changed, 519 insertions(+), 346 deletions(-) diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 88fea2e818ce..2871f318b3e5 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -158,6 +158,7 @@ package Aspects is Aspect_Stream_Size, Aspect_String_Literal, Aspect_Subprogram_Variant, -- GNAT + Aspect_Super, -- GNAT Aspect_Suppress, Aspect_Synchronization, Aspect_Test_Case, -- GNAT @@ -518,6 +519,7 @@ package Aspects is Aspect_Stream_Size => Expression, Aspect_String_Literal => Name, Aspect_Subprogram_Variant => Expression, + Aspect_Super => Expression, Aspect_Suppress => Name, Aspect_Synchronization => Name, Aspect_Test_Case => Expression, @@ -626,6 +628,7 @@ package Aspects is Aspect_Stream_Size => True, Aspect_String_Literal => False, Aspect_Subprogram_Variant => False, + Aspect_Super => False, Aspect_Suppress => False, Aspect_Synchronization => False, Aspect_Test_Case => False, @@ -842,6 +845,7 @@ package Aspects is Aspect_Stream_Size => Name_Stream_Size, Aspect_String_Literal => Name_String_Literal, Aspect_Subprogram_Variant => Name_Subprogram_Variant, + Aspect_Super => Name_Super, Aspect_Suppress => Name_Suppress, Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info, Aspect_Suppress_Initialization => Name_Suppress_Initialization, @@ -1124,6 +1128,7 @@ package Aspects is Aspect_SPARK_Mode => Never_Delay, Aspect_Static => Never_Delay, Aspect_Subprogram_Variant => Never_Delay, + Aspect_Super => Never_Delay, Aspect_Synchronization => Never_Delay, Aspect_Test_Case => Never_Delay, Aspect_Unimplemented => Never_Delay, @@ -1193,10 +1198,12 @@ package Aspects is -- Sem_Prag. Aspect_On_Body_Or_Stub_OK : constant array (Aspect_Id) of Boolean := - (Aspect_Refined_Depends => True, + (Aspect_Initialize => True, + Aspect_Refined_Depends => True, Aspect_Refined_Global => True, Aspect_Refined_Post => True, Aspect_SPARK_Mode => True, + Aspect_Super => True, Aspect_Warnings => True, others => False); diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 7fc104d173bc..a7255da90180 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -24,7 +24,6 @@ ------------------------------------------------------------------------------ with Accessibility; use Accessibility; -with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; @@ -5113,310 +5112,57 @@ package body Exp_Attr is when Attribute_Make => declare - Params : List_Id; - Param : Node_Id; - Par : Node_Id; - Construct : Entity_Id; - Obj : Node_Id := Empty; - Make_Expr : Node_Id := N; - - Formal : Entity_Id; - Replace_Expr : Node_Id; - Init_Param : Node_Id; - Construct_Call : Node_Id; - Curr_Nam : Node_Id := Empty; - - function Replace_Formal_Ref - (N : Node_Id) return Traverse_Result; - - function Replace_Formal_Ref - (N : Node_Id) return Traverse_Result is - begin - if Is_Entity_Name (N) - and then Chars (Formal) = Chars (N) - then - Rewrite (N, - New_Copy_Tree (Replace_Expr)); - end if; - - return OK; - end Replace_Formal_Ref; - - procedure Search_And_Replace_Formal is new - Traverse_Proc (Replace_Formal_Ref); - + Constructor_Params : List_Id := New_Copy_List (Expressions (N)); + Constructor_Call : Node_Id; + Constructor_EWA : Node_Id; + Result_Decl : Node_Id; + Result_Id : constant Entity_Id := + Make_Temporary (Loc, 'D', N); begin - -- Remove side effects for constructor call - - Param := First (Expressions (N)); - while Present (Param) loop - if Nkind (Param) = N_Parameter_Association then - Remove_Side_Effects (Explicit_Actual_Parameter (Param), - Check_Side_Effects => False); - else - Remove_Side_Effects (Param, Check_Side_Effects => False); - end if; - - Next (Param); - end loop; - - -- Construct the parameters list - - Params := New_Copy_List (Expressions (N)); - if Is_Empty_List (Params) then - Params := New_List; + if Is_Empty_List (Constructor_Params) then + Constructor_Params := New_List; end if; - -- Identify the enclosing parent for the non-copy cases + Result_Decl := Make_Object_Declaration (Loc, + Defining_Identifier => Result_Id, + Object_Definition => + New_Occurrence_Of (Typ, Loc)); - Par := Parent (N); - if Nkind (Par) = N_Qualified_Expression then - Par := Parent (Par); - Make_Expr := Par; - end if; - if Nkind (Par) = N_Allocator then - Par := Parent (Par); - Curr_Nam := Make_Explicit_Dereference - (Loc, Prefix => Empty); - Obj := Curr_Nam; - end if; + -- Suppress default initialization for result object. + -- Default init (except for tag, if tagged) will instead be + -- performed in the constructor procedure. + + Mutate_Ekind (Result_Id, E_Variable); + Set_Suppress_Initialization (Result_Id); + + -- Build a prefixed-notation call declare - Base_Obj : Node_Id := Empty; - Typ_Comp : Entity_Id; - Agg_Comp : Entity_Id; - Comp_Nam : Node_Id := Empty; + Proc_Name : constant Node_Id := + Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (Result_Id, Loc), + Selector_Name => Make_Identifier (Loc, + Chars (Constructor_Name (Typ)))); begin - while Nkind (Par) not in N_Object_Declaration - | N_Assignment_Statement - loop - if Nkind (Par) = N_Aggregate then - Typ_Comp := First_Entity (Etype (Par)); - Agg_Comp := First (Expressions (Par)); - loop - if No (Agg_Comp) then - return; - end if; + Set_Is_Prefixed_Call (Proc_Name); - if Agg_Comp = Make_Expr then - Comp_Nam := - Make_Selected_Component (Loc, - Prefix => Empty, - Selector_Name => - New_Occurrence_Of (Typ_Comp, Loc)); - - Make_Expr := Parent (Make_Expr); - Par := Parent (Par); - exit; - end if; - - Next_Entity (Typ_Comp); - Next (Agg_Comp); - end loop; - elsif Nkind (Par) = N_Component_Association then - Comp_Nam := - Make_Selected_Component (Loc, - Prefix => Empty, - Selector_Name => - Make_Identifier (Loc, - (Chars (First (Choices (Par)))))); - - Make_Expr := Parent (Parent (Make_Expr)); - Par := Parent (Parent (Par)); - else - declare - Temp : constant Entity_Id := - Make_Temporary (Loc, 'T', N); - begin - Rewrite (N, - Make_Expression_With_Actions (Loc, - Actions => New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => Temp, - Object_Definition => - New_Occurrence_Of (Typ, Loc), - Expression => - New_Copy_Tree (N))), - Expression => New_Occurrence_Of (Temp, Loc))); - Analyze_And_Resolve (N); - return; - end; - end if; - - if No (Curr_Nam) then - Curr_Nam := Comp_Nam; - Obj := Curr_Nam; - elsif Has_Prefix (Curr_Nam) then - Set_Prefix (Curr_Nam, Comp_Nam); - Curr_Nam := Comp_Nam; - end if; - end loop; - - Base_Obj := (case Nkind (Par) is - when N_Assignment_Statement => - New_Copy_Tree (Name (Par)), - when N_Object_Declaration => - New_Occurrence_Of - (Defining_Identifier (Par), Loc), - when others => (raise Program_Error)); - - if Present (Curr_Nam) then - Set_Prefix (Curr_Nam, Base_Obj); - else - Obj := Base_Obj; - end if; + Constructor_Call := Make_Procedure_Call_Statement (Loc, + Parameter_Associations => Constructor_Params, + Name => Proc_Name); end; - Prepend_To (Params, Obj); + Set_Is_Expanded_Constructor_Call (Constructor_Call, True); - -- Find the constructor we are interested in by doing a - -- pseudo-pass to resolve the constructor call. + Constructor_EWA := + Make_Expression_With_Actions (Loc, + Actions => New_List (Result_Decl, Constructor_Call), + Expression => New_Occurrence_Of (Result_Id, Loc)); - declare - Dummy_Params : List_Id := New_Copy_List (Expressions (N)); - Dummy_Self : Node_Id; - Dummy_Block : Node_Id; - Dummy_Call : Node_Id; - Dummy_Id : Entity_Id := Make_Temporary (Loc, 'D', N); - begin - if Is_Empty_List (Dummy_Params) then - Dummy_Params := New_List; - end if; - - Dummy_Self := Make_Object_Declaration (Loc, - Defining_Identifier => Dummy_Id, - Object_Definition => - New_Occurrence_Of (Typ, Loc)); - Prepend_To (Dummy_Params, New_Occurrence_Of (Dummy_Id, Loc)); - - Dummy_Call := Make_Procedure_Call_Statement (Loc, - Parameter_Associations => Dummy_Params, - Name => - (if not Has_Prefix (Pref) then - Make_Identifier (Loc, - Chars (Constructor_Name (Typ))) - else - Make_Expanded_Name (Loc, - Chars => - Chars (Constructor_Name (Typ)), - Prefix => - New_Copy_Tree (Prefix (Pref)), - Selector_Name => - Make_Identifier (Loc, - Chars (Constructor_Name (Typ)))))); - Set_Is_Expanded_Constructor_Call (Dummy_Call, True); - - Dummy_Block := Make_Block_Statement (Loc, - Declarations => New_List (Dummy_Self), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Dummy_Call))); - - Expander_Active := False; - - Insert_After_And_Analyze - (Enclosing_Declaration_Or_Statement (Par), Dummy_Block); - - Expander_Active := True; - - -- Finally, we can get the constructor based on our pseudo-pass - - Construct := Entity (Name (Dummy_Call)); - - -- Replace the Typ'Make attribute with an aggregate featuring - -- then relevant aggregate from the correct constructor's - -- Inializeaspect if it is present - otherwise, simply use a - -- box. - - if Has_Aspect (Construct, Aspect_Initialize) then - Rewrite (N, - New_Copy_Tree - (Find_Value_Of_Aspect (Construct, Aspect_Initialize))); - - Param := Next (First (Params)); - Formal := Next_Entity (First_Entity (Construct)); - while Present (Param) loop - if Nkind (Param) = N_Parameter_Association then - Formal := Selector_Name (Param); - Replace_Expr := Explicit_Actual_Parameter (Param); - else - Replace_Expr := Param; - end if; - - Init_Param := First (Component_Associations (N)); - while Present (Init_Param) loop - Search_And_Replace_Formal (Expression (Init_Param)); - - Next (Init_Param); - end loop; - - if Nkind (Param) /= N_Parameter_Association then - Next_Entity (Formal); - end if; - Next (Param); - end loop; - - Init_Param := First (Component_Associations (N)); - while Present (Init_Param) loop - if Nkind (Expression (Init_Param)) = N_Attribute_Reference - and then Attribute_Name - (Expression (Init_Param)) = Name_Make - then - Insert_After (Par, - Make_Assignment_Statement (Loc, - Name => - Make_Selected_Component (Loc, - Prefix => - New_Copy_Tree (First (Params)), - Selector_Name => - Make_Identifier (Loc, - Chars (First (Choices (Init_Param))))), - Expression => - New_Copy_Tree (Expression (Init_Param)))); - - Rewrite (Expression (Init_Param), - Make_Aggregate (Loc, - Expressions => New_List, - Component_Associations => New_List ( - Make_Component_Association (Loc, - Choices => - New_List (Make_Others_Choice (Loc)), - Expression => Empty, - Box_Present => True)))); - end if; - - Next (Init_Param); - end loop; - else - Rewrite (N, - Make_Aggregate (Loc, - Expressions => New_List, - Component_Associations => New_List ( - Make_Component_Association (Loc, - Choices => New_List (Make_Others_Choice (Loc)), - Expression => Empty, - Box_Present => True)))); - end if; - - -- Rewrite this block to be null and pretend it didn't happen - - Rewrite (Dummy_Block, Make_Null_Statement (Loc)); - end; - - Analyze_And_Resolve (N, Typ); - - -- Finally, insert the constructor call - - Construct_Call := - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (Construct, Loc), - Parameter_Associations => Params); - - Set_Is_Expanded_Constructor_Call (Construct_Call); - Insert_After (Par, Construct_Call); + Rewrite (N, Constructor_EWA); end; + Analyze_And_Resolve (N, Typ); + -------------- -- Mantissa -- -------------- diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 07cb4eb84de8..d5dfc5d20944 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -75,7 +75,6 @@ with Sinfo.Nodes; use Sinfo.Nodes; with Sinfo.Utils; use Sinfo.Utils; with Stand; use Stand; with Snames; use Snames; -with Tbuild; use Tbuild; with Ttypes; use Ttypes; with Validsw; use Validsw; with Warnsw; use Warnsw; @@ -211,32 +210,6 @@ package body Exp_Ch3 is -- component that requires late initialization; this includes -- components of ancestor types. - type Initialization_Mode is - (Full_Init, Full_Init_Except_Tag, Early_Init_Only, Late_Init_Only); - -- The initialization routine for a tagged type is passed in a - -- formal parameter of this type, indicating what initialization - -- is to be performed. This parameter defaults to Full_Init in all - -- cases except when the init proc of a type extension (let's call - -- that type T2) calls the init proc of its parent (let's call that - -- type T1). In that case, one of the other 3 values will - -- be passed in. In all three of those cases, the Tag component has - -- already been initialized before the call and is therefore not to be - -- modified. T2's init proc will either call T1's init proc - -- once (with Full_Init_Except_Tag as the parameter value) or twice - -- (first with Early_Init_Only, then later with Late_Init_Only), - -- depending on the result returned by Has_Late_Init_Component (T1). - -- In the latter case, the first call does not initialize any - -- components that require late initialization and the second call - -- then performs that deferred initialization. - -- Strictly speaking, the formal parameter subtype is actually Natural - -- but calls will only pass in values corresponding to literals - -- of this enumeration type. - - function Make_Mode_Literal - (Loc : Source_Ptr; Mode : Initialization_Mode) return Node_Id - is (Make_Integer_Literal (Loc, Initialization_Mode'Pos (Mode))); - -- Generate an integer literal for a given mode value. - function Tag_Init_Condition (Loc : Source_Ptr; Init_Control_Formal : Entity_Id) return Node_Id; @@ -2481,14 +2454,10 @@ package body Exp_Ch3 is and then Nkind (Id_Ref) = N_Selected_Component and then Chars (Selector_Name (Id_Ref)) = Name_uParent then - declare - use Initialization_Control; - begin - Append_To (Args, - (if Present (Init_Control_Actual) - then Init_Control_Actual - else Make_Mode_Literal (Loc, Full_Init_Except_Tag))); - end; + Append_To (Args, + (if Present (Init_Control_Actual) + then Init_Control_Actual + else Make_Mode_Literal (Loc, Full_Init_Except_Tag))); elsif Present (Constructor_Ref) then Append_List_To (Args, New_Copy_List (Parameter_Associations (Constructor_Ref))); @@ -3216,6 +3185,40 @@ package body Exp_Ch3 is if Parent_Subtype_Renaming_Discrims then Append_List_To (Body_Stmts, Build_Init_Call_Thru (Parameters)); + elsif Present (Constructor_Name (Rec_Type)) then + if Present (Default_Constructor (Rec_Type)) then + -- The 'Make attribute reference (with no arguments) will + -- generate a call to the one-parameter constructor procedure. + + Append_To (Body_Stmts, + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of + (Defining_Identifier (First (Parameters)), Loc), + Expression => Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Rec_Type, Loc), + Attribute_Name => Name_Make))); + else + -- No constructor procedure with an appropriate profile + -- is available, so raise Program_Error. + -- + -- We could instead do nothing here, since the absence of a + -- one-parameter constructor procedure should trigger other + -- legality checks which should statically ensure that + -- the init proc we are constructing here will never be + -- called. So a bit of "belt and suspenders" here. + -- If this raise statement is ever executed, that probably + -- means that some compile-time legality check is not + -- implemented, and that the program should have instead + -- failed to compile. + -- Because this raise statement should never be executed, it + -- seems ok to pass in a dubious Reason parameter instead of + -- declaring a new RT_Exception_Code value. + + Append_To (Body_Stmts, + Make_Raise_Program_Error (Loc, + Reason => PE_Explicit_Raise)); + end if; + elsif Nkind (Type_Definition (N)) = N_Record_Definition then Build_Discriminant_Assignments (Body_Stmts); @@ -3310,7 +3313,7 @@ package body Exp_Ch3 is end if; end if; - -- Add here the assignment to instantiate the Tag + -- Add here the assignment to initialize the Tag -- The assignment corresponds to the code: @@ -4170,7 +4173,6 @@ package body Exp_Ch3 is if Present (Parent_Id) then declare Parent_Loc : constant Source_Ptr := Sloc (Parent (Parent_Id)); - use Initialization_Control; begin -- We are building the init proc for a type extension. -- Call the parent type's init proc a second time, this @@ -4558,6 +4560,8 @@ package body Exp_Ch3 is -- since the call is generated, there had better be a routine -- at the other end of the call, even if it does nothing). + -- 10. The type has a specified Constructor aspect. + -- Note: the reason we exclude the CPP_Class case is because in this -- case the initialization is performed by the C++ constructors, and -- the IP is built by Set_CPP_Constructors. @@ -4573,6 +4577,7 @@ package body Exp_Ch3 is or else Is_Tagged_Type (Rec_Id) or else Is_Concurrent_Record_Type (Rec_Id) or else Has_Task (Rec_Id) + or else Present (Constructor_Name (Rec_Id)) then return True; end if; diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index 0b0a2b68642c..69e6cb4ba352 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -27,6 +27,7 @@ with Elists; use Elists; with Exp_Tss; use Exp_Tss; +with Tbuild; use Tbuild; with Types; use Types; with Uintp; use Uintp; @@ -194,6 +195,32 @@ package Exp_Ch3 is -- initialized; if Variable_Comps is True then tags components located at -- variable positions of Target are initialized. + type Initialization_Mode is + (Full_Init, Full_Init_Except_Tag, Early_Init_Only, Late_Init_Only); + -- The initialization routine for a tagged type is passed in a + -- formal parameter of this type, indicating what initialization + -- is to be performed. This parameter defaults to Full_Init in all + -- cases except when the init proc of a type extension (let's call + -- that type T2) calls the init proc of its parent (let's call that + -- type T1). In that case, one of the other 3 values will + -- be passed in. In all three of those cases, the Tag component has + -- already been initialized before the call and is therefore not to be + -- modified. T2's init proc will either call T1's init proc + -- once (with Full_Init_Except_Tag as the parameter value) or twice + -- (first with Early_Init_Only, then later with Late_Init_Only), + -- depending on the result returned by Has_Late_Init_Component (T1). + -- In the latter case, the first call does not initialize any + -- components that require late initialization and the second call + -- then performs that deferred initialization. + -- Strictly speaking, the formal parameter subtype is actually Natural + -- but calls will only pass in values corresponding to literals + -- of this enumeration type. + + function Make_Mode_Literal + (Loc : Source_Ptr; Mode : Initialization_Mode) return Node_Id + is (Make_Integer_Literal (Loc, Initialization_Mode'Pos (Mode))); + -- Generate an integer literal for a given mode value. + procedure Make_Controlling_Function_Wrappers (Tag_Typ : Entity_Id; Decl_List : out List_Id; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 1a9002ce3a8b..32e96bed2349 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6244,6 +6244,15 @@ package body Exp_Ch6 is -- returns, since they get eliminated anyway later on. Spec_Id denotes -- the corresponding spec of the subprogram body. + procedure Prepend_Constructor_Procedure_Prologue + (Spec_Id : Entity_Id; Body_Id : Entity_Id; L : List_Id); + + -- If N is the body of a constructor procedure (that is, a procedure + -- named in a Constructor aspect specification for the type of the + -- procedure's first parameter), then prepend and analyze the + -- associated initialization code for that parameter. + -- This has nothing to do with CPP constructors. + ---------------- -- Add_Return -- ---------------- @@ -6317,6 +6326,300 @@ package body Exp_Ch6 is end if; end Add_Return; + -------------------------------------------- + -- Prepend_Constructor_Procedure_Prologue -- + -------------------------------------------- + + procedure Prepend_Constructor_Procedure_Prologue + (Spec_Id : Entity_Id; Body_Id : Entity_Id; L : List_Id) + is + + function First_Param_Type return Entity_Id is + (Implementation_Base_Type (Etype (First_Formal (Spec_Id)))); + + Is_Constructor_Procedure : constant Boolean := + Nkind (Specification (N)) = N_Procedure_Specification + and then Present (First_Formal (Spec_Id)) + and then Present (Constructor_Name (First_Param_Type)) + and then Chars (Spec_Id) = Chars (Constructor_Name + (First_Param_Type)) + and then Ekind (First_Formal (Spec_Id)) = E_In_Out_Parameter + and then Scope (Spec_Id) = Scope (First_Param_Type); + begin + if not Is_Constructor_Procedure then + return; -- the usual case + end if; + + -- Initialize the first parameter. + -- First_Param_Type is a record type (tagged or untagged) or + -- a type extension. If it is a type extension, then we begin by + -- calling the appropriate constructor procedure for the _parent + -- part. In the absence of a Super aspect specification, the + -- "appropriate" constructor is the one that takes only a single + -- parameter (the object being initialized). Additional actual + -- parameters for the constructor call may be provided via a + -- Super aspect specification, in which case a different + -- constructor procedure will be invoked. + -- + -- For each remaining component we first check to see if it + -- is mentioned in the Initialize aspect specification (if any) for + -- Body_Id. If so, then evaluate the expression given for that + -- component in the aspect specification and assign it to the + -- given component of the first parameter. If not, and if an + -- explicit default initial value is provided for the given component + -- in the type declaration, then do the same thing with that + -- expression instead. Otherwise perform normal default + -- initialization for the component - invoke the init proc for the + -- component's type if one exists, and otherwise do nothing. + + -- We do not perform tag initialization here. That is dealt with + -- elsewhere. The init proc for a tagged type is + -- passed an extra parameter indicating whether to perform + -- tag initialization. + + -- In the case of a type (tagged or untagged) that is not + -- an extension, we could just generate a single assignment, + -- taking the RHS from the Initialize aspect value (which is an + -- N_Aggregate node). But that gets complicated in the case of + -- an extension, so we handle all cases one component at a time. + + declare + Initialize_Aspect : constant Node_Id := + Find_Aspect (Body_Id, Aspect_Initialize); + + First_Initialize_Comp_Assoc : constant Node_Id := + (if Present (Initialize_Aspect) + then First (Component_Associations + (Expression (Initialize_Aspect))) + else Empty); + + Component : Entity_Id := First_Entity (First_Param_Type); + Init_List : constant List_Id := New_List; + + function Init_Expression_If_Any (Component : Entity_Id) + return Node_Id; + -- If the given component is mentioned in the Initialize + -- aspect for the constructor procedure, then return the + -- initial value expression specified there. + -- Otherwise, if the component declaration includes an + -- initial value expression, then return that expression. + -- Otherwise, return Empty. + + function Make_Init_Proc_Call (Component : Entity_Id; + Component_Name : Node_Id) + return Node_Id; + -- Builds and returns a call to the init proc for the type of + -- the component in order to initialize the given component. + -- The init proc must exist. + + function Make_Parent_Constructor_Call (Parent_Type : Entity_Id) + return Node_Id; + -- Builds and returns a call to the appropriate constructor + -- procedure of the parent type. + -- This function is called only in the case of a + -- Constructor procedure for a type extension. + + ---------------------------- + -- Init_Expression_If_Any -- + ---------------------------- + + function Init_Expression_If_Any (Component : Entity_Id) + return Node_Id + is + Initialize_Comp_Assoc : Node_Id := First_Initialize_Comp_Assoc; + Choice : Node_Id; + + -- ??? Technically, this is quadratic (linear search called + -- a linear number of times). When/if we see performance + -- problems with hundreds of components mentioned in one + -- Initialize aspect specification, we can revisit this. + begin + while Present (Initialize_Comp_Assoc) loop + Choice := First (Choices (Initialize_Comp_Assoc)); + + while Present (Choice) loop + if Nkind (Choice) = N_Identifier + and then Chars (Choice) = Chars (Component) + then + return Expression (Initialize_Comp_Assoc); + end if; + Next (Choice); + end loop; + + Next (Initialize_Comp_Assoc); + end loop; + + if Present (Expression (Parent (Component))) then + return Expression (Parent (Component)); + end if; + + return Empty; + end Init_Expression_If_Any; + + ------------------------- + -- Make_Init_Proc_Call -- + ------------------------- + + function Make_Init_Proc_Call (Component : Entity_Id; + Component_Name : Node_Id) + return Node_Id + is + Params : constant List_Id := New_List (Component_Name); + Init_Proc : constant Entity_Id := + Base_Init_Proc (Etype (Component)); + begin + if Is_Tagged_Type (Etype (Component)) then + Append (Make_Mode_Literal (Loc, Full_Init), Params); + end if; + + return Init_Proc_Call : constant Node_Id := + Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (Init_Proc, Loc), + Parameter_Associations => Params) + do + pragma Assert (Check_Number_Of_Actuals + (Subp_Call => Init_Proc_Call, + Subp_Id => Init_Proc)); + end return; + end Make_Init_Proc_Call; + + ---------------------------------- + -- Make_Parent_Constructor_Call -- + ---------------------------------- + + function Make_Parent_Constructor_Call (Parent_Type : Entity_Id) + return Node_Id + is + Actual_Parameters : List_Id := No_List; + Super_Aspect : constant Node_Id := + Find_Aspect (Body_Id, Aspect_Super); + + -- Do not confuse the Super aspect with the Super attribute. + -- Both are referenced here, but they are not related as + -- closely as some aspect/attribute homonym pairs are. + -- The attribute takes an object as a prefix. The aspect + -- can be specified for the body of a constructor procedure. + begin + if Present (Super_Aspect) then + declare + Super_Expr : constant Node_Id := + Expression (Super_Aspect); + Expr : Node_Id; + begin + if Nkind (Super_Expr) /= N_Aggregate then + Expr := New_Copy_Tree (Super_Expr); + Set_Paren_Count (Expr, 0); + Actual_Parameters := New_List (Expr); + else + -- Interpret this "aggregate" as a list of + -- actual parameter expressions. + + Actual_Parameters := New_List; + Expr := First (Expressions (Super_Expr)); + while Present (Expr) loop + Append (New_Copy_Tree (Expr), Actual_Parameters); + Next (Expr); + end loop; + end if; + end; + end if; + + -- Build a prefixed-notation call + declare + Proc_Name : constant Node_Id := + Make_Selected_Component (Loc, + Prefix => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of + (First_Formal (Spec_Id), Loc), + Attribute_Name => Name_Super), + Selector_Name => + Make_Identifier (Loc, + Chars (Constructor_Name (Parent_Type)))); + begin + Set_Is_Prefixed_Call (Proc_Name); + + return Make_Procedure_Call_Statement (Loc, + Name => Proc_Name, + Parameter_Associations => Actual_Parameters); + end; + end Make_Parent_Constructor_Call; + + begin + while Present (Component) loop + pragma Assert (Ekind (Component) = E_Component); + + if Chars (Component) = Name_uTag then + null; + + elsif Chars (Component) = Name_uParent then + -- ??? Here is where we should be looking for a + -- Super aspect specification in order to call the + -- right constructor with the right parameters + -- (as opposed to unconditionally calling the + -- single-parameter constructor). + Append_To (Init_List, Make_Parent_Constructor_Call + (Parent_Type => Etype (Component))); + + else + declare + Maybe_Init_Exp : constant Node_Id := + Init_Expression_If_Any (Component); + + function Make_Component_Name return Node_Id is + (Make_Selected_Component (Loc, + Prefix => + New_Occurrence_Of (First_Formal (Spec_Id), Loc), + Selector_Name => + Make_Identifier (Loc, Chars (Component)))); + begin + -- Handle case where initial value for this component + -- is specified either in an Initialize aspect + -- specification or as part of the component declaration. + + if Present (Maybe_Init_Exp) then + -- ??? Should reorganize things so that + -- procedure Build_Assignment in exp_ch3.adb + -- (which is currently declared inside of + -- Build_Record_Init_Proc) can be called from here. + -- That procedure handles some corner cases + -- that are not properly handled here (e.g., + -- mapping current instance references to the + -- appropriate formal parameter). + + if Is_Tagged_Type (Etype (Component)) then + Append_To (Init_List, + Make_Tag_Assignment_From_Type (Loc, + Target => Make_Component_Name, + Typ => Etype (Component))); + end if; + + Append_To (Init_List, + Make_Assignment_Statement (Loc, + Name => Make_Component_Name, + Expression => New_Copy_Tree + (Maybe_Init_Exp, + New_Scope => Body_Id))); + + -- Handle case where component's type has an init proc + elsif Has_Non_Null_Base_Init_Proc (Etype (Component)) then + Append_To (Init_List, + Make_Init_Proc_Call ( + Component => Component, + Component_Name => Make_Component_Name)); + else + pragma Assert (not Is_Tagged_Type (Etype (Component))); + end if; + end; + end if; + + Next_Entity (Component); + end loop; + + Insert_List_Before_And_Analyze (First (L), Init_List); + end; + end Prepend_Constructor_Procedure_Prologue; + -- Local variables Except_H : Node_Id; @@ -6549,6 +6852,12 @@ package body Exp_Ch6 is Detect_Infinite_Recursion (N, Spec_Id); end if; + -- If the subprogram is a constructor procedure then prepend + -- and analyze initialization code. + + Prepend_Constructor_Procedure_Prologue + (Spec_Id => Spec_Id, Body_Id => Body_Id, L => L); + -- Set to encode entity names in package body before gigi is called Qualify_Entity_Names (N); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 2a92ffbce4f3..e08dc42d903d 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5179,10 +5179,8 @@ package body Sem_Attr is when Attribute_Make => declare Expr : Entity_Id; begin - -- Should this be assert? Parsing should fail if it hits 'Make - -- and all extensions aren't enabled ??? - if not All_Extensions_Allowed then + Error_Msg_GNAT_Extension ("Make attribute", Loc); return; end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a4f15ac979c1..2166eb318d75 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4464,11 +4464,16 @@ package body Sem_Ch13 is -- Error checking if not All_Extensions_Allowed then + Error_Msg_Name_1 := Nam; + Error_Msg_GNAT_Extension ("aspect %", Loc); goto Continue; end if; - if Ekind (E) /= E_Procedure then - Error_Msg_N ("Initialize must apply to a constructor", N); + if Ekind (E) /= E_Subprogram_Body + or else Nkind (Parent (E)) /= N_Procedure_Specification + then + Error_Msg_N + ("Initialize must apply to a constructor body", N); end if; if Present (Expressions (Expression (Aspect))) then @@ -4507,11 +4512,6 @@ package body Sem_Ch13 is Next_Entity (Type_Comp); end loop; - -- Push the scope and formals for analysis - - Push_Scope (E); - Install_Formals (Defining_Unit_Name (Specification (N))); - -- Analyze the components Aspect_Comp := @@ -4530,10 +4530,6 @@ package body Sem_Ch13 is Dummy_Aggr := New_Copy_Tree (Expression (Aspect)); Resolve_Aggregate (Dummy_Aggr, Typ); Expander_Active := True; - - -- Return the scope - - End_Scope; end Initialize; -- Initializes @@ -5031,6 +5027,12 @@ package body Sem_Ch13 is goto Continue; when Aspect_Constructor => + if not All_Extensions_Allowed then + Error_Msg_Name_1 := Nam; + Error_Msg_GNAT_Extension ("aspect %", Loc); + goto Continue; + end if; + Set_Constructor_Name (E, Expr); Set_Needs_Construction (E); @@ -5295,6 +5297,80 @@ package body Sem_Ch13 is -- generated yet because the evaluation of the boolean needs -- to be delayed till the freeze point. + -- Super + + when Aspect_Super => Super : + declare + Analyze_Parameter_Expressions : constant Boolean := True; + -- ??? + -- We can analyze actual parameter expressions here (with + -- no context, like the operand of a type conversion), + -- or leave them unanalyzed for now and catch problems + -- when we analyze the generated constructor call + -- (where overload resolution may provide context that + -- resolves some ambiguities). + -- For now, we analyze them here to avoid depending + -- on legality checking performed during expansion. + -- To reverse this decision, set this flag to False. + + begin + -- Error checking + + if not All_Extensions_Allowed then + Error_Msg_Name_1 := Nam; + Error_Msg_GNAT_Extension ("aspect %", Loc); + goto Continue; + end if; + + if Ekind (E) /= E_Subprogram_Body + or else Nkind (Parent (E)) /= N_Procedure_Specification + then + Error_Msg_N ("Super must apply to a constructor body", N); + end if; + + -- handle missing parameter list (an error case) + + if No (Expr) then + Error_Msg_N ("constructor parameters required", N); + + -- Handle parameter list of length more than one + -- (such a list is parsed as an aggregate). + + elsif Nkind (Expr) = N_Aggregate then + if Present (Component_Associations (Expr)) + or else No (Expressions (Expr)) + then + Error_Msg_N + ("malformed constructor parameter list", N); + + elsif Analyze_Parameter_Expressions then + declare + Param_Expr : Node_Id := First (Expressions (Expr)); + begin + while Present (Param_Expr) loop + Analyze (Param_Expr); + Next (Param_Expr); + end loop; + + Set_Analyzed (Expr); + -- Someday Vast may complain that this so-called + -- aggregate has no Etype. For now, we mark it + -- as analyzed and hope that nobody trips over it. + end; + end if; + + -- handle parameter list of length one + + elsif Paren_Count (Expr) = 0 then + Error_Msg_N + ("parentheses missing for constructor parameter list ", + N); + + elsif Analyze_Parameter_Expressions then + Analyze (Expr); + end if; + end Super; + when Boolean_Aspects | Library_Unit_Aspects => @@ -5690,7 +5766,9 @@ package body Sem_Ch13 is Set_Declarations (N, New_List); end if; - Prepend (Aitem, Declarations (N)); + if Present (Aitem) then + Prepend (Aitem, Declarations (N)); + end if; elsif Nkind (N) = N_Generic_Package_Declaration then if No (Visible_Declarations (Specification (N))) then @@ -5761,7 +5839,9 @@ package body Sem_Ch13 is -- The pragma is added before source declarations - Prepend_To (Declarations (N), Aitem); + if Present (Aitem) then + Prepend_To (Declarations (N), Aitem); + end if; -- When delay is not required and the context is not a compilation -- unit, we simply insert the pragma/attribute definition clause @@ -11629,7 +11709,7 @@ package body Sem_Ch13 is -- Case of stream attributes and Put_Image, just have to compare -- entities. However, the expression is just a possibly-overloaded -- name, so we need to verify that one of these interpretations is - -- the one available at at the freeze point. + -- the one available at the freeze point. elsif A_Id in Aspect_Constructor | Aspect_Destructor @@ -12221,6 +12301,7 @@ package body Sem_Ch13 is | Aspect_Relaxed_Initialization | Aspect_SPARK_Mode | Aspect_Subprogram_Variant + | Aspect_Super | Aspect_Suppress | Aspect_Test_Case | Aspect_Unimplemented From patchwork Mon Sep 15 13:01:16 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120277 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D53633858C52 for ; Mon, 15 Sep 2025 13:33:18 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org D53633858C52 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=U+oOZBd4 X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x329.google.com (mail-wm1-x329.google.com [IPv6:2a00:1450:4864:20::329]) by sourceware.org (Postfix) with ESMTPS id D9EF5385AC27 for ; Mon, 15 Sep 2025 13:01:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D9EF5385AC27 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org D9EF5385AC27 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::329 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941319; cv=none; b=nCVVGvVBxweNZvxr2w+LEQ30+SIBKJgVhCJ0rjDvJn7BYt+G/3Jo1McOglFY5CDZCxXsobuSBO0hBbVw7I59ai4IzwWwbYzTjkU3jDb9aCXGZ9+wNyvZVRwfVUZ9wfoSrMTmhvxeEwoXuIddRx6mgvS/1umYMMZYXJhsJHDXoxs= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941319; c=relaxed/simple; bh=pGb4+kxggn2Q+uIwvJbwChYJbHDKFgjiaNTD99wydP4=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=E/hVXCkiVu8aFHeD/g0vsrOSQ9mrrlnZzg95oRh7zb124bzFLi0ZL6m3criJpnqL6PXGzLx6NPgpU41+ymt3mZa8eMBwrhIdc1C2pW95qM659XSTBMHTjcxvrkJbM4H7IQnuhszLUbLiaRpyh86NTVGIN6p/aRBhg+LzIbHMfz4= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org D9EF5385AC27 Received: by mail-wm1-x329.google.com with SMTP id 5b1f17b1804b1-45b9c35bc0aso37492805e9.2 for ; Mon, 15 Sep 2025 06:01:58 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941317; x=1758546117; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=QH7tTP8nx6fUrixKBqhS12Cfw2YrQPqI3/TJ1WU03Ro=; b=U+oOZBd4zTEk6nkJt+wK5fBMoURjdPZqZOrj3FWYXWKZ7+j3GLufBh8GIbY3I8NuX4 TbugP6AGACoF+Tw8+ueR4xsy/OmE4e78aFRciB0GdwFG/gS1Pbyi0mxc6SQxlV8zEzKV eIBstg3iBtWjBEKAqpMCHhOacc/iRcbBHopGbMm0G1i+MEYQLzqCNxD3w+wYZJ01/ZEV frDkGQLQcwiUZwZ96dnxji7cIbes8Ohxrn3EjAPbjV3aEr5m7qWmBUaC1wHO6Qgpafeo vdTpZn28L8iY4bWNO0e7Nu2SSRRuUdat63UofynG8fU6rlqo8KJd6HeX6nYJ/RxmMKZ9 KArA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941317; x=1758546117; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=QH7tTP8nx6fUrixKBqhS12Cfw2YrQPqI3/TJ1WU03Ro=; b=Onh4u7rdDxcdP6aKX+8WO/88dSL0TmWTYZcBgDTpNT1WXITAfF6DWRjLNiLeMZ36Ev 5lKAHYA+cYvuqrV0zWezZ3b12+RlSR33u6eGhkCz6hd+H6vuLj6yrZd1HOKJ5QFfax44 DXWhotAvvXf0GODp1GYV7kEd4zy7HhEm9MscbQOHQPMOjRFWg9MJnP6ZOAsNCDoI9vG7 Ey3N/SIof+zk1Z1DM2FDC9sZfhRort7mRjhayztAZBP1RYc5kdV8i/QBU4Bbq2UG8Vni y2/aoql373kq8BY5Zgd92p0VcsIl45/K/OMJ2IZsYawKXZqdNvh+62lJboYJ/Dm0RiMs lGhA== X-Gm-Message-State: AOJu0Yz7uUsYdKIxGj9tO35PiDHMWxSLBvXQ5uRK6pSauH3jfz8KH922 Jixsya8Mt0JA7Pz+NZ2Dw6RIuqlQh/t5IFnCfKEsDLpvqd1I4rFxt4ojqLjtNe1vPtQDwDlPwkq Knn8= X-Gm-Gg: ASbGncvUj9uCerVqRcyKsJdf1d7jkCJkODi27JrbPEZQw9q574DThgtCaiPcAiQk76L CaiWx06OpLDNpFQK8OzUbY5xTukKeCdxArGBAkANmesdDzQsjFTet/ZFWy79xeGH2YiImo51AJD glzp4xbmXaDtVQUDkDh+43eLQYq/wUVGAvk+0e1qnF/DVMcRN4kvaDcS9pR3TM7WEA7rTjltUXb eaF1FNUdS/QMbBjkfJ0k7uS6vzmyBv9VgufYsTF32sOyg1Ib5wlIyLdbvJUKs7vHN16D6f48ft6 x07iyAAZjzgL2zEmTeCdhqUswEE8kdiKqna09QhR7m/8ZHDQF1Ge9pB4JLU6e94mo77x5Jr849s mgOxwWQ3XpvDiwCsDy6Vixl62py80AfL+dfg2ykGYDxn7E6M+cMUGLD/3W64ybCQJ59BgOFEQPJ M/5bCzdR/HhGtKrdrh3TjfQSapsfKyF6aY1OyiYA== X-Google-Smtp-Source: AGHT+IET/I9DUuL9hk6LZ6L1MNhMTwCvxmSds7qTuxYeryawLet3xldLziNuDg6LgPSG4PJ+BkTxrA== X-Received: by 2002:a05:600c:350f:b0:45f:2d21:cb36 with SMTP id 5b1f17b1804b1-45f2f2279e9mr16582355e9.35.1757941317395; Mon, 15 Sep 2025 06:01:57 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.56 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:56 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 10/27] ada: Avoid ghost context check in early freeze Date: Mon, 15 Sep 2025 15:01:16 +0200 Message-ID: <20250915130135.2720894-10-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus We freeze the expression for expression functions that complete before we have set up the ghost region from both the existing spec and body. Avoid triggering the ghost context checks during the analysis for this early freeze as the expression will be reanalyzed when we analyze the new function body created for the expression function. gcc/ada/ChangeLog: * sem_ch6.adb (Analyze_Expression_Function): Disable ghost checks during the early freeze. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch6.adb | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9042b3378ce7..4e5ede6b429e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -436,11 +436,20 @@ package body Sem_Ch6 is Set_Parent (New_Body, Parent (N)); + -- Disable Ghost checks for this early analysis on the expression. + -- We have not analyzed the new body of the expression function + -- yet so the ghost region is not set up properly for the ghost + -- context checks yet. Avoid the checks for now as the expression + -- will be re-analyzed when the expression function is replaced + -- with the function body. + + Ghost_Context_Checks_Disabled := True; Freeze_Expr_Types (Def_Id => Def_Id, Typ => Typ, Expr => Expr, N => N); + Ghost_Context_Checks_Disabled := False; end if; -- For navigation purposes, indicate that the function is a body From patchwork Mon Sep 15 13:01:17 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120259 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id B123A3856DEE for ; Mon, 15 Sep 2025 13:05:49 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B123A3856DEE Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=A/f4T2Ha X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32d.google.com (mail-wm1-x32d.google.com [IPv6:2a00:1450:4864:20::32d]) by sourceware.org (Postfix) with ESMTPS id 7A654385C41E for ; Mon, 15 Sep 2025 13:02:01 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 7A654385C41E Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 7A654385C41E Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32d ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941321; cv=none; b=EyiNcw45ELqxWjq1zp4zXlePaAhB/9cDbk1Vlc1S/+CHYgICgZpC50wk+3+eu+eO1Kc50O2++08VIsHw4PAUCzzbOEObbM/4v130arDjM90wXb4nc1nyqnltCyOltVBdkKu+ZGGrNT6u469Jw+U6knLWCSAhFSx6CrmorvCaoDc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941321; c=relaxed/simple; bh=fCxcylOVMOBTaRtwU0eMBDHDpcDqxthO4X5w9/9COuI=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=uTfJ6YGmUeDcOBWKUUCmxUM/0Pndpe7Y3lz79dWmM/I5qBnSpUP1jHsVbfMkLxGO83fjjjloVTuGsMUh5eNRMQXjUW0PYYF0iWWOeWcCAefrrxPe0LxC/GOMPn1fCiHBmepRCACvKWeYlTHwGlhBtyqBmun5g1zNQQypGomUuDA= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7A654385C41E Received: by mail-wm1-x32d.google.com with SMTP id 5b1f17b1804b1-45f2313dd86so26859775e9.2 for ; Mon, 15 Sep 2025 06:02:01 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941320; x=1758546120; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=U2ytHh2/PTL8ELIw0sSf1PU7/dVaN6vlyniMvb+LHZ4=; b=A/f4T2HaPkmJRRt3K0SVho8h79F5Q30z4/zlV1hutjr6VPtJ9uVpxJQhbRV0ra8lp5 NIQQGmZZAR87PXsExWI3GP8jbfc3HxPHiaV3grtRpKShjMZN/LSltXxZ0N5BQN4dC7DL Y1nwqMWg0g6Kln+wXvmlZMh2BaFetgBrHSdnhwXLXvWpjBFDrs6mu4YpgXAsSlv2REg4 +fw542D5AXPOQP3s8xit0LkmKH818jNZ8xPPRtjlfKFKJoqJJw/repP/wUEVbucVPVyd jwqMcJKWc3RJkOmD15GoXZyKFmqm6vPCaQPZ2jEFl7ZiX+hdStaZ6wMwVKg0RY9AFuNR n/fQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941320; x=1758546120; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=U2ytHh2/PTL8ELIw0sSf1PU7/dVaN6vlyniMvb+LHZ4=; b=Q+ysVhKL5eDVDSaXH8+9LGsD7G5bBu2MLLoQHJFr2a//YDe2mwQnQZsmuWFr6ITpPJ sGws6pb8axzCc5FJjnyMn7IdnW/T+MT4Xd3Uorxwif8bANnPyUq3iOuwUCE5vMSa12YD pOXLoSsau2pamEcOKsuG3tQ/eDGBhn5BE1HKpojuivEtrxyLV75NgmAg6iIBPoDwcpRh e0aXE9suKv5C25o90FUrt6BiyQssXHjjHQ3jxOlbAFZLwvmzf7S2xVTREMFuAZd02/j6 UL6n/kBXVJSfPqxhGZ9z5wKc2+ARokfo3mLw/vD5wP0P56KpjXPgYpRUq0kT7RGzmSf+ xLAA== X-Gm-Message-State: AOJu0YzMOmo3ol0XyjyRbi3zjrR221VLi4ZYRSAmSOQfehBWSOmRTjH3 WXXVkyq7yDk+IiQ9u6OBHs03ss1WA8WY9/7zNlnJQxL6e0ypEdh3j47wLDclEAecU41EOkHjxb9 Zfsw= X-Gm-Gg: ASbGnctPoo4eH0QA8VfmphyP6bA3XnsOABB0mVT6Nd4IJ/Sj8023MwebH6OdgYhvX1K wSs/qBu5KRSwUIVZRuRJpd/Rt+EWAIw6xA2eCJFgDLtC9AZwJIc2zO3lrZkfFAx+iMMuGJpJ1La HyOE4N8GkmLj/9w859kkSx1OgF2SKxmJZsXVx6hes4MzoJbo8QRL2p22xNF4GvvQziR1RhuVO7X ev+snkURIAa5XOPbKVZta0UQ9B9a3j0u1UhwUmYkwN+deoRIX71by9WQqhPiSlbk0ZpFmdB+QfX WTGQ1uG0pBNLbgs9R50QTpzcZmewEQYd8sVFSJRmNsVmtBqT9lrHpo5GnnJrZWzxOndFqpLmqxj Y/sQuSXcRayFUa99/cKPFH5giZYWO7I/3mJsv5g/jt0B1iUrYeuU23CTfKihSb+rGRqu7UdiH5N ZWUuMuEyQWBmA3qY7W/zlSGgfkx1onXxS5aVM54Er36dcTf+3C X-Google-Smtp-Source: AGHT+IFRB0iH1r0fomMrazzgYtv9ERNs8MD4PgOBBO+kBKbFJDCZUKM0Y4MkV8c12pOChKBgjjV2Hw== X-Received: by 2002:a5d:5886:0:b0:3e2:4a3e:d3e5 with SMTP id ffacd0b85a97d-3e765792886mr11318175f8f.22.1757941318331; Mon, 15 Sep 2025 06:01:58 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.57 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:57 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Ronan Desplanques Subject: [COMMITTED 11/27] ada: Fix section of Finalizable extension in GNAT RM Date: Mon, 15 Sep 2025 15:01:17 +0200 Message-ID: <20250915130135.2720894-11-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Ronan Desplanques The generalized finalization extension was awarded the title of curated extension some time ago, but this wasn't reflected in the GNAT reference manual before this patch, which moves the documentation for generalized finalization in the curated extension section. gcc/ada/ChangeLog: * doc/gnat_rm/gnat_language_extensions.rst: Fix section of Finalizable. * gnat_rm.texi: Regenerate. * gnat_ugn.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- .../doc/gnat_rm/gnat_language_extensions.rst | 262 ++++++------ gcc/ada/gnat_rm.texi | 378 +++++++++--------- gcc/ada/gnat_ugn.texi | 2 +- 3 files changed, 321 insertions(+), 321 deletions(-) diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst index c35f2b088dce..b0cd5fbfc09d 100644 --- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst +++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst @@ -605,6 +605,137 @@ Here is an example of this feature: It ensures that arithmetic operations of type ``Uns_64`` are carried out using 64 bits. +Generalized Finalization +------------------------ + +The ``Finalizable`` aspect can be applied to any record type, tagged or not, +to specify that it provides the same level of control on the operations of +initialization, finalization, and assignment of objects as the controlled +types (see RM 7.6(2) for a high-level overview). The only restriction is +that the record type must be a root type, in other words not a derived type. + +The aspect additionally makes it possible to specify relaxed semantics for +the finalization operations by means of the ``Relaxed_Finalization`` setting. +Here is the archetypal example: + +.. code-block:: ada + + type T is record + ... + end record + with Finalizable => (Initialize => Initialize, + Adjust => Adjust, + Finalize => Finalize, + Relaxed_Finalization => True); + + procedure Adjust (Obj : in out T); + procedure Finalize (Obj : in out T); + procedure Initialize (Obj : in out T); + +The three procedures have the same profile, with a single ``in out`` parameter, +and also have the same dynamic semantics as for controlled types: + + - ``Initialize`` is called when an object of type ``T`` is declared without + initialization expression. + + - ``Adjust`` is called after an object of type ``T`` is assigned a new value. + + - ``Finalize`` is called when an object of type ``T`` goes out of scope (for + stack-allocated objects) or is deallocated (for heap-allocated objects). + It is also called when the value is replaced by an assignment. + +However, when ``Relaxed_Finalization`` is either ``True`` or not explicitly +specified, the following differences are implemented relative to the semantics +of controlled types: + +* The compiler has permission to perform no automatic finalization of + heap-allocated objects: ``Finalize`` is only called when such an object + is explicitly deallocated, or when the designated object is assigned a new + value. As a consequence, no runtime support is needed for performing + implicit deallocation. In particular, no per-object header data is needed + for heap-allocated objects. + + Heap-allocated objects allocated through a nested access type will therefore + **not** be deallocated either. The result is simply that memory will be leaked + in this case. + +* The ``Adjust`` and ``Finalize`` procedures are automatically considered as + having the :ref:`No_Raise_Aspect` specified for them. In particular, the + compiler has permission to enforce none of the guarantees specified by the + RM 7.6.1 (14/1) and subsequent subclauses. + +Simple example of ref-counted type: + +.. code-block:: ada + + type T is record + Value : Integer; + Ref_Count : Natural := 0; + end record; + + procedure Inc_Ref (X : in out T); + procedure Dec_Ref (X : in out T); + + type T_Access is access all T; + + type T_Ref is record + Value : T_Access; + end record + with Finalizable => (Adjust => Adjust, + Finalize => Finalize); + + procedure Adjust (Ref : in out T_Ref) is + begin + Inc_Ref (Ref.Value); + end Adjust; + + procedure Finalize (Ref : in out T_Ref) is + begin + Def_Ref (Ref.Value); + end Finalize; + +Simple file handle that ensures resources are properly released: + +.. code-block:: ada + + package P is + type File (<>) is limited private; + + function Open (Path : String) return File; + + procedure Close (F : in out File); + + private + type File is limited record + Handle : ...; + end record + with Finalizable (Finalize => Close); + end P; + +Finalizable tagged types +^^^^^^^^^^^^^^^^^^^^^^^^ + +The aspect is inherited by derived types and the primitives may be overridden +by the derivation. The compiler-generated calls to these operations are then +dispatching whenever it makes sense, i.e. when the object in question is of a +class-wide type and the class includes at least one finalizable tagged type. + +Composite types +^^^^^^^^^^^^^^^ + +When a finalizable type is used as a component of a composite type, the latter +becomes finalizable as well. The three primitives are derived automatically +in order to call the primitives of their components. The dynamic semantics is +the same as for controlled components of composite types. + +Interoperability with controlled types +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +Finalizable types are fully interoperable with controlled types, in particular +it is possible for a finalizable type to have a controlled component and vice +versa, but the stricter dynamic semantics, in other words that of controlled +types, is applied in this case. + .. _Experimental_Language_Extensions: Experimental Language Extensions @@ -1518,137 +1649,6 @@ of the call is erroneous if the tag of the actual is changed while the formal parameter exists (that is, before leaving the corresponding callable construct). This is analogous to the RM 6.4.1(18) rule about discriminated parameters. -Generalized Finalization ------------------------- - -The ``Finalizable`` aspect can be applied to any record type, tagged or not, -to specify that it provides the same level of control on the operations of -initialization, finalization, and assignment of objects as the controlled -types (see RM 7.6(2) for a high-level overview). The only restriction is -that the record type must be a root type, in other words not a derived type. - -The aspect additionally makes it possible to specify relaxed semantics for -the finalization operations by means of the ``Relaxed_Finalization`` setting. -Here is the archetypal example: - -.. code-block:: ada - - type T is record - ... - end record - with Finalizable => (Initialize => Initialize, - Adjust => Adjust, - Finalize => Finalize, - Relaxed_Finalization => True); - - procedure Adjust (Obj : in out T); - procedure Finalize (Obj : in out T); - procedure Initialize (Obj : in out T); - -The three procedures have the same profile, with a single ``in out`` parameter, -and also have the same dynamic semantics as for controlled types: - - - ``Initialize`` is called when an object of type ``T`` is declared without - initialization expression. - - - ``Adjust`` is called after an object of type ``T`` is assigned a new value. - - - ``Finalize`` is called when an object of type ``T`` goes out of scope (for - stack-allocated objects) or is deallocated (for heap-allocated objects). - It is also called when the value is replaced by an assignment. - -However, when ``Relaxed_Finalization`` is either ``True`` or not explicitly -specified, the following differences are implemented relative to the semantics -of controlled types: - -* The compiler has permission to perform no automatic finalization of - heap-allocated objects: ``Finalize`` is only called when such an object - is explicitly deallocated, or when the designated object is assigned a new - value. As a consequence, no runtime support is needed for performing - implicit deallocation. In particular, no per-object header data is needed - for heap-allocated objects. - - Heap-allocated objects allocated through a nested access type will therefore - **not** be deallocated either. The result is simply that memory will be leaked - in this case. - -* The ``Adjust`` and ``Finalize`` procedures are automatically considered as - having the :ref:`No_Raise_Aspect` specified for them. In particular, the - compiler has permission to enforce none of the guarantees specified by the - RM 7.6.1 (14/1) and subsequent subclauses. - -Simple example of ref-counted type: - -.. code-block:: ada - - type T is record - Value : Integer; - Ref_Count : Natural := 0; - end record; - - procedure Inc_Ref (X : in out T); - procedure Dec_Ref (X : in out T); - - type T_Access is access all T; - - type T_Ref is record - Value : T_Access; - end record - with Finalizable => (Adjust => Adjust, - Finalize => Finalize); - - procedure Adjust (Ref : in out T_Ref) is - begin - Inc_Ref (Ref.Value); - end Adjust; - - procedure Finalize (Ref : in out T_Ref) is - begin - Def_Ref (Ref.Value); - end Finalize; - -Simple file handle that ensures resources are properly released: - -.. code-block:: ada - - package P is - type File (<>) is limited private; - - function Open (Path : String) return File; - - procedure Close (F : in out File); - - private - type File is limited record - Handle : ...; - end record - with Finalizable (Finalize => Close); - end P; - -Finalizable tagged types -^^^^^^^^^^^^^^^^^^^^^^^^ - -The aspect is inherited by derived types and the primitives may be overridden -by the derivation. The compiler-generated calls to these operations are then -dispatching whenever it makes sense, i.e. when the object in question is of a -class-wide type and the class includes at least one finalizable tagged type. - -Composite types -^^^^^^^^^^^^^^^ - -When a finalizable type is used as a component of a composite type, the latter -becomes finalizable as well. The three primitives are derived automatically -in order to call the primitives of their components. The dynamic semantics is -the same as for controlled components of composite types. - -Interoperability with controlled types -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -Finalizable types are fully interoperable with controlled types, in particular -it is possible for a finalizable type to have a controlled component and vice -versa, but the stricter dynamic semantics, in other words that of controlled -types, is applied in this case. - .. _No_Raise_Aspect: No_Raise aspect diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 47cf4941125e..d094720047c4 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -19,7 +19,7 @@ @copying @quotation -GNAT Reference Manual , Sep 05, 2025 +GNAT Reference Manual , Sep 12, 2025 AdaCore @@ -909,6 +909,7 @@ Curated Extensions * Static aspect on intrinsic functions:: * First Controlling Parameter:: * Unsigned_Base_Range aspect:: +* Generalized Finalization:: Deep delta Aggregates @@ -917,6 +918,12 @@ Deep delta Aggregates * Dynamic Semantics:: * Examples:: +Generalized Finalization + +* Finalizable tagged types:: +* Composite types:: +* Interoperability with controlled types:: + Experimental Language Extensions * Conditional when constructs:: @@ -926,7 +933,6 @@ Experimental Language Extensions * Simpler Accessibility Model:: * Case pattern matching:: * Mutably Tagged Types with Size’Class Aspect:: -* Generalized Finalization:: * No_Raise aspect:: * Inference of Dependent Types in Generic Instantiations:: * External_Initialization Aspect:: @@ -946,12 +952,6 @@ Simpler Accessibility Model * Subprogram parameters:: * Function results:: -Generalized Finalization - -* Finalizable tagged types:: -* Composite types:: -* Interoperability with controlled types:: - Finally construct * Syntax: Syntax<2>. @@ -30515,6 +30515,7 @@ Features activated via @code{-gnatX} or * Static aspect on intrinsic functions:: * First Controlling Parameter:: * Unsigned_Base_Range aspect:: +* Generalized Finalization:: @end menu @@ -31217,7 +31218,7 @@ overriding a primitive or creating new one. The result of a function is never a controlling result. @end itemize -@node Unsigned_Base_Range aspect,,First Controlling Parameter,Curated Extensions +@node Unsigned_Base_Range aspect,Generalized Finalization,First Controlling Parameter,Curated Extensions @anchor{gnat_rm/gnat_language_extensions unsigned-base-range-aspect}@anchor{458} @subsection @code{Unsigned_Base_Range} aspect @@ -31243,8 +31244,170 @@ type Uns_64 is range 0 .. 2 ** 64 - 1 It ensures that arithmetic operations of type @code{Uns_64} are carried out using 64 bits. +@node Generalized Finalization,,Unsigned_Base_Range aspect,Curated Extensions +@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{459} +@subsection Generalized Finalization + + +The @code{Finalizable} aspect can be applied to any record type, tagged or not, +to specify that it provides the same level of control on the operations of +initialization, finalization, and assignment of objects as the controlled +types (see RM 7.6(2) for a high-level overview). The only restriction is +that the record type must be a root type, in other words not a derived type. + +The aspect additionally makes it possible to specify relaxed semantics for +the finalization operations by means of the @code{Relaxed_Finalization} setting. +Here is the archetypal example: + +@example +type T is record + ... +end record + with Finalizable => (Initialize => Initialize, + Adjust => Adjust, + Finalize => Finalize, + Relaxed_Finalization => True); + +procedure Adjust (Obj : in out T); +procedure Finalize (Obj : in out T); +procedure Initialize (Obj : in out T); +@end example + +The three procedures have the same profile, with a single @code{in out} parameter, +and also have the same dynamic semantics as for controlled types: + +@quotation + + +@itemize - + +@item +@code{Initialize} is called when an object of type @code{T} is declared without +initialization expression. + +@item +@code{Adjust} is called after an object of type @code{T} is assigned a new value. + +@item +@code{Finalize} is called when an object of type @code{T} goes out of scope (for +stack-allocated objects) or is deallocated (for heap-allocated objects). +It is also called when the value is replaced by an assignment. +@end itemize +@end quotation + +However, when @code{Relaxed_Finalization} is either @code{True} or not explicitly +specified, the following differences are implemented relative to the semantics +of controlled types: + + +@itemize * + +@item +The compiler has permission to perform no automatic finalization of +heap-allocated objects: @code{Finalize} is only called when such an object +is explicitly deallocated, or when the designated object is assigned a new +value. As a consequence, no runtime support is needed for performing +implicit deallocation. In particular, no per-object header data is needed +for heap-allocated objects. + +Heap-allocated objects allocated through a nested access type will therefore +`not' be deallocated either. The result is simply that memory will be leaked +in this case. + +@item +The @code{Adjust} and @code{Finalize} procedures are automatically considered as +having the @ref{45a,,No_Raise aspect} specified for them. In particular, the +compiler has permission to enforce none of the guarantees specified by the +RM 7.6.1 (14/1) and subsequent subclauses. +@end itemize + +Simple example of ref-counted type: + +@example +type T is record + Value : Integer; + Ref_Count : Natural := 0; +end record; + +procedure Inc_Ref (X : in out T); +procedure Dec_Ref (X : in out T); + +type T_Access is access all T; + +type T_Ref is record + Value : T_Access; +end record + with Finalizable => (Adjust => Adjust, + Finalize => Finalize); + +procedure Adjust (Ref : in out T_Ref) is +begin + Inc_Ref (Ref.Value); +end Adjust; + +procedure Finalize (Ref : in out T_Ref) is +begin + Def_Ref (Ref.Value); +end Finalize; +@end example + +Simple file handle that ensures resources are properly released: + +@example +package P is + type File (<>) is limited private; + + function Open (Path : String) return File; + + procedure Close (F : in out File); + +private + type File is limited record + Handle : ...; + end record + with Finalizable (Finalize => Close); +end P; +@end example + +@menu +* Finalizable tagged types:: +* Composite types:: +* Interoperability with controlled types:: + +@end menu + +@node Finalizable tagged types,Composite types,,Generalized Finalization +@anchor{gnat_rm/gnat_language_extensions finalizable-tagged-types}@anchor{45b} +@subsubsection Finalizable tagged types + + +The aspect is inherited by derived types and the primitives may be overridden +by the derivation. The compiler-generated calls to these operations are then +dispatching whenever it makes sense, i.e. when the object in question is of a +class-wide type and the class includes at least one finalizable tagged type. + +@node Composite types,Interoperability with controlled types,Finalizable tagged types,Generalized Finalization +@anchor{gnat_rm/gnat_language_extensions composite-types}@anchor{45c} +@subsubsection Composite types + + +When a finalizable type is used as a component of a composite type, the latter +becomes finalizable as well. The three primitives are derived automatically +in order to call the primitives of their components. The dynamic semantics is +the same as for controlled components of composite types. + +@node Interoperability with controlled types,,Composite types,Generalized Finalization +@anchor{gnat_rm/gnat_language_extensions interoperability-with-controlled-types}@anchor{45d} +@subsubsection Interoperability with controlled types + + +Finalizable types are fully interoperable with controlled types, in particular +it is possible for a finalizable type to have a controlled component and vice +versa, but the stricter dynamic semantics, in other words that of controlled +types, is applied in this case. + @node Experimental Language Extensions,,Curated Extensions,GNAT language extensions -@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6b}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{459} +@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6b}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{45e} @section Experimental Language Extensions @@ -31259,7 +31422,6 @@ Features activated via @code{-gnatX0} or * Simpler Accessibility Model:: * Case pattern matching:: * Mutably Tagged Types with Size’Class Aspect:: -* Generalized Finalization:: * No_Raise aspect:: * Inference of Dependent Types in Generic Instantiations:: * External_Initialization Aspect:: @@ -31270,7 +31432,7 @@ Features activated via @code{-gnatX0} or @end menu @node Conditional when constructs,Implicit With,,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{45a} +@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{45f} @subsection Conditional when constructs @@ -31339,7 +31501,7 @@ end; @end example @node Implicit With,Storage Model,Conditional when constructs,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions implicit-with}@anchor{45b} +@anchor{gnat_rm/gnat_language_extensions implicit-with}@anchor{460} @subsection Implicit With @@ -31356,7 +31518,7 @@ end; @end example @node Storage Model,Attribute Super,Implicit With,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{45c} +@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{461} @subsection Storage Model @@ -31373,7 +31535,7 @@ memory models, in particular to support interactions with GPU. @end menu @node Aspect Storage_Model_Type,Aspect Designated_Storage_Model,,Storage Model -@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{45d} +@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{462} @subsubsection Aspect Storage_Model_Type @@ -31507,7 +31669,7 @@ end CUDA_Memory; @end example @node Aspect Designated_Storage_Model,Legacy Storage Pools,Aspect Storage_Model_Type,Storage Model -@anchor{gnat_rm/gnat_language_extensions aspect-designated-storage-model}@anchor{45e} +@anchor{gnat_rm/gnat_language_extensions aspect-designated-storage-model}@anchor{463} @subsubsection Aspect Designated_Storage_Model @@ -31585,7 +31747,7 @@ begin @end example @node Legacy Storage Pools,,Aspect Designated_Storage_Model,Storage Model -@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{45f} +@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{464} @subsubsection Legacy Storage Pools @@ -31636,7 +31798,7 @@ type Acc is access Integer_Array with Storage_Pool => My_Pool; can still be accepted as a shortcut for the new syntax. @node Attribute Super,Simpler Accessibility Model,Storage Model,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{460} +@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{465} @subsection Attribute Super @@ -31671,7 +31833,7 @@ end; @end example @node Simpler Accessibility Model,Case pattern matching,Attribute Super,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions simpler-accessibility-model}@anchor{461} +@anchor{gnat_rm/gnat_language_extensions simpler-accessibility-model}@anchor{466} @subsection Simpler Accessibility Model @@ -31702,7 +31864,7 @@ All of the refined rules are compatible with the [use of anonymous access types @end menu @node Stand-alone objects,Subprogram parameters,,Simpler Accessibility Model -@anchor{gnat_rm/gnat_language_extensions stand-alone-objects}@anchor{462} +@anchor{gnat_rm/gnat_language_extensions stand-alone-objects}@anchor{467} @subsubsection Stand-alone objects @@ -31750,7 +31912,7 @@ of the RM 4.6 rule “The accessibility level of the operand type shall not be statically deeper than that of the target type …”. @node Subprogram parameters,Function results,Stand-alone objects,Simpler Accessibility Model -@anchor{gnat_rm/gnat_language_extensions subprogram-parameters}@anchor{463} +@anchor{gnat_rm/gnat_language_extensions subprogram-parameters}@anchor{468} @subsubsection Subprogram parameters @@ -31843,7 +32005,7 @@ end; @end example @node Function results,,Subprogram parameters,Simpler Accessibility Model -@anchor{gnat_rm/gnat_language_extensions function-results}@anchor{464} +@anchor{gnat_rm/gnat_language_extensions function-results}@anchor{469} @subsubsection Function results @@ -31971,7 +32133,7 @@ end; @end example @node Case pattern matching,Mutably Tagged Types with Size’Class Aspect,Simpler Accessibility Model,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{465} +@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{46a} @subsection Case pattern matching @@ -32100,8 +32262,8 @@ compile-time capacity limits in some annoyingly common scenarios; the message generated in such cases is usually “Capacity exceeded in compiling case statement with composite selector type”. -@node Mutably Tagged Types with Size’Class Aspect,Generalized Finalization,Case pattern matching,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions mutably-tagged-types-with-size-class-aspect}@anchor{466} +@node Mutably Tagged Types with Size’Class Aspect,No_Raise aspect,Case pattern matching,Experimental Language Extensions +@anchor{gnat_rm/gnat_language_extensions mutably-tagged-types-with-size-class-aspect}@anchor{46b} @subsection Mutably Tagged Types with Size’Class Aspect @@ -32271,170 +32433,8 @@ of the call is erroneous if the tag of the actual is changed while the formal parameter exists (that is, before leaving the corresponding callable construct). This is analogous to the RM 6.4.1(18) rule about discriminated parameters. -@node Generalized Finalization,No_Raise aspect,Mutably Tagged Types with Size’Class Aspect,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{467} -@subsection Generalized Finalization - - -The @code{Finalizable} aspect can be applied to any record type, tagged or not, -to specify that it provides the same level of control on the operations of -initialization, finalization, and assignment of objects as the controlled -types (see RM 7.6(2) for a high-level overview). The only restriction is -that the record type must be a root type, in other words not a derived type. - -The aspect additionally makes it possible to specify relaxed semantics for -the finalization operations by means of the @code{Relaxed_Finalization} setting. -Here is the archetypal example: - -@example -type T is record - ... -end record - with Finalizable => (Initialize => Initialize, - Adjust => Adjust, - Finalize => Finalize, - Relaxed_Finalization => True); - -procedure Adjust (Obj : in out T); -procedure Finalize (Obj : in out T); -procedure Initialize (Obj : in out T); -@end example - -The three procedures have the same profile, with a single @code{in out} parameter, -and also have the same dynamic semantics as for controlled types: - -@quotation - - -@itemize - - -@item -@code{Initialize} is called when an object of type @code{T} is declared without -initialization expression. - -@item -@code{Adjust} is called after an object of type @code{T} is assigned a new value. - -@item -@code{Finalize} is called when an object of type @code{T} goes out of scope (for -stack-allocated objects) or is deallocated (for heap-allocated objects). -It is also called when the value is replaced by an assignment. -@end itemize -@end quotation - -However, when @code{Relaxed_Finalization} is either @code{True} or not explicitly -specified, the following differences are implemented relative to the semantics -of controlled types: - - -@itemize * - -@item -The compiler has permission to perform no automatic finalization of -heap-allocated objects: @code{Finalize} is only called when such an object -is explicitly deallocated, or when the designated object is assigned a new -value. As a consequence, no runtime support is needed for performing -implicit deallocation. In particular, no per-object header data is needed -for heap-allocated objects. - -Heap-allocated objects allocated through a nested access type will therefore -`not' be deallocated either. The result is simply that memory will be leaked -in this case. - -@item -The @code{Adjust} and @code{Finalize} procedures are automatically considered as -having the @ref{468,,No_Raise aspect} specified for them. In particular, the -compiler has permission to enforce none of the guarantees specified by the -RM 7.6.1 (14/1) and subsequent subclauses. -@end itemize - -Simple example of ref-counted type: - -@example -type T is record - Value : Integer; - Ref_Count : Natural := 0; -end record; - -procedure Inc_Ref (X : in out T); -procedure Dec_Ref (X : in out T); - -type T_Access is access all T; - -type T_Ref is record - Value : T_Access; -end record - with Finalizable => (Adjust => Adjust, - Finalize => Finalize); - -procedure Adjust (Ref : in out T_Ref) is -begin - Inc_Ref (Ref.Value); -end Adjust; - -procedure Finalize (Ref : in out T_Ref) is -begin - Def_Ref (Ref.Value); -end Finalize; -@end example - -Simple file handle that ensures resources are properly released: - -@example -package P is - type File (<>) is limited private; - - function Open (Path : String) return File; - - procedure Close (F : in out File); - -private - type File is limited record - Handle : ...; - end record - with Finalizable (Finalize => Close); -end P; -@end example - -@menu -* Finalizable tagged types:: -* Composite types:: -* Interoperability with controlled types:: - -@end menu - -@node Finalizable tagged types,Composite types,,Generalized Finalization -@anchor{gnat_rm/gnat_language_extensions finalizable-tagged-types}@anchor{469} -@subsubsection Finalizable tagged types - - -The aspect is inherited by derived types and the primitives may be overridden -by the derivation. The compiler-generated calls to these operations are then -dispatching whenever it makes sense, i.e. when the object in question is of a -class-wide type and the class includes at least one finalizable tagged type. - -@node Composite types,Interoperability with controlled types,Finalizable tagged types,Generalized Finalization -@anchor{gnat_rm/gnat_language_extensions composite-types}@anchor{46a} -@subsubsection Composite types - - -When a finalizable type is used as a component of a composite type, the latter -becomes finalizable as well. The three primitives are derived automatically -in order to call the primitives of their components. The dynamic semantics is -the same as for controlled components of composite types. - -@node Interoperability with controlled types,,Composite types,Generalized Finalization -@anchor{gnat_rm/gnat_language_extensions interoperability-with-controlled-types}@anchor{46b} -@subsubsection Interoperability with controlled types - - -Finalizable types are fully interoperable with controlled types, in particular -it is possible for a finalizable type to have a controlled component and vice -versa, but the stricter dynamic semantics, in other words that of controlled -types, is applied in this case. - -@node No_Raise aspect,Inference of Dependent Types in Generic Instantiations,Generalized Finalization,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions id3}@anchor{46c}@anchor{gnat_rm/gnat_language_extensions no-raise-aspect}@anchor{468} +@node No_Raise aspect,Inference of Dependent Types in Generic Instantiations,Mutably Tagged Types with Size’Class Aspect,Experimental Language Extensions +@anchor{gnat_rm/gnat_language_extensions id3}@anchor{46c}@anchor{gnat_rm/gnat_language_extensions no-raise-aspect}@anchor{45a} @subsection No_Raise aspect diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e0c2d2571f61..5ab6a0520b85 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -30295,8 +30295,8 @@ to permit their use in free software. @printindex ge -@anchor{d2}@w{ } @anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } +@anchor{d2}@w{ } @c %**end of body @bye From patchwork Mon Sep 15 13:01:18 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120270 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 869C03858C36 for ; Mon, 15 Sep 2025 13:21:42 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 869C03858C36 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=NIJaig6/ X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32d.google.com (mail-wm1-x32d.google.com [IPv6:2a00:1450:4864:20::32d]) by sourceware.org (Postfix) with ESMTPS id E5D1D38560BE for ; Mon, 15 Sep 2025 13:02:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org E5D1D38560BE Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org E5D1D38560BE Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32d ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941321; cv=none; b=SwnJMjRdqdQtp4ltsQydldu27C83T6Myu6pNLhZIhRbEZ1+QpgqzTtvKz7BPHX/ESfXU+9HHt4vZIdGPLMTcSrXIZi3ikEt4QPt71em2qvwUFDPazNwsEkMtBSN72CeNNILnHBcKZwBZrwDaeGnu1SimeUCPjMVR5JW6D+p/GNc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941321; c=relaxed/simple; bh=DW9XuVNXRSuKvO3b3hSFdoE1qIbFAJawSfYDqHWv3F0=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=nvedsNhnCOxIKVEvRwTw4q9X4dMmO5CRmBiNNO74O6wlL7lCxGFhg6MAwiWeLc213a3+SDOsS2hrcqNYQQCfYG0hUdQ9FnmgMzKbtNmtn4VhxFPvq6oXT3O3cte928TVW9t2yewqIq6GeTkjzEmltXsTx+ga8cJGwOVnvY5qBig= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E5D1D38560BE Received: by mail-wm1-x32d.google.com with SMTP id 5b1f17b1804b1-45f29e5e89bso18808715e9.2 for ; Mon, 15 Sep 2025 06:02:00 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941319; x=1758546119; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=NcUEhWSKrg7m1g/y3mmcd/VBD2BsqRh1qkX6B51AJZ4=; b=NIJaig6/bk8PHiux9nfJ8qrGHCAG6VPwaiZoi+iWDWxdD8/w+24f0lhkvI+HkmSyZe 0RX7ogiehAxbajcwJirTCCCAYEFMHunD6xQxB3BwzHvuG4lVoWJtBV/4aD8iKODiCNlA ym55CgjLZMKP3qSB7I+45W2Be3LIK7o20H6ktetyK0rZx86jQPQVXqvKlQ/d05Zjy6XL N5Qd9tL7fIWHKPxlf2RPKYc0sPT1rgpcJPa1UAOoNn+SI39aT6rBw1u14tL8K7skBXrv EEtie5ZmZ5VFUCNVwTwioGeiZwCwXUQMGibVgX5tGGrLunxklOajEYzgx9b1MGuS6v4w xOXw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941319; x=1758546119; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=NcUEhWSKrg7m1g/y3mmcd/VBD2BsqRh1qkX6B51AJZ4=; b=DTNjnBXhYXQ5Gs0M4A6TAcsOaRH8fO3hmPbs4O/rD/rf4I8T9TUeDG5BNgieYLDwVl 0fHYySkubLWFHyKaj1yUFP2q/yyJYqxojzhT9dyu6wlkpAgJUCtpzNKhzf6Wsp44HJCI vZGUO1DcKxMqLQFluqOJUwl0oU5FgTm3BVweCL0gjoOKD79I0xUGoGytSFwdbhUbqlgH rvfyENzsOH5Wg+D3lHepfbV7jXtnQX2w8bCJYFwseqoXsZe0DfpPM8ytKcU6/8fnKVy7 jAjS5FrwNe9d0H55rm6O+T/HU6V962dvn7bmkO62O1auhGkSoi46VVIN8di/N1z/UXY5 wKug== X-Gm-Message-State: AOJu0YxVuXuW+qlhnM2t2j1gaKat4NlOM8n/L+I1wMw9EUgWX2OkrHRD Ppk9G51OxstchOpA8HQBXr+no/yQLmkEdHt8yJQkfJ7gWQZeNLORWWPlwq8JNCp8D+fRb6V41MO +p1M= X-Gm-Gg: ASbGncsGECMQ/mOcStZye1PcoYzK0foaYXizzDvECzBKi+7rkmb2DjxVXvOZDCDhIei K2P13PXmAm9QubjXIB3dYvSvVqTwCIXXoqSoVS1EABxY4VqmZwCwlCm12b7gtgXpSoEoa8Tylnc +q+VWaXMaRPqqf09wkEZiJgjRmWHr6+RrTQ19ndIeqbzhElHej3uk3EQSJplMR7G8WXxgzCVpHx rdqFAqo2ySQgzcUZlEXS7j32fgZ7kRyYbnYdsLzRTSljvuNq0tAK5Ls5VoggzpiB2spUw0Yqgzq inrWwFVSbkXfyb17myIL9IngDH4h5VWZf+jqCznrl8anbxdnZgQZmyLoa4D+XiVFz7EhtrG+OxN lwn/wZvuQz1J6oCyew64k/Ug8XTOX5xiQs3IR4t9tha1nqN2zSRP79jz0rxqa5+/M0ovn2tZzl2 kKNztU/ENUyvDAi3GOpebHHlHIRB8FLAmyjudC5w== X-Google-Smtp-Source: AGHT+IG8nDT1buEwT3SUBwTGm+5Lx92wtlwbDyWbRW9nnNbrGC1VspkgA0lnLve/Z9mfeUus/g2F5Q== X-Received: by 2002:a05:600c:45c4:b0:45b:5f3d:aa3d with SMTP id 5b1f17b1804b1-45f211e6832mr106297775e9.21.1757941319205; Mon, 15 Sep 2025 06:01:59 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.58 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:58 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 12/27] ada: Fix missing finalization for qualified expression in conditional expression Date: Mon, 15 Sep 2025 15:01:18 +0200 Message-ID: <20250915130135.2720894-12-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Eric Botcazou A qualified expression around a function call may cause a temporary to be created and, therefore, cannot be bypassed in Expand_Ctrl_Function_Call. gcc/ada/ChangeLog: * exp_util.ads (Unqualified_Unconditional_Parent): New function. * exp_util.adb (Unconditional_Parent): Do not look through qualified expressions. (Unqualified_Unconditional_Parent): New function identical to the original Unconditional_Parent. * exp_aggr.adb (Convert_To_Assignments): Replace Unconditional_Parent with Unqualified_Unconditional_Parent. (Expand_Array_Aggregate): Likewse. * exp_ch4.adb (Expand_N_Case_Expression): Likewise. (Expand_N_If_Expression): Likewise. * exp_ch6.adb (Expand_Ctrl_Function_Call): Do not bypass an enclosing qualified expression in the parent chain. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 4 ++-- gcc/ada/exp_ch4.adb | 6 ++++-- gcc/ada/exp_ch6.adb | 5 ++++- gcc/ada/exp_util.adb | 33 ++++++++++++++++++++++++++++++++- gcc/ada/exp_util.ads | 4 ++++ 5 files changed, 46 insertions(+), 6 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6b4f4a19d1f9..d62b7351e862 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4283,7 +4283,7 @@ package body Exp_Aggr is -- Set the Expansion_Delayed flag in the cases where the transformation -- will be done top down from above. - Parent_Node := Unconditional_Parent (N); + Parent_Node := Unqualified_Unconditional_Parent (N); if -- Internal aggregates (transformed when expanding the parent), @@ -6254,7 +6254,7 @@ package body Exp_Aggr is -- Set the Expansion_Delayed flag in the cases where the transformation -- will be done top down from above. - Parent_Node := Unconditional_Parent (N); + Parent_Node := Unqualified_Unconditional_Parent (N); if -- Internal aggregates (transformed when expanding the parent), diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 23a59de6f872..8fba1c4e71fa 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5198,7 +5198,8 @@ package body Exp_Ch4 is if not Expansion_Delayed (N) then declare - Uncond_Par : constant Node_Id := Unconditional_Parent (N); + Uncond_Par : constant Node_Id := + Unqualified_Unconditional_Parent (N); begin if Nkind (Uncond_Par) = N_Simple_Return_Statement or else Is_Optimizable_Declaration (Uncond_Par) @@ -5807,7 +5808,8 @@ package body Exp_Ch4 is if not Expansion_Delayed (N) then declare - Uncond_Par : constant Node_Id := Unconditional_Parent (N); + Uncond_Par : constant Node_Id := + Unqualified_Unconditional_Parent (N); begin if Nkind (Uncond_Par) = N_Simple_Return_Statement or else Is_Optimizable_Declaration (Uncond_Par) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 32e96bed2349..5056b1f990fa 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5793,11 +5793,14 @@ package body Exp_Ch6 is is Par : constant Node_Id := Parent (N); Uncond_Par : constant Node_Id := Unconditional_Parent (N); + -- Beware that a qualified expression around a function call cannot be + -- considered as transparent (like around an aggregate) because it may + -- cause a temporary to be created. begin -- Optimization: if the returned value is returned again, then no need -- to copy/readjust/finalize, we can just pass the value through (see - -- Expand_N_Simple_Return_Statement), and thus no attachment is needed. + -- Expand_Simple_Function_Return), and thus no attachment is needed. -- Note that simple return statements are distributed into conditional -- expressions, but we may be invoked before this distribution is done. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 6ce6c0cd81d6..4135e24424d3 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -14903,6 +14903,37 @@ package body Exp_Util is Node : Node_Id := N; Parent_Node : Node_Id := Parent (Node); + begin + loop + case Nkind (Parent_Node) is + when N_Case_Expression_Alternative => + null; + + when N_Case_Expression => + exit when Node = Expression (Parent_Node); + + when N_If_Expression => + exit when Node = First (Expressions (Parent_Node)); + + when others => + exit; + end case; + + Node := Parent_Node; + Parent_Node := Parent (Node); + end loop; + + return Parent_Node; + end Unconditional_Parent; + + -------------------------------------- + -- Unqualified_Unconditional_Parent -- + -------------------------------------- + + function Unqualified_Unconditional_Parent (N : Node_Id) return Node_Id is + Node : Node_Id := N; + Parent_Node : Node_Id := Parent (Node); + begin loop case Nkind (Parent_Node) is @@ -14927,7 +14958,7 @@ package body Exp_Util is end loop; return Parent_Node; - end Unconditional_Parent; + end Unqualified_Unconditional_Parent; ------------------------------- -- Update_Primitives_Mapping -- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 4226fcc93777..b7d8a185f4bd 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -1344,6 +1344,10 @@ package Exp_Util is function Unconditional_Parent (N : Node_Id) return Node_Id; -- Return the first parent of arbitrary node N that is not a conditional + -- expression, one of whose dependent expressions is N, recursively. + + function Unqualified_Unconditional_Parent (N : Node_Id) return Node_Id; + -- Return the first parent of arbitrary node N that is not a conditional -- expression, one of whose dependent expressions is N, and that is not -- a qualified expression, whose expression is N, recursively. From patchwork Mon Sep 15 13:01:19 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120267 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E92B63857C6E for ; Mon, 15 Sep 2025 13:18:49 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E92B63857C6E Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=T5HZq+j5 X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x434.google.com (mail-wr1-x434.google.com [IPv6:2a00:1450:4864:20::434]) by sourceware.org (Postfix) with ESMTPS id 6E9773856245 for ; Mon, 15 Sep 2025 13:02:01 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 6E9773856245 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 6E9773856245 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::434 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941321; cv=none; b=ib0eyh8HDYisjA75rCTSu1jam/fYvgOIJo1J2qp/E62F0N4dumXg/ZAZ0m2EqqavZvmS+ysZ1nVgl2b9Dz+0E4O1qdg9YDjQLXdfNVLjFREWXBPg+UTFlR49qjxofQIa1AZpK1k+X/3RKXHWrtC7erldDqDg/LGSE9NfWvK0VyA= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941321; c=relaxed/simple; bh=kLFG8GWT+oonWJoDVQxRWJt7FVDNCh38deK/Mz5J/aI=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=rvrbGNfX0cjm0SJM3uRqPN7huaRfs7BGH/w2AG4zj1Ckhtk/AciybdxANgOiEQOXxsw/n/Xh+kOl8YNgijpEtdyn3Bw0gqpi+fUblMWm7kB3swSDD/uInq6Vyc7c6qVYUL44/fNJKpieS/wUHvrENkBmohXHyD5wiVn8C+sYM7E= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6E9773856245 Received: by mail-wr1-x434.google.com with SMTP id ffacd0b85a97d-3dae49b117bso3234043f8f.1 for ; Mon, 15 Sep 2025 06:02:01 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941320; x=1758546120; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=x9BWifLXTFlAWooWytR7TCNH6XhV5XeP2urHFOI2wFE=; b=T5HZq+j5LxaVF1rx3BVbnRmAELG2oXKZwBaJOVk2t7CaurSHWRnueXNSaltC55jI3u b1AlYPto1iZ+nuxKlv9ohxMcvkzlPiXR+s1QrD2Xdn5z/pqUdpXSct2K+pw7CmoMiMpy T6MPw2X7R8UxOe5ny7f/vlPn8AvWPnqDjefwPW8DtUHHlc6BQnrzHMP9ZssyZlLs/5VV tgkaDkMKlM4ZQtgQCIcEXXn+JLTl11xkgRC8iNaAHWs22wrIvosNG+fyR27XlhvBl5xl zoejGdrEIL8w27cjku+lwjNLb5rbd9uIUW2eJC9vXxBMx9p32ciqq48jaxN64hQRCxqk VcyA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941320; x=1758546120; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=x9BWifLXTFlAWooWytR7TCNH6XhV5XeP2urHFOI2wFE=; b=IyEcEDGD4ZflPj+gVDhdj3JV+ohtVq7yZshAhquv2c3NALXSp6PfEuaClfXUD5QhpU 3jDoWpemUIZr/50OCfJ+4dJs9Qb1aYfkZQfUX18oA3RtJM2FtWurapsgtn/hltuEnCcE 8BC7lMx3rkjtUo3MyrkzRGtD8vNci4GwmMJXFFBjzu8olVNMiBhmtDa6wIynD61Pwow5 RNgrKYH/0cvve0ZataNeeKLCBXd4tlIZ1+MZA/8XkIsckCYjGkUmGNj4KxCsjCb14GRG BElo3TBXiVONldehKjpdmcPJpS9ZsTT8hyjzLB9G9IziG3TwZ3P+mRcqqMKOWc1agDJK TTYw== X-Gm-Message-State: AOJu0YxeI/9nDl/YWw7NkZ+lqF79fpt8v8xja5iJeA6iYQh+W0guvkau zZzHVuPL7KWL6+31fBGbda2B3X7p70P/yT5mIa9TRRva3NKpMfmyFDCYgr6gJYymZAm4TXWdm7S EAhU= X-Gm-Gg: ASbGncs56NjltoYzprmUn50JNiEs0YUgZ+SxaD+3Vt78pnweIart3E9oPISIgX9uVHM NmEhoF73K9A7aGhXAtIfjoL4imrY4nMEfet6OtMJ1qAzve/18ZuWM+EJl4+VrC2ndapwtosTO36 hnIXe9en/PDxZZ/h1cJZiH+G70qHA2XrnH8OylthgoQ2E21sSvqcjK1sDCfoLNexeAmEr1kcCpk +e959rwU327wspViIt5jU/3YU5CoJalYdJZavaf7qnJmE1Hj/IJAM38UKTypvG4B7BH43ey1Bce 4xKrITKT308phfZuzMj8kC/i2N+fE1yoEMaldIayjLH9d7aNAhY6qRrI+qifC5s4Uou07GVqIat P6XhVpl/WfBLL5bzDCsB7cfSc/Nk/1Ap3zM4peZTOL406Q9JA3ECp2tFBu102F8yLAtv10XUKpk qhWNw5rRBOFlr5rncBHbBL4M5YU8Gw0UapVgu9CQ== X-Google-Smtp-Source: AGHT+IEc63vkhZvsHh4+Yz0JL63qcd5FvhWLzUVexehCo5vzkbR/Heo3zl+Zhb0Hx+mLDGt78MucNw== X-Received: by 2002:a05:6000:2289:b0:3d8:3eca:a978 with SMTP id ffacd0b85a97d-3e765798616mr11935985f8f.21.1757941319990; Mon, 15 Sep 2025 06:01:59 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.01.59 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:01:59 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 13/27] ada: Fix crash on iterator of type with Constant_Indexing aspect Date: Mon, 15 Sep 2025 15:01:19 +0200 Message-ID: <20250915130135.2720894-13-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Eric Botcazou This happens when the type returned by the indexing function is a private type whose completion is derived from another private type, because the Finalize_Address routine cannot correctly fetch the actual root type. gcc/ada/ChangeLog: * exp_util.adb (Finalize_Address): In an untagged derivation, call Root_Type on the full view of the base type if the partial view is itself not a derived type. (Is_Untagged_Derivation): Minor formatting tweak. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_util.adb | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4135e24424d3..78fb3167c82d 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6206,7 +6206,11 @@ package body Exp_Util is Utyp := Corresponding_Record_Type (Root_Type (Btyp)); elsif Is_Implicit_Full_View (Utyp) then - Utyp := Underlying_Type (Root_Type (Btyp)); + if Is_Derived_Type (Btyp) then + Utyp := Underlying_Type (Root_Type (Btyp)); + else + Utyp := Underlying_Type (Root_Type (Full_View (Btyp))); + end if; if Is_Protected_Type (Utyp) then Utyp := Corresponding_Record_Type (Utyp); @@ -10033,7 +10037,8 @@ package body Exp_Util is begin return (not Is_Tagged_Type (T) and then Is_Derived_Type (T)) or else - (Is_Private_Type (T) and then Present (Full_View (T)) + (Is_Private_Type (T) + and then Present (Full_View (T)) and then not Is_Tagged_Type (Full_View (T)) and then Is_Derived_Type (Full_View (T)) and then Etype (Full_View (T)) /= T); From patchwork Mon Sep 15 13:01:20 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120287 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id CD8223856DEB for ; Mon, 15 Sep 2025 13:46:31 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org CD8223856DEB Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=c9a5J/6O X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 42C783857358 for ; Mon, 15 Sep 2025 13:02:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 42C783857358 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 42C783857358 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42f ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941327; cv=none; b=g8r+MGw4QD3p128bh59mK8sNzQQWBSXBtL5j9qGeK8QSv0lcmt7pRJhP9CmPZxcXJJah/JOALiS4nMzReAaOE58X4YO0SzMm9IRAhx8XJ8MonHjuE3fl5HQx6V7ViQEQIFEhXOGIDjpvwLfFUl0orJRIe8XeXhILUjoodq+dcqA= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941327; c=relaxed/simple; bh=glQsLc3aIjaBDOgo+pcdaRoTCKOxKJpaC0i0goOv0NU=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Yf6MzG1uwBWAkC7ZboQFLGbt1loPRvm8U+XyEpXvO3idSivq3VoHYSyRUzNKI7wfB2qs90vrinn7ETGWjM/OYCTeexuRl+mCikL9Gyoz4/nKFaAmvRHYXoGICSqUNtMpoSR+9XJAhp7kEv8gA1fsiJWBMSh2gOmtOBtpeIRa3gU= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 42C783857358 Received: by mail-wr1-x42f.google.com with SMTP id ffacd0b85a97d-3ebe8dc13a3so256332f8f.3 for ; Mon, 15 Sep 2025 06:02:06 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941325; x=1758546125; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=6w5hGoDGQ2o/vaL3XGu/cbzwLP//waYJmPg+1Z2wMSw=; b=c9a5J/6O7hJ8KvD2wgu5LpBmd5KCH6R0CaAC45WK+3uPRf5ngz9HYjF89nQhxgIewp U9Duxr7qPiZxB0DXbqBVnVDjBD9gMRGwEusRK80Jxi+DKERfKU7QQdkAxJPItv464o0W 5INPbopOChgNhTjfn7+R0/Vd2tmh8W4KclLPhPnDrdEswXIl7ACD9Rxwv8hF17foM+m6 G8d7c7qm5AQ3AWfviZei4T33tVf8WatUBG6GPx5oW6k8xZYpcfsaZx3JaSN8xqw3JBxe DGRfT9RjpnG/46EBLf0GGDe0PUesWxmc+Z6h5ZS2F5vA/4kmvN5zqYhhpL2U40V11xro fLpg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941325; x=1758546125; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=6w5hGoDGQ2o/vaL3XGu/cbzwLP//waYJmPg+1Z2wMSw=; b=ZUnOQuJOHq2LIAMR1YUUp4sM4Y64bALsQLqbGeH1fKtofunhSw5GyxjBR72GTa/neb SS2ENBBVf/BuZb8INAcixKMemY/imMEI6d3b8XtTP21rzjTnm0cG5UFZoriUZLq+a4Om Z9LxQahXDcq3LWt0RI93gFV81WeeMQEn0/WV7X7Tv9Ylh6bstdOM/J57wA3cQTRzn41F Iuuw/nosLY8gOVPtBVd+zW7VdsIVXHvDfa4r/k1q0+qxq8kvy0VwJXWWb9R1wOoZeLR6 4XtyJph3ixIKgaC2FT4zcBwMDAEcmDyiDCdLrBRhPRl4TSugzxIEYvpiGuZ6ly7CZHnV OgoQ== X-Gm-Message-State: AOJu0YxqM0KF5zXVQV8De1IBR1QfDrR/LKWv+A6xoSJ/7FoEqN9Ibcpb MEG46Kx3Dd9bP4QSgZrzm5Mrjr6m56kpfO17+Px6/lZosC0beRKLYNVeHu/VB/vTdEcJNFtMSWA ZLdQ= X-Gm-Gg: ASbGncvMZxzl/ODIGtQ4FbLs4x4RlRTQG9UnTWBxI0KMXWItFFw4nHkQwNfQWUW+FS0 PTcbqFKsbwftRGqZ+Bxa238D1SZ9LJmVIwA1vnl9ZnCC6FaZ371XjPOzZwNCzMYUZsM+no7Er/A uMj2uukFC0nFG21IUHXoOowMoGA+QoRFrgsxS3UhyHPTbWkR4zl1COsqD/if48Lf7KT0hoU8CPg TWTmyO3g8MTKsqu/WqF63lgVtmTCMlC64xotYFR0g0cd/U2BmNlvM40rvJz6CF86S9ady1XYieW Zye2xvQ1MPidOJGPab+z4Swe+bXqsBv9gbDAsHIAxMsSVmFKcIrOFFCg0SVa3N49c7+9UVpOXkT CNAReCAFstYRjNe6U59PfxjmIXeaoPgQCHGBm91Lsc67lN32RkiRsUoqoPLsD8xQ6dG1mh0CPdR hkTIJOCSJNMgOT2NtWC6hC92BBaydE4jNdgIL8I4kauvcbiAdo X-Google-Smtp-Source: AGHT+IH2JkUXaFnDi9ZDD1QUoq/QtGefuonOJgYt3i31wWBu301eRjIXW+9/LqVryaovFZ+BkNS90Q== X-Received: by 2002:a5d:5886:0:b0:3e4:64b0:a776 with SMTP id ffacd0b85a97d-3e7659fcbc7mr13555974f8f.52.1757941321390; Mon, 15 Sep 2025 06:02:01 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.00 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:00 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Nicolas Boulenguez Subject: [COMMITTED 14/27] ada: Add System.C_Time and GNAT.C_Time units to libgnat Date: Mon, 15 Sep 2025 15:01:20 +0200 Message-ID: <20250915130135.2720894-14-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Nicolas Boulenguez The first unit provides the time_t, timeval and timespec types corresponding to the C types defined by the OS, as well as various conversion functions. The second unit is a mere renaming of the first under the GNAT hierarchy. This removes C time types and conversions under System, and from bodies and private parts under GNAT, while keeping visible types and conversions under GNAT as Obsolescent. gcc/ada/ChangeLog: PR ada/114065 * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add g-c_time$(objext) and s-c_time$(objext). (Aarch64/Android): Do not use s-osinte__android.adb. (SPARC/Solaris): Do not use s-osprim__solaris.adb. (x86/Solaris): Likewise. (LynxOS178): Do not use s-parame__posix2008.ads. (RTEMS): Likewise. (x32/Linux): Likewise, as well as s-linux__x32.ads. Replace s-osprim__x32.adb with s-osprim__posix.adb. (LIBGNAT_OBJS): Remove cal.o. * cal.c: Delete. * doc/gnat_rm/the_gnat_library.rst (GNAT.C_Time): New entry. (GNAT.Calendar): Do not mention the obsolete conversion functions. * impunit.adb (Non_Imp_File_Names_95): Add g-c_time. * libgnarl/a-exetim__posix.adb: Add with clause for System.C_Time (Clock): Use type and functions from System.C_Time. * libgnarl/s-linux.ads: Remove with clause for System.Parameters. Remove declarations of C time types. * libgnarl/s-linux__alpha.ads: Likewise. * libgnarl/s-linux__android-aarch64.ads: Likewise. * libgnarl/s-linux__android-arm.ads: Likewise. * libgnarl/s-linux__hppa.ads: Likewise. * libgnarl/s-linux__loongarch.ads: Likewise. * libgnarl/s-linux__mips.ads: Likewise. * libgnarl/s-linux__riscv.ads: Likewise. * libgnarl/s-linux__sparc.ads: Likewise. * libgnarl/s-osinte__aix.ads: Likewise. * libgnarl/s-osinte__android.ads: Likewise. * libgnarl/s-osinte__cheribsd.ads: Likewise. * libgnarl/s-osinte__darwin.ads: Likewise. * libgnarl/s-osinte__dragonfly.ads: Likewise. * libgnarl/s-osinte__freebsd.ads: Likewise. * libgnarl/s-osinte__gnu.ads: Likewise. * libgnarl/s-osinte__hpux.ads: Likewise. * libgnarl/s-osinte__kfreebsd-gnu.ads: Likewise. * libgnarl/s-osinte__linux.ads: Likewise. * libgnarl/s-osinte__lynxos178e.ads: Likewise. * libgnarl/s-osinte__qnx.ads: Likewise. * libgnarl/s-osinte__rtems.ads: Likewise. * libgnarl/s-osinte__solaris.ads: Likewise. * libgnarl/s-osinte__vxworks.ads: Likewise. * libgnarl/s-qnx.ads: Likewise. * libgnarl/s-linux__x32.ads: Delete. * libgnarl/s-osinte__darwin.adb (To_Duration): Remove. (To_Timespec): Likewise. * libgnarl/s-osinte__aix.adb: Likewise. * libgnarl/s-osinte__dragonfly.adb: Likewise. * libgnarl/s-osinte__freebsd.adb: Likewise. * libgnarl/s-osinte__gnu.adb: Likewise. * libgnarl/s-osinte__lynxos178.adb: Likewise. * libgnarl/s-osinte__posix.adb: Likewise. * libgnarl/s-osinte__qnx.adb: Likewise. * libgnarl/s-osinte__rtems.adb: Likewise. * libgnarl/s-osinte__solaris.adb: Likewise. * libgnarl/s-osinte__vxworks.adb: Likewise. * libgnarl/s-osinte__x32.adb: Likewise. * libgnarl/s-taprop__solaris.adb: Add with clause for System.C_Time. (Monotonic_Clock): Use type and functions from System.C_Time. (RT_Resolution): Likewise. (Timed_Sleep): Likewise. (Timed_Delay): Likewise. * libgnarl/s-taprop__vxworks.adb: Likewise. * libgnarl/s-tpopmo.adb: Likewise. * libgnarl/s-osinte__android.adb: Delete. * libgnat/g-c_time.ads: New file. * libgnat/g-calend.adb: Delegate to System.C_Time. * libgnat/g-calend.ads: Likewise. * libgnat/g-socket.adb: Likewise. * libgnat/g-socthi.adb: Likewise. * libgnat/g-socthi__vxworks.adb: Likewise. * libgnat/g-sothco.ads: Likewise. * libgnat/g-spogwa.adb: Likewise. * libgnat/s-c_time.adb: New file. * libgnat/s-c_time.ads: Likewise. * libgnat/s-optide.adb: Import nanosleep here. * libgnat/s-os_lib.ads (time_t): Remove. (To_Ada): Adjust. (To_C): Likewise. * libgnat/s-os_lib.adb: Likewise. * libgnat/s-osprim__darwin.adb: Delegate to System.C_Time. * libgnat/s-osprim__posix.adb: Likewise. * libgnat/s-osprim__posix2008.adb: Likewise. * libgnat/s-osprim__rtems.adb: Likewise. * libgnat/s-osprim__unix.adb: Likewise. * libgnat/s-osprim__solaris.adb: Delete. * libgnat/s-osprim__x32.adb: Likewise. * libgnat/s-parame.ads (time_t_bits): Remove. * libgnat/s-parame__hpux.ads: Likewise. * libgnat/s-parame__vxworks.ads: Likewise. * libgnat/s-parame__posix2008.ads: Delete. * s-oscons-tmplt.c (SIZEOF_tv_nsec): New constant. * gnat_rm.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/Makefile.rtl | 15 +- gcc/ada/cal.c | 74 --- gcc/ada/doc/gnat_rm/the_gnat_library.rst | 14 +- gcc/ada/gnat_rm.texi | 426 +++++++++--------- gcc/ada/impunit.adb | 1 + gcc/ada/libgnarl/a-exetim__posix.adb | 9 +- gcc/ada/libgnarl/s-linux.ads | 17 - gcc/ada/libgnarl/s-linux__alpha.ads | 17 - gcc/ada/libgnarl/s-linux__android-aarch64.ads | 17 - gcc/ada/libgnarl/s-linux__android-arm.ads | 17 - gcc/ada/libgnarl/s-linux__hppa.ads | 17 - gcc/ada/libgnarl/s-linux__loongarch.ads | 18 - gcc/ada/libgnarl/s-linux__mips.ads | 22 +- gcc/ada/libgnarl/s-linux__riscv.ads | 22 +- gcc/ada/libgnarl/s-linux__sparc.ads | 17 - gcc/ada/libgnarl/s-linux__x32.ads | 133 ------ gcc/ada/libgnarl/s-osinte__aix.adb | 32 -- gcc/ada/libgnarl/s-osinte__aix.ads | 25 +- gcc/ada/libgnarl/s-osinte__android.ads | 25 +- gcc/ada/libgnarl/s-osinte__cheribsd.ads | 27 +- gcc/ada/libgnarl/s-osinte__darwin.adb | 61 +-- gcc/ada/libgnarl/s-osinte__darwin.ads | 25 +- gcc/ada/libgnarl/s-osinte__dragonfly.adb | 33 -- gcc/ada/libgnarl/s-osinte__dragonfly.ads | 27 +- gcc/ada/libgnarl/s-osinte__freebsd.adb | 32 -- gcc/ada/libgnarl/s-osinte__freebsd.ads | 27 +- gcc/ada/libgnarl/s-osinte__gnu.adb | 33 -- gcc/ada/libgnarl/s-osinte__gnu.ads | 27 +- gcc/ada/libgnarl/s-osinte__hpux.ads | 25 +- gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads | 27 +- gcc/ada/libgnarl/s-osinte__linux.ads | 18 +- gcc/ada/libgnarl/s-osinte__lynxos178.adb | 32 -- gcc/ada/libgnarl/s-osinte__lynxos178e.ads | 35 +- gcc/ada/libgnarl/s-osinte__posix.adb | 34 +- gcc/ada/libgnarl/s-osinte__qnx.adb | 34 +- gcc/ada/libgnarl/s-osinte__qnx.ads | 25 +- gcc/ada/libgnarl/s-osinte__rtems.adb | 30 -- gcc/ada/libgnarl/s-osinte__rtems.ads | 29 +- gcc/ada/libgnarl/s-osinte__solaris.adb | 34 -- gcc/ada/libgnarl/s-osinte__solaris.ads | 25 +- gcc/ada/libgnarl/s-osinte__vxworks.adb | 32 -- gcc/ada/libgnarl/s-osinte__vxworks.ads | 28 +- gcc/ada/libgnarl/s-osinte__x32.adb | 35 +- gcc/ada/libgnarl/s-qnx.ads | 18 - gcc/ada/libgnarl/s-taprop__solaris.adb | 17 +- gcc/ada/libgnarl/s-taprop__vxworks.adb | 5 +- gcc/ada/libgnarl/s-tpopmo.adb | 18 +- .../g-c_time.ads} | 58 +-- gcc/ada/libgnat/g-calend.adb | 61 +-- gcc/ada/libgnat/g-calend.ads | 25 +- gcc/ada/libgnat/g-socket.adb | 78 +--- gcc/ada/libgnat/g-socthi.adb | 4 +- gcc/ada/libgnat/g-socthi__vxworks.adb | 4 +- gcc/ada/libgnat/g-sothco.ads | 30 +- gcc/ada/libgnat/g-spogwa.adb | 11 +- gcc/ada/libgnat/s-c_time.adb | 203 +++++++++ gcc/ada/libgnat/s-c_time.ads | 93 ++++ gcc/ada/libgnat/s-optide.adb | 11 +- gcc/ada/libgnat/s-os_lib.adb | 6 +- gcc/ada/libgnat/s-os_lib.ads | 29 +- gcc/ada/libgnat/s-osprim__darwin.adb | 62 +-- gcc/ada/libgnat/s-osprim__posix.adb | 69 +-- gcc/ada/libgnat/s-osprim__posix2008.adb | 52 +-- gcc/ada/libgnat/s-osprim__rtems.adb | 71 +-- gcc/ada/libgnat/s-osprim__solaris.adb | 126 ------ gcc/ada/libgnat/s-osprim__unix.adb | 29 +- gcc/ada/libgnat/s-osprim__x32.adb | 170 ------- gcc/ada/libgnat/s-parame.ads | 7 - gcc/ada/libgnat/s-parame__hpux.ads | 7 - gcc/ada/libgnat/s-parame__posix2008.ads | 189 -------- gcc/ada/libgnat/s-parame__vxworks.ads | 15 - gcc/ada/s-oscons-tmplt.c | 11 + 72 files changed, 763 insertions(+), 2369 deletions(-) delete mode 100644 gcc/ada/cal.c delete mode 100644 gcc/ada/libgnarl/s-linux__x32.ads rename gcc/ada/{libgnarl/s-osinte__android.adb => libgnat/g-c_time.ads} (59%) create mode 100644 gcc/ada/libgnat/s-c_time.adb create mode 100644 gcc/ada/libgnat/s-c_time.ads delete mode 100644 gcc/ada/libgnat/s-osprim__solaris.adb delete mode 100644 gcc/ada/libgnat/s-osprim__x32.adb delete mode 100644 gcc/ada/libgnat/s-parame__posix2008.ads diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 9d8c2f1aeae4..0c290794309a 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -415,6 +415,7 @@ GNATRTL_NONTASKING_OBJS= \ g-busorg$(objext) \ g-byorma$(objext) \ g-bytswa$(objext) \ + g-c_time$(objext) \ g-calend$(objext) \ g-casuti$(objext) \ g-catiio$(objext) \ @@ -535,6 +536,7 @@ GNATRTL_NONTASKING_OBJS= \ s-boarop$(objext) \ s-boustr$(objext) \ s-bytswa$(objext) \ + s-c_time$(objext) \ s-carsi8$(objext) \ s-carun8$(objext) \ s-casi16$(objext) \ @@ -1418,7 +1420,6 @@ ifeq ($(strip $(filter-out arm% aarch64 linux-android%,$(target_cpu) $(target_os s-inmaop.adb. * - * * - * GNAT was originally developed by the GNAT team at New York University. * - * Extensive contributions were provided by Ada Core Technologies Inc. * - * * - ****************************************************************************/ - -/* This file contains routines marked with pragmas Import in package */ -/* GNAT.Calendar. It is used to do Duration to timeval conversion. */ -/* These are simple wrapper functions to abstract the fact that the C */ -/* struct timeval fields are not normalized (they are generally */ -/* defined as int or long values). */ - -#if defined (__vxworks) -#ifdef __RTP__ -#include -#include -#if (_WRS_VXWORKS_MAJOR == 7) || (_WRS_VXWORKS_MINOR != 0) -#include -#endif -#else -#include -#endif -#elif defined (__nucleus__) -#include -#else -#include -#endif - -#ifdef __MINGW32__ -#include "mingw32.h" -#include -#endif - -void -__gnat_timeval_to_duration (struct timeval *t, long long *sec, long *usec) -{ - *sec = (long long) t->tv_sec; - *usec = (long) t->tv_usec; -} - -void -__gnat_duration_to_timeval (long long sec, long usec, struct timeval *t) -{ - /* here we are doing implicit conversion to the struct timeval - fields types. */ - - t->tv_sec = sec; - t->tv_usec = usec; -} diff --git a/gcc/ada/doc/gnat_rm/the_gnat_library.rst b/gcc/ada/doc/gnat_rm/the_gnat_library.rst index d041090eab06..29642aa89709 100644 --- a/gcc/ada/doc/gnat_rm/the_gnat_library.rst +++ b/gcc/ada/doc/gnat_rm/the_gnat_library.rst @@ -663,6 +663,18 @@ sequences for various UCS input formats. General routines for swapping the bytes in 2-, 4-, and 8-byte quantities. Machine-specific implementations are available in some cases. +.. _`GNAT.C_Time_(g-c_time.ads)`: + +``GNAT.C_Time`` (:file:`g-c_time.ads`) +====================================== + +.. index:: GNAT.C_Time (g-c_time.ads) + +.. index:: Time + +Provides the time_t, timeval and timespec types corresponding to the C +types defined by the OS, as well as various conversion functions. + .. _`GNAT.Calendar_(g-calend.ads)`: ``GNAT.Calendar`` (:file:`g-calend.ads`) @@ -674,8 +686,6 @@ Machine-specific implementations are available in some cases. Extends the facilities provided by ``Ada.Calendar`` to include handling of days of the week, an extended ``Split`` and ``Time_Of`` capability. -Also provides conversion of ``Ada.Calendar.Time`` values to and from the -C ``timeval`` format. .. _`GNAT.Calendar.Time_IO_(g-catiio.ads)`: diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index d094720047c4..e2ede5ea1b74 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -755,6 +755,7 @@ The GNAT Library * GNAT.Bubble_Sort_G (g-busorg.ads): GNAT Bubble_Sort_G g-busorg ads. * GNAT.Byte_Order_Mark (g-byorma.ads): GNAT Byte_Order_Mark g-byorma ads. * GNAT.Byte_Swapping (g-bytswa.ads): GNAT Byte_Swapping g-bytswa ads. +* GNAT.C_Time (g-c_time.ads): GNAT C_Time g-c_time ads. * GNAT.Calendar (g-calend.ads): GNAT Calendar g-calend ads. * GNAT.Calendar.Time_IO (g-catiio.ads): GNAT Calendar Time_IO g-catiio ads. * GNAT.CRC32 (g-crc32.ads): GNAT CRC32 g-crc32 ads. @@ -23522,6 +23523,7 @@ of GNAT, and will generate a warning message. * GNAT.Bubble_Sort_G (g-busorg.ads): GNAT Bubble_Sort_G g-busorg ads. * GNAT.Byte_Order_Mark (g-byorma.ads): GNAT Byte_Order_Mark g-byorma ads. * GNAT.Byte_Swapping (g-bytswa.ads): GNAT Byte_Swapping g-bytswa ads. +* GNAT.C_Time (g-c_time.ads): GNAT C_Time g-c_time ads. * GNAT.Calendar (g-calend.ads): GNAT Calendar g-calend ads. * GNAT.Calendar.Time_IO (g-catiio.ads): GNAT Calendar Time_IO g-catiio ads. * GNAT.CRC32 (g-crc32.ads): GNAT CRC32 g-crc32 ads. @@ -24261,7 +24263,7 @@ see whether it is one of the standard byte order marks (BOM’s) which signal the encoding of the string. The routine includes detection of special XML sequences for various UCS input formats. -@node GNAT Byte_Swapping g-bytswa ads,GNAT Calendar g-calend ads,GNAT Byte_Order_Mark g-byorma ads,The GNAT Library +@node GNAT Byte_Swapping g-bytswa ads,GNAT C_Time g-c_time ads,GNAT Byte_Order_Mark g-byorma ads,The GNAT Library @anchor{gnat_rm/the_gnat_library gnat-byte-swapping-g-bytswa-ads}@anchor{34a}@anchor{gnat_rm/the_gnat_library id45}@anchor{34b} @section @code{GNAT.Byte_Swapping} (@code{g-bytswa.ads}) @@ -24275,8 +24277,20 @@ sequences for various UCS input formats. General routines for swapping the bytes in 2-, 4-, and 8-byte quantities. Machine-specific implementations are available in some cases. -@node GNAT Calendar g-calend ads,GNAT Calendar Time_IO g-catiio ads,GNAT Byte_Swapping g-bytswa ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{34c}@anchor{gnat_rm/the_gnat_library id46}@anchor{34d} +@node GNAT C_Time g-c_time ads,GNAT Calendar g-calend ads,GNAT Byte_Swapping g-bytswa ads,The GNAT Library +@anchor{gnat_rm/the_gnat_library gnat-c-time-g-c-time-ads}@anchor{34c}@anchor{gnat_rm/the_gnat_library id46}@anchor{34d} +@section @code{GNAT.C_Time} (@code{g-c_time.ads}) + + +@geindex GNAT.C_Time (g-c_time.ads) + +@geindex Time + +Provides the time_t, timeval and timespec types corresponding to the C +types defined by the OS, as well as various conversion functions. + +@node GNAT Calendar g-calend ads,GNAT Calendar Time_IO g-catiio ads,GNAT C_Time g-c_time ads,The GNAT Library +@anchor{gnat_rm/the_gnat_library gnat-calendar-g-calend-ads}@anchor{34e}@anchor{gnat_rm/the_gnat_library id47}@anchor{34f} @section @code{GNAT.Calendar} (@code{g-calend.ads}) @@ -24286,11 +24300,9 @@ Machine-specific implementations are available in some cases. Extends the facilities provided by @code{Ada.Calendar} to include handling of days of the week, an extended @code{Split} and @code{Time_Of} capability. -Also provides conversion of @code{Ada.Calendar.Time} values to and from the -C @code{timeval} format. @node GNAT Calendar Time_IO g-catiio ads,GNAT CRC32 g-crc32 ads,GNAT Calendar g-calend ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{34e}@anchor{gnat_rm/the_gnat_library id47}@anchor{34f} +@anchor{gnat_rm/the_gnat_library gnat-calendar-time-io-g-catiio-ads}@anchor{350}@anchor{gnat_rm/the_gnat_library id48}@anchor{351} @section @code{GNAT.Calendar.Time_IO} (@code{g-catiio.ads}) @@ -24301,7 +24313,7 @@ C @code{timeval} format. @geindex GNAT.Calendar.Time_IO (g-catiio.ads) @node GNAT CRC32 g-crc32 ads,GNAT Case_Util g-casuti ads,GNAT Calendar Time_IO g-catiio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{350}@anchor{gnat_rm/the_gnat_library id48}@anchor{351} +@anchor{gnat_rm/the_gnat_library gnat-crc32-g-crc32-ads}@anchor{352}@anchor{gnat_rm/the_gnat_library id49}@anchor{353} @section @code{GNAT.CRC32} (@code{g-crc32.ads}) @@ -24318,7 +24330,7 @@ of this algorithm see Aug. 1988. Sarwate, D.V. @node GNAT Case_Util g-casuti ads,GNAT CGI g-cgi ads,GNAT CRC32 g-crc32 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{352}@anchor{gnat_rm/the_gnat_library id49}@anchor{353} +@anchor{gnat_rm/the_gnat_library gnat-case-util-g-casuti-ads}@anchor{354}@anchor{gnat_rm/the_gnat_library id50}@anchor{355} @section @code{GNAT.Case_Util} (@code{g-casuti.ads}) @@ -24333,7 +24345,7 @@ without the overhead of the full casing tables in @code{Ada.Characters.Handling}. @node GNAT CGI g-cgi ads,GNAT CGI Cookie g-cgicoo ads,GNAT Case_Util g-casuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{354}@anchor{gnat_rm/the_gnat_library id50}@anchor{355} +@anchor{gnat_rm/the_gnat_library gnat-cgi-g-cgi-ads}@anchor{356}@anchor{gnat_rm/the_gnat_library id51}@anchor{357} @section @code{GNAT.CGI} (@code{g-cgi.ads}) @@ -24348,7 +24360,7 @@ builds a table whose index is the key and provides some services to deal with this table. @node GNAT CGI Cookie g-cgicoo ads,GNAT CGI Debug g-cgideb ads,GNAT CGI g-cgi ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{356}@anchor{gnat_rm/the_gnat_library id51}@anchor{357} +@anchor{gnat_rm/the_gnat_library gnat-cgi-cookie-g-cgicoo-ads}@anchor{358}@anchor{gnat_rm/the_gnat_library id52}@anchor{359} @section @code{GNAT.CGI.Cookie} (@code{g-cgicoo.ads}) @@ -24363,7 +24375,7 @@ Common Gateway Interface (CGI). It exports services to deal with Web cookies (piece of information kept in the Web client software). @node GNAT CGI Debug g-cgideb ads,GNAT Command_Line g-comlin ads,GNAT CGI Cookie g-cgicoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{358}@anchor{gnat_rm/the_gnat_library id52}@anchor{359} +@anchor{gnat_rm/the_gnat_library gnat-cgi-debug-g-cgideb-ads}@anchor{35a}@anchor{gnat_rm/the_gnat_library id53}@anchor{35b} @section @code{GNAT.CGI.Debug} (@code{g-cgideb.ads}) @@ -24375,7 +24387,7 @@ This is a package to help debugging CGI (Common Gateway Interface) programs written in Ada. @node GNAT Command_Line g-comlin ads,GNAT Compiler_Version g-comver ads,GNAT CGI Debug g-cgideb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{35a}@anchor{gnat_rm/the_gnat_library id53}@anchor{35b} +@anchor{gnat_rm/the_gnat_library gnat-command-line-g-comlin-ads}@anchor{35c}@anchor{gnat_rm/the_gnat_library id54}@anchor{35d} @section @code{GNAT.Command_Line} (@code{g-comlin.ads}) @@ -24388,7 +24400,7 @@ including the ability to scan for named switches with optional parameters and expand file names using wildcard notations. @node GNAT Compiler_Version g-comver ads,GNAT Ctrl_C g-ctrl_c ads,GNAT Command_Line g-comlin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{35c}@anchor{gnat_rm/the_gnat_library id54}@anchor{35d} +@anchor{gnat_rm/the_gnat_library gnat-compiler-version-g-comver-ads}@anchor{35e}@anchor{gnat_rm/the_gnat_library id55}@anchor{35f} @section @code{GNAT.Compiler_Version} (@code{g-comver.ads}) @@ -24406,7 +24418,7 @@ of the compiler if a consistent tool set is used to compile all units of a partition). @node GNAT Ctrl_C g-ctrl_c ads,GNAT Current_Exception g-curexc ads,GNAT Compiler_Version g-comver ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{35e}@anchor{gnat_rm/the_gnat_library id55}@anchor{35f} +@anchor{gnat_rm/the_gnat_library gnat-ctrl-c-g-ctrl-c-ads}@anchor{360}@anchor{gnat_rm/the_gnat_library id56}@anchor{361} @section @code{GNAT.Ctrl_C} (@code{g-ctrl_c.ads}) @@ -24417,7 +24429,7 @@ of a partition). Provides a simple interface to handle Ctrl-C keyboard events. @node GNAT Current_Exception g-curexc ads,GNAT Debug_Pools g-debpoo ads,GNAT Ctrl_C g-ctrl_c ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{360}@anchor{gnat_rm/the_gnat_library id56}@anchor{361} +@anchor{gnat_rm/the_gnat_library gnat-current-exception-g-curexc-ads}@anchor{362}@anchor{gnat_rm/the_gnat_library id57}@anchor{363} @section @code{GNAT.Current_Exception} (@code{g-curexc.ads}) @@ -24434,7 +24446,7 @@ This is particularly useful in simulating typical facilities for obtaining information about exceptions provided by Ada 83 compilers. @node GNAT Debug_Pools g-debpoo ads,GNAT Debug_Utilities g-debuti ads,GNAT Current_Exception g-curexc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{362}@anchor{gnat_rm/the_gnat_library id57}@anchor{363} +@anchor{gnat_rm/the_gnat_library gnat-debug-pools-g-debpoo-ads}@anchor{364}@anchor{gnat_rm/the_gnat_library id58}@anchor{365} @section @code{GNAT.Debug_Pools} (@code{g-debpoo.ads}) @@ -24451,7 +24463,7 @@ problems. See @code{The GNAT Debug_Pool Facility} section in the @cite{GNAT User’s Guide}. @node GNAT Debug_Utilities g-debuti ads,GNAT Decode_String g-decstr ads,GNAT Debug_Pools g-debpoo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{364}@anchor{gnat_rm/the_gnat_library id58}@anchor{365} +@anchor{gnat_rm/the_gnat_library gnat-debug-utilities-g-debuti-ads}@anchor{366}@anchor{gnat_rm/the_gnat_library id59}@anchor{367} @section @code{GNAT.Debug_Utilities} (@code{g-debuti.ads}) @@ -24464,7 +24476,7 @@ to and from string images of address values. Supports both C and Ada formats for hexadecimal literals. @node GNAT Decode_String g-decstr ads,GNAT Decode_UTF8_String g-deutst ads,GNAT Debug_Utilities g-debuti ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{366}@anchor{gnat_rm/the_gnat_library id59}@anchor{367} +@anchor{gnat_rm/the_gnat_library gnat-decode-string-g-decstr-ads}@anchor{368}@anchor{gnat_rm/the_gnat_library id60}@anchor{369} @section @code{GNAT.Decode_String} (@code{g-decstr.ads}) @@ -24488,7 +24500,7 @@ Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Decode_UTF8_String g-deutst ads,GNAT Directory_Operations g-dirope ads,GNAT Decode_String g-decstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{368}@anchor{gnat_rm/the_gnat_library id60}@anchor{369} +@anchor{gnat_rm/the_gnat_library gnat-decode-utf8-string-g-deutst-ads}@anchor{36a}@anchor{gnat_rm/the_gnat_library id61}@anchor{36b} @section @code{GNAT.Decode_UTF8_String} (@code{g-deutst.ads}) @@ -24509,7 +24521,7 @@ preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Decode_Strings for UTF-8 encoding. @node GNAT Directory_Operations g-dirope ads,GNAT Directory_Operations Iteration g-diopit ads,GNAT Decode_UTF8_String g-deutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{36a}@anchor{gnat_rm/the_gnat_library id61}@anchor{36b} +@anchor{gnat_rm/the_gnat_library gnat-directory-operations-g-dirope-ads}@anchor{36c}@anchor{gnat_rm/the_gnat_library id62}@anchor{36d} @section @code{GNAT.Directory_Operations} (@code{g-dirope.ads}) @@ -24522,7 +24534,7 @@ the current directory, making new directories, and scanning the files in a directory. @node GNAT Directory_Operations Iteration g-diopit ads,GNAT Dynamic_HTables g-dynhta ads,GNAT Directory_Operations g-dirope ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{36c}@anchor{gnat_rm/the_gnat_library id62}@anchor{36d} +@anchor{gnat_rm/the_gnat_library gnat-directory-operations-iteration-g-diopit-ads}@anchor{36e}@anchor{gnat_rm/the_gnat_library id63}@anchor{36f} @section @code{GNAT.Directory_Operations.Iteration} (@code{g-diopit.ads}) @@ -24534,7 +24546,7 @@ A child unit of GNAT.Directory_Operations providing additional operations for iterating through directories. @node GNAT Dynamic_HTables g-dynhta ads,GNAT Dynamic_Tables g-dyntab ads,GNAT Directory_Operations Iteration g-diopit ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{36e}@anchor{gnat_rm/the_gnat_library id63}@anchor{36f} +@anchor{gnat_rm/the_gnat_library gnat-dynamic-htables-g-dynhta-ads}@anchor{370}@anchor{gnat_rm/the_gnat_library id64}@anchor{371} @section @code{GNAT.Dynamic_HTables} (@code{g-dynhta.ads}) @@ -24552,7 +24564,7 @@ dynamic instances of the hash table, while an instantiation of @code{GNAT.HTable} creates a single instance of the hash table. @node GNAT Dynamic_Tables g-dyntab ads,GNAT Encode_String g-encstr ads,GNAT Dynamic_HTables g-dynhta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{370}@anchor{gnat_rm/the_gnat_library id64}@anchor{371} +@anchor{gnat_rm/the_gnat_library gnat-dynamic-tables-g-dyntab-ads}@anchor{372}@anchor{gnat_rm/the_gnat_library id65}@anchor{373} @section @code{GNAT.Dynamic_Tables} (@code{g-dyntab.ads}) @@ -24572,7 +24584,7 @@ dynamic instances of the table, while an instantiation of @code{GNAT.Table} creates a single instance of the table type. @node GNAT Encode_String g-encstr ads,GNAT Encode_UTF8_String g-enutst ads,GNAT Dynamic_Tables g-dyntab ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{372}@anchor{gnat_rm/the_gnat_library id65}@anchor{373} +@anchor{gnat_rm/the_gnat_library gnat-encode-string-g-encstr-ads}@anchor{374}@anchor{gnat_rm/the_gnat_library id66}@anchor{375} @section @code{GNAT.Encode_String} (@code{g-encstr.ads}) @@ -24594,7 +24606,7 @@ encoding method. Useful in conjunction with Unicode character coding. Note there is a preinstantiation for UTF-8. See next entry. @node GNAT Encode_UTF8_String g-enutst ads,GNAT Exception_Actions g-excact ads,GNAT Encode_String g-encstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{374}@anchor{gnat_rm/the_gnat_library id66}@anchor{375} +@anchor{gnat_rm/the_gnat_library gnat-encode-utf8-string-g-enutst-ads}@anchor{376}@anchor{gnat_rm/the_gnat_library id67}@anchor{377} @section @code{GNAT.Encode_UTF8_String} (@code{g-enutst.ads}) @@ -24615,7 +24627,7 @@ Note there is a preinstantiation for UTF-8. See next entry. A preinstantiation of GNAT.Encode_Strings for UTF-8 encoding. @node GNAT Exception_Actions g-excact ads,GNAT Exception_Traces g-exctra ads,GNAT Encode_UTF8_String g-enutst ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{376}@anchor{gnat_rm/the_gnat_library id67}@anchor{377} +@anchor{gnat_rm/the_gnat_library gnat-exception-actions-g-excact-ads}@anchor{378}@anchor{gnat_rm/the_gnat_library id68}@anchor{379} @section @code{GNAT.Exception_Actions} (@code{g-excact.ads}) @@ -24628,7 +24640,7 @@ for specific exceptions, or when any exception is raised. This can be used for instance to force a core dump to ease debugging. @node GNAT Exception_Traces g-exctra ads,GNAT Exceptions g-except ads,GNAT Exception_Actions g-excact ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{378}@anchor{gnat_rm/the_gnat_library id68}@anchor{379} +@anchor{gnat_rm/the_gnat_library gnat-exception-traces-g-exctra-ads}@anchor{37a}@anchor{gnat_rm/the_gnat_library id69}@anchor{37b} @section @code{GNAT.Exception_Traces} (@code{g-exctra.ads}) @@ -24642,7 +24654,7 @@ Provides an interface allowing to control automatic output upon exception occurrences. @node GNAT Exceptions g-except ads,GNAT Expect g-expect ads,GNAT Exception_Traces g-exctra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-except-ads}@anchor{37a}@anchor{gnat_rm/the_gnat_library id69}@anchor{37b} +@anchor{gnat_rm/the_gnat_library gnat-exceptions-g-except-ads}@anchor{37c}@anchor{gnat_rm/the_gnat_library id70}@anchor{37d} @section @code{GNAT.Exceptions} (@code{g-except.ads}) @@ -24663,7 +24675,7 @@ predefined exceptions, and for example allows raising @code{Constraint_Error} with a message from a pure subprogram. @node GNAT Expect g-expect ads,GNAT Expect TTY g-exptty ads,GNAT Exceptions g-except ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{37c}@anchor{gnat_rm/the_gnat_library id70}@anchor{37d} +@anchor{gnat_rm/the_gnat_library gnat-expect-g-expect-ads}@anchor{37e}@anchor{gnat_rm/the_gnat_library id71}@anchor{37f} @section @code{GNAT.Expect} (@code{g-expect.ads}) @@ -24679,7 +24691,7 @@ It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Expect TTY g-exptty ads,GNAT Float_Control g-flocon ads,GNAT Expect g-expect ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{37e}@anchor{gnat_rm/the_gnat_library id71}@anchor{37f} +@anchor{gnat_rm/the_gnat_library gnat-expect-tty-g-exptty-ads}@anchor{380}@anchor{gnat_rm/the_gnat_library id72}@anchor{381} @section @code{GNAT.Expect.TTY} (@code{g-exptty.ads}) @@ -24691,7 +24703,7 @@ ports. It is not implemented for cross ports, and in particular is not implemented for VxWorks or LynxOS. @node GNAT Float_Control g-flocon ads,GNAT Formatted_String g-forstr ads,GNAT Expect TTY g-exptty ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{380}@anchor{gnat_rm/the_gnat_library id72}@anchor{381} +@anchor{gnat_rm/the_gnat_library gnat-float-control-g-flocon-ads}@anchor{382}@anchor{gnat_rm/the_gnat_library id73}@anchor{383} @section @code{GNAT.Float_Control} (@code{g-flocon.ads}) @@ -24705,7 +24717,7 @@ library calls may cause this mode to be modified, and the Reset procedure in this package can be used to reestablish the required mode. @node GNAT Formatted_String g-forstr ads,GNAT Generic_Fast_Math_Functions g-gfmafu ads,GNAT Float_Control g-flocon ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{382}@anchor{gnat_rm/the_gnat_library id73}@anchor{383} +@anchor{gnat_rm/the_gnat_library gnat-formatted-string-g-forstr-ads}@anchor{384}@anchor{gnat_rm/the_gnat_library id74}@anchor{385} @section @code{GNAT.Formatted_String} (@code{g-forstr.ads}) @@ -24720,7 +24732,7 @@ derived from Integer, Float or enumerations as values for the formatted string. @node GNAT Generic_Fast_Math_Functions g-gfmafu ads,GNAT Heap_Sort g-heasor ads,GNAT Formatted_String g-forstr ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-generic-fast-math-functions-g-gfmafu-ads}@anchor{384}@anchor{gnat_rm/the_gnat_library id74}@anchor{385} +@anchor{gnat_rm/the_gnat_library gnat-generic-fast-math-functions-g-gfmafu-ads}@anchor{386}@anchor{gnat_rm/the_gnat_library id75}@anchor{387} @section @code{GNAT.Generic_Fast_Math_Functions} (@code{g-gfmafu.ads}) @@ -24738,7 +24750,7 @@ have a vector implementation that can be automatically used by the compiler when auto-vectorization is enabled. @node GNAT Heap_Sort g-heasor ads,GNAT Heap_Sort_A g-hesora ads,GNAT Generic_Fast_Math_Functions g-gfmafu ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{386}@anchor{gnat_rm/the_gnat_library id75}@anchor{387} +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-heasor-ads}@anchor{388}@anchor{gnat_rm/the_gnat_library id76}@anchor{389} @section @code{GNAT.Heap_Sort} (@code{g-heasor.ads}) @@ -24752,7 +24764,7 @@ access-to-procedure values. The algorithm used is a modified heap sort that performs approximately N*log(N) comparisons in the worst case. @node GNAT Heap_Sort_A g-hesora ads,GNAT Heap_Sort_G g-hesorg ads,GNAT Heap_Sort g-heasor ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{388}@anchor{gnat_rm/the_gnat_library id76}@anchor{389} +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-a-g-hesora-ads}@anchor{38a}@anchor{gnat_rm/the_gnat_library id77}@anchor{38b} @section @code{GNAT.Heap_Sort_A} (@code{g-hesora.ads}) @@ -24768,7 +24780,7 @@ This differs from @code{GNAT.Heap_Sort} in having a less convenient interface, but may be slightly more efficient. @node GNAT Heap_Sort_G g-hesorg ads,GNAT HTable g-htable ads,GNAT Heap_Sort_A g-hesora ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{38a}@anchor{gnat_rm/the_gnat_library id77}@anchor{38b} +@anchor{gnat_rm/the_gnat_library gnat-heap-sort-g-g-hesorg-ads}@anchor{38c}@anchor{gnat_rm/the_gnat_library id78}@anchor{38d} @section @code{GNAT.Heap_Sort_G} (@code{g-hesorg.ads}) @@ -24782,7 +24794,7 @@ if the procedures can be inlined, at the expense of duplicating code for multiple instantiations. @node GNAT HTable g-htable ads,GNAT IO g-io ads,GNAT Heap_Sort_G g-hesorg ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{38c}@anchor{gnat_rm/the_gnat_library id78}@anchor{38d} +@anchor{gnat_rm/the_gnat_library gnat-htable-g-htable-ads}@anchor{38e}@anchor{gnat_rm/the_gnat_library id79}@anchor{38f} @section @code{GNAT.HTable} (@code{g-htable.ads}) @@ -24795,7 +24807,7 @@ data. Provides two approaches, one a simple static approach, and the other allowing arbitrary dynamic hash tables. @node GNAT IO g-io ads,GNAT IO_Aux g-io_aux ads,GNAT HTable g-htable ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{38e}@anchor{gnat_rm/the_gnat_library id79}@anchor{38f} +@anchor{gnat_rm/the_gnat_library gnat-io-g-io-ads}@anchor{390}@anchor{gnat_rm/the_gnat_library id80}@anchor{391} @section @code{GNAT.IO} (@code{g-io.ads}) @@ -24811,7 +24823,7 @@ Standard_Input, and writing characters, strings and integers to either Standard_Output or Standard_Error. @node GNAT IO_Aux g-io_aux ads,GNAT Lock_Files g-locfil ads,GNAT IO g-io ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{390}@anchor{gnat_rm/the_gnat_library id80}@anchor{391} +@anchor{gnat_rm/the_gnat_library gnat-io-aux-g-io-aux-ads}@anchor{392}@anchor{gnat_rm/the_gnat_library id81}@anchor{393} @section @code{GNAT.IO_Aux} (@code{g-io_aux.ads}) @@ -24825,7 +24837,7 @@ Provides some auxiliary functions for use with Text_IO, including a test for whether a file exists, and functions for reading a line of text. @node GNAT Lock_Files g-locfil ads,GNAT MBBS_Discrete_Random g-mbdira ads,GNAT IO_Aux g-io_aux ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{392}@anchor{gnat_rm/the_gnat_library id81}@anchor{393} +@anchor{gnat_rm/the_gnat_library gnat-lock-files-g-locfil-ads}@anchor{394}@anchor{gnat_rm/the_gnat_library id82}@anchor{395} @section @code{GNAT.Lock_Files} (@code{g-locfil.ads}) @@ -24839,7 +24851,7 @@ Provides a general interface for using files as locks. Can be used for providing program level synchronization. @node GNAT MBBS_Discrete_Random g-mbdira ads,GNAT MBBS_Float_Random g-mbflra ads,GNAT Lock_Files g-locfil ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{394}@anchor{gnat_rm/the_gnat_library id82}@anchor{395} +@anchor{gnat_rm/the_gnat_library gnat-mbbs-discrete-random-g-mbdira-ads}@anchor{396}@anchor{gnat_rm/the_gnat_library id83}@anchor{397} @section @code{GNAT.MBBS_Discrete_Random} (@code{g-mbdira.ads}) @@ -24851,7 +24863,7 @@ The original implementation of @code{Ada.Numerics.Discrete_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MBBS_Float_Random g-mbflra ads,GNAT MD5 g-md5 ads,GNAT MBBS_Discrete_Random g-mbdira ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{396}@anchor{gnat_rm/the_gnat_library id83}@anchor{397} +@anchor{gnat_rm/the_gnat_library gnat-mbbs-float-random-g-mbflra-ads}@anchor{398}@anchor{gnat_rm/the_gnat_library id84}@anchor{399} @section @code{GNAT.MBBS_Float_Random} (@code{g-mbflra.ads}) @@ -24863,7 +24875,7 @@ The original implementation of @code{Ada.Numerics.Float_Random}. Uses a modified version of the Blum-Blum-Shub generator. @node GNAT MD5 g-md5 ads,GNAT Memory_Dump g-memdum ads,GNAT MBBS_Float_Random g-mbflra ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{398}@anchor{gnat_rm/the_gnat_library id84}@anchor{399} +@anchor{gnat_rm/the_gnat_library gnat-md5-g-md5-ads}@anchor{39a}@anchor{gnat_rm/the_gnat_library id85}@anchor{39b} @section @code{GNAT.MD5} (@code{g-md5.ads}) @@ -24876,7 +24888,7 @@ the HMAC-MD5 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Memory_Dump g-memdum ads,GNAT Most_Recent_Exception g-moreex ads,GNAT MD5 g-md5 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{39a}@anchor{gnat_rm/the_gnat_library id85}@anchor{39b} +@anchor{gnat_rm/the_gnat_library gnat-memory-dump-g-memdum-ads}@anchor{39c}@anchor{gnat_rm/the_gnat_library id86}@anchor{39d} @section @code{GNAT.Memory_Dump} (@code{g-memdum.ads}) @@ -24889,7 +24901,7 @@ standard output or standard error files. Uses GNAT.IO for actual output. @node GNAT Most_Recent_Exception g-moreex ads,GNAT OS_Lib g-os_lib ads,GNAT Memory_Dump g-memdum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{39c}@anchor{gnat_rm/the_gnat_library id86}@anchor{39d} +@anchor{gnat_rm/the_gnat_library gnat-most-recent-exception-g-moreex-ads}@anchor{39e}@anchor{gnat_rm/the_gnat_library id87}@anchor{39f} @section @code{GNAT.Most_Recent_Exception} (@code{g-moreex.ads}) @@ -24903,7 +24915,7 @@ various logging purposes, including duplicating functionality of some Ada 83 implementation dependent extensions. @node GNAT OS_Lib g-os_lib ads,GNAT Perfect_Hash_Generators g-pehage ads,GNAT Most_Recent_Exception g-moreex ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{39e}@anchor{gnat_rm/the_gnat_library id87}@anchor{39f} +@anchor{gnat_rm/the_gnat_library gnat-os-lib-g-os-lib-ads}@anchor{3a0}@anchor{gnat_rm/the_gnat_library id88}@anchor{3a1} @section @code{GNAT.OS_Lib} (@code{g-os_lib.ads}) @@ -24919,7 +24931,7 @@ including a portable spawn procedure, and access to environment variables and error return codes. @node GNAT Perfect_Hash_Generators g-pehage ads,GNAT Random_Numbers g-rannum ads,GNAT OS_Lib g-os_lib ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{3a0}@anchor{gnat_rm/the_gnat_library id88}@anchor{3a1} +@anchor{gnat_rm/the_gnat_library gnat-perfect-hash-generators-g-pehage-ads}@anchor{3a2}@anchor{gnat_rm/the_gnat_library id89}@anchor{3a3} @section @code{GNAT.Perfect_Hash_Generators} (@code{g-pehage.ads}) @@ -24937,7 +24949,7 @@ hashcode are in the same order. These hashing functions are very convenient for use with realtime applications. @node GNAT Random_Numbers g-rannum ads,GNAT Regexp g-regexp ads,GNAT Perfect_Hash_Generators g-pehage ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{3a2}@anchor{gnat_rm/the_gnat_library id89}@anchor{3a3} +@anchor{gnat_rm/the_gnat_library gnat-random-numbers-g-rannum-ads}@anchor{3a4}@anchor{gnat_rm/the_gnat_library id90}@anchor{3a5} @section @code{GNAT.Random_Numbers} (@code{g-rannum.ads}) @@ -24951,7 +24963,7 @@ however NOT suitable for situations requiring cryptographically secure randomness. @node GNAT Regexp g-regexp ads,GNAT Registry g-regist ads,GNAT Random_Numbers g-rannum ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{279}@anchor{gnat_rm/the_gnat_library id90}@anchor{3a4} +@anchor{gnat_rm/the_gnat_library gnat-regexp-g-regexp-ads}@anchor{279}@anchor{gnat_rm/the_gnat_library id91}@anchor{3a6} @section @code{GNAT.Regexp} (@code{g-regexp.ads}) @@ -24967,7 +24979,7 @@ simplest of the three pattern matching packages provided, and is particularly suitable for ‘file globbing’ applications. @node GNAT Registry g-regist ads,GNAT Regpat g-regpat ads,GNAT Regexp g-regexp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{3a5}@anchor{gnat_rm/the_gnat_library id91}@anchor{3a6} +@anchor{gnat_rm/the_gnat_library gnat-registry-g-regist-ads}@anchor{3a7}@anchor{gnat_rm/the_gnat_library id92}@anchor{3a8} @section @code{GNAT.Registry} (@code{g-regist.ads}) @@ -24981,7 +24993,7 @@ registry API, but at a lower level of abstraction, refer to the Win32.Winreg package provided with the Win32Ada binding @node GNAT Regpat g-regpat ads,GNAT Rewrite_Data g-rewdat ads,GNAT Registry g-regist ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{3a7}@anchor{gnat_rm/the_gnat_library id92}@anchor{3a8} +@anchor{gnat_rm/the_gnat_library gnat-regpat-g-regpat-ads}@anchor{3a9}@anchor{gnat_rm/the_gnat_library id93}@anchor{3aa} @section @code{GNAT.Regpat} (@code{g-regpat.ads}) @@ -24996,7 +25008,7 @@ from the original V7 style regular expression library written in C by Henry Spencer (and binary compatible with this C library). @node GNAT Rewrite_Data g-rewdat ads,GNAT Secondary_Stack_Info g-sestin ads,GNAT Regpat g-regpat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{3a9}@anchor{gnat_rm/the_gnat_library id93}@anchor{3aa} +@anchor{gnat_rm/the_gnat_library gnat-rewrite-data-g-rewdat-ads}@anchor{3ab}@anchor{gnat_rm/the_gnat_library id94}@anchor{3ac} @section @code{GNAT.Rewrite_Data} (@code{g-rewdat.ads}) @@ -25010,7 +25022,7 @@ full content to be processed is not loaded into memory all at once. This makes this interface usable for large files or socket streams. @node GNAT Secondary_Stack_Info g-sestin ads,GNAT Semaphores g-semaph ads,GNAT Rewrite_Data g-rewdat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{3ab}@anchor{gnat_rm/the_gnat_library id94}@anchor{3ac} +@anchor{gnat_rm/the_gnat_library gnat-secondary-stack-info-g-sestin-ads}@anchor{3ad}@anchor{gnat_rm/the_gnat_library id95}@anchor{3ae} @section @code{GNAT.Secondary_Stack_Info} (@code{g-sestin.ads}) @@ -25022,7 +25034,7 @@ Provides the capability to query the high water mark of the current task’s secondary stack. @node GNAT Semaphores g-semaph ads,GNAT Serial_Communications g-sercom ads,GNAT Secondary_Stack_Info g-sestin ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{3ad}@anchor{gnat_rm/the_gnat_library id95}@anchor{3ae} +@anchor{gnat_rm/the_gnat_library gnat-semaphores-g-semaph-ads}@anchor{3af}@anchor{gnat_rm/the_gnat_library id96}@anchor{3b0} @section @code{GNAT.Semaphores} (@code{g-semaph.ads}) @@ -25033,7 +25045,7 @@ secondary stack. Provides classic counting and binary semaphores using protected types. @node GNAT Serial_Communications g-sercom ads,GNAT SHA1 g-sha1 ads,GNAT Semaphores g-semaph ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{3af}@anchor{gnat_rm/the_gnat_library id96}@anchor{3b0} +@anchor{gnat_rm/the_gnat_library gnat-serial-communications-g-sercom-ads}@anchor{3b1}@anchor{gnat_rm/the_gnat_library id97}@anchor{3b2} @section @code{GNAT.Serial_Communications} (@code{g-sercom.ads}) @@ -25045,7 +25057,7 @@ Provides a simple interface to send and receive data over a serial port. This is only supported on GNU/Linux and Windows. @node GNAT SHA1 g-sha1 ads,GNAT SHA224 g-sha224 ads,GNAT Serial_Communications g-sercom ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{3b1}@anchor{gnat_rm/the_gnat_library id97}@anchor{3b2} +@anchor{gnat_rm/the_gnat_library gnat-sha1-g-sha1-ads}@anchor{3b3}@anchor{gnat_rm/the_gnat_library id98}@anchor{3b4} @section @code{GNAT.SHA1} (@code{g-sha1.ads}) @@ -25058,7 +25070,7 @@ and RFC 3174, and the HMAC-SHA1 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA224 g-sha224 ads,GNAT SHA256 g-sha256 ads,GNAT SHA1 g-sha1 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{3b3}@anchor{gnat_rm/the_gnat_library id98}@anchor{3b4} +@anchor{gnat_rm/the_gnat_library gnat-sha224-g-sha224-ads}@anchor{3b5}@anchor{gnat_rm/the_gnat_library id99}@anchor{3b6} @section @code{GNAT.SHA224} (@code{g-sha224.ads}) @@ -25071,7 +25083,7 @@ and the HMAC-SHA224 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA256 g-sha256 ads,GNAT SHA384 g-sha384 ads,GNAT SHA224 g-sha224 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{3b5}@anchor{gnat_rm/the_gnat_library id99}@anchor{3b6} +@anchor{gnat_rm/the_gnat_library gnat-sha256-g-sha256-ads}@anchor{3b7}@anchor{gnat_rm/the_gnat_library id100}@anchor{3b8} @section @code{GNAT.SHA256} (@code{g-sha256.ads}) @@ -25084,7 +25096,7 @@ and the HMAC-SHA256 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA384 g-sha384 ads,GNAT SHA512 g-sha512 ads,GNAT SHA256 g-sha256 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{3b7}@anchor{gnat_rm/the_gnat_library id100}@anchor{3b8} +@anchor{gnat_rm/the_gnat_library gnat-sha384-g-sha384-ads}@anchor{3b9}@anchor{gnat_rm/the_gnat_library id101}@anchor{3ba} @section @code{GNAT.SHA384} (@code{g-sha384.ads}) @@ -25097,7 +25109,7 @@ and the HMAC-SHA384 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT SHA512 g-sha512 ads,GNAT Signals g-signal ads,GNAT SHA384 g-sha384 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{3b9}@anchor{gnat_rm/the_gnat_library id101}@anchor{3ba} +@anchor{gnat_rm/the_gnat_library gnat-sha512-g-sha512-ads}@anchor{3bb}@anchor{gnat_rm/the_gnat_library id102}@anchor{3bc} @section @code{GNAT.SHA512} (@code{g-sha512.ads}) @@ -25110,7 +25122,7 @@ and the HMAC-SHA512 message authentication function as described in RFC 2104 and FIPS PUB 198. @node GNAT Signals g-signal ads,GNAT Sockets g-socket ads,GNAT SHA512 g-sha512 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{3bb}@anchor{gnat_rm/the_gnat_library id102}@anchor{3bc} +@anchor{gnat_rm/the_gnat_library gnat-signals-g-signal-ads}@anchor{3bd}@anchor{gnat_rm/the_gnat_library id103}@anchor{3be} @section @code{GNAT.Signals} (@code{g-signal.ads}) @@ -25122,7 +25134,7 @@ Provides the ability to manipulate the blocked status of signals on supported targets. @node GNAT Sockets g-socket ads,GNAT Source_Info g-souinf ads,GNAT Signals g-signal ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3bd}@anchor{gnat_rm/the_gnat_library id103}@anchor{3be} +@anchor{gnat_rm/the_gnat_library gnat-sockets-g-socket-ads}@anchor{3bf}@anchor{gnat_rm/the_gnat_library id104}@anchor{3c0} @section @code{GNAT.Sockets} (@code{g-socket.ads}) @@ -25137,7 +25149,7 @@ on all native GNAT ports and on VxWorks cross ports. It is not implemented for the LynxOS cross port. @node GNAT Source_Info g-souinf ads,GNAT Spelling_Checker g-speche ads,GNAT Sockets g-socket ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3bf}@anchor{gnat_rm/the_gnat_library id104}@anchor{3c0} +@anchor{gnat_rm/the_gnat_library gnat-source-info-g-souinf-ads}@anchor{3c1}@anchor{gnat_rm/the_gnat_library id105}@anchor{3c2} @section @code{GNAT.Source_Info} (@code{g-souinf.ads}) @@ -25151,7 +25163,7 @@ subprograms yielding the date and time of the current compilation (like the C macros @code{__DATE__} and @code{__TIME__}) @node GNAT Spelling_Checker g-speche ads,GNAT Spelling_Checker_Generic g-spchge ads,GNAT Source_Info g-souinf ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3c1}@anchor{gnat_rm/the_gnat_library id105}@anchor{3c2} +@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-g-speche-ads}@anchor{3c3}@anchor{gnat_rm/the_gnat_library id106}@anchor{3c4} @section @code{GNAT.Spelling_Checker} (@code{g-speche.ads}) @@ -25163,7 +25175,7 @@ Provides a function for determining whether one string is a plausible near misspelling of another string. @node GNAT Spelling_Checker_Generic g-spchge ads,GNAT Spitbol Patterns g-spipat ads,GNAT Spelling_Checker g-speche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3c3}@anchor{gnat_rm/the_gnat_library id106}@anchor{3c4} +@anchor{gnat_rm/the_gnat_library gnat-spelling-checker-generic-g-spchge-ads}@anchor{3c5}@anchor{gnat_rm/the_gnat_library id107}@anchor{3c6} @section @code{GNAT.Spelling_Checker_Generic} (@code{g-spchge.ads}) @@ -25176,7 +25188,7 @@ determining whether one string is a plausible near misspelling of another string. @node GNAT Spitbol Patterns g-spipat ads,GNAT Spitbol g-spitbo ads,GNAT Spelling_Checker_Generic g-spchge ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3c5}@anchor{gnat_rm/the_gnat_library id107}@anchor{3c6} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-patterns-g-spipat-ads}@anchor{3c7}@anchor{gnat_rm/the_gnat_library id108}@anchor{3c8} @section @code{GNAT.Spitbol.Patterns} (@code{g-spipat.ads}) @@ -25192,7 +25204,7 @@ the SNOBOL4 dynamic pattern construction and matching capabilities, using the efficient algorithm developed by Robert Dewar for the SPITBOL system. @node GNAT Spitbol g-spitbo ads,GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Patterns g-spipat ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3c7}@anchor{gnat_rm/the_gnat_library id108}@anchor{3c8} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-g-spitbo-ads}@anchor{3c9}@anchor{gnat_rm/the_gnat_library id109}@anchor{3ca} @section @code{GNAT.Spitbol} (@code{g-spitbo.ads}) @@ -25207,7 +25219,7 @@ useful for constructing arbitrary mappings from strings in the style of the SNOBOL4 TABLE function. @node GNAT Spitbol Table_Boolean g-sptabo ads,GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol g-spitbo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3c9}@anchor{gnat_rm/the_gnat_library id109}@anchor{3ca} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-boolean-g-sptabo-ads}@anchor{3cb}@anchor{gnat_rm/the_gnat_library id110}@anchor{3cc} @section @code{GNAT.Spitbol.Table_Boolean} (@code{g-sptabo.ads}) @@ -25222,7 +25234,7 @@ for type @code{Standard.Boolean}, giving an implementation of sets of string values. @node GNAT Spitbol Table_Integer g-sptain ads,GNAT Spitbol Table_VString g-sptavs ads,GNAT Spitbol Table_Boolean g-sptabo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3cb}@anchor{gnat_rm/the_gnat_library id110}@anchor{3cc} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-integer-g-sptain-ads}@anchor{3cd}@anchor{gnat_rm/the_gnat_library id111}@anchor{3ce} @section @code{GNAT.Spitbol.Table_Integer} (@code{g-sptain.ads}) @@ -25239,7 +25251,7 @@ for type @code{Standard.Integer}, giving an implementation of maps from string to integer values. @node GNAT Spitbol Table_VString g-sptavs ads,GNAT SSE g-sse ads,GNAT Spitbol Table_Integer g-sptain ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3cd}@anchor{gnat_rm/the_gnat_library id111}@anchor{3ce} +@anchor{gnat_rm/the_gnat_library gnat-spitbol-table-vstring-g-sptavs-ads}@anchor{3cf}@anchor{gnat_rm/the_gnat_library id112}@anchor{3d0} @section @code{GNAT.Spitbol.Table_VString} (@code{g-sptavs.ads}) @@ -25256,7 +25268,7 @@ a variable length string type, giving an implementation of general maps from strings to strings. @node GNAT SSE g-sse ads,GNAT SSE Vector_Types g-ssvety ads,GNAT Spitbol Table_VString g-sptavs ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3cf}@anchor{gnat_rm/the_gnat_library id112}@anchor{3d0} +@anchor{gnat_rm/the_gnat_library gnat-sse-g-sse-ads}@anchor{3d1}@anchor{gnat_rm/the_gnat_library id113}@anchor{3d2} @section @code{GNAT.SSE} (@code{g-sse.ads}) @@ -25268,7 +25280,7 @@ targets. It exposes vector component types together with a general introduction to the binding contents and use. @node GNAT SSE Vector_Types g-ssvety ads,GNAT String_Hash g-strhas ads,GNAT SSE g-sse ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3d1}@anchor{gnat_rm/the_gnat_library id113}@anchor{3d2} +@anchor{gnat_rm/the_gnat_library gnat-sse-vector-types-g-ssvety-ads}@anchor{3d3}@anchor{gnat_rm/the_gnat_library id114}@anchor{3d4} @section @code{GNAT.SSE.Vector_Types} (@code{g-ssvety.ads}) @@ -25277,7 +25289,7 @@ introduction to the binding contents and use. SSE vector types for use with SSE related intrinsics. @node GNAT String_Hash g-strhas ads,GNAT Strings g-string ads,GNAT SSE Vector_Types g-ssvety ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3d3}@anchor{gnat_rm/the_gnat_library id114}@anchor{3d4} +@anchor{gnat_rm/the_gnat_library gnat-string-hash-g-strhas-ads}@anchor{3d5}@anchor{gnat_rm/the_gnat_library id115}@anchor{3d6} @section @code{GNAT.String_Hash} (@code{g-strhas.ads}) @@ -25289,7 +25301,7 @@ Provides a generic hash function working on arrays of scalars. Both the scalar type and the hash result type are parameters. @node GNAT Strings g-string ads,GNAT String_Split g-strspl ads,GNAT String_Hash g-strhas ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3d5}@anchor{gnat_rm/the_gnat_library id115}@anchor{3d6} +@anchor{gnat_rm/the_gnat_library gnat-strings-g-string-ads}@anchor{3d7}@anchor{gnat_rm/the_gnat_library id116}@anchor{3d8} @section @code{GNAT.Strings} (@code{g-string.ads}) @@ -25299,7 +25311,7 @@ Common String access types and related subprograms. Basically it defines a string access and an array of string access types. @node GNAT String_Split g-strspl ads,GNAT Table g-table ads,GNAT Strings g-string ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3d7}@anchor{gnat_rm/the_gnat_library id116}@anchor{3d8} +@anchor{gnat_rm/the_gnat_library gnat-string-split-g-strspl-ads}@anchor{3d9}@anchor{gnat_rm/the_gnat_library id117}@anchor{3da} @section @code{GNAT.String_Split} (@code{g-strspl.ads}) @@ -25313,7 +25325,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Table g-table ads,GNAT Task_Lock g-tasloc ads,GNAT String_Split g-strspl ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3d9}@anchor{gnat_rm/the_gnat_library id117}@anchor{3da} +@anchor{gnat_rm/the_gnat_library gnat-table-g-table-ads}@anchor{3db}@anchor{gnat_rm/the_gnat_library id118}@anchor{3dc} @section @code{GNAT.Table} (@code{g-table.ads}) @@ -25333,7 +25345,7 @@ while an instantiation of @code{GNAT.Dynamic_Tables} creates a type that can be used to define dynamic instances of the table. @node GNAT Task_Lock g-tasloc ads,GNAT Time_Stamp g-timsta ads,GNAT Table g-table ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3db}@anchor{gnat_rm/the_gnat_library id118}@anchor{3dc} +@anchor{gnat_rm/the_gnat_library gnat-task-lock-g-tasloc-ads}@anchor{3dd}@anchor{gnat_rm/the_gnat_library id119}@anchor{3de} @section @code{GNAT.Task_Lock} (@code{g-tasloc.ads}) @@ -25350,7 +25362,7 @@ single global task lock. Appropriate for use in situations where contention between tasks is very rarely expected. @node GNAT Time_Stamp g-timsta ads,GNAT Threads g-thread ads,GNAT Task_Lock g-tasloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3dd}@anchor{gnat_rm/the_gnat_library id119}@anchor{3de} +@anchor{gnat_rm/the_gnat_library gnat-time-stamp-g-timsta-ads}@anchor{3df}@anchor{gnat_rm/the_gnat_library id120}@anchor{3e0} @section @code{GNAT.Time_Stamp} (@code{g-timsta.ads}) @@ -25365,7 +25377,7 @@ represents the current date and time in ISO 8601 format. This is a very simple routine with minimal code and there are no dependencies on any other unit. @node GNAT Threads g-thread ads,GNAT Traceback g-traceb ads,GNAT Time_Stamp g-timsta ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3df}@anchor{gnat_rm/the_gnat_library id120}@anchor{3e0} +@anchor{gnat_rm/the_gnat_library gnat-threads-g-thread-ads}@anchor{3e1}@anchor{gnat_rm/the_gnat_library id121}@anchor{3e2} @section @code{GNAT.Threads} (@code{g-thread.ads}) @@ -25382,7 +25394,7 @@ further details if your program has threads that are created by a non-Ada environment which then accesses Ada code. @node GNAT Traceback g-traceb ads,GNAT Traceback Symbolic g-trasym ads,GNAT Threads g-thread ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3e1}@anchor{gnat_rm/the_gnat_library id121}@anchor{3e2} +@anchor{gnat_rm/the_gnat_library gnat-traceback-g-traceb-ads}@anchor{3e3}@anchor{gnat_rm/the_gnat_library id122}@anchor{3e4} @section @code{GNAT.Traceback} (@code{g-traceb.ads}) @@ -25394,7 +25406,7 @@ Provides a facility for obtaining non-symbolic traceback information, useful in various debugging situations. @node GNAT Traceback Symbolic g-trasym ads,GNAT UTF_32 g-utf_32 ads,GNAT Traceback g-traceb ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3e3}@anchor{gnat_rm/the_gnat_library id122}@anchor{3e4} +@anchor{gnat_rm/the_gnat_library gnat-traceback-symbolic-g-trasym-ads}@anchor{3e5}@anchor{gnat_rm/the_gnat_library id123}@anchor{3e6} @section @code{GNAT.Traceback.Symbolic} (@code{g-trasym.ads}) @@ -25403,7 +25415,7 @@ in various debugging situations. @geindex Trace back facilities @node GNAT UTF_32 g-utf_32 ads,GNAT UTF_32_Spelling_Checker g-u3spch ads,GNAT Traceback Symbolic g-trasym ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-utf-32-ads}@anchor{3e5}@anchor{gnat_rm/the_gnat_library id123}@anchor{3e6} +@anchor{gnat_rm/the_gnat_library gnat-utf-32-g-utf-32-ads}@anchor{3e7}@anchor{gnat_rm/the_gnat_library id124}@anchor{3e8} @section @code{GNAT.UTF_32} (@code{g-utf_32.ads}) @@ -25422,7 +25434,7 @@ lower case to upper case fold routine corresponding to the Ada 2005 rules for identifier equivalence. @node GNAT UTF_32_Spelling_Checker g-u3spch ads,GNAT Wide_Spelling_Checker g-wispch ads,GNAT UTF_32 g-utf_32 ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-utf-32-spelling-checker-g-u3spch-ads}@anchor{3e7}@anchor{gnat_rm/the_gnat_library id124}@anchor{3e8} +@anchor{gnat_rm/the_gnat_library gnat-utf-32-spelling-checker-g-u3spch-ads}@anchor{3e9}@anchor{gnat_rm/the_gnat_library id125}@anchor{3ea} @section @code{GNAT.UTF_32_Spelling_Checker} (@code{g-u3spch.ads}) @@ -25435,7 +25447,7 @@ near misspelling of another wide wide string, where the strings are represented using the UTF_32_String type defined in System.Wch_Cnv. @node GNAT Wide_Spelling_Checker g-wispch ads,GNAT Wide_String_Split g-wistsp ads,GNAT UTF_32_Spelling_Checker g-u3spch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3e9}@anchor{gnat_rm/the_gnat_library id125}@anchor{3ea} +@anchor{gnat_rm/the_gnat_library gnat-wide-spelling-checker-g-wispch-ads}@anchor{3eb}@anchor{gnat_rm/the_gnat_library id126}@anchor{3ec} @section @code{GNAT.Wide_Spelling_Checker} (@code{g-wispch.ads}) @@ -25447,7 +25459,7 @@ Provides a function for determining whether one wide string is a plausible near misspelling of another wide string. @node GNAT Wide_String_Split g-wistsp ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Spelling_Checker g-wispch ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3eb}@anchor{gnat_rm/the_gnat_library id126}@anchor{3ec} +@anchor{gnat_rm/the_gnat_library gnat-wide-string-split-g-wistsp-ads}@anchor{3ed}@anchor{gnat_rm/the_gnat_library id127}@anchor{3ee} @section @code{GNAT.Wide_String_Split} (@code{g-wistsp.ads}) @@ -25461,7 +25473,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node GNAT Wide_Wide_Spelling_Checker g-zspche ads,GNAT Wide_Wide_String_Split g-zistsp ads,GNAT Wide_String_Split g-wistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3ed}@anchor{gnat_rm/the_gnat_library id127}@anchor{3ee} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-spelling-checker-g-zspche-ads}@anchor{3ef}@anchor{gnat_rm/the_gnat_library id128}@anchor{3f0} @section @code{GNAT.Wide_Wide_Spelling_Checker} (@code{g-zspche.ads}) @@ -25473,7 +25485,7 @@ Provides a function for determining whether one wide wide string is a plausible near misspelling of another wide wide string. @node GNAT Wide_Wide_String_Split g-zistsp ads,Interfaces C Extensions i-cexten ads,GNAT Wide_Wide_Spelling_Checker g-zspche ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3ef}@anchor{gnat_rm/the_gnat_library id128}@anchor{3f0} +@anchor{gnat_rm/the_gnat_library gnat-wide-wide-string-split-g-zistsp-ads}@anchor{3f1}@anchor{gnat_rm/the_gnat_library id129}@anchor{3f2} @section @code{GNAT.Wide_Wide_String_Split} (@code{g-zistsp.ads}) @@ -25487,7 +25499,7 @@ to the resulting slices. This package is instantiated from @code{GNAT.Array_Split}. @node Interfaces C Extensions i-cexten ads,Interfaces C Streams i-cstrea ads,GNAT Wide_Wide_String_Split g-zistsp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id129}@anchor{3f1}@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3f2} +@anchor{gnat_rm/the_gnat_library id130}@anchor{3f3}@anchor{gnat_rm/the_gnat_library interfaces-c-extensions-i-cexten-ads}@anchor{3f4} @section @code{Interfaces.C.Extensions} (@code{i-cexten.ads}) @@ -25498,7 +25510,7 @@ for use with either manually or automatically generated bindings to C libraries. @node Interfaces C Streams i-cstrea ads,Interfaces Packed_Decimal i-pacdec ads,Interfaces C Extensions i-cexten ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id130}@anchor{3f3}@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3f4} +@anchor{gnat_rm/the_gnat_library id131}@anchor{3f5}@anchor{gnat_rm/the_gnat_library interfaces-c-streams-i-cstrea-ads}@anchor{3f6} @section @code{Interfaces.C.Streams} (@code{i-cstrea.ads}) @@ -25511,7 +25523,7 @@ This package is a binding for the most commonly used operations on C streams. @node Interfaces Packed_Decimal i-pacdec ads,Interfaces VxWorks i-vxwork ads,Interfaces C Streams i-cstrea ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id131}@anchor{3f5}@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3f6} +@anchor{gnat_rm/the_gnat_library id132}@anchor{3f7}@anchor{gnat_rm/the_gnat_library interfaces-packed-decimal-i-pacdec-ads}@anchor{3f8} @section @code{Interfaces.Packed_Decimal} (@code{i-pacdec.ads}) @@ -25526,7 +25538,7 @@ from a packed decimal format compatible with that used on IBM mainframes. @node Interfaces VxWorks i-vxwork ads,Interfaces VxWorks IO i-vxwoio ads,Interfaces Packed_Decimal i-pacdec ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id132}@anchor{3f7}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3f8} +@anchor{gnat_rm/the_gnat_library id133}@anchor{3f9}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-i-vxwork-ads}@anchor{3fa} @section @code{Interfaces.VxWorks} (@code{i-vxwork.ads}) @@ -25540,7 +25552,7 @@ mainframes. This package provides a limited binding to the VxWorks API. @node Interfaces VxWorks IO i-vxwoio ads,System Address_Image s-addima ads,Interfaces VxWorks i-vxwork ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id133}@anchor{3f9}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3fa} +@anchor{gnat_rm/the_gnat_library id134}@anchor{3fb}@anchor{gnat_rm/the_gnat_library interfaces-vxworks-io-i-vxwoio-ads}@anchor{3fc} @section @code{Interfaces.VxWorks.IO} (@code{i-vxwoio.ads}) @@ -25563,7 +25575,7 @@ function codes. A particular use of this package is to enable the use of Get_Immediate under VxWorks. @node System Address_Image s-addima ads,System Assertions s-assert ads,Interfaces VxWorks IO i-vxwoio ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id134}@anchor{3fb}@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3fc} +@anchor{gnat_rm/the_gnat_library id135}@anchor{3fd}@anchor{gnat_rm/the_gnat_library system-address-image-s-addima-ads}@anchor{3fe} @section @code{System.Address_Image} (@code{s-addima.ads}) @@ -25579,7 +25591,7 @@ function that gives an (implementation dependent) string which identifies an address. @node System Assertions s-assert ads,System Atomic_Counters s-atocou ads,System Address_Image s-addima ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id135}@anchor{3fd}@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{3fe} +@anchor{gnat_rm/the_gnat_library id136}@anchor{3ff}@anchor{gnat_rm/the_gnat_library system-assertions-s-assert-ads}@anchor{400} @section @code{System.Assertions} (@code{s-assert.ads}) @@ -25595,7 +25607,7 @@ by an run-time assertion failure, as well as the routine that is used internally to raise this assertion. @node System Atomic_Counters s-atocou ads,System Memory s-memory ads,System Assertions s-assert ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id136}@anchor{3ff}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{400} +@anchor{gnat_rm/the_gnat_library id137}@anchor{401}@anchor{gnat_rm/the_gnat_library system-atomic-counters-s-atocou-ads}@anchor{402} @section @code{System.Atomic_Counters} (@code{s-atocou.ads}) @@ -25609,7 +25621,7 @@ on most targets, including all Alpha, AARCH64, ARM, ia64, PowerPC, SPARC V9, x86, and x86_64 platforms. @node System Memory s-memory ads,System Multiprocessors s-multip ads,System Atomic_Counters s-atocou ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id137}@anchor{401}@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{402} +@anchor{gnat_rm/the_gnat_library id138}@anchor{403}@anchor{gnat_rm/the_gnat_library system-memory-s-memory-ads}@anchor{404} @section @code{System.Memory} (@code{s-memory.ads}) @@ -25627,7 +25639,7 @@ calls to this unit may be made for low level allocation uses (for example see the body of @code{GNAT.Tables}). @node System Multiprocessors s-multip ads,System Multiprocessors Dispatching_Domains s-mudido ads,System Memory s-memory ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id138}@anchor{403}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{404} +@anchor{gnat_rm/the_gnat_library id139}@anchor{405}@anchor{gnat_rm/the_gnat_library system-multiprocessors-s-multip-ads}@anchor{406} @section @code{System.Multiprocessors} (@code{s-multip.ads}) @@ -25640,7 +25652,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Multiprocessors Dispatching_Domains s-mudido ads,System Partition_Interface s-parint ads,System Multiprocessors s-multip ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id139}@anchor{405}@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{406} +@anchor{gnat_rm/the_gnat_library id140}@anchor{407}@anchor{gnat_rm/the_gnat_library system-multiprocessors-dispatching-domains-s-mudido-ads}@anchor{408} @section @code{System.Multiprocessors.Dispatching_Domains} (@code{s-mudido.ads}) @@ -25653,7 +25665,7 @@ in GNAT we also make it available in Ada 95 and Ada 2005 (where it is technically an implementation-defined addition). @node System Partition_Interface s-parint ads,System Pool_Global s-pooglo ads,System Multiprocessors Dispatching_Domains s-mudido ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id140}@anchor{407}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{408} +@anchor{gnat_rm/the_gnat_library id141}@anchor{409}@anchor{gnat_rm/the_gnat_library system-partition-interface-s-parint-ads}@anchor{40a} @section @code{System.Partition_Interface} (@code{s-parint.ads}) @@ -25666,7 +25678,7 @@ is used primarily in a distribution context when using Annex E with @code{PolyORB}. @node System Pool_Global s-pooglo ads,System Pool_Local s-pooloc ads,System Partition_Interface s-parint ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id141}@anchor{409}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{40a} +@anchor{gnat_rm/the_gnat_library id142}@anchor{40b}@anchor{gnat_rm/the_gnat_library system-pool-global-s-pooglo-ads}@anchor{40c} @section @code{System.Pool_Global} (@code{s-pooglo.ads}) @@ -25683,7 +25695,7 @@ declared. It uses malloc/free to allocate/free and does not attempt to do any automatic reclamation. @node System Pool_Local s-pooloc ads,System Restrictions s-restri ads,System Pool_Global s-pooglo ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id142}@anchor{40b}@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{40c} +@anchor{gnat_rm/the_gnat_library id143}@anchor{40d}@anchor{gnat_rm/the_gnat_library system-pool-local-s-pooloc-ads}@anchor{40e} @section @code{System.Pool_Local} (@code{s-pooloc.ads}) @@ -25700,7 +25712,7 @@ a list of allocated blocks, so that all storage allocated for the pool can be freed automatically when the pool is finalized. @node System Restrictions s-restri ads,System Rident s-rident ads,System Pool_Local s-pooloc ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id143}@anchor{40d}@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{40e} +@anchor{gnat_rm/the_gnat_library id144}@anchor{40f}@anchor{gnat_rm/the_gnat_library system-restrictions-s-restri-ads}@anchor{410} @section @code{System.Restrictions} (@code{s-restri.ads}) @@ -25716,7 +25728,7 @@ compiler determined information on which restrictions are violated by one or more packages in the partition. @node System Rident s-rident ads,System Strings Stream_Ops s-ststop ads,System Restrictions s-restri ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id144}@anchor{40f}@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{410} +@anchor{gnat_rm/the_gnat_library id145}@anchor{411}@anchor{gnat_rm/the_gnat_library system-rident-s-rident-ads}@anchor{412} @section @code{System.Rident} (@code{s-rident.ads}) @@ -25732,7 +25744,7 @@ since the necessary instantiation is included in package System.Restrictions. @node System Strings Stream_Ops s-ststop ads,System Unsigned_Types s-unstyp ads,System Rident s-rident ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id145}@anchor{411}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{412} +@anchor{gnat_rm/the_gnat_library id146}@anchor{413}@anchor{gnat_rm/the_gnat_library system-strings-stream-ops-s-ststop-ads}@anchor{414} @section @code{System.Strings.Stream_Ops} (@code{s-ststop.ads}) @@ -25748,7 +25760,7 @@ stream attributes are applied to string types, but the subprograms in this package can be used directly by application programs. @node System Unsigned_Types s-unstyp ads,System Wch_Cnv s-wchcnv ads,System Strings Stream_Ops s-ststop ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id146}@anchor{413}@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{414} +@anchor{gnat_rm/the_gnat_library id147}@anchor{415}@anchor{gnat_rm/the_gnat_library system-unsigned-types-s-unstyp-ads}@anchor{416} @section @code{System.Unsigned_Types} (@code{s-unstyp.ads}) @@ -25761,7 +25773,7 @@ also contains some related definitions for other specialized types used by the compiler in connection with packed array types. @node System Wch_Cnv s-wchcnv ads,System Wch_Con s-wchcon ads,System Unsigned_Types s-unstyp ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id147}@anchor{415}@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{416} +@anchor{gnat_rm/the_gnat_library id148}@anchor{417}@anchor{gnat_rm/the_gnat_library system-wch-cnv-s-wchcnv-ads}@anchor{418} @section @code{System.Wch_Cnv} (@code{s-wchcnv.ads}) @@ -25782,7 +25794,7 @@ encoding method. It uses definitions in package @code{System.Wch_Con}. @node System Wch_Con s-wchcon ads,,System Wch_Cnv s-wchcnv ads,The GNAT Library -@anchor{gnat_rm/the_gnat_library id148}@anchor{417}@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{418} +@anchor{gnat_rm/the_gnat_library id149}@anchor{419}@anchor{gnat_rm/the_gnat_library system-wch-con-s-wchcon-ads}@anchor{41a} @section @code{System.Wch_Con} (@code{s-wchcon.ads}) @@ -25794,7 +25806,7 @@ in ordinary strings. These definitions are used by the package @code{System.Wch_Cnv}. @node Interfacing to Other Languages,Specialized Needs Annexes,The GNAT Library,Top -@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{419}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{41a}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11} +@anchor{gnat_rm/interfacing_to_other_languages doc}@anchor{41b}@anchor{gnat_rm/interfacing_to_other_languages id1}@anchor{41c}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-other-languages}@anchor{11} @chapter Interfacing to Other Languages @@ -25812,7 +25824,7 @@ provided. @end menu @node Interfacing to C,Interfacing to C++,,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{41b}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{41c} +@anchor{gnat_rm/interfacing_to_other_languages id2}@anchor{41d}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-c}@anchor{41e} @section Interfacing to C @@ -25952,7 +25964,7 @@ of the length corresponding to the @code{type'Size} value in Ada. @end itemize @node Interfacing to C++,Interfacing to COBOL,Interfacing to C,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{49}@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{41d} +@anchor{gnat_rm/interfacing_to_other_languages id3}@anchor{49}@anchor{gnat_rm/interfacing_to_other_languages id4}@anchor{41f} @section Interfacing to C++ @@ -26169,7 +26181,7 @@ builds an opaque @code{Type_Info_Ptr} to reference a @code{std::type_info} object at a given @code{System.Address}. @node Interfacing to COBOL,Interfacing to Fortran,Interfacing to C++,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{41e}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{41f} +@anchor{gnat_rm/interfacing_to_other_languages id5}@anchor{420}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-cobol}@anchor{421} @section Interfacing to COBOL @@ -26177,7 +26189,7 @@ Interfacing to COBOL is achieved as described in section B.4 of the Ada Reference Manual. @node Interfacing to Fortran,Interfacing to non-GNAT Ada code,Interfacing to COBOL,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{420}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{421} +@anchor{gnat_rm/interfacing_to_other_languages id6}@anchor{422}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-fortran}@anchor{423} @section Interfacing to Fortran @@ -26187,7 +26199,7 @@ multi-dimensional array causes the array to be stored in column-major order as required for convenient interface to Fortran. @node Interfacing to non-GNAT Ada code,,Interfacing to Fortran,Interfacing to Other Languages -@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{422}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{423} +@anchor{gnat_rm/interfacing_to_other_languages id7}@anchor{424}@anchor{gnat_rm/interfacing_to_other_languages interfacing-to-non-gnat-ada-code}@anchor{425} @section Interfacing to non-GNAT Ada code @@ -26211,7 +26223,7 @@ values or simple record types without variants, or simple array types with fixed bounds. @node Specialized Needs Annexes,Implementation of Specific Ada Features,Interfacing to Other Languages,Top -@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{424}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{425}@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12} +@anchor{gnat_rm/specialized_needs_annexes doc}@anchor{426}@anchor{gnat_rm/specialized_needs_annexes id1}@anchor{427}@anchor{gnat_rm/specialized_needs_annexes specialized-needs-annexes}@anchor{12} @chapter Specialized Needs Annexes @@ -26249,7 +26261,7 @@ in Ada 2005) is fully implemented. @end table @node Implementation of Specific Ada Features,Implementation of Ada 2022 Features,Specialized Needs Annexes,Top -@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{426}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{427}@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13} +@anchor{gnat_rm/implementation_of_specific_ada_features doc}@anchor{428}@anchor{gnat_rm/implementation_of_specific_ada_features id1}@anchor{429}@anchor{gnat_rm/implementation_of_specific_ada_features implementation-of-specific-ada-features}@anchor{13} @chapter Implementation of Specific Ada Features @@ -26268,7 +26280,7 @@ facilities. @end menu @node Machine Code Insertions,GNAT Implementation of Tasking,,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{428}@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{181} +@anchor{gnat_rm/implementation_of_specific_ada_features id2}@anchor{42a}@anchor{gnat_rm/implementation_of_specific_ada_features machine-code-insertions}@anchor{181} @section Machine Code Insertions @@ -26436,7 +26448,7 @@ according to normal visibility rules. In particular if there is no qualification is required. @node GNAT Implementation of Tasking,GNAT Implementation of Shared Passive Packages,Machine Code Insertions,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{429}@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{42a} +@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-tasking}@anchor{42b}@anchor{gnat_rm/implementation_of_specific_ada_features id3}@anchor{42c} @section GNAT Implementation of Tasking @@ -26452,7 +26464,7 @@ to compliance with the Real-Time Systems Annex. @end menu @node Mapping Ada Tasks onto the Underlying Kernel Threads,Ensuring Compliance with the Real-Time Annex,,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{42b}@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{42c} +@anchor{gnat_rm/implementation_of_specific_ada_features id4}@anchor{42d}@anchor{gnat_rm/implementation_of_specific_ada_features mapping-ada-tasks-onto-the-underlying-kernel-threads}@anchor{42e} @subsection Mapping Ada Tasks onto the Underlying Kernel Threads @@ -26521,7 +26533,7 @@ support this functionality when the parent contains more than one task. @geindex Forking a new process @node Ensuring Compliance with the Real-Time Annex,Support for Locking Policies,Mapping Ada Tasks onto the Underlying Kernel Threads,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{42d}@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{42e} +@anchor{gnat_rm/implementation_of_specific_ada_features ensuring-compliance-with-the-real-time-annex}@anchor{42f}@anchor{gnat_rm/implementation_of_specific_ada_features id5}@anchor{430} @subsection Ensuring Compliance with the Real-Time Annex @@ -26572,7 +26584,7 @@ placed at the end. @c Support_for_Locking_Policies @node Support for Locking Policies,,Ensuring Compliance with the Real-Time Annex,GNAT Implementation of Tasking -@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{42f} +@anchor{gnat_rm/implementation_of_specific_ada_features support-for-locking-policies}@anchor{431} @subsection Support for Locking Policies @@ -26606,7 +26618,7 @@ then ceiling locking is used. Otherwise, the @code{Ceiling_Locking} policy is ignored. @node GNAT Implementation of Shared Passive Packages,Code Generation for Array Aggregates,GNAT Implementation of Tasking,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{430}@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{431} +@anchor{gnat_rm/implementation_of_specific_ada_features gnat-implementation-of-shared-passive-packages}@anchor{432}@anchor{gnat_rm/implementation_of_specific_ada_features id6}@anchor{433} @section GNAT Implementation of Shared Passive Packages @@ -26704,7 +26716,7 @@ This is used to provide the required locking semantics for proper protected object synchronization. @node Code Generation for Array Aggregates,The Size of Discriminated Records with Default Discriminants,GNAT Implementation of Shared Passive Packages,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{432}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{433} +@anchor{gnat_rm/implementation_of_specific_ada_features code-generation-for-array-aggregates}@anchor{434}@anchor{gnat_rm/implementation_of_specific_ada_features id7}@anchor{435} @section Code Generation for Array Aggregates @@ -26735,7 +26747,7 @@ component values and static subtypes also lead to simpler code. @end menu @node Static constant aggregates with static bounds,Constant aggregates with unconstrained nominal types,,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{434}@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{435} +@anchor{gnat_rm/implementation_of_specific_ada_features id8}@anchor{436}@anchor{gnat_rm/implementation_of_specific_ada_features static-constant-aggregates-with-static-bounds}@anchor{437} @subsection Static constant aggregates with static bounds @@ -26782,7 +26794,7 @@ Zero2: constant two_dim := (others => (others => 0)); @end example @node Constant aggregates with unconstrained nominal types,Aggregates with static bounds,Static constant aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{436}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{437} +@anchor{gnat_rm/implementation_of_specific_ada_features constant-aggregates-with-unconstrained-nominal-types}@anchor{438}@anchor{gnat_rm/implementation_of_specific_ada_features id9}@anchor{439} @subsection Constant aggregates with unconstrained nominal types @@ -26797,7 +26809,7 @@ Cr_Unc : constant One_Unc := (12,24,36); @end example @node Aggregates with static bounds,Aggregates with nonstatic bounds,Constant aggregates with unconstrained nominal types,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{438}@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{439} +@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-static-bounds}@anchor{43a}@anchor{gnat_rm/implementation_of_specific_ada_features id10}@anchor{43b} @subsection Aggregates with static bounds @@ -26825,7 +26837,7 @@ end loop; @end example @node Aggregates with nonstatic bounds,Aggregates in assignment statements,Aggregates with static bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{43a}@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{43b} +@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-with-nonstatic-bounds}@anchor{43c}@anchor{gnat_rm/implementation_of_specific_ada_features id11}@anchor{43d} @subsection Aggregates with nonstatic bounds @@ -26836,7 +26848,7 @@ have to be applied to sub-arrays individually, if they do not have statically compatible subtypes. @node Aggregates in assignment statements,,Aggregates with nonstatic bounds,Code Generation for Array Aggregates -@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{43c}@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{43d} +@anchor{gnat_rm/implementation_of_specific_ada_features aggregates-in-assignment-statements}@anchor{43e}@anchor{gnat_rm/implementation_of_specific_ada_features id12}@anchor{43f} @subsection Aggregates in assignment statements @@ -26878,7 +26890,7 @@ a temporary (created either by the front-end or the code generator) and then that temporary will be copied onto the target. @node The Size of Discriminated Records with Default Discriminants,Image Values For Nonscalar Types,Code Generation for Array Aggregates,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{43e}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{43f} +@anchor{gnat_rm/implementation_of_specific_ada_features id13}@anchor{440}@anchor{gnat_rm/implementation_of_specific_ada_features the-size-of-discriminated-records-with-default-discriminants}@anchor{441} @section The Size of Discriminated Records with Default Discriminants @@ -26958,7 +26970,7 @@ say) must be consistent, so it is imperative that the object, once created, remain invariant. @node Image Values For Nonscalar Types,Strict Conformance to the Ada Reference Manual,The Size of Discriminated Records with Default Discriminants,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{440}@anchor{gnat_rm/implementation_of_specific_ada_features image-values-for-nonscalar-types}@anchor{441} +@anchor{gnat_rm/implementation_of_specific_ada_features id14}@anchor{442}@anchor{gnat_rm/implementation_of_specific_ada_features image-values-for-nonscalar-types}@anchor{443} @section Image Values For Nonscalar Types @@ -26978,7 +26990,7 @@ control of image text is required for some type T, then T’Put_Image should be explicitly specified. @node Strict Conformance to the Ada Reference Manual,,Image Values For Nonscalar Types,Implementation of Specific Ada Features -@anchor{gnat_rm/implementation_of_specific_ada_features id15}@anchor{442}@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{443} +@anchor{gnat_rm/implementation_of_specific_ada_features id15}@anchor{444}@anchor{gnat_rm/implementation_of_specific_ada_features strict-conformance-to-the-ada-reference-manual}@anchor{445} @section Strict Conformance to the Ada Reference Manual @@ -27005,7 +27017,7 @@ behavior (although at the cost of a significant performance penalty), so infinite and NaN values are properly generated. @node Implementation of Ada 2022 Features,GNAT language extensions,Implementation of Specific Ada Features,Top -@anchor{gnat_rm/implementation_of_ada_2022_features doc}@anchor{444}@anchor{gnat_rm/implementation_of_ada_2022_features id1}@anchor{445}@anchor{gnat_rm/implementation_of_ada_2022_features implementation-of-ada-2022-features}@anchor{14} +@anchor{gnat_rm/implementation_of_ada_2022_features doc}@anchor{446}@anchor{gnat_rm/implementation_of_ada_2022_features id1}@anchor{447}@anchor{gnat_rm/implementation_of_ada_2022_features implementation-of-ada-2022-features}@anchor{14} @chapter Implementation of Ada 2022 Features @@ -30424,7 +30436,7 @@ RM references: 3.02.04 (31/5) 4.06 (51.1/5) @end itemize @node GNAT language extensions,Security Hardening Features,Implementation of Ada 2022 Features,Top -@anchor{gnat_rm/gnat_language_extensions doc}@anchor{446}@anchor{gnat_rm/gnat_language_extensions gnat-language-extensions}@anchor{447}@anchor{gnat_rm/gnat_language_extensions id1}@anchor{448} +@anchor{gnat_rm/gnat_language_extensions doc}@anchor{448}@anchor{gnat_rm/gnat_language_extensions gnat-language-extensions}@anchor{449}@anchor{gnat_rm/gnat_language_extensions id1}@anchor{44a} @chapter GNAT language extensions @@ -30456,7 +30468,7 @@ These features might be removed or heavily modified at any time. @end menu @node How to activate the extended GNAT Ada superset,Curated Extensions,,GNAT language extensions -@anchor{gnat_rm/gnat_language_extensions how-to-activate-the-extended-gnat-ada-superset}@anchor{449} +@anchor{gnat_rm/gnat_language_extensions how-to-activate-the-extended-gnat-ada-superset}@anchor{44b} @section How to activate the extended GNAT Ada superset @@ -30497,7 +30509,7 @@ for use in playground experiments. @end cartouche @node Curated Extensions,Experimental Language Extensions,How to activate the extended GNAT Ada superset,GNAT language extensions -@anchor{gnat_rm/gnat_language_extensions curated-extensions}@anchor{44a}@anchor{gnat_rm/gnat_language_extensions curated-language-extensions}@anchor{6a} +@anchor{gnat_rm/gnat_language_extensions curated-extensions}@anchor{44c}@anchor{gnat_rm/gnat_language_extensions curated-language-extensions}@anchor{6a} @section Curated Extensions @@ -30520,7 +30532,7 @@ Features activated via @code{-gnatX} or @end menu @node Local Declarations Without Block,Deep delta Aggregates,,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions local-declarations-without-block}@anchor{44b} +@anchor{gnat_rm/gnat_language_extensions local-declarations-without-block}@anchor{44d} @subsection Local Declarations Without Block @@ -30613,7 +30625,7 @@ And as such the second `@w{`}A`@w{`} declaration is hiding the first one. @end cartouche @node Deep delta Aggregates,Fixed lower bounds for array types and subtypes,Local Declarations Without Block,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions deep-delta-aggregates}@anchor{44c} +@anchor{gnat_rm/gnat_language_extensions deep-delta-aggregates}@anchor{44e} @subsection Deep delta Aggregates @@ -30635,7 +30647,7 @@ The syntax of delta aggregates in the extended version is the following: @end menu @node Syntax,Legality Rules,,Deep delta Aggregates -@anchor{gnat_rm/gnat_language_extensions syntax}@anchor{44d} +@anchor{gnat_rm/gnat_language_extensions syntax}@anchor{44f} @subsubsection Syntax @@ -30681,7 +30693,7 @@ array_subcomponent_choice ::= @end example @node Legality Rules,Dynamic Semantics,Syntax,Deep delta Aggregates -@anchor{gnat_rm/gnat_language_extensions legality-rules}@anchor{44e} +@anchor{gnat_rm/gnat_language_extensions legality-rules}@anchor{450} @subsubsection Legality Rules @@ -30718,7 +30730,7 @@ the object denoted by the base_expression, prior to any update.] @end enumerate @node Dynamic Semantics,Examples,Legality Rules,Deep delta Aggregates -@anchor{gnat_rm/gnat_language_extensions dynamic-semantics}@anchor{44f} +@anchor{gnat_rm/gnat_language_extensions dynamic-semantics}@anchor{451} @subsubsection Dynamic Semantics @@ -30775,7 +30787,7 @@ and assigned to the corresponding subcomponent of the anonymous object. @end itemize @node Examples,,Dynamic Semantics,Deep delta Aggregates -@anchor{gnat_rm/gnat_language_extensions examples}@anchor{450} +@anchor{gnat_rm/gnat_language_extensions examples}@anchor{452} @subsubsection Examples @@ -30803,7 +30815,7 @@ end; @end example @node Fixed lower bounds for array types and subtypes,Prefixed-view notation for calls to primitive subprograms of untagged types,Deep delta Aggregates,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions fixed-lower-bounds-for-array-types-and-subtypes}@anchor{451} +@anchor{gnat_rm/gnat_language_extensions fixed-lower-bounds-for-array-types-and-subtypes}@anchor{453} @subsection Fixed lower bounds for array types and subtypes @@ -30854,7 +30866,7 @@ lower bound of unconstrained array formals when the formal’s subtype has index ranges with static fixed lower bounds. @node Prefixed-view notation for calls to primitive subprograms of untagged types,Expression defaults for generic formal functions,Fixed lower bounds for array types and subtypes,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions prefixed-view-notation-for-calls-to-primitive-subprograms-of-untagged-types}@anchor{452} +@anchor{gnat_rm/gnat_language_extensions prefixed-view-notation-for-calls-to-primitive-subprograms-of-untagged-types}@anchor{454} @subsection Prefixed-view notation for calls to primitive subprograms of untagged types @@ -30904,7 +30916,7 @@ pragma Assert (V.Nth_Element(1) = 42); @end example @node Expression defaults for generic formal functions,String interpolation,Prefixed-view notation for calls to primitive subprograms of untagged types,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions expression-defaults-for-generic-formal-functions}@anchor{453} +@anchor{gnat_rm/gnat_language_extensions expression-defaults-for-generic-formal-functions}@anchor{455} @subsection Expression defaults for generic formal functions @@ -30935,7 +30947,7 @@ If the default is used (i.e. there is no actual corresponding to Copy), then calls to Copy in the instance will simply return Item. @node String interpolation,Constrained attribute for generic objects,Expression defaults for generic formal functions,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions string-interpolation}@anchor{454} +@anchor{gnat_rm/gnat_language_extensions string-interpolation}@anchor{456} @subsection String interpolation @@ -31102,7 +31114,7 @@ a double quote is " and an open brace is @{ @end example @node Constrained attribute for generic objects,Static aspect on intrinsic functions,String interpolation,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions constrained-attribute-for-generic-objects}@anchor{455} +@anchor{gnat_rm/gnat_language_extensions constrained-attribute-for-generic-objects}@anchor{457} @subsection Constrained attribute for generic objects @@ -31110,7 +31122,7 @@ The @code{Constrained} attribute is permitted for objects of generic types. The result indicates whether the corresponding actual is constrained. @node Static aspect on intrinsic functions,First Controlling Parameter,Constrained attribute for generic objects,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions static-aspect-on-intrinsic-functions}@anchor{456} +@anchor{gnat_rm/gnat_language_extensions static-aspect-on-intrinsic-functions}@anchor{458} @subsection @code{Static} aspect on intrinsic functions @@ -31119,7 +31131,7 @@ and the compiler will evaluate some of these intrinsics statically, in particular the @code{Shift_Left} and @code{Shift_Right} intrinsics. @node First Controlling Parameter,Unsigned_Base_Range aspect,Static aspect on intrinsic functions,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions first-controlling-parameter}@anchor{457} +@anchor{gnat_rm/gnat_language_extensions first-controlling-parameter}@anchor{459} @subsection First Controlling Parameter @@ -31219,7 +31231,7 @@ The result of a function is never a controlling result. @end itemize @node Unsigned_Base_Range aspect,Generalized Finalization,First Controlling Parameter,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions unsigned-base-range-aspect}@anchor{458} +@anchor{gnat_rm/gnat_language_extensions unsigned-base-range-aspect}@anchor{45a} @subsection @code{Unsigned_Base_Range} aspect @@ -31245,7 +31257,7 @@ It ensures that arithmetic operations of type @code{Uns_64} are carried out using 64 bits. @node Generalized Finalization,,Unsigned_Base_Range aspect,Curated Extensions -@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{459} +@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{45b} @subsection Generalized Finalization @@ -31316,7 +31328,7 @@ in this case. @item The @code{Adjust} and @code{Finalize} procedures are automatically considered as -having the @ref{45a,,No_Raise aspect} specified for them. In particular, the +having the @ref{45c,,No_Raise aspect} specified for them. In particular, the compiler has permission to enforce none of the guarantees specified by the RM 7.6.1 (14/1) and subsequent subclauses. @end itemize @@ -31377,7 +31389,7 @@ end P; @end menu @node Finalizable tagged types,Composite types,,Generalized Finalization -@anchor{gnat_rm/gnat_language_extensions finalizable-tagged-types}@anchor{45b} +@anchor{gnat_rm/gnat_language_extensions finalizable-tagged-types}@anchor{45d} @subsubsection Finalizable tagged types @@ -31387,7 +31399,7 @@ dispatching whenever it makes sense, i.e. when the object in question is of a class-wide type and the class includes at least one finalizable tagged type. @node Composite types,Interoperability with controlled types,Finalizable tagged types,Generalized Finalization -@anchor{gnat_rm/gnat_language_extensions composite-types}@anchor{45c} +@anchor{gnat_rm/gnat_language_extensions composite-types}@anchor{45e} @subsubsection Composite types @@ -31397,7 +31409,7 @@ in order to call the primitives of their components. The dynamic semantics is the same as for controlled components of composite types. @node Interoperability with controlled types,,Composite types,Generalized Finalization -@anchor{gnat_rm/gnat_language_extensions interoperability-with-controlled-types}@anchor{45d} +@anchor{gnat_rm/gnat_language_extensions interoperability-with-controlled-types}@anchor{45f} @subsubsection Interoperability with controlled types @@ -31407,7 +31419,7 @@ versa, but the stricter dynamic semantics, in other words that of controlled types, is applied in this case. @node Experimental Language Extensions,,Curated Extensions,GNAT language extensions -@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6b}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{45e} +@anchor{gnat_rm/gnat_language_extensions experimental-language-extensions}@anchor{6b}@anchor{gnat_rm/gnat_language_extensions id2}@anchor{460} @section Experimental Language Extensions @@ -31432,7 +31444,7 @@ Features activated via @code{-gnatX0} or @end menu @node Conditional when constructs,Implicit With,,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{45f} +@anchor{gnat_rm/gnat_language_extensions conditional-when-constructs}@anchor{461} @subsection Conditional when constructs @@ -31501,7 +31513,7 @@ end; @end example @node Implicit With,Storage Model,Conditional when constructs,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions implicit-with}@anchor{460} +@anchor{gnat_rm/gnat_language_extensions implicit-with}@anchor{462} @subsection Implicit With @@ -31518,7 +31530,7 @@ end; @end example @node Storage Model,Attribute Super,Implicit With,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{461} +@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{463} @subsection Storage Model @@ -31535,7 +31547,7 @@ memory models, in particular to support interactions with GPU. @end menu @node Aspect Storage_Model_Type,Aspect Designated_Storage_Model,,Storage Model -@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{462} +@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{464} @subsubsection Aspect Storage_Model_Type @@ -31669,7 +31681,7 @@ end CUDA_Memory; @end example @node Aspect Designated_Storage_Model,Legacy Storage Pools,Aspect Storage_Model_Type,Storage Model -@anchor{gnat_rm/gnat_language_extensions aspect-designated-storage-model}@anchor{463} +@anchor{gnat_rm/gnat_language_extensions aspect-designated-storage-model}@anchor{465} @subsubsection Aspect Designated_Storage_Model @@ -31747,7 +31759,7 @@ begin @end example @node Legacy Storage Pools,,Aspect Designated_Storage_Model,Storage Model -@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{464} +@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{466} @subsubsection Legacy Storage Pools @@ -31798,7 +31810,7 @@ type Acc is access Integer_Array with Storage_Pool => My_Pool; can still be accepted as a shortcut for the new syntax. @node Attribute Super,Simpler Accessibility Model,Storage Model,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{465} +@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{467} @subsection Attribute Super @@ -31833,7 +31845,7 @@ end; @end example @node Simpler Accessibility Model,Case pattern matching,Attribute Super,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions simpler-accessibility-model}@anchor{466} +@anchor{gnat_rm/gnat_language_extensions simpler-accessibility-model}@anchor{468} @subsection Simpler Accessibility Model @@ -31864,7 +31876,7 @@ All of the refined rules are compatible with the [use of anonymous access types @end menu @node Stand-alone objects,Subprogram parameters,,Simpler Accessibility Model -@anchor{gnat_rm/gnat_language_extensions stand-alone-objects}@anchor{467} +@anchor{gnat_rm/gnat_language_extensions stand-alone-objects}@anchor{469} @subsubsection Stand-alone objects @@ -31912,7 +31924,7 @@ of the RM 4.6 rule “The accessibility level of the operand type shall not be statically deeper than that of the target type …”. @node Subprogram parameters,Function results,Stand-alone objects,Simpler Accessibility Model -@anchor{gnat_rm/gnat_language_extensions subprogram-parameters}@anchor{468} +@anchor{gnat_rm/gnat_language_extensions subprogram-parameters}@anchor{46a} @subsubsection Subprogram parameters @@ -32005,7 +32017,7 @@ end; @end example @node Function results,,Subprogram parameters,Simpler Accessibility Model -@anchor{gnat_rm/gnat_language_extensions function-results}@anchor{469} +@anchor{gnat_rm/gnat_language_extensions function-results}@anchor{46b} @subsubsection Function results @@ -32133,7 +32145,7 @@ end; @end example @node Case pattern matching,Mutably Tagged Types with Size’Class Aspect,Simpler Accessibility Model,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{46a} +@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{46c} @subsection Case pattern matching @@ -32263,7 +32275,7 @@ message generated in such cases is usually “Capacity exceeded in compiling case statement with composite selector type”. @node Mutably Tagged Types with Size’Class Aspect,No_Raise aspect,Case pattern matching,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions mutably-tagged-types-with-size-class-aspect}@anchor{46b} +@anchor{gnat_rm/gnat_language_extensions mutably-tagged-types-with-size-class-aspect}@anchor{46d} @subsection Mutably Tagged Types with Size’Class Aspect @@ -32434,7 +32446,7 @@ parameter exists (that is, before leaving the corresponding callable construct). This is analogous to the RM 6.4.1(18) rule about discriminated parameters. @node No_Raise aspect,Inference of Dependent Types in Generic Instantiations,Mutably Tagged Types with Size’Class Aspect,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions id3}@anchor{46c}@anchor{gnat_rm/gnat_language_extensions no-raise-aspect}@anchor{45a} +@anchor{gnat_rm/gnat_language_extensions id3}@anchor{46e}@anchor{gnat_rm/gnat_language_extensions no-raise-aspect}@anchor{45c} @subsection No_Raise aspect @@ -32444,7 +32456,7 @@ be raised during the execution of the subprogram, it is caught at the end of this execution and @code{Program_Error} is propagated to the caller. @node Inference of Dependent Types in Generic Instantiations,External_Initialization Aspect,No_Raise aspect,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions inference-of-dependent-types-in-generic-instantiations}@anchor{46d} +@anchor{gnat_rm/gnat_language_extensions inference-of-dependent-types-in-generic-instantiations}@anchor{46f} @subsection Inference of Dependent Types in Generic Instantiations @@ -32521,7 +32533,7 @@ package Int_Array_Operations is new Array_Operations @end example @node External_Initialization Aspect,Finally construct,Inference of Dependent Types in Generic Instantiations,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions external-initialization-aspect}@anchor{46e} +@anchor{gnat_rm/gnat_language_extensions external-initialization-aspect}@anchor{470} @subsection External_Initialization Aspect @@ -32562,7 +32574,7 @@ The maximum size of loaded files is limited to 2@w{^31} bytes. @end cartouche @node Finally construct,Continue statement,External_Initialization Aspect,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions finally-construct}@anchor{46f} +@anchor{gnat_rm/gnat_language_extensions finally-construct}@anchor{471} @subsection Finally construct @@ -32579,7 +32591,7 @@ This feature is similar to the one with the same name in other languages such as @end menu @node Syntax<2>,Legality Rules<2>,,Finally construct -@anchor{gnat_rm/gnat_language_extensions id4}@anchor{470} +@anchor{gnat_rm/gnat_language_extensions id4}@anchor{472} @subsubsection Syntax @@ -32594,7 +32606,7 @@ handled_sequence_of_statements ::= @end example @node Legality Rules<2>,Dynamic Semantics<2>,Syntax<2>,Finally construct -@anchor{gnat_rm/gnat_language_extensions id5}@anchor{471} +@anchor{gnat_rm/gnat_language_extensions id5}@anchor{473} @subsubsection Legality Rules @@ -32604,7 +32616,7 @@ to be transferred outside the finally part are forbidden. Goto & exit where the target is outside of the finally’s @code{sequence_of_statements} are forbidden @node Dynamic Semantics<2>,,Legality Rules<2>,Finally construct -@anchor{gnat_rm/gnat_language_extensions id6}@anchor{472} +@anchor{gnat_rm/gnat_language_extensions id6}@anchor{474} @subsubsection Dynamic Semantics @@ -32619,7 +32631,7 @@ execution, that is the finally block must be executed in full even if the contai aborted, or if the control is transferred out of the block. @node Continue statement,Destructors,Finally construct,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions continue-statement}@anchor{473} +@anchor{gnat_rm/gnat_language_extensions continue-statement}@anchor{475} @subsection Continue statement @@ -32637,7 +32649,7 @@ Note that @code{continue} is a keyword but it is not a reserved word. This is a configuration that does not exist in standard Ada. @node Destructors,,Continue statement,Experimental Language Extensions -@anchor{gnat_rm/gnat_language_extensions destructors}@anchor{474} +@anchor{gnat_rm/gnat_language_extensions destructors}@anchor{476} @subsection Destructors @@ -32707,7 +32719,7 @@ imposing that rule on outside types that derive from the private view of the type. @node Security Hardening Features,Obsolescent Features,GNAT language extensions,Top -@anchor{gnat_rm/security_hardening_features doc}@anchor{475}@anchor{gnat_rm/security_hardening_features id1}@anchor{476}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} +@anchor{gnat_rm/security_hardening_features doc}@anchor{477}@anchor{gnat_rm/security_hardening_features id1}@anchor{478}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} @chapter Security Hardening Features @@ -32729,7 +32741,7 @@ change. @end menu @node Register Scrubbing,Stack Scrubbing,,Security Hardening Features -@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{477} +@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{479} @section Register Scrubbing @@ -32765,7 +32777,7 @@ programming languages, see @cite{Using the GNU Compiler Collection (GCC)}. @c Stack Scrubbing: @node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security Hardening Features -@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{478} +@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{47a} @section Stack Scrubbing @@ -32909,7 +32921,7 @@ Bar_Callable_Ptr. @c Hardened Conditionals: @node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security Hardening Features -@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{479} +@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{47b} @section Hardened Conditionals @@ -32999,7 +33011,7 @@ be used with other programming languages supported by GCC. @c Hardened Booleans: @node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security Hardening Features -@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{47a} +@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{47c} @section Hardened Booleans @@ -33060,7 +33072,7 @@ and more details on that attribute, see @cite{Using the GNU Compiler Collection @c Control Flow Redundancy: @node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features -@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{47b} +@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{47d} @section Control Flow Redundancy @@ -33228,7 +33240,7 @@ see @cite{Using the GNU Compiler Collection (GCC)}. These options can be used with other programming languages supported by GCC. @node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top -@anchor{gnat_rm/obsolescent_features doc}@anchor{47c}@anchor{gnat_rm/obsolescent_features id1}@anchor{47d}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} +@anchor{gnat_rm/obsolescent_features doc}@anchor{47e}@anchor{gnat_rm/obsolescent_features id1}@anchor{47f}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} @chapter Obsolescent Features @@ -33247,7 +33259,7 @@ compatibility purposes. @end menu @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id2}@anchor{47e}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{47f} +@anchor{gnat_rm/obsolescent_features id2}@anchor{480}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{481} @section pragma No_Run_Time @@ -33260,7 +33272,7 @@ preferred usage is to use an appropriately configured run-time that includes just those features that are to be made accessible. @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id3}@anchor{480}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{481} +@anchor{gnat_rm/obsolescent_features id3}@anchor{482}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{483} @section pragma Ravenscar @@ -33269,7 +33281,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma is part of the new Ada 2005 standard. @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id4}@anchor{482}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{483} +@anchor{gnat_rm/obsolescent_features id4}@anchor{484}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{485} @section pragma Restricted_Run_Time @@ -33279,7 +33291,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for this kind of implementation dependent addition. @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id5}@anchor{484}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{485} +@anchor{gnat_rm/obsolescent_features id5}@anchor{486}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{487} @section pragma Task_Info @@ -33305,7 +33317,7 @@ in the spec of package System.Task_Info in the runtime library. @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features -@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{486}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{487} +@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{488}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{489} @section package System.Task_Info (@code{s-tasinf.ads}) @@ -33315,7 +33327,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package standard replacement for GNAT’s @code{Task_Info} functionality. @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top -@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{488}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{489} +@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{48a}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{48b} @chapter Compatibility and Porting Guide @@ -33337,7 +33349,7 @@ applications developed in other Ada environments. @end menu @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{48a}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{48b} +@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{48c}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{48d} @section Writing Portable Fixed-Point Declarations @@ -33459,7 +33471,7 @@ If you follow this scheme you will be guaranteed that your fixed-point types will be portable. @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{48c}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{48d} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{48e}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{48f} @section Compatibility with Ada 83 @@ -33487,7 +33499,7 @@ following subsections treat the most likely issues to be encountered. @end menu @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{48e}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{48f} +@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{490}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{491} @subsection Legal Ada 83 programs that are illegal in Ada 95 @@ -33587,7 +33599,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration. @end itemize @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{490}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{491} +@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{492}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{493} @subsection More deterministic semantics @@ -33615,7 +33627,7 @@ which open select branches are executed. @end itemize @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{492}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{493} +@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{494}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{495} @subsection Changed semantics @@ -33657,7 +33669,7 @@ covers only the restricted range. @end itemize @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{494}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{495} +@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{496}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{497} @subsection Other language compatibility issues @@ -33690,7 +33702,7 @@ include @code{pragma Interface} and the floating point type attributes @end itemize @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{496}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{497} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{498}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{499} @section Compatibility between Ada 95 and Ada 2005 @@ -33762,7 +33774,7 @@ can declare a function returning a value from an anonymous access type. @end itemize @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{498}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{499} +@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{49a}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{49b} @section Implementation-dependent characteristics @@ -33785,7 +33797,7 @@ transition from certain Ada 83 compilers. @end menu @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{49a}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{49b} +@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{49c}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{49d} @subsection Implementation-defined pragmas @@ -33807,7 +33819,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not relevant in a GNAT context and hence are not otherwise implemented. @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{49c}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{49d} +@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{49e}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{49f} @subsection Implementation-defined attributes @@ -33821,7 +33833,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and @code{Type_Class}. @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{49e}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{49f} +@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{4a0}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{4a1} @subsection Libraries @@ -33850,7 +33862,7 @@ be preferable to retrofit the application using modular types. @end itemize @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{4a0}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{4a1} +@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{4a2}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{4a3} @subsection Elaboration order @@ -33886,7 +33898,7 @@ pragmas either globally (as an effect of the `-gnatE' switch) or locally @end itemize @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{4a2}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{4a3} +@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{4a4}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{4a5} @subsection Target-specific aspects @@ -33899,10 +33911,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus Ada 2005, Ada 2012, and Ada 2022) are sometimes incompatible with typical Ada 83 compiler practices regarding implicit packing, the meaning of the Size attribute, and the size of access values. -GNAT’s approach to these issues is described in @ref{4a4,,Representation Clauses}. +GNAT’s approach to these issues is described in @ref{4a6,,Representation Clauses}. @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{4a5}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{4a6} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{4a7}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{4a8} @section Compatibility with Other Ada Systems @@ -33945,7 +33957,7 @@ far beyond this minimal set, as described in the next section. @end itemize @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{4a7}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{4a4} +@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{4a9}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{4a6} @section Representation Clauses @@ -34038,7 +34050,7 @@ with thin pointers. @end itemize @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{4a8}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{4a9} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{4aa}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{4ab} @section Compatibility with HP Ada 83 @@ -34068,7 +34080,7 @@ extension of package System. @end itemize @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top -@anchor{share/gnu_free_documentation_license doc}@anchor{4aa}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{4ab} +@anchor{share/gnu_free_documentation_license doc}@anchor{4ac}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{4ad} @chapter GNU Free Documentation License diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index edb04a20f418..712d46c54abb 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -250,6 +250,7 @@ package body Impunit is ("g-busorg", F), -- GNAT.Bubble_Sort_G ("g-byorma", F), -- GNAT.Byte_Order_Mark ("g-bytswa", F), -- GNAT.Byte_Swapping + ("g-c_time", F), -- GNAT.C_Time ("g-calend", F), -- GNAT.Calendar ("g-catiio", F), -- GNAT.Calendar.Time_IO ("g-casuti", F), -- GNAT.Case_Util diff --git a/gcc/ada/libgnarl/a-exetim__posix.adb b/gcc/ada/libgnarl/a-exetim__posix.adb index ee27ff29f156..a57689e0847d 100644 --- a/gcc/ada/libgnarl/a-exetim__posix.adb +++ b/gcc/ada/libgnarl/a-exetim__posix.adb @@ -34,8 +34,9 @@ with Ada.Task_Identification; use Ada.Task_Identification; with Ada.Unchecked_Conversion; -with System.Tasking; +with System.C_Time; with System.OS_Interface; use System.OS_Interface; +with System.Tasking; with System.Task_Primitives.Operations; use System.Task_Primitives.Operations; with Interfaces.C; use Interfaces.C; @@ -98,7 +99,7 @@ package body Ada.Execution_Time is (T : Ada.Task_Identification.Task_Id := Ada.Task_Identification.Current_Task) return CPU_Time is - TS : aliased timespec; + TS : aliased System.C_Time.timespec; Clock_Id : aliased Interfaces.C.int; Result : Interfaces.C.int; @@ -112,7 +113,7 @@ package body Ada.Execution_Time is function clock_gettime (clock_id : Interfaces.C.int; - tp : access timespec) + tp : access System.C_Time.timespec) return Interfaces.C.int; pragma Import (C, clock_gettime, "clock_gettime"); -- Function from the POSIX.1b Realtime Extensions library @@ -139,7 +140,7 @@ package body Ada.Execution_Time is (clock_id => Clock_Id, tp => TS'Unchecked_Access); pragma Assert (Result = 0); - return To_CPU_Time (To_Duration (TS)); + return To_CPU_Time (System.C_Time.To_Duration (TS)); end Clock; -------------------------- diff --git a/gcc/ada/libgnarl/s-linux.ads b/gcc/ada/libgnarl/s-linux.ads index 62176f1bd968..f41a67bd8a3a 100644 --- a/gcc/ada/libgnarl/s-linux.ads +++ b/gcc/ada/libgnarl/s-linux.ads @@ -36,7 +36,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -45,24 +44,8 @@ package System.Linux is -- Time -- ---------- - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-linux__alpha.ads b/gcc/ada/libgnarl/s-linux__alpha.ads index 855e6672e365..c05b90c04cb7 100644 --- a/gcc/ada/libgnarl/s-linux__alpha.ads +++ b/gcc/ada/libgnarl/s-linux__alpha.ads @@ -36,7 +36,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -45,24 +44,8 @@ package System.Linux is -- Time -- ---------- - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-linux__android-aarch64.ads b/gcc/ada/libgnarl/s-linux__android-aarch64.ads index 537c46b5d3cc..c7a69fa29c01 100644 --- a/gcc/ada/libgnarl/s-linux__android-aarch64.ads +++ b/gcc/ada/libgnarl/s-linux__android-aarch64.ads @@ -36,7 +36,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -45,24 +44,8 @@ package System.Linux is -- Time -- ---------- - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-linux__android-arm.ads b/gcc/ada/libgnarl/s-linux__android-arm.ads index 07bca55f6c47..fdc14c387fb9 100644 --- a/gcc/ada/libgnarl/s-linux__android-arm.ads +++ b/gcc/ada/libgnarl/s-linux__android-arm.ads @@ -36,7 +36,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -45,24 +44,8 @@ package System.Linux is -- Time -- ---------- - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-linux__hppa.ads b/gcc/ada/libgnarl/s-linux__hppa.ads index a3ce02bcb6e7..e249846cd302 100644 --- a/gcc/ada/libgnarl/s-linux__hppa.ads +++ b/gcc/ada/libgnarl/s-linux__hppa.ads @@ -36,7 +36,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -45,24 +44,8 @@ package System.Linux is -- Time -- ---------- - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-linux__loongarch.ads b/gcc/ada/libgnarl/s-linux__loongarch.ads index e0eaaa47e71d..20e3d909c0e0 100644 --- a/gcc/ada/libgnarl/s-linux__loongarch.ads +++ b/gcc/ada/libgnarl/s-linux__loongarch.ads @@ -35,7 +35,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -44,25 +43,8 @@ package System.Linux is -- Time -- ---------- - subtype int is Interfaces.C.int; - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-linux__mips.ads b/gcc/ada/libgnarl/s-linux__mips.ads index 3ad7f45379eb..6a575c7a865e 100644 --- a/gcc/ada/libgnarl/s-linux__mips.ads +++ b/gcc/ada/libgnarl/s-linux__mips.ads @@ -35,7 +35,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -44,25 +43,8 @@ package System.Linux is -- Time -- ---------- - subtype int is Interfaces.C.int; - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- @@ -125,8 +107,8 @@ package System.Linux is -- struct_sigaction offsets - sa_handler_pos : constant := int'Size / 8; - sa_mask_pos : constant := int'Size / 8 + + sa_handler_pos : constant := Interfaces.C.int'Size / 8; + sa_mask_pos : constant := Interfaces.C.int'Size / 8 + Standard'Address_Size / 8; sa_flags_pos : constant := 0; diff --git a/gcc/ada/libgnarl/s-linux__riscv.ads b/gcc/ada/libgnarl/s-linux__riscv.ads index 867cb1fa8070..ad0a07b8c506 100644 --- a/gcc/ada/libgnarl/s-linux__riscv.ads +++ b/gcc/ada/libgnarl/s-linux__riscv.ads @@ -35,7 +35,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -44,25 +43,8 @@ package System.Linux is -- Time -- ---------- - subtype int is Interfaces.C.int; - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- @@ -125,8 +107,8 @@ package System.Linux is -- struct_sigaction offsets sa_handler_pos : constant := 0; - sa_mask_pos : constant := long'Size / 8; - sa_flags_pos : constant := long'Size / 8 + 128; + sa_mask_pos : constant := Interfaces.C.long'Size / 8; + sa_flags_pos : constant := Interfaces.C.long'Size / 8 + 128; SA_SIGINFO : constant := 16#04#; SA_ONSTACK : constant := 16#08000000#; diff --git a/gcc/ada/libgnarl/s-linux__sparc.ads b/gcc/ada/libgnarl/s-linux__sparc.ads index 5ff201cf832c..037834617d72 100644 --- a/gcc/ada/libgnarl/s-linux__sparc.ads +++ b/gcc/ada/libgnarl/s-linux__sparc.ads @@ -36,7 +36,6 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Interfaces.C; -with System.Parameters; package System.Linux is pragma Preelaborate; @@ -45,24 +44,8 @@ package System.Linux is -- Time -- ---------- - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-linux__x32.ads b/gcc/ada/libgnarl/s-linux__x32.ads deleted file mode 100644 index 6144b8b34ce1..000000000000 --- a/gcc/ada/libgnarl/s-linux__x32.ads +++ /dev/null @@ -1,133 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . L I N U X -- --- -- --- S p e c -- --- -- --- Copyright (C) 2013-2025, Free Software Foundation, Inc. -- --- --- -- --- GNARL is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- -- ------------------------------------------------------------------------------- - --- This is the x32 version of this package - --- This package encapsulates cpu specific differences between implementations --- of GNU/Linux, in order to share s-osinte-linux.ads. - --- PLEASE DO NOT add any with-clauses to this package or remove the pragma --- Preelaborate. This package is designed to be a bottom-level (leaf) package - -with Interfaces.C; - -with System.Parameters; - -package System.Linux is - pragma Preelaborate; - - ---------- - -- Time -- - ---------- - - subtype suseconds_t is Long_Long_Integer; - -- Note that suseconds_t is 64 bits. - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - subtype clockid_t is Interfaces.C.int; - - type timespec is record - tv_sec : time_t; - tv_nsec : Long_Long_Integer; - -- Note that tv_nsec is 64 bits. - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - - ----------- - -- Errno -- - ----------- - - EAGAIN : constant := 11; - EINTR : constant := 4; - EINVAL : constant := 22; - ENOMEM : constant := 12; - EPERM : constant := 1; - ETIMEDOUT : constant := 110; - - ------------- - -- Signals -- - ------------- - - SIGHUP : constant := 1; -- hangup - SIGINT : constant := 2; -- interrupt (rubout) - SIGQUIT : constant := 3; -- quit (ASCD FS) - SIGILL : constant := 4; -- illegal instruction (not reset) - SIGTRAP : constant := 5; -- trace trap (not reset) - SIGIOT : constant := 6; -- IOT instruction - SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future - SIGFPE : constant := 8; -- floating point exception - SIGKILL : constant := 9; -- kill (cannot be caught or ignored) - SIGBUS : constant := 7; -- bus error - SIGUSR1 : constant := 10; -- user defined signal 1 - SIGSEGV : constant := 11; -- segmentation violation - SIGUSR2 : constant := 12; -- user defined signal 2 - SIGPIPE : constant := 13; -- write on a pipe with no one to read it - SIGALRM : constant := 14; -- alarm clock - SIGTERM : constant := 15; -- software termination signal from kill - SIGSTKFLT : constant := 16; -- coprocessor stack fault (Linux) - SIGCLD : constant := 17; -- alias for SIGCHLD - SIGCHLD : constant := 17; -- child status change - SIGSTOP : constant := 19; -- stop (cannot be caught or ignored) - SIGTSTP : constant := 20; -- user stop requested from tty - SIGCONT : constant := 18; -- stopped process has been continued - SIGTTIN : constant := 21; -- background tty read attempted - SIGTTOU : constant := 22; -- background tty write attempted - SIGURG : constant := 23; -- urgent condition on IO channel - SIGXCPU : constant := 24; -- CPU time limit exceeded - SIGXFSZ : constant := 25; -- filesize limit exceeded - SIGVTALRM : constant := 26; -- virtual timer expired - SIGPROF : constant := 27; -- profiling timer expired - SIGWINCH : constant := 28; -- window size change - SIGPOLL : constant := 29; -- pollable event occurred - SIGIO : constant := 29; -- I/O now possible (4.2 BSD) - SIGLOST : constant := 29; -- File lock lost - SIGPWR : constant := 30; -- power-fail restart - SIGSYS : constant := 31; -- bad system call - SIGUNUSED : constant := 31; -- unused signal (mapped to SIGSYS) - SIG32 : constant := 32; -- glibc internal signal - SIG33 : constant := 33; -- glibc internal signal - SIG34 : constant := 34; -- glibc internal signal - - -- struct_sigaction offsets - - sa_handler_pos : constant := 0; - sa_mask_pos : constant := Standard'Address_Size / 8; - sa_flags_pos : constant := 128 + sa_mask_pos; - - SA_SIGINFO : constant := 16#04#; - SA_ONSTACK : constant := 16#08000000#; - -end System.Linux; diff --git a/gcc/ada/libgnarl/s-osinte__aix.adb b/gcc/ada/libgnarl/s-osinte__aix.adb index da057d47cf5b..3a2df424d91b 100644 --- a/gcc/ada/libgnarl/s-osinte__aix.adb +++ b/gcc/ada/libgnarl/s-osinte__aix.adb @@ -35,15 +35,6 @@ package body System.OS_Interface is use Interfaces.C; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -72,29 +63,6 @@ package body System.OS_Interface is end if; end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F is negative due to a round-up, adjust for positive F value - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ----------------- -- sched_yield -- ----------------- diff --git a/gcc/ada/libgnarl/s-osinte__aix.ads b/gcc/ada/libgnarl/s-osinte__aix.ads index 1e115b80d6fb..eb417a2cc999 100644 --- a/gcc/ada/libgnarl/s-osinte__aix.ads +++ b/gcc/ada/libgnarl/s-osinte__aix.ads @@ -43,8 +43,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; with Interfaces.C.Extensions; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -200,26 +200,18 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported - type timespec is private; - type clockid_t is new long_long; function clock_gettime (clock_id : clockid_t; - tp : access timespec) return int; + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - type struct_timezone is record tz_minuteswest : int; tz_dsttime : int; @@ -420,7 +412,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -543,15 +535,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - type pthread_attr_t is new System.Address; pragma Convention (C, pthread_attr_t); -- typedef struct __pt_attr *pthread_attr_t; diff --git a/gcc/ada/libgnarl/s-osinte__android.ads b/gcc/ada/libgnarl/s-osinte__android.ads index 4383860ed2b1..bf774fc491af 100644 --- a/gcc/ada/libgnarl/s-osinte__android.ads +++ b/gcc/ada/libgnarl/s-osinte__android.ads @@ -42,10 +42,10 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.Linux; with System.OS_Constants; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -213,25 +213,17 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported - type timespec is private; - type clockid_t is new int; function clock_gettime - (clock_id : clockid_t; tp : access timespec) return int; + (clock_id : clockid_t; tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - function sysconf (name : int) return long; pragma Import (C, sysconf); @@ -463,7 +455,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -630,15 +622,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - type unsigned_long_long_t is mod 2 ** 64; -- Local type only used to get the alignment of this type below diff --git a/gcc/ada/libgnarl/s-osinte__cheribsd.ads b/gcc/ada/libgnarl/s-osinte__cheribsd.ads index d9dae354d41e..350fa1f15ad9 100644 --- a/gcc/ada/libgnarl/s-osinte__cheribsd.ads +++ b/gcc/ada/libgnarl/s-osinte__cheribsd.ads @@ -44,8 +44,8 @@ with Ada.Unchecked_Conversion; with Interfaces; with Interfaces.C; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -232,30 +232,22 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported (i.e SCHED_RR is supported) - type timespec is private; - - function nanosleep (rqtp, rmtp : access timespec) return int; + function nanosleep (rqtp, rmtp : access C_Time.timespec) return int; pragma Import (C, nanosleep, "nanosleep"); type clockid_t is new int; function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); function clock_gettime (clock_id : clockid_t; - tp : access timespec) + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - type struct_timezone is record tz_minuteswest : int; tz_dsttime : int; @@ -463,7 +455,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -664,15 +656,6 @@ private Self_PID : constant pid_t := 0; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - ts_sec : time_t; - ts_nsec : long; - end record; - pragma Convention (C, timespec); - type pthread_t is new System.Address; type pthread_attr_t is new System.Address; type pthread_mutexattr_t is new System.Address; diff --git a/gcc/ada/libgnarl/s-osinte__darwin.adb b/gcc/ada/libgnarl/s-osinte__darwin.adb index f512210d3437..eeafbdbef8f1 100644 --- a/gcc/ada/libgnarl/s-osinte__darwin.adb +++ b/gcc/ada/libgnarl/s-osinte__darwin.adb @@ -36,15 +36,6 @@ with Interfaces.C.Extensions; package body System.OS_Interface is use Interfaces.C; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -56,37 +47,13 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ------------------- -- clock_gettime -- ------------------- function clock_gettime (clock_id : clockid_t; - tp : access timespec) return int + tp : access C_Time.timespec) return int is pragma Unreferenced (clock_id); @@ -94,33 +61,18 @@ package body System.OS_Interface is use Interfaces; - type timeval is array (1 .. 3) of C.long; - -- The timeval array is sized to contain long_long sec and long usec. - -- If long_long'Size = long'Size then it will be overly large but that - -- won't effect the implementation since it's not accessed directly. - - procedure timeval_to_duration - (T : not null access timeval; - sec : not null access C.Extensions.long_long; - usec : not null access C.long); - pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); - - Micro : constant := 10**6; - sec : aliased C.Extensions.long_long; - usec : aliased C.long; - TV : aliased timeval; + TV : aliased C_Time.timeval; Result : int; function gettimeofday - (Tv : access timeval; + (Tv : access C_Time.timeval; Tz : System.Address := System.Null_Address) return int; pragma Import (C, gettimeofday, "gettimeofday"); begin Result := gettimeofday (TV'Access, System.Null_Address); pragma Assert (Result = 0); - timeval_to_duration (TV'Access, sec'Access, usec'Access); - tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro); + tp.all := C_Time.To_Timespec (TV); return Result; end clock_gettime; @@ -130,13 +82,12 @@ package body System.OS_Interface is function clock_getres (clock_id : clockid_t; - res : access timespec) return int + res : access C_Time.timespec) return int is pragma Unreferenced (clock_id); -- Darwin Threads don't have clock_getres. - Nano : constant := 10**9; nsec : int := 0; Result : int := -1; @@ -145,7 +96,7 @@ package body System.OS_Interface is begin nsec := clock_get_res; - res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano); + res.all := C_Time.Nanoseconds_To_Timespec (nsec); if nsec > 0 then Result := 0; diff --git a/gcc/ada/libgnarl/s-osinte__darwin.ads b/gcc/ada/libgnarl/s-osinte__darwin.ads index ea62f24cbc0d..1b2a40b3cbe8 100644 --- a/gcc/ada/libgnarl/s-osinte__darwin.ads +++ b/gcc/ada/libgnarl/s-osinte__darwin.ads @@ -40,9 +40,9 @@ with Interfaces.C; +with System.C_Time; with System.OS_Constants; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -184,23 +184,15 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported - type timespec is private; - type clockid_t is new int; function clock_gettime (clock_id : clockid_t; - tp : access timespec) return int; + tp : access C_Time.timespec) return int; function clock_getres (clock_id : clockid_t; - res : access timespec) return int; - - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); + res : access C_Time.timespec) return int; ------------------------- -- Priority Scheduling -- @@ -397,7 +389,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -517,15 +509,6 @@ private type pid_t is new int32_t; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - -- -- Darwin specific signal implementation -- diff --git a/gcc/ada/libgnarl/s-osinte__dragonfly.adb b/gcc/ada/libgnarl/s-osinte__dragonfly.adb index 73061d9eeb0c..adfbaeb27fc7 100644 --- a/gcc/ada/libgnarl/s-osinte__dragonfly.adb +++ b/gcc/ada/libgnarl/s-osinte__dragonfly.adb @@ -69,15 +69,6 @@ package body System.OS_Interface is null; end pthread_init; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -89,28 +80,4 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(ts_sec => S, - ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-osinte__dragonfly.ads b/gcc/ada/libgnarl/s-osinte__dragonfly.ads index 00dc11de2745..9e7b88e3c6e9 100644 --- a/gcc/ada/libgnarl/s-osinte__dragonfly.ads +++ b/gcc/ada/libgnarl/s-osinte__dragonfly.ads @@ -43,8 +43,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -198,30 +198,22 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported (i.e SCHED_RR is supported) - type timespec is private; - - function nanosleep (rqtp, rmtp : access timespec) return int; + function nanosleep (rqtp, rmtp : access C_Time.timespec) return int; pragma Import (C, nanosleep, "nanosleep"); type clockid_t is new unsigned_long; function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); function clock_gettime (clock_id : clockid_t; - tp : access timespec) + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - type struct_timezone is record tz_minuteswest : int; tz_dsttime : int; @@ -432,7 +424,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); Relative_Timed_Wait : constant Boolean := False; @@ -636,15 +628,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - ts_sec : time_t; - ts_nsec : long; - end record; - pragma Convention (C, timespec); - type pthread_t is new System.Address; type pthread_attr_t is new System.Address; type pthread_mutexattr_t is new System.Address; diff --git a/gcc/ada/libgnarl/s-osinte__freebsd.adb b/gcc/ada/libgnarl/s-osinte__freebsd.adb index a3240bb38d18..4516935bbc8e 100644 --- a/gcc/ada/libgnarl/s-osinte__freebsd.adb +++ b/gcc/ada/libgnarl/s-osinte__freebsd.adb @@ -69,15 +69,6 @@ package body System.OS_Interface is null; end pthread_init; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -89,27 +80,4 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(ts_sec => S, - ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-osinte__freebsd.ads b/gcc/ada/libgnarl/s-osinte__freebsd.ads index b10270a4cc49..027f81d060bf 100644 --- a/gcc/ada/libgnarl/s-osinte__freebsd.ads +++ b/gcc/ada/libgnarl/s-osinte__freebsd.ads @@ -43,8 +43,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -198,30 +198,22 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported (i.e SCHED_RR is supported) - type timespec is private; - - function nanosleep (rqtp, rmtp : access timespec) return int; + function nanosleep (rqtp, rmtp : access C_Time.timespec) return int; pragma Import (C, nanosleep, "nanosleep"); type clockid_t is new int; function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); function clock_gettime (clock_id : clockid_t; - tp : access timespec) + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - type struct_timezone is record tz_minuteswest : int; tz_dsttime : int; @@ -431,7 +423,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -633,15 +625,6 @@ private type pid_t is new int; Self_PID : constant pid_t := 0; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - ts_sec : time_t; - ts_nsec : long; - end record; - pragma Convention (C, timespec); - type pthread_t is new System.Address; type pthread_attr_t is new System.Address; type pthread_mutexattr_t is new System.Address; diff --git a/gcc/ada/libgnarl/s-osinte__gnu.adb b/gcc/ada/libgnarl/s-osinte__gnu.adb index 675cd0d93990..2c70f0dea157 100644 --- a/gcc/ada/libgnarl/s-osinte__gnu.adb +++ b/gcc/ada/libgnarl/s-osinte__gnu.adb @@ -93,15 +93,6 @@ package body System.OS_Interface is return 0; end pthread_setschedparam; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -113,28 +104,4 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-osinte__gnu.ads b/gcc/ada/libgnarl/s-osinte__gnu.ads index 870059d09670..18410c60415e 100644 --- a/gcc/ada/libgnarl/s-osinte__gnu.ads +++ b/gcc/ada/libgnarl/s-osinte__gnu.ads @@ -42,8 +42,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -210,9 +210,7 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported (i.e SCHED_RR is supported) - type timespec is private; - - function nanosleep (rqtp, rmtp : access timespec) return int; + function nanosleep (rqtp, rmtp : access C_Time.timespec) return int; pragma Import (C, nanosleep, "nanosleep"); type clockid_t is new int; @@ -221,21 +219,15 @@ package System.OS_Interface is -- From: /usr/include/time.h function clock_gettime (clock_id : clockid_t; - tp : access timespec) + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - -- From: /usr/include/unistd.h function sysconf (name : int) return long; pragma Import (C, sysconf); @@ -487,7 +479,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); Relative_Timed_Wait : constant Boolean := False; @@ -656,15 +648,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - -- From: /usr/include/pthread/pthreadtypes.h: -- typedef struct __pthread_attr pthread_attr_t; -- /usr/include/i386-gnu/bits/thread-attr.h: struct __pthread_attr... diff --git a/gcc/ada/libgnarl/s-osinte__hpux.ads b/gcc/ada/libgnarl/s-osinte__hpux.ads index 9d0f26d50f70..60fab698113b 100644 --- a/gcc/ada/libgnarl/s-osinte__hpux.ads +++ b/gcc/ada/libgnarl/s-osinte__hpux.ads @@ -42,8 +42,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -181,26 +181,18 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported - type timespec is private; - type clockid_t is new int; function clock_gettime (clock_id : clockid_t; - tp : access timespec) return int; + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - type struct_timezone is record tz_minuteswest : int; tz_dsttime : int; @@ -400,7 +392,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -517,15 +509,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - type pthread_attr_t is new int; type pthread_condattr_t is new int; type pthread_mutexattr_t is new int; diff --git a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads index 9924659cce5d..fc6d7a992f19 100644 --- a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads +++ b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads @@ -42,8 +42,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -205,9 +205,7 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported (i.e SCHED_RR is supported) - type timespec is private; - - function nanosleep (rqtp, rmtp : access timespec) return int; + function nanosleep (rqtp, rmtp : access C_Time.timespec) return int; pragma Import (C, nanosleep, "nanosleep"); type clockid_t is new int; @@ -215,21 +213,15 @@ package System.OS_Interface is function clock_gettime (clock_id : clockid_t; - tp : access timespec) + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - function sysconf (name : int) return long; pragma Import (C, sysconf); @@ -430,7 +422,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -602,15 +594,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - type pthread_attr_t is record detachstate : int; schedpolicy : int; diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads index 7aeb15da523b..2c6b353a5e0f 100644 --- a/gcc/ada/libgnarl/s-osinte__linux.ads +++ b/gcc/ada/libgnarl/s-osinte__linux.ads @@ -42,6 +42,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.Linux; with System.OS_Constants; with System.OS_Locks; @@ -54,8 +55,6 @@ package System.OS_Interface is pragma Linker_Options ("-lpthread"); - use type System.Linux.time_t; - subtype int is Interfaces.C.int; subtype char is Interfaces.C.char; subtype short is Interfaces.C.short; @@ -229,26 +228,17 @@ package System.OS_Interface is -- Time -- ---------- - subtype time_t is System.Linux.time_t; - subtype timespec is System.Linux.timespec; - subtype timeval is System.Linux.timeval; subtype clockid_t is System.Linux.clockid_t; function clock_gettime - (clock_id : clockid_t; tp : access timespec) return int; + (clock_id : clockid_t; tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - function sysconf (name : int) return long; pragma Import (C, sysconf); @@ -457,7 +447,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__lynxos178.adb b/gcc/ada/libgnarl/s-osinte__lynxos178.adb index 88758a954f8a..beeefb617fe9 100644 --- a/gcc/ada/libgnarl/s-osinte__lynxos178.adb +++ b/gcc/ada/libgnarl/s-osinte__lynxos178.adb @@ -85,15 +85,6 @@ package body System.OS_Interface is return int (sysconf (SC_PAGESIZE)); end Get_Page_Size; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -105,29 +96,6 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F is negative due to a round-up, adjust for positive F value - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ------------- -- sigwait -- ------------- diff --git a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads index 8b31e204acb5..dcc36b251857 100644 --- a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads +++ b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads @@ -42,9 +42,9 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.Multiprocessors; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -193,26 +193,18 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported - type timespec is private; - type clockid_t is new int; function clock_gettime (clock_id : clockid_t; - tp : access timespec) return int; + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - type struct_timezone is record tz_minuteswest : int; tz_dsttime : int; @@ -220,8 +212,6 @@ package System.OS_Interface is pragma Convention (C, struct_timezone); type struct_timezone_ptr is access all struct_timezone; - type struct_timeval is private; - ------------------------- -- Priority Scheduling -- ------------------------- @@ -415,7 +405,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -541,23 +531,6 @@ private type pid_t is new long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type suseconds_t is new int; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type struct_timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, struct_timeval); - type st_attr is record stksize : int; prio : int; diff --git a/gcc/ada/libgnarl/s-osinte__posix.adb b/gcc/ada/libgnarl/s-osinte__posix.adb index 1cb4f23aec6e..2d9baeb7f363 100644 --- a/gcc/ada/libgnarl/s-osinte__posix.adb +++ b/gcc/ada/libgnarl/s-osinte__posix.adb @@ -36,6 +36,7 @@ -- that are needed by children of System. with Interfaces.C; use Interfaces.C; + package body System.OS_Interface is -------------------- @@ -58,15 +59,6 @@ package body System.OS_Interface is null; end pthread_init; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -78,28 +70,4 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-osinte__qnx.adb b/gcc/ada/libgnarl/s-osinte__qnx.adb index 720022548df1..bf95b0eab34f 100644 --- a/gcc/ada/libgnarl/s-osinte__qnx.adb +++ b/gcc/ada/libgnarl/s-osinte__qnx.adb @@ -36,6 +36,7 @@ -- that are needed by children of System. with Interfaces.C; use Interfaces.C; + package body System.OS_Interface is ----------------- @@ -70,15 +71,6 @@ package body System.OS_Interface is null; end pthread_init; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -90,28 +82,4 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-osinte__qnx.ads b/gcc/ada/libgnarl/s-osinte__qnx.ads index ea940d86330d..ee13235d891b 100644 --- a/gcc/ada/libgnarl/s-osinte__qnx.ads +++ b/gcc/ada/libgnarl/s-osinte__qnx.ads @@ -41,9 +41,9 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.OS_Constants; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -213,25 +213,17 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported - type timespec is private; - type clockid_t is new int; function clock_gettime - (clock_id : clockid_t; tp : access timespec) return int; + (clock_id : clockid_t; tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - ------------------------- -- Priority Scheduling -- ------------------------- @@ -418,7 +410,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -572,15 +564,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - type unsigned_long_long_t is mod 2 ** 64; -- Local type only used to get the alignment of this type below diff --git a/gcc/ada/libgnarl/s-osinte__rtems.adb b/gcc/ada/libgnarl/s-osinte__rtems.adb index c0f6c265b509..efd602e73f82 100644 --- a/gcc/ada/libgnarl/s-osinte__rtems.adb +++ b/gcc/ada/libgnarl/s-osinte__rtems.adb @@ -92,15 +92,6 @@ package body System.OS_Interface is return int with Import, External_Name => "rtems_semaphore_release", Convention => C; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -112,27 +103,6 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to round-up, adjust for positive F value - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ----------------------------- -- Binary_Semaphore_Create -- ----------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__rtems.ads b/gcc/ada/libgnarl/s-osinte__rtems.ads index 21b1be8a306a..184d48978364 100644 --- a/gcc/ada/libgnarl/s-osinte__rtems.ads +++ b/gcc/ada/libgnarl/s-osinte__rtems.ads @@ -52,9 +52,9 @@ with Interfaces.C; +with System.C_Time; with System.OS_Constants; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -181,8 +181,6 @@ package System.OS_Interface is Time_Slice_Supported : constant Boolean := True; -- Indicates whether time slicing is supported (i.e SCHED_RR is supported) - type timespec is private; - type clockid_t is new int; CLOCK_REALTIME : constant clockid_t; @@ -190,20 +188,14 @@ package System.OS_Interface is function clock_gettime (clock_id : clockid_t; - tp : access timespec) return int; + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres (clock_id : clockid_t; - res : access timespec) return int; + res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - ------------------------- -- Priority Scheduling -- ------------------------- @@ -428,7 +420,7 @@ package System.OS_Interface is function pthread_cond_timedwait (cond : access pthread_cond_t; mutex : access pthread_mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); -------------------------- @@ -454,8 +446,8 @@ package System.OS_Interface is type struct_sched_param is record sched_priority : int; ss_low_priority : int; - ss_replenish_period : timespec; - ss_initial_budget : timespec; + ss_replenish_period : C_Time.timespec; + ss_initial_budget : C_Time.timespec; sched_ss_max_repl : int; end record; pragma Convention (C, struct_sched_param); @@ -591,15 +583,6 @@ private type pid_t is new int; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - CLOCK_REALTIME : constant clockid_t := System.OS_Constants.CLOCK_REALTIME; CLOCK_MONOTONIC : constant clockid_t := System.OS_Constants.CLOCK_MONOTONIC; diff --git a/gcc/ada/libgnarl/s-osinte__solaris.adb b/gcc/ada/libgnarl/s-osinte__solaris.adb index e5626fc4f0d8..78144efdbcdb 100644 --- a/gcc/ada/libgnarl/s-osinte__solaris.adb +++ b/gcc/ada/libgnarl/s-osinte__solaris.adb @@ -35,42 +35,8 @@ -- This package encapsulates all direct interfaces to OS services -- that are needed by children of System. -with Interfaces.C; use Interfaces.C; - package body System.OS_Interface is - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ------------------ -- pthread_init -- ------------------ diff --git a/gcc/ada/libgnarl/s-osinte__solaris.ads b/gcc/ada/libgnarl/s-osinte__solaris.ads index d62dd37110eb..e9b59fe1ca92 100644 --- a/gcc/ada/libgnarl/s-osinte__solaris.ads +++ b/gcc/ada/libgnarl/s-osinte__solaris.ads @@ -42,8 +42,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.OS_Locks; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -241,24 +241,16 @@ package System.OS_Interface is -- Time -- ---------- - type timespec is private; - type clockid_t is new int; function clock_gettime - (clock_id : clockid_t; tp : access timespec) return int; + (clock_id : clockid_t; tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); function clock_getres - (clock_id : clockid_t; res : access timespec) return int; + (clock_id : clockid_t; res : access C_Time.timespec) return int; pragma Import (C, clock_getres, "clock_getres"); - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - function sysconf (name : int) return long; pragma Import (C, sysconf); @@ -347,7 +339,7 @@ package System.OS_Interface is function cond_timedwait (cond : access cond_t; mutex : access mutex_t; - abstime : access timespec) return int; + abstime : access C_Time.timespec) return int; pragma Import (C, cond_timedwait, "cond_timedwait"); function cond_signal (cond : access cond_t) return int; @@ -526,15 +518,6 @@ private type pid_t is new long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - type array_type_9 is array (0 .. 3) of unsigned_char; type record_type_3 is record flag : array_type_9; diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.adb b/gcc/ada/libgnarl/s-osinte__vxworks.adb index 5c227a1e54c8..0b2b5d442698 100644 --- a/gcc/ada/libgnarl/s-osinte__vxworks.adb +++ b/gcc/ada/libgnarl/s-osinte__vxworks.adb @@ -41,38 +41,6 @@ package body System.OS_Interface is Low_Priority : constant := 255; -- VxWorks native (default) lowest scheduling priority - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; - end To_Duration; - - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F is negative due to a round-up, adjust for positive F value - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(ts_sec => S, - ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ------------------------- -- To_VxWorks_Priority -- ------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.ads b/gcc/ada/libgnarl/s-osinte__vxworks.ads index a4095735bd6d..ecb63440a5db 100644 --- a/gcc/ada/libgnarl/s-osinte__vxworks.ads +++ b/gcc/ada/libgnarl/s-osinte__vxworks.ads @@ -40,10 +40,10 @@ with Interfaces.C; +with System.C_Time; with System.VxWorks; with System.VxWorks.Ext; with System.Multiprocessors; -with System.Parameters; package System.OS_Interface is pragma Preelaborate; @@ -244,37 +244,13 @@ package System.OS_Interface is -- Time -- ---------- - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - -- Time_t here used to be unsigned to match the VxWorks header declaration. - -- The header declaration has changed in newer releases and is now signed - -- for applications. - - type timespec is record - ts_sec : time_t; - ts_nsec : long; - end record; - pragma Convention (C, timespec); - type clockid_t is new int; - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - -- Convert a Duration value to a timespec value. Note that in VxWorks, - -- timespec is always non-negative (since time_t is defined above as - -- unsigned long). This means that there is a potential problem if a - -- negative argument is passed for D. However, in actual usage, the - -- value of the input argument D is always non-negative, so no problem - -- arises in practice. - function To_Clock_Ticks (D : Duration) return int; -- Convert a duration value (in seconds) into clock ticks function clock_gettime - (clock_id : clockid_t; tp : access timespec) return int; + (clock_id : clockid_t; tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); ---------------------- diff --git a/gcc/ada/libgnarl/s-osinte__x32.adb b/gcc/ada/libgnarl/s-osinte__x32.adb index 27313a4bcc07..2e6585352d3d 100644 --- a/gcc/ada/libgnarl/s-osinte__x32.adb +++ b/gcc/ada/libgnarl/s-osinte__x32.adb @@ -35,7 +35,7 @@ -- This package encapsulates all direct interfaces to OS services -- that are needed by children of System. -with Interfaces.C; use Interfaces.C; +with Interfaces.C; package body System.OS_Interface is @@ -59,15 +59,6 @@ package body System.OS_Interface is null; end pthread_init; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - ------------------------ -- To_Target_Priority -- ------------------------ @@ -79,28 +70,4 @@ package body System.OS_Interface is return Interfaces.C.int (Prio); end To_Target_Priority; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => Long_Long_Integer (F * 10#1#E9)); - end To_Timespec; - end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-qnx.ads b/gcc/ada/libgnarl/s-qnx.ads index 1197be15ef6c..f342ad673056 100644 --- a/gcc/ada/libgnarl/s-qnx.ads +++ b/gcc/ada/libgnarl/s-qnx.ads @@ -37,8 +37,6 @@ with Interfaces.C; -with System.Parameters; - package System.QNX is pragma Preelaborate; @@ -46,24 +44,8 @@ package System.QNX is -- Time -- ---------- - subtype long is Interfaces.C.long; - subtype suseconds_t is Interfaces.C.long; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; subtype clockid_t is Interfaces.C.int; - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type timeval is record - tv_sec : time_t; - tv_usec : suseconds_t; - end record; - pragma Convention (C, timeval); - ----------- -- Errno -- ----------- diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb index 8edc58ea9d80..1b65100362c4 100644 --- a/gcc/ada/libgnarl/s-taprop__solaris.adb +++ b/gcc/ada/libgnarl/s-taprop__solaris.adb @@ -36,6 +36,7 @@ with Interfaces.C; +with System.C_Time; with System.Interrupt_Management; with System.Multiprocessors; with System.OS_Constants; @@ -762,12 +763,12 @@ package body System.Task_Primitives.Operations is --------------------- function Monotonic_Clock return Duration is - TS : aliased timespec; + TS : aliased C_Time.timespec; Result : Interfaces.C.int; begin Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access); pragma Assert (Result = 0); - return To_Duration (TS); + return C_Time.To_Duration (TS); end Monotonic_Clock; ------------------- @@ -775,13 +776,13 @@ package body System.Task_Primitives.Operations is ------------------- function RT_Resolution return Duration is - TS : aliased timespec; + TS : aliased C_Time.timespec; Result : Interfaces.C.int; begin Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); pragma Assert (Result = 0); - return To_Duration (TS); + return C_Time.To_Duration (TS); end RT_Resolution; ----------- @@ -1175,7 +1176,7 @@ package body System.Task_Primitives.Operations is Base_Time : constant Duration := Monotonic_Clock; Check_Time : Duration := Base_Time; Abs_Time : Duration; - Request : aliased timespec; + Request : aliased C_Time.timespec; Result : Interfaces.C.int; begin @@ -1189,7 +1190,7 @@ package body System.Task_Primitives.Operations is else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); if Abs_Time > Check_Time then - Request := To_Timespec (Abs_Time); + Request := C_Time.To_Timespec (Abs_Time); loop exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; @@ -1230,7 +1231,7 @@ package body System.Task_Primitives.Operations is Base_Time : constant Duration := Monotonic_Clock; Check_Time : Duration := Base_Time; Abs_Time : Duration; - Request : aliased timespec; + Request : aliased C_Time.timespec; Result : Interfaces.C.int; Yielded : Boolean := False; @@ -1243,7 +1244,7 @@ package body System.Task_Primitives.Operations is else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); if Abs_Time > Check_Time then - Request := To_Timespec (Abs_Time); + Request := C_Time.To_Timespec (Abs_Time); Self_ID.Common.State := Delay_Sleep; pragma Assert (Check_Sleep (Delay_Sleep)); diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb index a0f1885a7e8d..a4dab5fa9d1e 100644 --- a/gcc/ada/libgnarl/s-taprop__vxworks.adb +++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb @@ -38,6 +38,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.C_Time; with System.Float_Control; with System.Interrupt_Management; with System.Multiprocessors; @@ -681,12 +682,12 @@ package body System.Task_Primitives.Operations is --------------------- function Monotonic_Clock return Duration is - TS : aliased timespec; + TS : aliased C_Time.timespec; Result : int; begin Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access); pragma Assert (Result = 0); - return To_Duration (TS); + return C_Time.To_Duration (TS); end Monotonic_Clock; ------------------- diff --git a/gcc/ada/libgnarl/s-tpopmo.adb b/gcc/ada/libgnarl/s-tpopmo.adb index 9ff1ecdc329f..547a5e44abcd 100644 --- a/gcc/ada/libgnarl/s-tpopmo.adb +++ b/gcc/ada/libgnarl/s-tpopmo.adb @@ -31,6 +31,8 @@ -- This is the Monotonic version of this package for Posix and Linux targets. +with System.C_Time; + separate (System.Task_Primitives.Operations) package body Monotonic is @@ -54,14 +56,14 @@ package body Monotonic is --------------------- function Monotonic_Clock return Duration is - TS : aliased timespec; + TS : aliased C_Time.timespec; Result : Interfaces.C.int; begin Result := clock_gettime (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); pragma Assert (Result = 0); - return To_Duration (TS); + return C_Time.To_Duration (TS); end Monotonic_Clock; ------------------- @@ -69,14 +71,14 @@ package body Monotonic is ------------------- function RT_Resolution return Duration is - TS : aliased timespec; + TS : aliased C_Time.timespec; Result : Interfaces.C.int; begin Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); pragma Assert (Result = 0); - return To_Duration (TS); + return C_Time.To_Duration (TS); end RT_Resolution; ---------------------- @@ -150,7 +152,7 @@ package body Monotonic is Abs_Time : Duration; P_Abs_Time : Duration; - Request : aliased timespec; + Request : aliased C_Time.timespec; Result : Interfaces.C.int; Exit_Outer : Boolean := False; @@ -184,7 +186,7 @@ package body Monotonic is end if; pragma Warnings (On); - Request := To_Timespec (P_Abs_Time); + Request := C_Time.To_Timespec (P_Abs_Time); Inner : loop exit Outer @@ -236,7 +238,7 @@ package body Monotonic is Check_Time : Duration; Abs_Time : Duration; P_Abs_Time : Duration; - Request : aliased timespec; + Request : aliased C_Time.timespec; Result : Interfaces.C.int; Exit_Outer : Boolean := False; @@ -271,7 +273,7 @@ package body Monotonic is end if; pragma Warnings (On); - Request := To_Timespec (P_Abs_Time); + Request := C_Time.To_Timespec (P_Abs_Time); Inner : loop exit Outer diff --git a/gcc/ada/libgnarl/s-osinte__android.adb b/gcc/ada/libgnat/g-c_time.ads similarity index 59% rename from gcc/ada/libgnarl/s-osinte__android.adb rename to gcc/ada/libgnat/g-c_time.ads index 3e36d284c918..02461955b2f4 100644 --- a/gcc/ada/libgnarl/s-osinte__android.adb +++ b/gcc/ada/libgnat/g-c_time.ads @@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME COMPONENTS -- -- -- --- S Y S T E M . O S _ I N T E R F A C E -- +-- G N A T . C _ T I M E -- -- -- --- B o d y -- +-- S p e c -- -- -- --- Copyright (C) 1995-2025, AdaCore -- +-- Copyright (C) 2025, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -24,51 +24,15 @@ -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ --- This is an Android version of this package. +-- This package provides the time_t, timeval and timespec types corresponding +-- to the C types defined by the OS, as well as various conversion functions. --- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- See file s-c_time.ads for full documentation of the interface -with Interfaces.C; use Interfaces.C; - -package body System.OS_Interface is - - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (TS : timespec) return Duration is - begin - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; - end To_Duration; - - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - -end System.OS_Interface; +with System.C_Time; +package GNAT.C_Time renames System.C_Time; diff --git a/gcc/ada/libgnat/g-calend.adb b/gcc/ada/libgnat/g-calend.adb index a2bc77c1cc7b..80b62b7547f5 100644 --- a/gcc/ada/libgnat/g-calend.adb +++ b/gcc/ada/libgnat/g-calend.adb @@ -29,11 +29,8 @@ -- -- ------------------------------------------------------------------------------ -with Interfaces.C.Extensions; - package body GNAT.Calendar is use Ada.Calendar; - use Interfaces; ----------------- -- Day_In_Year -- @@ -333,25 +330,8 @@ package body GNAT.Calendar is ----------------- function To_Duration (T : not null access timeval) return Duration is - - procedure timeval_to_duration - (T : not null access timeval; - sec : not null access C.Extensions.long_long; - usec : not null access C.long); - pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); - - Micro : constant := 10**6; - sec : aliased C.Extensions.long_long; - usec : aliased C.long; - - pragma Unsuppress (Overflow_Check); - begin - timeval_to_duration (T, sec'Access, usec'Access); - pragma Annotate (CodePeer, Modified, sec); - pragma Annotate (CodePeer, Modified, usec); - - return Duration (sec) + Duration (usec) / Micro; + return System.C_Time.To_Duration (T.all); end To_Duration; ---------------- @@ -359,45 +339,8 @@ package body GNAT.Calendar is ---------------- function To_Timeval (D : Duration) return timeval is - - procedure duration_to_timeval - (Sec : C.Extensions.long_long; - Usec : C.long; - T : not null access timeval); - pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval"); - - Micro : constant := 10**6; - Result : aliased timeval; - sec : C.Extensions.long_long; - usec : C.long; - - pragma Unsuppress (Overflow_Check); - begin - if D = 0.0 then - sec := 0; - usec := 0; - - elsif D < 0.0 then - sec := C.Extensions.long_long (D + 0.5); - if D = Duration (sec) then - usec := 0; - else - usec := C.long ((D - Duration (sec)) * Micro + 0.5); - end if; - - else - sec := C.Extensions.long_long (D - 0.5); - if D = Duration (sec) then - usec := 0; - else - usec := C.long ((D - Duration (sec)) * Micro - 0.5); - end if; - end if; - - duration_to_timeval (sec, usec, Result'Access); - - return Result; + return System.C_Time.To_Timeval (D); end To_Timeval; ------------------ diff --git a/gcc/ada/libgnat/g-calend.ads b/gcc/ada/libgnat/g-calend.ads index a3294993aa6d..c57b7df7a220 100644 --- a/gcc/ada/libgnat/g-calend.ads +++ b/gcc/ada/libgnat/g-calend.ads @@ -40,7 +40,8 @@ -- Day_Of_Week, Day_In_Year and Week_In_Year. with Ada.Calendar.Formatting; -with Interfaces.C; + +with System.C_Time; package GNAT.Calendar is @@ -126,7 +127,7 @@ package GNAT.Calendar is -- locale (equivalent to Clock). Due to this simplified behavior, the -- implementation does not require expensive system calls on targets such -- as Windows. - -- WARNING: Split_At_Locale is no longer aware of historic events and may + -- WARNING: Time_At_Locale is no longer aware of historic events and may -- produce inaccurate results over DST changes which occurred in the past. function Week_In_Year (Date : Ada.Calendar.Time) return Week_In_Year_Number; @@ -145,24 +146,18 @@ package GNAT.Calendar is -- Return the week number as defined in ISO 8601 along with the year in -- which the week occurs. - -- C timeval conversion - - -- C timeval represent a duration (used in Select for example). This - -- structure is composed of a number of seconds and a number of micro - -- seconds. The timeval structure is not exposed here because its - -- definition is target dependent. Interface to C programs is done via a - -- pointer to timeval structure. - - type timeval is private; + subtype timeval is System.C_Time.timeval; + pragma Obsolescent (timeval, "use type from GNAT.C_Time instead"); function To_Duration (T : not null access timeval) return Duration; + pragma Inline (To_Duration); + pragma Obsolescent (To_Duration, "use function from GNAT.C_Time instead"); + function To_Timeval (D : Duration) return timeval; + pragma Inline (To_Timeval); + pragma Obsolescent (To_Timeval, "use function from GNAT.C_Time instead"); private - -- This is a dummy declaration that should be the largest possible timeval - -- structure of all supported targets. - - type timeval is array (1 .. 3) of Interfaces.C.long; function Julian_Day (Year : Ada.Calendar.Year_Number; diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb index 303640f7fcca..37232ec031c0 100644 --- a/gcc/ada/libgnat/g-socket.adb +++ b/gcc/ada/libgnat/g-socket.adb @@ -47,6 +47,7 @@ with GNAT.Sockets.Poll; with System; use System; with System.Communication; use System.Communication; with System.CRTL; use System.CRTL; +with System.C_Time; with System.Task_Lock; package body GNAT.Sockets is @@ -179,13 +180,6 @@ package body GNAT.Sockets is function Value (S : System.Address) return String; -- Same as Interfaces.C.Strings.Value but taking a System.Address - function To_Timeval (Val : Timeval_Duration) return Timeval; - -- Separate Val in seconds and microseconds - - function To_Duration (Val : Timeval) return Timeval_Duration; - -- Reconstruct a Duration value from a Timeval record (seconds and - -- microseconds). - function Dedot (Value : String) return String is (if Value /= "" and then Value (Value'Last) = '.' then Value (Value'First .. Value'Last - 1) @@ -528,7 +522,7 @@ package body GNAT.Sockets is Res : C.int; Last : C.int; RSig : Socket_Type := No_Socket; - TVal : aliased Timeval; + TVal : aliased System.C_Time.timeval; TPtr : Timeval_Access; begin @@ -543,7 +537,7 @@ package body GNAT.Sockets is if Timeout = Forever then TPtr := null; else - TVal := To_Timeval (Timeout); + TVal := System.C_Time.To_Timeval (Timeout); TPtr := TVal'Unchecked_Access; end if; @@ -1423,7 +1417,7 @@ package body GNAT.Sockets is U4 : aliased C.unsigned; V1 : aliased C.unsigned_char; VS : aliased C.char_array (1 .. NS); -- for devices name - VT : aliased Timeval; + VT : aliased System.C_Time.timeval; Len : aliased C.int; Add : System.Address; Res : C.int; @@ -1596,8 +1590,10 @@ package body GNAT.Sockets is Opt.Timeout := Duration (U4) / 1000; end if; + elsif System.C_Time.In_Timeval_Duration (VT) then + Opt.Timeout := System.C_Time.To_Duration (VT); else - Opt.Timeout := To_Duration (VT); + Opt.Timeout := Forever; end if; when Bind_To_Device => @@ -2633,7 +2629,7 @@ package body GNAT.Sockets is (1 .. (if Option.Name = Bind_To_Device then C.size_t (ASU.Length (Option.Device) + 1) else 0)); - VT : aliased Timeval; + VT : aliased System.C_Time.timeval; Len : C.int; Add : System.Address := Null_Address; Res : C.int; @@ -2767,7 +2763,7 @@ package body GNAT.Sockets is end if; else - VT := To_Timeval (Option.Timeout); + VT := System.C_Time.To_Timeval (Option.Timeout); Len := VT'Size / 8; Add := VT'Address; end if; @@ -2865,33 +2861,6 @@ package body GNAT.Sockets is return Integer (Socket); end To_C; - ----------------- - -- To_Duration -- - ----------------- - - function To_Duration (Val : Timeval) return Timeval_Duration is - Max_D : constant Long_Long_Integer := Long_Long_Integer (Forever - 0.5); - Tv_sec_64 : constant Boolean := SOSC.SIZEOF_tv_sec = 8; - -- Need to separate this condition into the constant declaration to - -- avoid GNAT warning about "always true" or "always false". - begin - if Tv_sec_64 then - -- Check for possible Duration overflow when Tv_Sec field is 64 bit - -- integer. - - if Val.Tv_Sec > time_t (Max_D) - or else - (Val.Tv_Sec = time_t (Max_D) - and then - Val.Tv_Usec > suseconds_t ((Forever - Duration (Max_D)) * 1E6)) - then - return Forever; - end if; - end if; - - return Duration (Val.Tv_Sec) + Duration (Val.Tv_Usec) * 1.0E-6; - end To_Duration; - ------------------- -- To_Host_Entry -- ------------------- @@ -3041,35 +3010,6 @@ package body GNAT.Sockets is return HN.Name (1 .. HN.Length); end To_String; - ---------------- - -- To_Timeval -- - ---------------- - - function To_Timeval (Val : Timeval_Duration) return Timeval is - S : time_t; - uS : suseconds_t; - - begin - -- If zero, set result as zero (otherwise it gets rounded down to -1) - - if Val = 0.0 then - S := 0; - uS := 0; - - -- Normal case where we do round down - - else - S := time_t (Val - 0.5); - if Val = Timeval_Duration (S) then - uS := 0; - else - uS := suseconds_t ((Val - Timeval_Duration (S)) * 1_000_000 - 0.5); - end if; - end if; - - return (S, uS); - end To_Timeval; - ----------- -- Value -- ----------- diff --git a/gcc/ada/libgnat/g-socthi.adb b/gcc/ada/libgnat/g-socthi.adb index 5540dce04aef..c79b8db868be 100644 --- a/gcc/ada/libgnat/g-socthi.adb +++ b/gcc/ada/libgnat/g-socthi.adb @@ -40,6 +40,8 @@ with GNAT.Task_Lock; with Interfaces.C; use Interfaces.C; +with System.C_Time; + package body GNAT.Sockets.Thin is Non_Blocking_Sockets : aliased Fd_Set; @@ -215,7 +217,7 @@ package body GNAT.Sockets.Thin is declare -- unreachable if Thread_Blocking_IO is statically True pragma Warnings (On, "unreachable code"); WSet : aliased Fd_Set; - Now : aliased Timeval; + Now : aliased System.C_Time.timeval; begin Reset_Socket_Set (WSet'Access); diff --git a/gcc/ada/libgnat/g-socthi__vxworks.adb b/gcc/ada/libgnat/g-socthi__vxworks.adb index a3f05b384025..6ae74eb5f6bf 100644 --- a/gcc/ada/libgnat/g-socthi__vxworks.adb +++ b/gcc/ada/libgnat/g-socthi__vxworks.adb @@ -40,6 +40,8 @@ with GNAT.Task_Lock; with Interfaces.C; use Interfaces.C; +with System.C_Time; + package body GNAT.Sockets.Thin is Non_Blocking_Sockets : aliased Fd_Set; @@ -194,7 +196,7 @@ package body GNAT.Sockets.Thin is declare -- unreachable if Thread_Blocking_IO is statically True pragma Warnings (On, "unreachable code"); WSet : aliased Fd_Set; - Now : aliased Timeval; + Now : aliased System.C_Time.timeval; begin Reset_Socket_Set (WSet'Access); loop diff --git a/gcc/ada/libgnat/g-sothco.ads b/gcc/ada/libgnat/g-sothco.ads index cdf0a16ef086..ec9b5746f0c6 100644 --- a/gcc/ada/libgnat/g-sothco.ads +++ b/gcc/ada/libgnat/g-sothco.ads @@ -33,8 +33,10 @@ -- This package should not be directly with'ed by an applications program. with Ada.Unchecked_Conversion; + with Interfaces.C.Strings; -with System.Parameters; + +with System.C_Time; package GNAT.Sockets.Thin_Common is @@ -44,31 +46,23 @@ package GNAT.Sockets.Thin_Common is Success : constant C.int := 0; Failure : constant C.int := -1; - type time_t is - range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - for time_t'Size use System.Parameters.time_t_bits; - pragma Convention (C, time_t); + subtype time_t is System.C_Time.time_t; + pragma Obsolescent (time_t, "use type from GNAT.C_Time instead"); - type suseconds_t is - range -2 ** (8 * SOSC.SIZEOF_tv_usec - 1) - .. 2 ** (8 * SOSC.SIZEOF_tv_usec - 1) - 1; - for suseconds_t'Size use 8 * SOSC.SIZEOF_tv_usec; - pragma Convention (C, suseconds_t); + subtype suseconds_t is System.C_Time.usec_t; + pragma Obsolescent (suseconds_t, "use type from GNAT.C_Time instead"); - type Timeval is record - Tv_Sec : time_t; - Tv_Usec : suseconds_t; - end record; - pragma Convention (C, Timeval); + subtype timeval is System.C_Time.timeval; + pragma Obsolescent (timeval, "use type from GNAT.C_Time instead"); - type Timeval_Access is access all Timeval; + type Timeval_Access is access all System.C_Time.timeval; pragma Convention (C, Timeval_Access); type socklen_t is mod 2 ** (8 * SOSC.SIZEOF_socklen_t); for socklen_t'Size use (8 * SOSC.SIZEOF_socklen_t); - Immediat : constant Timeval := (0, 0); + Immediat : constant System.C_Time.timeval + := System.C_Time.Milliseconds_To_Timeval (0); ------------------------------------------- -- Mapping tables to low level constants -- diff --git a/gcc/ada/libgnat/g-spogwa.adb b/gcc/ada/libgnat/g-spogwa.adb index a4bbf962a9f3..3752b2bf4422 100644 --- a/gcc/ada/libgnat/g-spogwa.adb +++ b/gcc/ada/libgnat/g-spogwa.adb @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ -with GNAT.Sockets.Thin_Common; +with System.C_Time; procedure GNAT.Sockets.Poll.G_Wait (Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer) @@ -41,11 +41,11 @@ is readfds : access FD_Set_Type; writefds : access FD_Set_Type; exceptfds : access FD_Set_Type; - timeout : access Thin_Common.Timeval) return Integer + timeout : access System.C_Time.timeval) return Integer with Import => True, Convention => Stdcall, External_Name => "select"; - Timeout_V : aliased Thin_Common.Timeval; - Timeout_A : access Thin_Common.Timeval; + Timeout_V : aliased System.C_Time.timeval; + Timeout_A : access System.C_Time.timeval; Rfds : aliased FD_Set_Type; Rcount : Natural := 0; @@ -63,8 +63,7 @@ begin if Timeout >= 0 then Timeout_A := Timeout_V'Access; - Timeout_V.Tv_Sec := Thin_Common.time_t (Timeout / 1000); - Timeout_V.Tv_Usec := Thin_Common.suseconds_t (Timeout rem 1000 * 1000); + Timeout_V := System.C_Time.Milliseconds_To_Timeval (Timeout); end if; Reset_Socket_Set (Rfds); diff --git a/gcc/ada/libgnat/s-c_time.adb b/gcc/ada/libgnat/s-c_time.adb new file mode 100644 index 000000000000..70f8a9cac08f --- /dev/null +++ b/gcc/ada/libgnat/s-c_time.adb @@ -0,0 +1,203 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . C _ T I M E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2025, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +package body System.C_Time is + + -- Two Duration representations are described in targparm.ads: + -- Size Small Last = (2**(Size - 1) - 1) * Small + -- 32 0.02 42_949_672.94 + -- 64 0.000_000_001 9_223_372_036.854_775_807 + + Recip : constant := (if Duration'Size = 32 then 50 else 1_000_000_000); + -- The reciprocal of the Small used to write "* Small" as "/ Recip" + + Milli : constant := 1_000; + Micro : constant := 1_000_000; + Nano : constant := 1_000_000_000; + -- The standard divisors + + pragma Unsuppress (Overflow_Check); + -- Overflow may occur during the various conversions + + ------------------------- + -- In_Timeval_Duration -- + ------------------------- + + -- Immediate : constant Duration := 0.0; + + -- Forever : constant Duration := + -- Duration'Min (Duration'Last, 1.0 * OS_Constants.MAX_tv_sec); + + -- subtype Timeval_Duration is Duration range Immediate .. Forever; + + function In_Timeval_Duration (T : timeval) return Boolean is + Max_Dur : constant := 2**(Duration'Size - 1) - 1; + Max_Sec : constant := Max_Dur / Recip; + Max_Usec : constant := (Max_Dur mod Recip) * Micro / Recip; + + -- When Duration'Size = 64 and time_t'Size = 32, the compiler + -- complains that Max_Sec does not fit in time_t, hence cannot + -- be compared with T.tv_sec. + Safe_Max_Sec : constant := + (if Max_Sec > time_t'Last then time_t'Last else Max_Sec); + Safe_Max_Usec : constant := + (if Max_Sec > time_t'Last then usec_t'Last else Max_Usec); + + begin + pragma Warnings (Off, "condition is always"); + return T.tv_sec >= 0 + and then (T.tv_sec > 0 or else T.tv_usec >= 0) + and then T.tv_sec <= Safe_Max_Sec + and then (T.tv_sec < Safe_Max_Sec or else T.tv_usec <= Safe_Max_Usec) + and then T.tv_sec <= OS_Constants.MAX_tv_sec + and then (T.tv_sec < OS_Constants.MAX_tv_sec or else T.tv_usec = 0); + pragma Warnings (On, "condition is always"); + end In_Timeval_Duration; + + ----------------------------- + -- Milliseconds_To_Timeval -- + ----------------------------- + + function Milliseconds_To_Timeval (M : Interfaces.C.int) return timeval is + use Interfaces.C; + Q : constant int := M / Milli; + R : constant int := M rem Milli; + + begin + return (tv_sec => time_t (Q), tv_usec => usec_t (R) * (Micro / Milli)); + end Milliseconds_To_Timeval; + + ----------------------------- + -- Nanoseconds_To_Timespec -- + ----------------------------- + + function Nanoseconds_To_Timespec (N : Interfaces.C.int) return timespec is + use Interfaces.C; + Q : constant int := N / Nano; + R : constant int := N rem Nano; + + begin + return (tv_sec => time_t (Q), tv_nsec => nsec_t (R)); + end Nanoseconds_To_Timespec; + + ----------------- + -- To_Duration -- + ----------------- + + -- Duration (tv_usec) is OK even when Duration'Size = 32, see above + + function To_Duration (T : timeval) return Duration is + begin + return Duration (T.tv_sec) + Duration (T.tv_usec) / Micro; + end To_Duration; + + -- Duration (tv_nsec) overflows when Duration'Size = 32, see above. + -- Scale down nanoseconds by the value of the Small in nanoseconds. + + function To_Duration (T : timespec) return Duration is + S : constant := Nano / Recip; + + begin + return Duration (T.tv_sec) + Duration (T.tv_nsec / S) / (Nano / S); + end To_Duration; + + ----------------- + -- To_Timespec -- + ----------------- + + function To_Timespec (T : timeval) return timespec is + begin + return (tv_sec => T.tv_sec, tv_nsec => nsec_t (T.tv_usec) * Milli); + end To_Timespec; + + function To_Timespec (D : Duration) return timespec is + tv_sec : time_t; + tv_nsec : nsec_t; + + begin + if D = 0.0 then + tv_sec := 0; + tv_nsec := 0; + + elsif D < 0.0 then + tv_sec := time_t (D + 0.5); + if D = Duration (tv_sec) then + tv_nsec := 0; + else + tv_nsec := nsec_t ((D - Duration (tv_sec)) * Nano + 0.5); + end if; + + else + tv_sec := time_t (D - 0.5); + if D = Duration (tv_sec) then + tv_nsec := 0; + else + tv_nsec := nsec_t ((D - Duration (tv_sec)) * Nano - 0.5); + end if; + end if; + + return (tv_sec, tv_nsec); + end To_Timespec; + + ----------------- + -- To_Timeval -- + ----------------- + + function To_Timeval (D : Duration) return timeval is + tv_sec : time_t; + tv_usec : usec_t; + + begin + if D = 0.0 then + tv_sec := 0; + tv_usec := 0; + + elsif D < 0.0 then + tv_sec := time_t (D + 0.5); + if D = Duration (tv_sec) then + tv_usec := 0; + else + tv_usec := usec_t ((D - Duration (tv_sec)) * Micro + 0.5); + end if; + + else + tv_sec := time_t (D - 0.5); + if D = Duration (tv_sec) then + tv_usec := 0; + else + tv_usec := usec_t ((D - Duration (tv_sec)) * Micro - 0.5); + end if; + end if; + + return (tv_sec, tv_usec); + end To_Timeval; + +end System.C_Time; diff --git a/gcc/ada/libgnat/s-c_time.ads b/gcc/ada/libgnat/s-c_time.ads new file mode 100644 index 000000000000..626a02df5be0 --- /dev/null +++ b/gcc/ada/libgnat/s-c_time.ads @@ -0,0 +1,93 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . C _ T I M E -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2025, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides the time_t, timeval and timespec types corresponding +-- to the C types defined by the OS, as well as various conversion functions. + +with Interfaces.C; + +with System.OS_Constants; + +package System.C_Time + with Pure +is + -- These two C structs represent durations with different accuracies and + -- maximal values. + + type time_t is range -2 ** (OS_Constants.SIZEOF_tv_sec * 8 - 1) .. + 2 ** (OS_Constants.SIZEOF_tv_sec * 8 - 1) - 1 + with Convention => C, Size => OS_Constants.SIZEOF_tv_sec * 8; + + type usec_t is range -2 ** (OS_Constants.SIZEOF_tv_usec * 8 - 1) .. + 2 ** (OS_Constants.SIZEOF_tv_usec * 8 - 1) - 1 + with Convention => C, Size => OS_Constants.SIZEOF_tv_usec * 8; + -- Larger than the suseconds_t C type on ARM 32 bits with GNU libc + -- when __TIME_BITS=64. + + type timeval is record + tv_sec : time_t; -- seconds + tv_usec : usec_t; -- microseconds + end record + with Convention => C; + + type nsec_t is range -2 ** (OS_Constants.SIZEOF_tv_nsec * 8 - 1) .. + 2 ** (OS_Constants.SIZEOF_tv_nsec * 8 - 1) - 1 + with Convention => C, Size => OS_Constants.SIZEOF_tv_nsec * 8; + -- Larger than the signed long int C type on x32. + + type timespec is record + tv_sec : time_t; -- seconds + tv_nsec : nsec_t; -- nanoseconds + end record + with Convention => C; + + -- All conversion functions truncate the result if it is inexact + + function To_Duration (T : timespec) return Duration with Inline; + function To_Duration (T : timeval) return Duration with Inline; + + function To_Timespec (D : Duration) return timespec with Inline; + function To_Timeval (D : Duration) return timeval with Inline; + + function In_Timeval_Duration (T : timeval) return Boolean with Inline; + -- g-socket.adb if not Windows target + + function Milliseconds_To_Timeval (M : Interfaces.C.int) return timeval + with Inline; + -- g-sothco.ads + -- g-spogwa.adb + + function Nanoseconds_To_Timespec (N : Interfaces.C.int) return timespec + with Inline; + function To_Timespec (T : timeval) return timespec with Inline; + -- s-osinte__darwin.adb + +end System.C_Time; diff --git a/gcc/ada/libgnat/s-optide.adb b/gcc/ada/libgnat/s-optide.adb index 6abe6d3a0e69..e39c7cbe2d20 100644 --- a/gcc/ada/libgnat/s-optide.adb +++ b/gcc/ada/libgnat/s-optide.adb @@ -36,8 +36,13 @@ procedure Timed_Delay (Time : Duration; Mode : Integer) is - Request : aliased timespec; - Remaind : aliased timespec; + + function nanosleep (rqtp, rmtp : not null access C_Time.timespec) + return Integer; + pragma Import (C, nanosleep, "nanosleep"); + + Request : aliased C_Time.timespec; + Remaind : aliased C_Time.timespec; Rel_Time : Duration; Abs_Time : Duration; Base_Time : constant Duration := Clock; @@ -71,7 +76,7 @@ begin end if; pragma Warnings (On); - Request := To_Timespec (Time_Chunk); + Request := C_Time.To_Timespec (Time_Chunk); Result := nanosleep (Request'Access, Remaind'Access); Check_Time := Clock; diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb index b07bdeadd092..d0a0ad34859d 100644 --- a/gcc/ada/libgnat/s-os_lib.adb +++ b/gcc/ada/libgnat/s-os_lib.adb @@ -2985,7 +2985,7 @@ package body System.OS_Lib is -- To_Ada -- ------------ - function To_Ada (Time : time_t) return OS_Time is + function To_Ada (Time : Long_Long_Integer) return OS_Time is begin return OS_Time (Time); end To_Ada; @@ -3023,9 +3023,9 @@ package body System.OS_Lib is -- To_C -- ---------- - function To_C (Time : OS_Time) return time_t is + function To_C (Time : OS_Time) return Long_Long_Integer is begin - return time_t (Time); + return Long_Long_Integer (Time); end To_C; ------------------ diff --git a/gcc/ada/libgnat/s-os_lib.ads b/gcc/ada/libgnat/s-os_lib.ads index 38cfc88c4eaa..734f4fd50a5d 100644 --- a/gcc/ada/libgnat/s-os_lib.ads +++ b/gcc/ada/libgnat/s-os_lib.ads @@ -115,6 +115,12 @@ package System.OS_Lib is -- these have Intrinsic convention, so for example it is not permissible -- to create accesses to any of these functions. + function To_Ada (Time : Long_Long_Integer) return OS_Time; + -- Convert Long_Long_Integer to OS_Time + + function To_C (Time : OS_Time) return Long_Long_Integer; + -- Convert OS_Time to Long_Long_Integer + subtype Year_Type is Integer range 1900 .. 2099; subtype Month_Type is Integer range 1 .. 12; subtype Day_Type is Integer range 1 .. 31; @@ -161,27 +167,6 @@ package System.OS_Lib is -- component parts to be interpreted in the local time zone, and returns -- an OS_Time. Returns Invalid_Time if the creation fails. - ------------------ - -- Time_t Stuff -- - ------------------ - - -- Note: Do not use time_t in the compiler and host-based tools; instead - -- use OS_Time. - - subtype time_t is Long_Long_Integer; - -- C time_t can be either long or long long, so we choose the Ada - -- equivalent of the latter because eventually that will be the - -- type used out of necessity. This may affect some user code on 32-bit - -- targets that have not yet migrated to the Posix 2008 standard, - -- particularly pre version 5 32-bit Linux. Do not change this - -- declaration without coordinating it with conversions in Ada.Calendar. - - function To_C (Time : OS_Time) return time_t; - -- Convert OS_Time to C time_t type - - function To_Ada (Time : time_t) return OS_Time; - -- Convert C time_t type to OS_Time - ---------------- -- File Stuff -- ---------------- @@ -1126,8 +1111,8 @@ private pragma Import (Intrinsic, ">"); pragma Import (Intrinsic, "<="); pragma Import (Intrinsic, ">="); - pragma Inline (To_C); pragma Inline (To_Ada); + pragma Inline (To_C); type Process_Id is new Integer; Invalid_Pid : constant Process_Id := -1; diff --git a/gcc/ada/libgnat/s-osprim__darwin.adb b/gcc/ada/libgnat/s-osprim__darwin.adb index 28bfcb8c6831..7b978a3b486d 100644 --- a/gcc/ada/libgnat/s-osprim__darwin.adb +++ b/gcc/ada/libgnat/s-osprim__darwin.adb @@ -29,9 +29,10 @@ -- -- ------------------------------------------------------------------------------ --- This version is for darwin +-- This version is for Darwin + +with System.C_Time; -with System.Parameters; package body System.OS_Primitives is -- ??? These definitions are duplicated from System.OS_Interface @@ -46,27 +47,13 @@ package body System.OS_Primitives is pragma Convention (C, struct_timezone); type struct_timezone_ptr is access all struct_timezone; - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type struct_timeval is record - tv_sec : time_t; - tv_usec : Integer; - end record; - pragma Convention (C, struct_timeval); - function gettimeofday - (tv : not null access struct_timeval; + (tv : not null access C_Time.timeval; tz : struct_timezone_ptr) return Integer; pragma Import (C, gettimeofday, "gettimeofday"); - type timespec is record - tv_sec : time_t; - tv_nsec : Long_Integer; - end record; - pragma Convention (C, timespec); - - function nanosleep (rqtp, rmtp : not null access timespec) return Integer; + function nanosleep (rqtp, rmtp : not null access C_Time.timespec) + return Integer; pragma Import (C, nanosleep, "nanosleep"); ----------- @@ -74,7 +61,7 @@ package body System.OS_Primitives is ----------- function Clock return Duration is - TV : aliased struct_timeval; + TV : aliased C_Time.timeval; Result : Integer; pragma Unreferenced (Result); @@ -89,36 +76,9 @@ package body System.OS_Primitives is -- value is never checked. Result := gettimeofday (TV'Access, null); - return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; + return C_Time.To_Duration (TV); end Clock; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec; - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return - timespec'(tv_sec => S, - tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ----------------- -- Timed_Delay -- ----------------- @@ -127,8 +87,8 @@ package body System.OS_Primitives is (Time : Duration; Mode : Integer) is - Request : aliased timespec; - Remaind : aliased timespec; + Request : aliased C_Time.timespec; + Remaind : aliased C_Time.timespec; Rel_Time : Duration; Abs_Time : Duration; Base_Time : constant Duration := Clock; @@ -148,7 +108,7 @@ package body System.OS_Primitives is if Rel_Time > 0.0 then loop - Request := To_Timespec (Rel_Time); + Request := C_Time.To_Timespec (Rel_Time); Result := nanosleep (Request'Access, Remaind'Access); Check_Time := Clock; diff --git a/gcc/ada/libgnat/s-osprim__posix.adb b/gcc/ada/libgnat/s-osprim__posix.adb index 94d06c325bb2..45836ac806d3 100644 --- a/gcc/ada/libgnat/s-osprim__posix.adb +++ b/gcc/ada/libgnat/s-osprim__posix.adb @@ -30,54 +30,23 @@ ------------------------------------------------------------------------------ -- This version is for POSIX-like operating systems -with System.Parameters; + +with System.C_Time; package body System.OS_Primitives is - -- ??? These definitions are duplicated from System.OS_Interface - -- because we don't want to depend on any package. Consider removing - -- these declarations in System.OS_Interface and move these ones in - -- the spec. - - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : Long_Integer; - end record; - pragma Convention (C, timespec); - - function nanosleep (rqtp, rmtp : not null access timespec) return Integer; - pragma Import (C, nanosleep, "nanosleep"); - ----------- -- Clock -- ----------- function Clock return Duration is - type timeval is array (1 .. 3) of Long_Integer; - -- The timeval array is sized to contain Long_Long_Integer sec and - -- Long_Integer usec. If Long_Long_Integer'Size = Long_Integer'Size then - -- it will be overly large but that will not effect the implementation - -- since it is not accessed directly. - - procedure timeval_to_duration - (T : not null access timeval; - sec : not null access Long_Long_Integer; - usec : not null access Long_Integer); - pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); - - Micro : constant := 10**6; - sec : aliased Long_Long_Integer; - usec : aliased Long_Integer; - TV : aliased timeval; + TV : aliased C_Time.timeval; Result : Integer; pragma Unreferenced (Result); function gettimeofday - (Tv : access timeval; + (Tv : access C_Time.timeval; Tz : System.Address := System.Null_Address) return Integer; pragma Import (C, gettimeofday, "gettimeofday"); @@ -91,37 +60,9 @@ package body System.OS_Primitives is -- value is never checked. Result := gettimeofday (TV'Access, System.Null_Address); - timeval_to_duration (TV'Access, sec'Access, usec'Access); - return Duration (sec) + Duration (usec) / Micro; + return C_Time.To_Duration (TV); end Clock; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec; - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return - timespec'(tv_sec => S, - tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ----------------- -- Timed_Delay -- ----------------- diff --git a/gcc/ada/libgnat/s-osprim__posix2008.adb b/gcc/ada/libgnat/s-osprim__posix2008.adb index 78b21c6444d9..fceb37cdd011 100644 --- a/gcc/ada/libgnat/s-osprim__posix2008.adb +++ b/gcc/ada/libgnat/s-osprim__posix2008.adb @@ -32,34 +32,19 @@ -- This version is for POSIX.1-2008-like operating systems with System.CRTL; +with System.C_Time; with System.OS_Constants; -with System.Parameters; + package body System.OS_Primitives is subtype int is System.CRTL.int; - -- ??? These definitions are duplicated from System.OS_Interface because - -- we don't want to depend on any package. Consider removing these - -- declarations in System.OS_Interface and move these ones to the spec. - - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : Long_Integer; - end record; - pragma Convention (C, timespec); - - function nanosleep (rqtp, rmtp : not null access timespec) return Integer; - pragma Import (C, nanosleep, "nanosleep"); - ----------- -- Clock -- ----------- function Clock return Duration is - TS : aliased timespec; + TS : aliased C_Time.timespec; Result : int; type clockid_t is new int; @@ -68,42 +53,15 @@ package body System.OS_Primitives is function clock_gettime (clock_id : clockid_t; - tp : access timespec) return int; + tp : access C_Time.timespec) return int; pragma Import (C, clock_gettime, "clock_gettime"); begin Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access); pragma Assert (Result = 0); - return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; + return C_Time.To_Duration (TS); end Clock; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec; - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return - timespec'(tv_sec => S, - tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ----------------- -- Timed_Delay -- ----------------- diff --git a/gcc/ada/libgnat/s-osprim__rtems.adb b/gcc/ada/libgnat/s-osprim__rtems.adb index c8fbc8270ca8..99644b39424a 100644 --- a/gcc/ada/libgnat/s-osprim__rtems.adb +++ b/gcc/ada/libgnat/s-osprim__rtems.adb @@ -31,7 +31,8 @@ -- This version is for POSIX-like operating systems -with System.Parameters; +with System.C_Time; + package body System.OS_Primitives is -- ??? These definitions are duplicated from System.OS_Interface @@ -39,16 +40,8 @@ package body System.OS_Primitives is -- these declarations in System.OS_Interface and move these ones in -- the spec. - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : Long_Integer; - end record; - pragma Convention (C, timespec); - - function nanosleep (rqtp, rmtp : not null access timespec) return Integer; + function nanosleep (rqtp, rmtp : not null access C_Time.timespec) + return Integer; pragma Import (C, nanosleep, "nanosleep"); ----------- @@ -56,28 +49,12 @@ package body System.OS_Primitives is ----------- function Clock return Duration is - - type timeval is record - tv_sec : time_t; - tv_usec : Long_Integer; - end record; - pragma Convention (C, timeval); - - procedure timeval_to_duration - (T : not null access timeval; - sec : not null access Long_Long_Integer; - usec : not null access Long_Integer); - pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); - - Micro : constant := 10**6; - sec : aliased Long_Long_Integer; - usec : aliased Long_Integer; - TV : aliased timeval; + TV : aliased C_Time.timeval; Result : Integer; pragma Unreferenced (Result); function gettimeofday - (Tv : access timeval; + (Tv : access C_Time.timeval; Tz : System.Address := System.Null_Address) return Integer; pragma Import (C, gettimeofday, "gettimeofday"); @@ -91,37 +68,9 @@ package body System.OS_Primitives is -- value is never checked. Result := gettimeofday (TV'Access, System.Null_Address); - timeval_to_duration (TV'Access, sec'Access, usec'Access); - return Duration (sec) + Duration (usec) / Micro; + return C_Time.To_Duration (TV); end Clock; - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec; - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return - timespec'(tv_sec => S, - tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9))); - end To_Timespec; - ----------------- -- Timed_Delay -- ----------------- @@ -130,8 +79,8 @@ package body System.OS_Primitives is (Time : Duration; Mode : Integer) is - Request : aliased timespec; - Remaind : aliased timespec; + Request : aliased C_Time.timespec; + Remaind : aliased C_Time.timespec; Rel_Time : Duration; Abs_Time : Duration; Base_Time : constant Duration := Clock; @@ -151,7 +100,7 @@ package body System.OS_Primitives is if Rel_Time > 0.0 then loop - Request := To_Timespec (Rel_Time); + Request := C_Time.To_Timespec (Rel_Time); Result := nanosleep (Request'Access, Remaind'Access); Check_Time := Clock; diff --git a/gcc/ada/libgnat/s-osprim__solaris.adb b/gcc/ada/libgnat/s-osprim__solaris.adb deleted file mode 100644 index a08feb5f666f..000000000000 --- a/gcc/ada/libgnat/s-osprim__solaris.adb +++ /dev/null @@ -1,126 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . O S _ P R I M I T I V E S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2025, Free Software Foundation, Inc. -- --- -- --- GNARL is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This version uses gettimeofday and select --- This file is suitable for Solaris (32 and 64 bits). - -package body System.OS_Primitives is - - -- ??? These definitions are duplicated from System.OS_Interface - -- because we don't want to depend on any package. Consider removing - -- these declarations in System.OS_Interface and move these ones in - -- the spec. - - type struct_timeval is record - tv_sec : Long_Integer; - tv_usec : Long_Integer; - end record; - pragma Convention (C, struct_timeval); - - procedure gettimeofday - (tv : not null access struct_timeval; - tz : Address := Null_Address); - pragma Import (C, gettimeofday, "gettimeofday"); - - procedure C_select - (n : Integer := 0; - readfds, - writefds, - exceptfds : Address := Null_Address; - timeout : not null access struct_timeval); - pragma Import (C, C_select, "select"); - - ----------- - -- Clock -- - ----------- - - function Clock return Duration is - TV : aliased struct_timeval; - - begin - gettimeofday (TV'Access); - return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; - end Clock; - - ----------------- - -- Timed_Delay -- - ----------------- - - procedure Timed_Delay - (Time : Duration; - Mode : Integer) - is - Rel_Time : Duration; - Abs_Time : Duration; - Base_Time : constant Duration := Clock; - Check_Time : Duration := Base_Time; - timeval : aliased struct_timeval; - - begin - if Mode = Relative then - Rel_Time := Time; - Abs_Time := Time + Check_Time; - else - Rel_Time := Time - Check_Time; - Abs_Time := Time; - end if; - - if Rel_Time > 0.0 then - loop - timeval.tv_sec := Long_Integer (Rel_Time); - - if Duration (timeval.tv_sec) > Rel_Time then - timeval.tv_sec := timeval.tv_sec - 1; - end if; - - timeval.tv_usec := - Long_Integer ((Rel_Time - Duration (timeval.tv_sec)) * 10#1#E6); - - C_select (timeout => timeval'Unchecked_Access); - Check_Time := Clock; - - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - - Rel_Time := Abs_Time - Check_Time; - end loop; - end if; - end Timed_Delay; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - begin - null; - end Initialize; - -end System.OS_Primitives; diff --git a/gcc/ada/libgnat/s-osprim__unix.adb b/gcc/ada/libgnat/s-osprim__unix.adb index 5848df6f63fc..c48fbe1001f0 100644 --- a/gcc/ada/libgnat/s-osprim__unix.adb +++ b/gcc/ada/libgnat/s-osprim__unix.adb @@ -30,7 +30,9 @@ ------------------------------------------------------------------------------ -- This version uses gettimeofday and select --- This file is suitable for OpenNT, Dec Unix and SCO UnixWare. +-- This file is suitable for Dec Unix, SCO UnixWare and Sun Solaris. + +with System.C_Time; package body System.OS_Primitives is @@ -39,14 +41,8 @@ package body System.OS_Primitives is -- these declarations in System.OS_Interface and move these ones in -- the spec. - type struct_timeval is record - tv_sec : Integer; - tv_usec : Integer; - end record; - pragma Convention (C, struct_timeval); - procedure gettimeofday - (tv : not null access struct_timeval; + (tv : not null access C_Time.timeval; tz : Address := Null_Address); pragma Import (C, gettimeofday, "gettimeofday"); @@ -55,7 +51,7 @@ package body System.OS_Primitives is readfds, writefds, exceptfds : Address := Null_Address; - timeout : not null access struct_timeval); + timeout : not null access C_Time.timeval); pragma Import (C, C_select, "select"); ----------- @@ -63,11 +59,11 @@ package body System.OS_Primitives is ----------- function Clock return Duration is - TV : aliased struct_timeval; + TV : aliased C_Time.timeval; begin gettimeofday (TV'Access); - return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; + return C_Time.To_Duration (TV); end Clock; ----------------- @@ -82,7 +78,7 @@ package body System.OS_Primitives is Abs_Time : Duration; Base_Time : constant Duration := Clock; Check_Time : Duration := Base_Time; - timeval : aliased struct_timeval; + timeval : aliased C_Time.timeval; begin if Mode = Relative then @@ -95,14 +91,7 @@ package body System.OS_Primitives is if Rel_Time > 0.0 then loop - timeval.tv_sec := Integer (Rel_Time); - - if Duration (timeval.tv_sec) > Rel_Time then - timeval.tv_sec := timeval.tv_sec - 1; - end if; - - timeval.tv_usec := - Integer ((Rel_Time - Duration (timeval.tv_sec)) * 10#1#E6); + timeval := C_Time.To_Timeval (Rel_Time); C_select (timeout => timeval'Unchecked_Access); Check_Time := Clock; diff --git a/gcc/ada/libgnat/s-osprim__x32.adb b/gcc/ada/libgnat/s-osprim__x32.adb deleted file mode 100644 index e127107aa57d..000000000000 --- a/gcc/ada/libgnat/s-osprim__x32.adb +++ /dev/null @@ -1,170 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . O S _ P R I M I T I V E S -- --- -- --- B o d y -- --- -- --- Copyright (C) 2013-2025, Free Software Foundation, Inc. -- --- -- --- GNARL is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This version is for Linux/x32 - -with System.Parameters; - -package body System.OS_Primitives is - - -- ??? These definitions are duplicated from System.OS_Interface - -- because we don't want to depend on any package. Consider removing - -- these declarations in System.OS_Interface and move these ones in - -- the spec. - - type time_t is range -2 ** (System.Parameters.time_t_bits - 1) - .. 2 ** (System.Parameters.time_t_bits - 1) - 1; - - type timespec is record - tv_sec : time_t; - tv_nsec : Long_Long_Integer; - end record; - pragma Convention (C, timespec); - - function nanosleep (rqtp, rmtp : not null access timespec) return Integer; - pragma Import (C, nanosleep, "nanosleep"); - - ----------- - -- Clock -- - ----------- - - function Clock return Duration is - type timeval is array (1 .. 2) of Long_Long_Integer; - - procedure timeval_to_duration - (T : not null access timeval; - sec : not null access Long_Integer; - usec : not null access Long_Integer); - pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); - - Micro : constant := 10**6; - sec : aliased Long_Integer; - usec : aliased Long_Integer; - TV : aliased timeval; - Result : Integer; - pragma Unreferenced (Result); - - function gettimeofday - (Tv : access timeval; - Tz : System.Address := System.Null_Address) return Integer; - pragma Import (C, gettimeofday, "gettimeofday"); - - begin - -- The return codes for gettimeofday are as follows (from man pages): - -- EPERM settimeofday is called by someone other than the superuser - -- EINVAL Timezone (or something else) is invalid - -- EFAULT One of tv or tz pointed outside accessible address space - - -- None of these codes signal a potential clock skew, hence the return - -- value is never checked. - - Result := gettimeofday (TV'Access, System.Null_Address); - timeval_to_duration (TV'Access, sec'Access, usec'Access); - return Duration (sec) + Duration (usec) / Micro; - end Clock; - - ----------------- - -- To_Timespec -- - ----------------- - - function To_Timespec (D : Duration) return timespec; - - function To_Timespec (D : Duration) return timespec is - S : time_t; - F : Duration; - - begin - S := time_t (Long_Long_Integer (D)); - F := D - Duration (S); - - -- If F has negative value due to a round-up, adjust for positive F - -- value. - - if F < 0.0 then - S := S - 1; - F := F + 1.0; - end if; - - return - timespec'(tv_sec => S, - tv_nsec => Long_Long_Integer (F * 10#1#E9)); - end To_Timespec; - - ----------------- - -- Timed_Delay -- - ----------------- - - procedure Timed_Delay - (Time : Duration; - Mode : Integer) - is - Request : aliased timespec; - Remaind : aliased timespec; - Rel_Time : Duration; - Abs_Time : Duration; - Base_Time : constant Duration := Clock; - Check_Time : Duration := Base_Time; - - Result : Integer; - pragma Unreferenced (Result); - - begin - if Mode = Relative then - Rel_Time := Time; - Abs_Time := Time + Check_Time; - else - Rel_Time := Time - Check_Time; - Abs_Time := Time; - end if; - - if Rel_Time > 0.0 then - loop - Request := To_Timespec (Rel_Time); - Result := nanosleep (Request'Access, Remaind'Access); - Check_Time := Clock; - - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; - - Rel_Time := Abs_Time - Check_Time; - end loop; - end if; - end Timed_Delay; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - begin - null; - end Initialize; - -end System.OS_Primitives; diff --git a/gcc/ada/libgnat/s-parame.ads b/gcc/ada/libgnat/s-parame.ads index 98284a4d13ec..8587453c947e 100644 --- a/gcc/ada/libgnat/s-parame.ads +++ b/gcc/ada/libgnat/s-parame.ads @@ -97,13 +97,6 @@ package System.Parameters is -- Indicates if secondary stacks can grow and shrink at run-time. If False, -- the size of a secondary stack is fixed at the point of its creation. - ------------------------------------ - -- Characteristics of time_t type -- - ------------------------------------ - - time_t_bits : constant := Long_Integer'Size; - -- Number of bits in type time_t - ---------------------------------------------- -- Characteristics of types in Interfaces.C -- ---------------------------------------------- diff --git a/gcc/ada/libgnat/s-parame__hpux.ads b/gcc/ada/libgnat/s-parame__hpux.ads index a8a7b691802d..832f344a5927 100644 --- a/gcc/ada/libgnat/s-parame__hpux.ads +++ b/gcc/ada/libgnat/s-parame__hpux.ads @@ -96,13 +96,6 @@ package System.Parameters is -- Indicates if secondary stacks can grow and shrink at run-time. If False, -- the size of a secondary stack is fixed at the point of its creation. - ------------------------------------ - -- Characteristics of time_t type -- - ------------------------------------ - - time_t_bits : constant := Long_Integer'Size; - -- Number of bits in type time_t - ---------------------------------------------- -- Characteristics of Types in Interfaces.C -- ---------------------------------------------- diff --git a/gcc/ada/libgnat/s-parame__posix2008.ads b/gcc/ada/libgnat/s-parame__posix2008.ads deleted file mode 100644 index 1cf09c6e39f1..000000000000 --- a/gcc/ada/libgnat/s-parame__posix2008.ads +++ /dev/null @@ -1,189 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P A R A M E T E R S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2025, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the Posix 2008 version for 64 bit time_t. - --- This package defines some system dependent parameters for GNAT. These --- are values that are referenced by the runtime library and are therefore --- relevant to the target machine. - --- The parameters whose value is defined in the spec are not generally --- expected to be changed. If they are changed, it will be necessary to --- recompile the run-time library. - --- The parameters which are defined by functions can be changed by modifying --- the body of System.Parameters in file s-parame.adb. A change to this body --- requires only rebinding and relinking of the application. - --- Note: do not introduce any pragma Inline statements into this unit, since --- otherwise the relinking and rebinding capability would be deactivated. - -package System.Parameters is - pragma Pure; - - --------------------------------------- - -- Task And Stack Allocation Control -- - --------------------------------------- - - type Size_Type is range -Memory_Size / 2 .. Memory_Size / 2 - 1; - -- Type used to provide task stack sizes to the runtime. Sized to permit - -- stack sizes of up to half the total addressable memory space. This may - -- seem excessively large (even for 32-bit systems), however there are many - -- instances of users requiring large stack sizes (for example string - -- processing). - - Unspecified_Size : constant Size_Type := Size_Type'First; - -- Value used to indicate that no size type is set - - function Default_Stack_Size return Size_Type; - -- Default task stack size used if none is specified - - function Minimum_Stack_Size return Size_Type; - -- Minimum task stack size permitted - - function Adjust_Storage_Size (Size : Size_Type) return Size_Type; - -- Given the storage size stored in the TCB, return the Storage_Size - -- value required by the RM for the Storage_Size attribute. The - -- required adjustment is as follows: - -- - -- when Size = Unspecified_Size, return Default_Stack_Size - -- when Size < Minimum_Stack_Size, return Minimum_Stack_Size - -- otherwise return given Size - - Default_Env_Stack_Size : constant Size_Type := 8_192_000; - -- Assumed size of the environment task, if no other information is - -- available. This value is used when stack checking is enabled and - -- no GNAT_STACK_LIMIT environment variable is set. - - Stack_Grows_Down : constant Boolean := True; - -- This constant indicates whether the stack grows up (False) or - -- down (True) in memory as functions are called. It is used for - -- proper implementation of the stack overflow check. - - Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; - -- The run-time chosen default size for secondary stacks that may be - -- overridden by the user with the use of binder -D switch. - - Sec_Stack_Dynamic : constant Boolean := True; - -- Indicates if secondary stacks can grow and shrink at run-time. If False, - -- the size of a secondary stack is fixed at the point of its creation. - - ------------------------------------ - -- Characteristics of time_t type -- - ------------------------------------ - - time_t_bits : constant := Long_Long_Integer'Size; - -- Number of bits in type time_t. Use for targets that are Posix 2008 - -- compliant (fixes the year 2038 time_t overflow). - - ---------------------------------------------- - -- Characteristics of types in Interfaces.C -- - ---------------------------------------------- - - long_bits : constant := Long_Integer'Size; - -- Number of bits in type long and unsigned_long. The normal convention - -- is that this is the same as type Long_Integer, but this may not be true - -- of all targets. - - ptr_bits : constant := Standard'Address_Size; - subtype C_Address is System.Address; - -- Number of bits in Interfaces.C pointers, normally a standard address - - C_Malloc_Linkname : constant String := "__gnat_malloc"; - -- Name of runtime function used to allocate such a pointer - - ---------------------------------------------- - -- Behavior of Pragma Finalize_Storage_Only -- - ---------------------------------------------- - - -- Garbage_Collected is a Boolean constant whose value indicates the - -- effect of the pragma Finalize_Storage_Entry on a controlled type. - - -- Garbage_Collected = False - - -- The system releases all storage on program termination only, - -- but not other garbage collection occurs, so finalization calls - -- are omitted only for outer level objects can be omitted if - -- pragma Finalize_Storage_Only is used. - - -- Garbage_Collected = True - - -- The system provides full garbage collection, so it is never - -- necessary to release storage for controlled objects for which - -- a pragma Finalize_Storage_Only is used. - - Garbage_Collected : constant Boolean := False; - -- The storage mode for this system (release on program exit) - - --------------------- - -- Tasking Profile -- - --------------------- - - -- In the following sections, constant parameters are defined to - -- allow some optimizations and fine tuning within the tasking run time - -- based on restrictions on the tasking features. - - ------------------- - -- Task Abortion -- - ------------------- - - No_Abort : constant Boolean := False; - -- This constant indicates whether abort statements and asynchronous - -- transfer of control (ATC) are disallowed. If set to True, it is - -- assumed that neither construct is used, and the run time does not - -- need to defer/undefer abort and check for pending actions at - -- completion points. A value of True for No_Abort corresponds to: - -- pragma Restrictions (No_Abort_Statements); - -- pragma Restrictions (Max_Asynchronous_Select_Nesting => 0); - - --------------------- - -- Task Attributes -- - --------------------- - - Max_Attribute_Count : constant := 32; - -- Number of task attributes stored in the task control block - - ----------------------- - -- Task Image Length -- - ----------------------- - - Max_Task_Image_Length : constant := 256; - -- This constant specifies the maximum length of a task's image - - ------------------------------ - -- Exception Message Length -- - ------------------------------ - - Default_Exception_Msg_Max_Length : constant := 200; - -- This constant specifies the default number of characters to allow - -- in an exception message (200 is minimum required by RM 11.4.1(18)). - -end System.Parameters; diff --git a/gcc/ada/libgnat/s-parame__vxworks.ads b/gcc/ada/libgnat/s-parame__vxworks.ads index dbaadb404b75..de9afdbb0b2b 100644 --- a/gcc/ada/libgnat/s-parame__vxworks.ads +++ b/gcc/ada/libgnat/s-parame__vxworks.ads @@ -98,21 +98,6 @@ package System.Parameters is -- Indicates if secondary stacks can grow and shrink at run-time. If False, -- the size of a secondary stack is fixed at the point of its creation. - ------------------------------------ - -- Characteristics of time_t type -- - ------------------------------------ - - -- IMPORTANT NOTE: - -- Select the appropriate time_t_bits for the VSB in use, then rebuild - -- the runtime using instructions in adainclude/libada.gpr. - - -- time_t_bits : constant := Long_Integer'Size; - -- Number of bits in type time_t for SR0650 and before and SR0660 with - -- non-default configuration. - - time_t_bits : constant := Long_Long_Integer'Size; - -- Number of bits in type time_t for SR0660 with default configuration. - ---------------------------------------------- -- Characteristics of types in Interfaces.C -- ---------------------------------------------- diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 4f9ff2aac867..6b2190578071 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -1764,6 +1764,17 @@ CND(SIZEOF_tv_usec, "tv_usec") #endif CNS(MAX_tv_sec, "") } + +{ + struct timespec ts; +/* + -- Sizes (in bytes) of the components of struct timespec. + -- The tv_sec field is the same as in struct timeval. +*/ +#define SIZEOF_tv_nsec (sizeof (ts.tv_nsec)) +CND(SIZEOF_tv_nsec, "tv_nsec"); +} + /* -- Sizes of various data types From patchwork Mon Sep 15 13:01:21 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120275 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7F7C8385782C for ; Mon, 15 Sep 2025 13:27:35 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7F7C8385782C Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=CvTQjbYR X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x331.google.com (mail-wm1-x331.google.com [IPv6:2a00:1450:4864:20::331]) by sourceware.org (Postfix) with ESMTPS id EEDFE385B511 for ; Mon, 15 Sep 2025 13:02:03 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org EEDFE385B511 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org EEDFE385B511 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::331 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941324; cv=none; b=B8hBs3dgy+lnSks29S3mmIYIUXywWkiJfKomMjvHNHDVvBlzmBDfj1S03bJSnYFXq4/FLRdaIbRN275ejF/N40Cx1npP8A/DmjhlewNjbjsQu0hgMhTheFWxeBd9frXLd6MykZuK6v2j2MAG+W/rRhvHyWt7solNsVtrLqRe06c= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941324; c=relaxed/simple; bh=lWcli1BUqta3LbVennr7Jar4y8ZSOulTIgXcTEo9Ks0=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=qraMKGiBg4SQm2uLiO6o25k3mptoOFey5CUZEbY+n0HtP/mrvDDuTtFAAeDnX9KkdTEBHP1L4qyKmCVeAhhqod0rIByTJax59T9vEE/WCpqHV1FhJx0FoOlV2qkCngHn4FP2mi5EM2zlM3SLA6iqSqmfdmsEftXT2HoUcRs59W8= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org EEDFE385B511 Received: by mail-wm1-x331.google.com with SMTP id 5b1f17b1804b1-45f2fbdacd2so3548215e9.3 for ; Mon, 15 Sep 2025 06:02:03 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941323; x=1758546123; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=iGVgm5qTTVYk7BULdIellfaDR4MoanNEH1xeuKfS50s=; b=CvTQjbYRhgYnyi9t2nig61esYyOPF6SDOij/du63jdnsPe6BryCR/Ds+3JgvuvG2gt 6fjmEX5HLMq/1tF7vL4htY5LbHfQKX9yMx6DxZnCze1xTAJuinOq/8jgUG0WlgnsEulW 7LkCddHrPng34ZYLCZmgBDQHkeL8PQBtgcg85FlUmi/vNcNf0ehv7o8sKOBID6ckuGJO ZfL9unHqvT60iYwlfHQC4dlWf6M+p7n6f7DtAsWspmdFIdbysvUvusodnQPr1EsJlwBZ 3KscuItNIYfCRY+4WuPs2Jery9ILx6qq8fwPAjS95JrOqOufwsnbAroz2Jw9pbKjxqZh cofw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941323; x=1758546123; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=iGVgm5qTTVYk7BULdIellfaDR4MoanNEH1xeuKfS50s=; b=JbX0QZMch+tRZWP79tBkEnEvJHUW9LgolBcUJT+fEbEo4tYcRac7xmds/0Ic2mVNnX MOLsXLq0+/U+EwHWRT+DSyIoTro7R/mBUxwv23LXwKC6WtZMT7ZYn8tQbTGS6e27x7Ca wYd8M+4rtKsHFDqsdfJWuKTYKRJAZwusiJLZo4aV6E0TLvgxsVPmcML9o59xCApS7A5K wJevxRqX9oei1coTl7VGT28bExHBrBlPjLQGrZucgPX19JTJmJS2gnc985N5nhKWyx3n c4zdKL96SdhLJSjuZedgj6oYcN6XklyYeBWEsKr2uTQvpJFamkLsYyfKm3wgtIxnIIj4 3diA== X-Gm-Message-State: AOJu0YyoHpqbKffWh9W6SCzPw+NOSaO8BwD59qMKC2tDbMZRtVuRFUdz yAMWlTM1eWT0l8B1KdnFdxMiQNSdaSJWiqG7fKpl5GQmEmT8OpXxlNbewdpPi6rxRheprk89lmS H1GY= X-Gm-Gg: ASbGncvVdKS9JdECdTMTws1YSEO9xb6rDl3szEpvwkt437HBwqrk3Cihh9+5LajxpHv NFc2j+mPI8U1gKYr1DLdkA1NKkgf/jiOjha+5GvgIS1RbUirufNZhSwxAKhH94oDdcAO5zjOqeb YfrN9CQWC/pZIZw4LSiUshv3R8rfqoiVprP59YSbc4rhAFiDrvkWy6inHNMDn3jnOa1kWazS1aL 5adQ3bh6GWjNJwpI2HGw9XH/0QFpGfY8TbMmwj8q78Gxd1c3F75OoIWWbDiWj3qHZz6UljGAeN3 KeI583tRZCGACj8P1K7pddAOkwyMpyC1PYuD4+B/T5hkHuSO+Gge+qtELrcfsZo4JxZasitNq8/ 9SMkqdHpdhtn5kdLSX5l0kaNXUgjaxY6nCc145i9+WyuMDB4EFFkiieTaIItktI13GSe1TGOHnw jKoXHX0QHqqwjd/pixIFxu0matwqLA3ScxkArLfg== X-Google-Smtp-Source: AGHT+IHWCwYys2w8G97z2Moc8tFRk2yBvnG8FIVIM57XSBHqZnRer+Jk+s7zQvrYRwg0wJTMAj8w5g== X-Received: by 2002:a05:600c:1ca5:b0:456:1a69:94fd with SMTP id 5b1f17b1804b1-45f227746bbmr104092265e9.0.1757941322342; Mon, 15 Sep 2025 06:02:02 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.01 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:01 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 15/27] ada: Fix the condition of ghost level dependencies inside assignments Date: Mon, 15 Sep 2025 15:01:21 +0200 Message-ID: <20250915130135.2720894-15-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus The assignee should depend on the level of all of the ghost entiies with the assignment. gcc/ada/ChangeLog: * ghost.adb (Check_Assignee_Levels): Fix the condition and improve error message handling. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/ghost.adb | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index bfe6bff0751e..ef6315a7d3d5 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -561,22 +561,19 @@ package body Ghost is -- within an assignment statement whose target is a ghost -- variable that is assertion-level-dependent on E. - if not Is_Assertion_Level_Dependent (Id_Level, Assignee_Level) + if not Is_Assertion_Level_Dependent (Assignee_Level, Id_Level) then - Error_Msg_Sloc := Sloc (Ghost_Ref); - Error_Msg_N (Assertion_Level_Error_Msg, Ghost_Ref); Error_Msg_Name_1 := Chars (Id_Level); - Error_Msg_NE ("\& has assertion level %", Ghost_Ref, Id); + Error_Msg_N ("\& has assertion level %", Ghost_Ref); Error_Msg_Name_1 := Chars (Assignee_Level); Error_Msg_Node_2 := Assignee; - Error_Msg_NE - ("\& is modifying & with %", Ghost_Ref, Id); - Error_Msg_Name_1 := Chars (Assignee_Level); + Error_Msg_NE ("\& is modifying & with %", Ghost_Ref, Id); + Error_Msg_Name_1 := Chars (Id_Level); Error_Msg_NE ("\assertion level of & should depend on %", Ghost_Ref, - Id); + Assignee); end if; end Check_Assignment_Levels; From patchwork Mon Sep 15 13:01:22 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120269 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id AD56D3857C7A for ; Mon, 15 Sep 2025 13:21:05 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AD56D3857C7A Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=OcqGGQyd X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x333.google.com (mail-wm1-x333.google.com [IPv6:2a00:1450:4864:20::333]) by sourceware.org (Postfix) with ESMTPS id 2F90F385C6E6 for ; Mon, 15 Sep 2025 13:02:05 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 2F90F385C6E6 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 2F90F385C6E6 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::333 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941325; cv=none; b=iWMqlOVXEROEk41EFXPQi40jny5QLE3EA1WKsBscsCy029t5w4AfgfT7cLu6uq3leZChHA4BROfQ/+nNrpmEIc9uioMUesM/dQW9+G31IFUihoY4tlJwmfiQZKP+2XN4jbmqYsnRlwmZdwP/7DruyrdPYb89cA7EXlM/B4OsCqw= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941325; c=relaxed/simple; bh=Mkioi2RxG4vNkrsMhSiWEpwvQFNqJ7sdbXydMAI2Oa8=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=AhRlppejFK9/HU2PzlbBv3yHYiXXST/cw64f9oadAbgWgmjsKWDaOWgM6fA0xBc9s5phccCrDY42a7oTGgaIp92i3tVcP+5OxiOqJ+JDGBti8PSbBTnAiwDn/y13RIJeP5gl5fSL/8jkrDs/tq3PFuhxFQHHS+NikIMSprcfLmk= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 2F90F385C6E6 Received: by mail-wm1-x333.google.com with SMTP id 5b1f17b1804b1-45dec026c78so43233575e9.0 for ; Mon, 15 Sep 2025 06:02:05 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941324; x=1758546124; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=TL/Bec5u2LWyWlRX/8zBR1iiUtAmSH61JXVp7KbZzSE=; b=OcqGGQyde6b4zHuaGJMkJE1dt7rgw4kQGN1XVuHImSkRJ9qcxUeeUhhEm1c654CI/A DMLDc4Gc24g6jxG5SZ3hNaMje5dkfMSXT6zFlHqI2fESG4qY8tFveI5eDZajg31777Ld g1DHeCFHIvjajzHGIH12iBqhOTbdQP9VqVTBvEEYQddZnLCWlroNnpzqHcUUsDASpIsJ cAyeWz4Pwie15kGaDqs03rNn+5GQ3QR6X2YNcSOvcXo9zXSLSbN044eafaSnlRlMQJW2 XHnHuTrHn1en/mLIui9w7wmTBi9EkYbXvcysiqGPHuu1chbJvHgzlvufYnJhRS/XTYJP cpAg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941324; x=1758546124; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=TL/Bec5u2LWyWlRX/8zBR1iiUtAmSH61JXVp7KbZzSE=; b=GEyHV0gFZk6lig8ksqiNiOHgq7ICQAu34w2YOfL6d79YKEMZMIqWIesmiVpG2nei2J K1CPiHsqAvpkwosGXBLqpUSXgY3HaER5Z/O2MwXCRvWhcoX6MAOk6P791wCR1l4Chi2l oaM+xNZsq9pru4mDaPx3e74032tTnN0c0TtSAYmdUSIV6LAAVV67qhBx8cJaQcfEm8/S 9LjMUZlhWrftajzUo4NaZ+fy8VQUIYYtWVbS8HPkU9z6HTgoademwhKJFwJgA4Pg37bz LZPz2GVwJkiuMCbjaVbYpuzxEVrR6mTLISNnv+RmnIK7DwSZKCwbiMid/MQN8M924b0N atJg== X-Gm-Message-State: AOJu0Yx0c+LmdfvnKInUGbH4uNcgl0M2IFFGC4K81Q/PkanMb7FzJBa3 KDCzcBQT1larNa1HcYqsEVHw5koqpwf57nj6uOnki4J4stAPjiKmDzU2Gu+rSBraKlpd+9MTCGZ wff8= X-Gm-Gg: ASbGncs1/5CFPsJ2oipL6wLpwPKpvQdpf1YcrRr8peHXtFty2460PeftgroHU4UpG7D OzZQwGi8mfsuPPcN3EWcktr9l1KIC4uJLQxjWxiVw1dAsgezYD8JySFrC7iBD09qwGyoGoX/t3m OQCTHqnvH1Xhi5V83pvIdAVmNAfGn/yDPCtwNtY2DMO1qehHM0dVWHc6MKgZunrqm8rGNzYALq2 gSLBop/K7y1t7qnfiLUgprgwTzS0NgyGjcg1MSNTXp7Zk/vy5EB9rldmupd2pmEGeusOSueD3EO jNwcxMLNS/TgMLZ5Eua3phW+bzMOsKfYUCgfxWvVxadz1K780N/t9n5lnTWmWyOhD45xP0qcLPZ BZlDa62wsImeVuj43/7pbsX0Y04OSylv7l/oi/UEn1UF1PKPiKpDV25SpvYNAEh9FcanjkrWdOD cWKgrTC8a0Hs2H3/RtL1pyA3ZSApJGyHbD/3nIEoAy0/YBF04P X-Google-Smtp-Source: AGHT+IHIyEnwXf/DZJPZJVEJituDoiSbhsj4G3AwPvkdrANLMAU9tg8F4Gniua7yAQBO2vdq7P5FlA== X-Received: by 2002:a05:600c:4585:b0:45d:98be:ee9e with SMTP id 5b1f17b1804b1-45f211ca331mr115346825e9.1.1757941323467; Mon, 15 Sep 2025 06:02:03 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.02 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:02 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 16/27] ada: Refactor ghost argument consistency checks Date: Mon, 15 Sep 2025 15:01:22 +0200 Message-ID: <20250915130135.2720894-16-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus Create a new method for checking and emitting errors on pragmas Unused, Unrefefrenced, Unreferenced_Objects, Inline and No_Return that support specifying multiple entities as arguments. Emit an error when one argument is ghost and the other is not and when one argument has a ghost policy check and the other has ghost policy ignore. Update the Suppressed_Ghost_Policy_Check_Pragma list pragma Inline that should be there to avoid an incorrect invalid pragma context error. gcc/ada/ChangeLog: * sem_prag.adb (Check_Inconsistent_Argument_Ghostliness): new method for handling the ghost constency errors between different arguments. Use this method in the processing for pragmas Unused, Unrefefrenced, Unreferenced_Objects, Inline and No_Return. * sem_prag.ads (Suppressed_Ghost_Policy_Check_Pragma): add missing entry for pragma Inline. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 329 ++++++++++++++++++++++--------------------- gcc/ada/sem_prag.ads | 1 + 2 files changed, 172 insertions(+), 158 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a17d9d2b8138..9289e02b56ad 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5054,6 +5054,16 @@ package body Sem_Prag is -- Common checks for pragmas that appear within a main program -- (Priority, Main_Storage, Time_Slice, Relative_Deadline, CPU). + procedure Check_Inconsistent_Argument_Ghostliness + (Arg1 : Entity_Id; + Arg2 : Entity_Id; + Ghost_Error_Posted : in out Boolean); + -- Reports an error and sets Ghost_Error_Posted when: + -- * One argument is ghost and the other is not ghost + -- * One argument is checked ghost and the other is ignored ghost + -- + -- Checks are avoided when Ghost_Error_Posted is already set. + procedure Check_Interrupt_Or_Attach_Handler; -- Common processing for first argument of pragma Interrupt_Handler or -- pragma Attach_Handler. @@ -6033,9 +6043,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost variables is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost variable encountered while - -- processing the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing the + -- arguments of the pragma. This is used as a reference for assessing + -- the ghostliness of other arguments. begin GNAT_Pragma; @@ -6073,41 +6084,22 @@ package body Sem_Prag is Set_Has_Pragma_Unused (Arg_Id); end if; - -- A pragma that applies to a Ghost entity becomes Ghost for - -- the purposes of legality checks and removal of ignored - -- Ghost code. - - Mark_Ghost_Pragma (N, Arg_Id); - - -- Capture the entity of the first Ghost variable being + -- Capture the entity of the first variable being -- processed for error detection purposes. - if Is_Ghost_Entity (Arg_Id) then - if No (Ghost_Id) then - Ghost_Id := Arg_Id; - end if; + if No (First_Arg_Id) then + First_Arg_Id := Arg_Id; - -- Otherwise the variable is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities - -- (SPARK RM 6.9). + -- A pragma that applies to a Ghost entity becomes Ghost + -- for the purposes of legality checks and removal of + -- ignored Ghost code. - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost " - & "variables", N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Arg_Id); - Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id); + Mark_Ghost_Pragma (N, Arg_Id); end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Arg_Id, Ghost_Error_Posted); + -- Warn if already flagged as Unused or Unmodified elsif Has_Pragma_Unmodified (Arg_Id) then @@ -6149,9 +6141,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost names is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost name encountered while processing - -- the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing the + -- arguments of the pragma. This is used as a reference for assessing + -- the ghostliness of other arguments. begin GNAT_Pragma; @@ -6214,6 +6207,19 @@ package body Sem_Prag is if Is_Entity_Name (Arg_Expr) then Arg_Id := Entity (Arg_Expr); + -- Capture the entity of the first variable being + -- processed for error detection purposes. + + if No (First_Arg_Id) then + First_Arg_Id := Arg_Id; + + -- A pragma that applies to a Ghost entity becomes Ghost + -- for the purposes of legality checks and removal of + -- ignored Ghost code. + + Mark_Ghost_Pragma (N, Arg_Id); + end if; + -- Warn if already flagged as Unused or Unreferenced and -- skip processing the argument. @@ -6253,36 +6259,8 @@ package body Sem_Prag is Mark_Ghost_Pragma (N, Arg_Id); - -- Capture the entity of the first Ghost name being - -- processed for error detection purposes. - - if Is_Ghost_Entity (Arg_Id) then - if No (Ghost_Id) then - Ghost_Id := Arg_Id; - end if; - - -- Otherwise the name is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities - -- (SPARK RM 6.9). - - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost " - & "names", N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE - ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Arg_Id); - Error_Msg_NE - ("\& # declared as non-ghost", N, Arg_Id); - end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Arg_Id, Ghost_Error_Posted); end if; end if; @@ -7012,6 +6990,91 @@ package body Sem_Prag is end if; end Check_In_Main_Program; + --------------------------------------------- + -- Check_Inconsistent_Argument_Ghostliness -- + --------------------------------------------- + + procedure Check_Inconsistent_Argument_Ghostliness + (Arg1 : Entity_Id; + Arg2 : Entity_Id; + Ghost_Error_Posted : in out Boolean) + is + + procedure Report_Ghost_Argument_Mismatch + (Ghost_Arg : Entity_Id; Non_Ghost_Arg : Entity_Id); + -- Constructs an error message when both a ghost and a non-ghost + -- argument are used in the same pragma. + + procedure Report_Ghost_Policy_Mismatch + (Checked_Arg : Entity_Id; Ignored_Arg : Entity_Id); + -- Constructs an error message when both a checked ghost and an + -- ignored ghost argument are used in the same pragma. + + ------------------------------------ + -- Report_Ghost_Argument_Mismatch -- + ------------------------------------ + + procedure Report_Ghost_Argument_Mismatch + (Ghost_Arg : Entity_Id; Non_Ghost_Arg : Entity_Id) is + + begin + Error_Msg_Name_1 := Pname; + Error_Msg_N + ("pragma % cannot mention ghost and non-ghost " & "variables", + N); + + Error_Msg_Sloc := Sloc (Ghost_Arg); + Error_Msg_NE ("\& # declared as ghost", N, Ghost_Arg); + + Error_Msg_Sloc := Sloc (Non_Ghost_Arg); + Error_Msg_NE ("\& # declared as non-ghost", N, Non_Ghost_Arg); + end Report_Ghost_Argument_Mismatch; + + ---------------------------------- + -- Report_Ghost_Policy_Mismatch -- + ---------------------------------- + + procedure Report_Ghost_Policy_Mismatch + (Checked_Arg : Entity_Id; Ignored_Arg : Entity_Id) is + + begin + Error_Msg_Name_1 := Pname; + Error_Msg_N + ("pragma % cannot mention checked ghost and ignored ghost " + & "variables", + N); + + Error_Msg_Sloc := Sloc (Checked_Arg); + Error_Msg_NE + ("\& # declared with a checked policy", N, Checked_Arg); + + Error_Msg_Sloc := Sloc (Ignored_Arg); + Error_Msg_NE + ("\& # declared with an ignored policy", N, Ignored_Arg); + end Report_Ghost_Policy_Mismatch; + begin + if Ghost_Error_Posted then + null; + elsif Is_Ghost_Entity (Arg1) and then not Is_Ghost_Entity (Arg2) then + Report_Ghost_Argument_Mismatch (Arg1, Arg2); + Ghost_Error_Posted := True; + elsif not Is_Ghost_Entity (Arg1) and then Is_Ghost_Entity (Arg2) + then + Report_Ghost_Argument_Mismatch (Arg2, Arg1); + Ghost_Error_Posted := True; + elsif Is_Checked_Ghost_Entity (Arg1) + and then Is_Ignored_Ghost_Entity (Arg2) + then + Report_Ghost_Policy_Mismatch (Arg1, Arg2); + Ghost_Error_Posted := True; + elsif Is_Ignored_Ghost_Entity (Arg1) + and then Is_Checked_Ghost_Entity (Arg2) + then + Report_Ghost_Policy_Mismatch (Arg2, Arg1); + Ghost_Error_Posted := True; + end if; + end Check_Inconsistent_Argument_Ghostliness; + --------------------------------------- -- Check_Interrupt_Or_Attach_Handler -- --------------------------------------- @@ -10688,9 +10751,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost subprograms is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost subprogram encountered while - -- processing the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing the + -- arguments of the pragma. This is used as a reference for assessing + -- the ghostliness of other arguments. procedure Check_Inline_Always_Placement (Spec_Id : Entity_Id); -- Verify the placement of pragma Inline_Always with respect to the @@ -11178,36 +11242,21 @@ package body Sem_Prag is end if; end case; - -- A pragma that applies to a Ghost entity becomes Ghost for the - -- purposes of legality checks and removal of ignored Ghost code. - - Mark_Ghost_Pragma (N, Subp); - - -- Capture the entity of the first Ghost subprogram being + -- Capture the entity of the first variable being -- processed for error detection purposes. - if Is_Ghost_Entity (Subp) then - if No (Ghost_Id) then - Ghost_Id := Subp; - end if; + if No (First_Arg_Id) then + First_Arg_Id := Subp; - -- Otherwise the subprogram is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities (SPARK RM 6.9). + -- A pragma that applies to a Ghost entity becomes Ghost + -- for the purposes of legality checks and removal of + -- ignored Ghost code. - elsif Present (Ghost_Id) and then not Ghost_Error_Posted then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost subprograms", - N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Subp); - Error_Msg_NE ("\& # declared as non-ghost", N, Subp); + Mark_Ghost_Pragma (N, Subp); end if; + + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Subp, Ghost_Error_Posted); end Set_Inline_Flags; -- Start of processing for Process_Inline @@ -22377,9 +22426,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost subprograms is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost procedure encountered while - -- processing the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing + -- the arguments of the pragma. This is used as a reference for + -- assessing the ghostliness of other arguments. begin Ada_2005_Pragma; @@ -22476,42 +22526,22 @@ package body Sem_Prag is Set_No_Return (E); end if; - -- A pragma that applies to a Ghost entity becomes - -- Ghost for the purposes of legality checks and - -- removal of ignored Ghost code. + -- Capture the entity of the first variable being + -- processed for error detection purposes. - Mark_Ghost_Pragma (N, E); + if No (First_Arg_Id) then + First_Arg_Id := E; - -- Capture the entity of the first Ghost procedure - -- being processed for error detection purposes. + -- A pragma that applies to a Ghost entity becomes + -- Ghost for the purposes of legality checks and + -- removal of ignored Ghost code. - if Is_Ghost_Entity (E) then - if No (Ghost_Id) then - Ghost_Id := E; - end if; - - -- Otherwise the subprogram is non-Ghost. It is - -- illegal to mix references to Ghost and non-Ghost - -- entities (SPARK RM 6.9). - - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost " - & "procedures", N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE - ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (E); - Error_Msg_NE ("\& # declared as non-ghost", N, E); + Mark_Ghost_Pragma (N, E); end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, E, Ghost_Error_Posted); + -- Set flag on any alias as well if Is_Overloadable (E) @@ -27985,9 +28015,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost types is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost type encountered while processing - -- the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing + -- the arguments of the pragma. This is used as a reference for + -- assessing the ghostliness of other arguments. begin GNAT_Pragma; @@ -28002,43 +28033,25 @@ package body Sem_Prag is if Is_Entity_Name (Arg_Expr) then Arg_Id := Entity (Arg_Expr); - if Is_Type (Arg_Id) then - Set_Has_Pragma_Unreferenced_Objects (Arg_Id); + -- Capture the entity of the first Ghost type being + -- processed for error detection purposes. + + if No (First_Arg_Id) then + First_Arg_Id := Arg_Id; -- A pragma that applies to a Ghost entity becomes Ghost -- for the purposes of legality checks and removal of -- ignored Ghost code. Mark_Ghost_Pragma (N, Arg_Id); + end if; - -- Capture the entity of the first Ghost type being - -- processed for error detection purposes. + if Is_Type (Arg_Id) then + Set_Has_Pragma_Unreferenced_Objects (Arg_Id); - if Is_Ghost_Entity (Arg_Id) then - if No (Ghost_Id) then - Ghost_Id := Arg_Id; - end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Arg_Id, Ghost_Error_Posted); - -- Otherwise the type is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities - -- (SPARK RM 6.9). - - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost types", - N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Arg_Id); - Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id); - end if; else Error_Pragma_Arg ("argument for pragma% must be type or subtype", Arg); diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 49552fdd3fe6..1262ede04db8 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -283,6 +283,7 @@ package Sem_Prag is Pragma_Favor_Top_Level => True, Pragma_Import => True, Pragma_Independent_Components => True, + Pragma_Inline => True, Pragma_Interface => True, Pragma_No_Return => True, Pragma_Obsolescent => True, From patchwork Mon Sep 15 13:01:23 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120278 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id EE5E63857C7B for ; Mon, 15 Sep 2025 13:33:23 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org EE5E63857C7B Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=aZnCrG4c X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x432.google.com (mail-wr1-x432.google.com [IPv6:2a00:1450:4864:20::432]) by sourceware.org (Postfix) with ESMTPS id 0C6293858D1E for ; Mon, 15 Sep 2025 13:02:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 0C6293858D1E Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 0C6293858D1E Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::432 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941326; cv=none; b=PTIGBYTzoNKMq9BCW+zv4kRE1M4hqM6dNmnDwFqeixyRyTFLKnF9R/kpixg/vI8KYIAn9rXhy4O+XfeGp0B2Tv6qmf9qNFRwUPmhr/b31qMdyRhil+DcZ6nXvVUzqDne34dskfIBMShBciH4qz6ulNlBgHPN8Aqz33uQYOc8Eho= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941326; c=relaxed/simple; bh=bOps4mQhjJ0bdifFmHzznKPJxuvkFGKjNu3SMLnO00g=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=trj5c2oiLaxc8ivOKXIRfeNEMlgB7KqBrEfIozY58l9zXRwUj7eabPz3mlfACRDzt+mSoaxRdvJNx8I/PU2KkvuyW3dVXr6tESk6JT9tynUC9SMIZVADBeAEWALej9rvvThm8fV1+8TVp7znMXIHjb2ttg1J4+yuu3HVkW/R/wc= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 0C6293858D1E Received: by mail-wr1-x432.google.com with SMTP id ffacd0b85a97d-3eb0a50a4d6so524414f8f.2 for ; Mon, 15 Sep 2025 06:02:06 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941325; x=1758546125; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=Fagd/3IUmpceSOX8B7j6pGdIkweFq/AYcmWCgXIqbP8=; b=aZnCrG4cxqOmtblb6H7gjFG/m5TJeSbalUD6OGCf97q6J7OVjmKXpDy+fBaSVps5w9 aJcxQBHIYUUQZc+q29HEY9VlaYr+cysZt7MkFG/r6i7eq9jGXQKHoez0Ixcrf/w1H+xy klru7/MwiMkcEn6qKu4yk/zl6QJXV86Tp6Z6JsFp+H0nLuhKKaRMVLPQzAtSSwv4PHqR hxLYTYIwEtksCv8sxJ4PU/3XPUiQRfqwlvF5xR7RUqJHywrwS6zMmBDAjrIs690w6uYe IoODKJrtkg1DbdbU1r6A0icGkDosEFIPV9QWmzx1olCOsbt2PMej9OLgugYcoOm5UWAz EgVg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941325; x=1758546125; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=Fagd/3IUmpceSOX8B7j6pGdIkweFq/AYcmWCgXIqbP8=; b=DPcga6e3Gm4E9fOTlyR3H5kkTR5Q4ifeuJmv1n5tiRO7TtP5zIRyyPrckBXJG4TqbQ GvraqvbgTGrYSrifaZZY7xLzr0iYdak/WHm7Na3RAyKhq6Ore1lIHp/nLWEHOnnh7sop 1DpqqKLZKlp20WdSSYl7m8wTdLEijxR4pohYt1Okx+q/1B/0bk45JSc4CAaXhttV6oZr ixHKh8Pxukn2qd04Y0DicE53oSCz9i8cZG7JcNHJ69vD3W684VIrS2OCEasUP9xATkph Vccp0wvlI5+LN3PXaHqKI4LrxIvrfxrIvyEV52YZ482MiF07fohY+ei3r6kY7Jjg4hBZ zknA== X-Gm-Message-State: AOJu0YwrM4kcGUW7xAaRS5SpAkw2yIrzruCLVbrMaVfQud29SiTUIuhe bV6MkZsibzmprg96Pgx5TAKJnu7+0ASUmCMVLmY4nLBB67YuZc9bZEQ6f1Q/R5q7fJlzHqvdtVY J0UE= X-Gm-Gg: ASbGncsr0B2iz2LfjHHxjv7pDiMevn5dWyTmfv5q+dJpqaBA4+HQ7PT05Agwg6Un580 wmytyT9MSz3o1/NpndIrrIDs2jDTHJv9vMtbKf+/WhRhmG6G7bBIDawdKQGojS27acl4JfCXVE9 8WZLrqbK/iaQpfVPFIKvnPogRA9G3UWK35X3Z89gP+/5+hx8iBCHaLBd8RtrjO63gVcKFulHQR7 ho2EG14CRIOoI8UgrEBt/5uuXle6IoztQcN6vWcH8+XjMKq1vExqI2YQj9LFcywhFYMjO/oOQSV GCESZ795xzDkKEvN37Px7/fbIRNVvpbAJWXWlICYV+++X/EKMF4LRIcwRw5630A8rCif5rOme8J RBxPxA+YJnLu7pwRma0h1mKilNqC31dL8TeX7NN9v9H1zs1wuy2QBnHVw2NaFL2UDZs45g7WOJ6 L5P1pOfBwSpuXHoF0l7tQ0hpz0Mf/Unoea/F/syuBjUCc0fNl7 X-Google-Smtp-Source: AGHT+IHDgxwujgxwe/LuDDnFFY22yOAQTI2qo7nzIn1MD12jf9xRZ8V7pTyvShCcEn+1hBjO7wg8PA== X-Received: by 2002:a05:6000:4028:b0:3ea:bed8:7043 with SMTP id ffacd0b85a97d-3eabed874c4mr2427420f8f.7.1757941324322; Mon, 15 Sep 2025 06:02:04 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.03 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:03 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 17/27] ada: Update ghost code SPARK RM rules Date: Mon, 15 Sep 2025 15:01:23 +0200 Message-ID: <20250915130135.2720894-17-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus gcc/ada/ChangeLog: * contracts.adb: Update SPARK RM reference numbers. * freeze.adb: Likewise. * ghost.adb: Likewise. * ghost.ads: Likewise. * sem_ch12.adb: Likewise. * sem_ch3.adb: Likewise. * sem_ch6.adb: Likewise. * sem_prag.adb: Likwise. * sem_res.adb: Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/contracts.adb | 4 ++-- gcc/ada/freeze.adb | 2 +- gcc/ada/ghost.adb | 44 +++++++++++++++++++++---------------------- gcc/ada/ghost.ads | 10 +++++----- gcc/ada/sem_ch12.adb | 10 +++++----- gcc/ada/sem_ch3.adb | 4 ++-- gcc/ada/sem_ch6.adb | 14 +++++++------- gcc/ada/sem_prag.adb | 18 +++++++++--------- gcc/ada/sem_res.adb | 2 +- 9 files changed, 54 insertions(+), 54 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index a6862c424165..d87199939837 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -1131,12 +1131,12 @@ package body Contracts is if Comes_From_Source (Obj_Id) and then Is_Ghost_Entity (Obj_Id) then -- A Ghost object cannot be of a type that yields a synchronized - -- object (SPARK RM 6.9(21)). + -- object (SPARK RM 6.9(22)). if Yields_Synchronized_Object (Obj_Typ) then Error_Msg_N ("ghost object & cannot be synchronized", Obj_Id); - -- A Ghost object cannot be imported or exported (SPARK RM 6.9(7)). + -- A Ghost object cannot be imported or exported (SPARK RM 6.9(9)). -- One exception to this is the object that represents the dispatch -- table of a Ghost tagged type, as the symbol needs to be exported. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 31a583b769e8..9de4fa409c0f 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4245,7 +4245,7 @@ package body Freeze is <> -- A Ghost type cannot have a component of protected or task type - -- (SPARK RM 6.9(21)). + -- (SPARK RM 6.9(22)). if Is_Ghost_Entity (Arr) and then Is_Concurrent_Type (Ctyp) then Error_Msg_N diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index ef6315a7d3d5..d097c70b707f 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -226,7 +226,7 @@ package body Ghost is Policy := Ghost_Policy_In_Effect (Prev_Id); -- The Ghost policy in effect at the point of declaration and at the - -- point of completion must match (SPARK RM 6.9(16)). + -- point of completion must match (SPARK RM 6.9(19)). if Is_Checked_Ghost_Entity (Prev_Id) and then Policy = Name_Ignore @@ -260,7 +260,7 @@ package body Ghost is function Is_OK_Ghost_Context (Context : Node_Id) return Boolean; -- Determine whether node Context denotes a Ghost-friendly context where - -- a Ghost entity can safely reside (SPARK RM 6.9(10)). + -- a Ghost entity can safely reside (SPARK RM 6.9(13)). function In_Aspect_Or_Pragma_Predicate (N : Node_Id) return Boolean; -- Return True iff N is enclosed in an aspect or pragma Predicate @@ -486,8 +486,8 @@ package body Ghost is return True; -- An assertion expression pragma is Ghost when it contains a - -- reference to a Ghost entity (SPARK RM 6.9(10)), except for - -- predicate pragmas (SPARK RM 6.9(11)). + -- reference to a Ghost entity (SPARK RM 6.9(13)), except for + -- predicate pragmas (SPARK RM 6.9(14)). elsif Is_Valid_Assertion_Kind (Prag_Nam) and then Assertion_Expression_Pragma (Prag_Id) @@ -500,14 +500,14 @@ package body Ghost is return True; -- A pragma that applies to a Ghost construct or specifies an - -- aspect of a Ghost entity is a Ghost pragma (SPARK RM 6.9(3)) + -- aspect of a Ghost entity is a Ghost pragma (SPARK RM 6.9(4)) elsif Is_Ghost_Pragma (Prag) then return True; -- Several pragmas that may apply to a non-Ghost entity are -- treated as Ghost when they contain a reference to a Ghost - -- entity (SPARK RM 6.9(11)). + -- entity (SPARK RM 6.9(18)). elsif Prag_Nam in Name_Global @@ -728,11 +728,11 @@ package body Ghost is return True; -- A reference to a Ghost entity can appear within an aspect - -- specification (SPARK RM 6.9(10)). The precise checking will + -- specification (SPARK RM 6.9(13)). The precise checking will -- occur when analyzing the corresponding pragma. We make an -- exception for predicate aspects other than Ghost_Predicate -- that only allow referencing a Ghost entity when the - -- corresponding type declaration is Ghost (SPARK RM 6.9(11)). + -- corresponding type declaration is Ghost (SPARK RM 6.9(14)). elsif Nkind (Par) = N_Aspect_Specification and then @@ -743,7 +743,7 @@ package body Ghost is return True; -- A Ghost type may be referenced in a use or use_type clause - -- (SPARK RM 6.9(10)). + -- (SPARK RM 6.9(13)). elsif Present (Parent (Par)) and then Nkind (Parent (Par)) in N_Use_Package_Clause @@ -863,7 +863,7 @@ package body Ghost is end if; -- The Ghost policy in effect a the point of declaration and at the - -- point of use must match (SPARK RM 6.9(15)). + -- point of use must match (SPARK RM 6.9(18)). if Is_Checked_Ghost_Entity (Id) and then Applic_Policy = Ignore @@ -882,7 +882,7 @@ package body Ghost is -- assertion-level-dependent on E except in the following cases the -- specified aspect is either Global, Depends, Refined_Global, -- Refined_Depends, Initializes, Refined_State, or Iterable (SPARK RM - -- 6.9(15)). + -- 6.9(14)). if No (Ghost_Region) or else (Nkind (Ghost_Region) = N_Pragma @@ -965,7 +965,7 @@ package body Ghost is end if; -- If the Ghost entity appears in a non-Ghost context and affects - -- its behavior or value (SPARK RM 6.9(10,11)). + -- its behavior or value (SPARK RM 6.9(13,14)). if not Is_OK_Ghost_Context (Ghost_Ref) then Error_Msg_N ("ghost entity cannot appear in this context", Ghost_Ref); @@ -1210,7 +1210,7 @@ package body Ghost is Deriv_Typ := Find_Dispatching_Type (Subp); -- A Ghost primitive of a non-Ghost type extension cannot override an - -- inherited non-Ghost primitive (SPARK RM 6.9(8)). + -- inherited non-Ghost primitive (SPARK RM 6.9(10)). if Is_Ghost_Entity (Subp) and then Present (Deriv_Typ) @@ -1228,7 +1228,7 @@ package body Ghost is end if; -- A non-Ghost primitive of a type extension cannot override an - -- inherited Ghost primitive (SPARK RM 6.9(8)). + -- inherited Ghost primitive (SPARK RM 6.9(10)). if Is_Ghost_Entity (Over_Subp) and then not Is_Ghost_Entity (Subp) @@ -1249,7 +1249,7 @@ package body Ghost is -- When a tagged type is either non-Ghost or checked Ghost and -- one of its primitives overrides an inherited operation, the -- overridden operation of the ancestor type must be ignored Ghost - -- if the primitive is ignored Ghost (SPARK RM 6.9(19)). + -- if the primitive is ignored Ghost (SPARK RM 6.9(21)). if Is_Ignored_Ghost_Entity (Subp) then @@ -1288,7 +1288,7 @@ package body Ghost is -- When a tagged type is either non-Ghost or checked Ghost and -- one of its primitives overrides an inherited operation, the -- the primitive of the tagged type must be ignored Ghost if the - -- overridden operation is ignored Ghost (SPARK RM 6.9(19)). + -- overridden operation is ignored Ghost (SPARK RM 6.9(21)). elsif Is_Ignored_Ghost_Entity (Over_Subp) then @@ -1341,7 +1341,7 @@ package body Ghost is end if; -- The Ghost policy in effect at the point of declaration of a primitive - -- operation and a tagged type must match (SPARK RM 6.9(20)). + -- operation and a tagged type must match (SPARK RM 6.9(21)). if Is_Checked_Ghost_Entity (Prim) and then Is_Ignored_Ghost_Entity (Typ) @@ -1407,7 +1407,7 @@ package body Ghost is end if; -- The Ghost policy in effect at the point of an ignored abstract state - -- cannot be check (SPARK RM 6.9(19)). + -- cannot be check (SPARK RM 6.9(20)). if Is_Ignored_Ghost_Entity (State_Id) and then Is_Checked_Ghost_Entity (Constit_Id) @@ -1466,14 +1466,14 @@ package body Ghost is Conc_Typ := Typ; end if; - -- A Ghost type cannot be concurrent (SPARK RM 6.9(21)). Verify this + -- A Ghost type cannot be concurrent (SPARK RM 6.9(22)). Verify this -- legality rule first to give a finer-grained diagnostic. if Present (Conc_Typ) then Error_Msg_N ("ghost type & cannot be concurrent", Conc_Typ); end if; - -- A Ghost type cannot be effectively volatile (SPARK RM 6.9(7)) + -- A Ghost type cannot be effectively volatile (SPARK RM 6.9(9)) if Is_Effectively_Volatile (Full_Typ) then Error_Msg_N ("ghost type & cannot be volatile", Full_Typ); @@ -2068,7 +2068,7 @@ package body Ghost is end if; -- The Ghost policy in effect at the point of declaration and at the - -- point of completion must match (SPARK RM 6.9(16)). + -- point of completion must match (SPARK RM 6.9(18)). Check_Ghost_Completion (Prev_Id => Spec_Id, Compl_Id => Body_Id); @@ -2118,7 +2118,7 @@ package body Ghost is end if; -- The Ghost policy in effect at the point of declaration and at the - -- point of completion must match (SPARK RM 6.9(16)). + -- point of completion must match (SPARK RM 6.9(18)). Check_Ghost_Completion (Prev_Id => Prev_Id, diff --git a/gcc/ada/ghost.ads b/gcc/ada/ghost.ads index cc83d678088b..87401c16a66c 100644 --- a/gcc/ada/ghost.ads +++ b/gcc/ada/ghost.ads @@ -59,7 +59,7 @@ package Ghost is (Actual : Node_Id; Formal : Entity_Id); -- Check that if Actual contains references to ghost entities, generic - -- formal parameter Formal is ghost (SPARK RM 6.9(10)). + -- formal parameter Formal is ghost (SPARK RM 6.9(13)). procedure Check_Ghost_Formal_Procedure_Or_Package (N : Node_Id; @@ -68,7 +68,7 @@ package Ghost is Is_Default : Boolean := False); -- Verify that if generic formal procedure (resp. package) Formal is ghost, -- then Actual is not Empty and also a ghost procedure (resp. package) - -- (SPARK RM 6.9(13-14)). The error if any is located on N. If + -- (SPARK RM 6.9(16-17)). The error if any is located on N. If -- Is_Default is False, N and Actual represent the actual parameter in an -- instantiation. Otherwise, they represent the default subprogram of a -- formal subprogram declaration. @@ -79,7 +79,7 @@ package Ghost is Is_Default : Boolean := False); -- Verify that if Formal (either an IN OUT generic formal parameter, or an -- IN generic formal parameter of access-to-variable type) is ghost, then - -- Actual is a ghost object (SPARK RM 6.9(13-14)). Is_Default is True when + -- Actual is a ghost object (SPARK RM 6.9(16-17)). Is_Default is True when -- Actual is the default expression of the formal object declaration. procedure Check_Ghost_Overriding @@ -126,7 +126,7 @@ package Ghost is (Self : Entity_Id; Other : Entity_Id) return Boolean; -- Check that assertion level Self is assertion-level-dependent with Other. -- - -- According to SPARK RM 6.9(5) this means that + -- According to SPARK RM 6.9(6) this means that -- * Either Self or Other has the default assertion level. -- * Self either is or depends on Other -- * Self either is or depends on Static @@ -262,7 +262,7 @@ package Ghost is procedure Remove_Ignored_Ghost_Code; -- Remove all code marked as ignored Ghost from the trees of all qualifying - -- units (SPARK RM 6.9(4)). + -- units (SPARK RM 6.9(5)). -- -- WARNING: this is a separate front end pass, care should be taken to keep -- it optimized. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1ba76dc74cee..0f1746f1ac51 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2946,7 +2946,7 @@ package body Sem_Ch12 is end case; -- Check for correct use of Ghost entities in generic - -- instantiations (SPARK RM 6.9(10)). + -- instantiations (SPARK RM 6.9(13)). Check_Ghost_Context_In_Generic_Association (Actual => Match, @@ -4099,7 +4099,7 @@ package body Sem_Ch12 is end if; -- The default for a ghost generic formal procedure should be a ghost - -- procedure (SPARK RM 6.9(13)). + -- procedure (SPARK RM 6.9(16)). if Ekind (Nam) = E_Procedure then declare @@ -11704,7 +11704,7 @@ package body Sem_Ch12 is Formal_Pack := Defining_Unit_Name (Specification (Analyzed_Formal)); -- The actual for a ghost generic formal package should be a ghost - -- package (SPARK RM 6.9(14)). + -- package (SPARK RM 6.9(16)). Check_Ghost_Formal_Procedure_Or_Package (N => Actual, @@ -12023,7 +12023,7 @@ package body Sem_Ch12 is end if; -- The actual for a ghost generic formal procedure should be a ghost - -- procedure (SPARK RM 6.9(14)). + -- procedure (SPARK RM 6.9(16)). if Present (Act_E) and then Ekind (Act_E) = E_Procedure @@ -12530,7 +12530,7 @@ package body Sem_Ch12 is end if; -- The actual for a ghost generic formal IN OUT parameter should be a - -- ghost object (SPARK RM 6.9(14)). + -- ghost object (SPARK RM 6.9(16)). Check_Ghost_Formal_Variable (Actual => Actual, diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3317fd209816..5978d6779586 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -10217,7 +10217,7 @@ package body Sem_Ch3 is end if; -- A type extension is automatically Ghost when one of its - -- progenitors is Ghost (SPARK RM 6.9(9)). This property is + -- progenitors is Ghost (SPARK RM 6.9(10)). This property is -- also inherited when the parent type is Ghost, but this is -- done in Build_Derived_Type as the mechanism also handles -- untagged derivations. @@ -10541,7 +10541,7 @@ package body Sem_Ch3 is end if; -- A derived type becomes Ghost when its parent type is also Ghost - -- (SPARK RM 6.9(9)). Note that the Ghost-related attributes are not + -- (SPARK RM 6.9(10)). Note that the Ghost-related attributes are not -- directly inherited because the Ghost policy in effect may differ. if Is_Ghost_Entity (Parent_Type) then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4e5ede6b429e..5e84889e401d 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11839,7 +11839,7 @@ package body Sem_Ch6 is Check_Private_Overriding (B_Typ); -- The Ghost policy in effect at the point of declaration -- or a tagged type and a primitive operation must match - -- (SPARK RM 6.9(18)). + -- (SPARK RM 6.9(21)). Check_Ghost_Primitive (S, B_Typ); end if; @@ -11880,7 +11880,7 @@ package body Sem_Ch6 is -- The Ghost policy in effect at the point of declaration -- of a tagged type and a primitive operation must match - -- (SPARK RM 6.9(18)). + -- (SPARK RM 6.9(21)). Check_Ghost_Primitive (S, B_Typ); end if; @@ -11913,7 +11913,7 @@ package body Sem_Ch6 is -- The Ghost policy in effect at the point of declaration of a -- tagged type and a primitive operation must match - -- (SPARK RM 6.9(18)). + -- (SPARK RM 6.9(21)). Check_Ghost_Primitive (S, B_Typ); end if; @@ -12384,7 +12384,7 @@ package body Sem_Ch6 is -- The Ghost policy in effect at the point of declaration of a -- parent subprogram and an overriding subprogram must match - -- (SPARK RM 6.9(19)). + -- (SPARK RM 6.9(21)). Check_Ghost_Overriding (S, Overridden_Subp); end if; @@ -12547,7 +12547,7 @@ package body Sem_Ch6 is -- The Ghost policy in effect at the point of declaration -- of a parent subprogram and an overriding subprogram - -- must match (SPARK RM 6.9(19)). + -- must match (SPARK RM 6.9(21)). Check_Ghost_Overriding (E, S); end if; @@ -12751,7 +12751,7 @@ package body Sem_Ch6 is -- The Ghost policy in effect at the point of declaration -- of a parent subprogram and an overriding subprogram - -- must match (SPARK RM 6.9(19)). + -- must match (SPARK RM 6.9(21)). Check_Ghost_Overriding (S, E); @@ -12917,7 +12917,7 @@ package body Sem_Ch6 is -- The Ghost policy in effect at the point of declaration of a parent -- subprogram and an overriding subprogram must match - -- (SPARK RM 6.9(19)). + -- (SPARK RM 6.9(21)). Check_Ghost_Overriding (S, Overridden_Subp); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 9289e02b56ad..9175490eca27 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -13287,7 +13287,7 @@ package body Sem_Prag is procedure Check_Ghost_Synchronous is begin -- A synchronized abstract state cannot be Ghost and vice - -- versa (SPARK RM 6.9(21)). + -- versa (SPARK RM 6.9(22)). if Ghost_Seen and Synchronous_Seen then SPARK_Msg_N ("synchronized state cannot be ghost", State); @@ -14854,7 +14854,7 @@ package body Sem_Prag is if Kind = Name_Ghost then -- The Ghost policy must be either Check or Ignore - -- (SPARK RM 6.9(6)). + -- (SPARK RM 6.9(8)). if Chars (Policy) not in Name_Check | Name_Ignore then Error_Pragma_Arg @@ -14864,7 +14864,7 @@ package body Sem_Prag is -- Pragma Assertion_Policy specifying a Ghost policy -- cannot occur within a Ghost subprogram or package - -- (SPARK RM 6.9(16)). + -- (SPARK RM 6.9(19)). if Ghost_Config.Ghost_Mode > None then Error_Pragma @@ -19238,7 +19238,7 @@ package body Sem_Prag is end if; -- Task unit declared without a definition cannot be subject to - -- pragma Ghost (SPARK RM 6.9(21)). + -- pragma Ghost (SPARK RM 6.9(22)). elsif Nkind (Stmt) in N_Single_Task_Declaration | N_Task_Type_Declaration @@ -19334,7 +19334,7 @@ package body Sem_Prag is end if; -- Protected and task types cannot be subject to pragma Ghost - -- (SPARK RM 6.9(21)). + -- (SPARK RM 6.9(22)). if Nkind (Context) in N_Protected_Body | N_Protected_Definition then @@ -19392,7 +19392,7 @@ package body Sem_Prag is -- The full declaration of a deferred constant cannot be -- subject to pragma Ghost unless the deferred declaration - -- is also Ghost (SPARK RM 6.9(9)). + -- is also Ghost (SPARK RM 6.9(11)). if Ekind (Prev_Id) = E_Constant then Error_Msg_Name_1 := Pname; @@ -19410,7 +19410,7 @@ package body Sem_Prag is -- The full declaration of a type cannot be subject to -- pragma Ghost unless the partial view is also Ghost - -- (SPARK RM 6.9(9)). + -- (SPARK RM 6.9(11)). else Error_Msg_NE (Fix_Error @@ -19421,7 +19421,7 @@ package body Sem_Prag is end if; -- A synchronized object cannot be subject to pragma Ghost - -- (SPARK RM 6.9(21)). + -- (SPARK RM 6.9(22)). elsif Ekind (Id) = E_Variable then if Is_Protected_Type (Etype (Id)) then @@ -19451,7 +19451,7 @@ package body Sem_Prag is Is_Ghost := False; -- "Ghostness" cannot be turned off once enabled within a - -- region (SPARK RM 6.9(6)). + -- region (SPARK RM 6.9(8)). if Ghost_Config.Ghost_Mode > None then Error_Pragma diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f02c223809c7..4d467553373d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5273,7 +5273,7 @@ package body Sem_Res is end if; -- The actual parameter of a Ghost subprogram whose formal is of - -- mode IN OUT or OUT must be a Ghost variable (SPARK RM 6.9(12)). + -- mode IN OUT or OUT must be a Ghost variable (SPARK RM 6.9(15)). if Comes_From_Source (Nam) and then Is_Ghost_Entity (Nam) From patchwork Mon Sep 15 13:01:24 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120262 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 60F0B3857BB3 for ; Mon, 15 Sep 2025 13:11:38 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 60F0B3857BB3 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=bJG8JSZ9 X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32a.google.com (mail-wm1-x32a.google.com [IPv6:2a00:1450:4864:20::32a]) by sourceware.org (Postfix) with ESMTPS id AE6F6385695B for ; Mon, 15 Sep 2025 13:02:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org AE6F6385695B Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org AE6F6385695B Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941327; cv=none; b=oUhaVY4XR0c5i0YMXmINhiFtsW5Hpu8DSc0I/o6Yo25q9XES97mIQiLi2JeH8xUlesykbOsSLiIukS0XjDEIAlhKSxVEOOVSs28u+hA0nnYm8g+zImMRK+VMNBOHaNTRIacmxLOUTzljmLUSzleQOUFAYYj+Y45pTHyZWlht1pU= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941327; c=relaxed/simple; bh=sNNuuafAadVjjSMnBie1+0MdTGhWsI7nrxXkT/T0qks=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=tUdpZe+Xa8RVpT7Yk+F4MYzIcx6J8C8cPZapQvTcQJpkRjeyJcAoCCqKM4Y0WjmdLeLxhk395u2EWBDiH+SnRJNAru9DJhXAP9bMbhkCULurTdj9H7VvIFNLmpIkHg2F01wotGrae01KGZxkrdEv8jAXjc7PDh/Ca/o15TaCKfE= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AE6F6385695B Received: by mail-wm1-x32a.google.com with SMTP id 5b1f17b1804b1-45dd5e24d16so39729955e9.3 for ; Mon, 15 Sep 2025 06:02:06 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941325; x=1758546125; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=deTTNBr4T+VafXih2wUmy9xmlwJ76aJVdsep9XBAPlk=; b=bJG8JSZ93F8g71FH9XPZiBwplcQOijMmrdLPfJe9WobKZbPQ4EsCHcGY2iw3Hby6WM ttKGhhzlU5JIUO9EUjLT7PfUHTz+fDBGTEZlrh06KS97PzsbWHR4hc6uKOfDFsfnOKSc QxlYguGJ4UGR0vad5OzSBs3vnORax1GthZQxGBzXRwmIxYh17aYArCETCZjrYuHb+14d I0xT8AG6iTOJiFkU+hLniW0cJB/Lhyn2EFF5E4/pvnwNBvFa5HySGI08RCMPYeHG2CZH G4zqic1FAKW/Cwjlgd+/M1fvOnVSb+KWihTDXyzLgXhQ78X0ywVfxqzqXUgTA0akjpxT PYYw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941325; x=1758546125; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=deTTNBr4T+VafXih2wUmy9xmlwJ76aJVdsep9XBAPlk=; b=g4yhLqv2zdiER3hUWvI2F9N7PnezEclTACRPIcsnFSsJKNQJTE8gNPOpvnuV/Fp6gm Dar/3tdYf9Wm/3Or9uRXAdWmjaAo4R9EpXiajjwVC0+LxcF4JBdVAsB6LuqNwKzEbamn ZaycxXIe31rSoc66wcPEg+ELyHkNFtsrZkfmQLowczyWIZg9EhiL9RJLvvODlkYtW1Ld Xs0Px4zJ6ButV7zaPM3nitynF9H37HUQuSqUmD+5dP0VoLa4KkX9hWjXnLW/8aa1FPAA Gw7I1umZnKJ1daRNaQBRzwGuyq0ydvZSm3k8HgjzWXXXG9aANc18+nBF4BNdn81Zd5bg bwBA== X-Gm-Message-State: AOJu0YxR7vfnaKORhd43A1qcFxSHIGfgy/YeYlq8beCjpIQJMdHdp9VO zO7G0vaSeVZdfEJIzQx9YMlupSAlrFCu+9FTImtlrqdgoAuS0m6jD+3KtriwK/00d+wbUnk39Rv z8zM= X-Gm-Gg: ASbGncteNrfp5XwQw0bnbLHTBCCzxH52IM2XulALbZ389b98l6bm8HwUbrEbz00D/af S7VJykZkrWuiAxfcu36bFINeeqZXc30L+furkeWNNLg99sq4nz82QgNatTP1seflFqcE5IwBgGC J8IwfpsxJ4h235nk+I40HLRt1xtRb7rhMCbiDOxWgekuySBw1jLlbpDnDcwD2or5b9SfOaVStjS ceHT6ImhvYhV++WldG8V4hpJccreO1djrC25lCNe/aUnEZrzhTqJnBXLfNtDYjWGXYRGmCig19L 7c/L46VgvnvdgNsGXRkYkD3WwFJq/8yePmC4fJIZMKNwvQIU2Zb/I+0pI6sdQqcs+Adyo5UPgas s0zBOL5pRh4UJDDiYPv0NM4hZ7L7Q1WnWx3EnpshCx3NkZ1bBYvsLID2zQft+fxuq62krqb0W9q 5qh3eA8NoFpgBx8Vgv1tvlNxkbRnBHYOpIJDC4Xw== X-Google-Smtp-Source: AGHT+IGuatlCC4IS8WAo+KPQ5CMGdA6ULpZTYcwh/SOd4GpUqGAWqHUFo6Q+BbX1GNibCbGMSQgn8Q== X-Received: by 2002:a05:600c:6549:b0:45d:5c71:769a with SMTP id 5b1f17b1804b1-45f211efde9mr79626635e9.26.1757941325247; Mon, 15 Sep 2025 06:02:05 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.04 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:04 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 18/27] ada: Remove checks for the old rule 20 Date: Mon, 15 Sep 2025 15:01:24 +0200 Message-ID: <20250915130135.2720894-18-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus This rule was removed. This can scenario can be detected by Rule 18. gcc/ada/ChangeLog: * ghost.adb (Is_Ok_Pragma): Remove calls to Check_Policies. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/ghost.adb | 48 +++++------------------------------------------ 1 file changed, 5 insertions(+), 43 deletions(-) diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index d097c70b707f..40075bdf0a6b 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -278,9 +278,9 @@ package body Ghost is -- -- * Be subject to pragma Ghost - function Is_OK_Pragma (Prag : Node_Id; Id : Entity_Id) return Boolean; - -- Determine whether node Prag is a suitable context for a reference - -- to a Ghost entity Id. To qualify as such, Prag must either + function Is_OK_Pragma (Prag : Node_Id) return Boolean; + -- Determine whether node Prag is a suitable context for a ghost + -- reference. To qualify as such, Prag must either -- -- * Be an assertion expression pragma -- @@ -424,45 +424,11 @@ package body Ghost is -- Is_OK_Pragma -- ------------------ - function Is_OK_Pragma (Prag : Node_Id; Id : Entity_Id) return Boolean + function Is_OK_Pragma (Prag : Node_Id) return Boolean is - procedure Check_Policies; - -- Verify that the Ghost policy in effect at the point of the - -- declaration of Ghost entity Id (if present) is the same as - -- the assertion policy for the pragma. Emit an error if this - -- is not the case. - - -------------------- - -- Check_Policies -- - -------------------- - - procedure Check_Policies is - begin - -- If the Ghost policy in effect at the point of the - -- declaration of Ghost entity Id is Ignore, then the assertion - -- policy of the pragma must be Ignore (SPARK RM 6.9(20)). - - if Present (Id) - and then not Is_Checked_Ghost_Entity (Id) - and then not Is_Ignored (Prag) - then - Error_Msg_N (Ghost_Policy_Error_Msg, Ghost_Ref); - Error_Msg_NE - ("\ghost entity & has policy `Ignore`", - Ghost_Ref, Ghost_Id); - Error_Msg_N - ("\assertion expression has policy `Check`", - Ghost_Ref); - end if; - end Check_Policies; - - -- Local variables - Prag_Id : Pragma_Id; Prag_Nam : Name_Id; - -- Start of processing for Is_OK_Pragma - begin if Nkind (Prag) /= N_Pragma then return False; @@ -493,10 +459,6 @@ package body Ghost is and then Assertion_Expression_Pragma (Prag_Id) and then Prag_Id /= Pragma_Predicate then - -- Ensure that the assertion policy and the Ghost policy are - -- compatible (SPARK RM 6.9(20)). - - Check_Policies; return True; -- A pragma that applies to a Ghost construct or specifies an @@ -781,7 +743,7 @@ package body Ghost is elsif Is_OK_Declaration (Par) then return True; - elsif Is_OK_Pragma (Par, Ghost_Id) then + elsif Is_OK_Pragma (Par) then return True; elsif Is_OK_Statement (Par, Ghost_Id, Prev) then From patchwork Mon Sep 15 13:01:25 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120274 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 59E6E3857BB9 for ; Mon, 15 Sep 2025 13:27:10 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 59E6E3857BB9 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=XXtnxlCX X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32a.google.com (mail-wm1-x32a.google.com [IPv6:2a00:1450:4864:20::32a]) by sourceware.org (Postfix) with ESMTPS id 83FD3385B500 for ; Mon, 15 Sep 2025 13:02:07 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 83FD3385B500 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 83FD3385B500 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941327; cv=none; b=YwKYywwKnRKmzhPEpnvtX09BXRmATTK/iaKaBj5P2guK4fC/Y6RqsOMv6n/7vBQDux/tmmFz/BTbzfmxjPg860icdUZ5R8nTr5b4hDm1vIuwM29PNrIIQILSLLa+V3uw9s6STNjDU0TsxDfQrVYCmxth4Q+AnwBPnEfIOaJnKVg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941327; c=relaxed/simple; bh=YU+6a88rLa8LMasQDq9zb296Nqb44Ydn+Q37uFpHd0Q=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Zg1dwd1Tp++mmSJnBqBOWyb74UkqcLMn8URhGqkDqb9oZ4/J3DU89gR3U5wEINLtigywrM7KTY6LAcgNDMJrUUKJ3Re8oQmDacYIbmU9aQfih7lyxfiwEa/pDR/3X00SDR7DEPMI4gxuy44DUem/vobHRdMFwdxddrY7sa+o26w= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 83FD3385B500 Received: by mail-wm1-x32a.google.com with SMTP id 5b1f17b1804b1-45f2fa8a1adso4867045e9.1 for ; Mon, 15 Sep 2025 06:02:07 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941326; x=1758546126; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=XKfKAxiGo1+v/Sznj7Ypceo7McroehMWnieQiSOMahQ=; b=XXtnxlCXOSP41gLMNfDq/9MjzKXjRbvAg3FPmTG2Hqoz4UQYCwhjaANfMjo9Gd/e7c BVGlepjtdPx7CXz93yqJvlgmA7xhNMOi1LZ+BKrQiiNWFE2Q7OhVptsV2ue0V3jn1Vse RnqAO895ehT7vSzI+GNlBMIUpfVfRTKQDEz6Ulhe3CO/NxXie276+nlwgizUNgRrMr5Y C4dQy7Z7+hCnZLq4s2Ys3JHchb+dB7vFHB95lkdqhs8gCc1RVlDGtjrwJc4ArDrtjj0S abUKrSKn55Yc407momVJkg0YwixhYA45gSxPhKbHYuAK0XhHhR1aMVdbGYdxPCgs/W7y pusQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941326; x=1758546126; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=XKfKAxiGo1+v/Sznj7Ypceo7McroehMWnieQiSOMahQ=; b=FxY0f+nAkXxOQQzv/MHn3T/4sWl3qm7yQ93koAN1dJTYNfT8jdBsE8rWex2zBUTTun Lv0riBiasAArB2vDQOnkMdMO5OA0Z2lkeX7o2jUwenMX5/IuxbR50Wz4ptWc8Xv9Fine mmqTXlLCPHC+5AzK1IN/Uzj8ZluTFt7m6+Jw8JacejqO2tV9saOd8O0iYhAiXwaboMEZ 3mfnACClP42Xdgilrvhl/I/Zw5EruDfurigGejm8R9wllRQ7+TZcyp8EWnzCyUlyDCgC /Vn3NrFsxdstdZ/O+73UlaCdbWtBBdJU6vgFuK8A+0f7oLES+HJ5Yfm0jv2cIS5Kxb1j oY5A== X-Gm-Message-State: AOJu0YzuOeFXFwzDHwrVatNy5vwIDMEj1PXBYkFLLWFX+QCDkGMEwl9M G3QfMgJt3ym3jcD/Rb54iyo0r5C/SrU7CJ5C2uQGj9IKNc6khC5ByxpkGid1ViRpKEnSUHg/qGJ qf4w= X-Gm-Gg: ASbGnctEg0EdUUvL9mTNgAbsslOTkadQ0slc7I9nZYT/DQPWRjw2uooCtHxPvWWY8td AOYKyAs5+DlXUm2QDeg0Wmpo5rr7G9J1yGzeiOF+rOPAymw0XRiBlwDO0VpTOwAxMnRgjoVcpqn kJbI7+2r9ksa+wc9QYCuDt/VnVV3fOsDwuhPBUPIzvnaKQ8hmfqrKwrwIH72OJSEHWOjG15/R9n RjvSi1FzoOputOCJU6PKgCu/U61D+CkOeY35NsCe9H5Ma2W1/k1EJem9lTUvOQvU9kRmHWifydo 6+0vXOaWym89YB4KXPJjxa+cqDi5PPDTfUCpE0AJ4k8zLwyafYokslQlf75GQfG29oLEehGzdE8 1F2vbGnk0YIMJ8qnf/wnD4Hfq/9hUzGgPLquJv0Bq/E/bmrago7o+0G4Bp7Nf1UaOVBW2hwYtWU XG2zfhPpL/mfmEws4OVEOmnCnUH1NuQ8slsP19om+bgeqUqmvw X-Google-Smtp-Source: AGHT+IEjE105cPoKY2oehQiYD2DZAVmfDhqWytnkY83qbDtWA7ZEX/WXbGJRl5+uTXOK9zQlXT1c8Q== X-Received: by 2002:a05:600c:40c4:b0:45d:e775:d8b8 with SMTP id 5b1f17b1804b1-45dfd5aaff0mr114267475e9.1.1757941326020; Mon, 15 Sep 2025 06:02:06 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.05 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:05 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 19/27] ada: Fix ghost condition for level dependencies for assignments Date: Mon, 15 Sep 2025 15:01:25 +0200 Message-ID: <20250915130135.2720894-19-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus gcc/ada/ChangeLog: * ghost.adb (Check_Assignment_Policies): The level of the assignee should depend on the level of the region. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/ghost.adb | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 40075bdf0a6b..37f82ca849f7 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -1913,12 +1913,14 @@ package body Ghost is ("\& is modified in a region with `Ignore`", N, Assignee); end if; + -- If an assignment to a part of a ghost variable occurs in a ghost + -- entity, then the variable should be assertion-level-dependent on + -- this entity (SPARK RM 6.9(18)). + if Present (Region_Level) and then not Is_Assertion_Level_Dependent - (Region_Level, Assignee_Level) + (Assignee_Level, Region_Level) then - Error_Msg_Sloc := Sloc (N); - Error_Msg_N (Assertion_Level_Error_Msg, N); Error_Msg_Name_1 := Chars (Assignee_Level); Error_Msg_NE ("\& has assertion level %", N, Assignee); From patchwork Mon Sep 15 13:01:26 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120260 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 69218385781A for ; Mon, 15 Sep 2025 13:07:06 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 69218385781A Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=Q0nb53mM X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x436.google.com (mail-wr1-x436.google.com [IPv6:2a00:1450:4864:20::436]) by sourceware.org (Postfix) with ESMTPS id 8C25D3857348 for ; Mon, 15 Sep 2025 13:02:08 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 8C25D3857348 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 8C25D3857348 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::436 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941328; cv=none; b=lJ0xlnXf9LatkMNulmtCY8AFjbD8GEbVIum5Fcb1ulf+H6IDsQaULeM8RUJYTxNHNkSmFokW3dUirPtEEg7vhLZj4LqoBf/aTmj2y3pJbkAQSEjvgj7ZOOnIL2N2maaahmP4RWIhIEn50XGEoxwVqwiJ36zCcZlCvWAXpP4JaU8= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941328; c=relaxed/simple; bh=SE5sG/sl39FtsKTPRLwBI2UgbI16wtB6EYqCGStd04I=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=hCKavWRNoXGnvy1Y7naKTgWqebw2D6A1zDmgx6qBaz0Nkime/ibSnerHBMSFRMouwjTGoa0jGHdJ3TS67BczJhxQbZUrdu1HzPqSeWWzp3yie7yQ768XlGzlzEPDZJtYO117VWPWxnrF5JnmQ/NlB6ep1rMbpuUu2InJe5hjSkk= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8C25D3857348 Received: by mail-wr1-x436.google.com with SMTP id ffacd0b85a97d-3d44d734cabso2662336f8f.3 for ; Mon, 15 Sep 2025 06:02:08 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941327; x=1758546127; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=rB+ptkjVU9Wcy0H9+DZL/QAbGiN/5sCn71WO6tevC18=; b=Q0nb53mMmdvMVBGNv7crYSc11QDzHeiuAsnMLKvBHFJuGapcI6qZxEJ2PFJcPVz4PW VD27s6vXQXYjgOIkajjENlN3HPg/oxdQtel+L1lLvA4qQeGHO+jsI6uwB7ibcUDY0Mwq UMhgRaPJirewBAli3Kd2jZBS8y6GIHT4gXecHQmBVsKkqUiuLRAQR4LOr2jvpHetOQvZ G6Q3l1GYMFH5GEJWFIbWLUdoeDs+wjvMI+DSfplWmnistsYpHtACE0QYgnb9CSNdupQM 6dU0nwIj3GxeE+/hb514xblZjGmpHgUzhvxKjFeOkNOnaL25hRnW9EUFORtARQJWIKDD BFOg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941327; x=1758546127; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=rB+ptkjVU9Wcy0H9+DZL/QAbGiN/5sCn71WO6tevC18=; b=gtEAd6YV0jISwFcWLrN8D6ahQwVWZ8CKW8V4QO6IjsIC7wBWZQgsCaqITd217quXwK Ota5Y4kjwdWhMv+9B1Y8OakI80aQXS6S6ra5yuBPx5b4LJ+7STHAz7KKMN/291h+3SDS 5UJibcOZp58wIw3bh/dACa37kVkPh9P3In2xxXHFmp+Ey2PMszhxeo25o1/SfW9YqzXD X/QAHwfaC7FdsGR9cshvKcF17ZygcIwl/dnFry710/acwXx0Qk53/7OFZYKMNcEgWQp8 S7HEhYAMqra5bjM1KuLjgE5+KRnWV0ENJFSdOXm+9koBwzi25XzxTsPrktlwbu6qwwne Kfxg== X-Gm-Message-State: AOJu0YxvN4h3UL3CYyls0BVh7+45JAEar75lEEbb7/eqVegdP9ASXt9x OMvdYnJVAR8rzJ9dnsWRowp0QivenHf41/14LcMsHNWDPfqnxfoHNG5qqn0aRzZY7l8JOygNtcA lvoo= X-Gm-Gg: ASbGnctxaXLsEcQeCh/0kq3B72HrkIfE/jrEGrfm9y7mrtNpT2gN/N3y88WcC630eMn XIGT3XJUDGMYfEj+nvgximxNan1btlcZ54pFBMSLy/yHW88ADnrbAJ6WGxRgAaXSEB5Woaqgo9/ GnhEcx0zK1+BSTzJRBpnwp88zHXfxNvpZMhfL1OVQ3psiq+bKxj3RvvHTzhBEcnaSD/gZIkrP2I lK+ch9opTelTbGkrH67xBTWzBiv5Ir+v6RLxpuyMpHLCymqN9BOzbDQrQDF4JlKbcdhd5t8dUQ7 +80HU0bn1e5wHSxXF5/3dmwgODqbqN6l4AjBqWSNUZ4yjswHkT5i/cSNaOCoSO5+DY/u+LJsWec eAA0hA7hCI+HgvDuC2otCSyelYBE4RypOk15Gqzp1lEYdVIxy1oKTSTz6HTUYFEXky5qMnL9/Gv 8owTawkSWRXcxHxJErRGB2176f9kz/vcV8COEaZpFYVnolU5w+ X-Google-Smtp-Source: AGHT+IE0gJS4mdNsMB5FpTSio9UH8YhjsTF78CKGRQteamlDw5h6fK4QUdw6Gf0WMWqUp6SuXTwuZg== X-Received: by 2002:a05:6000:3109:b0:3e6:116a:8fe1 with SMTP id ffacd0b85a97d-3e765a16066mr10004832f8f.61.1757941326855; Mon, 15 Sep 2025 06:02:06 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.06 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:06 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 20/27] ada: Add Assertion_Policy checks for assertion levels Date: Mon, 15 Sep 2025 15:01:26 +0200 Message-ID: <20250915130135.2720894-20-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus Implement SPARK RM 6.9(19) check: An Assertion_Policy pragma specifying an Assertion_Level policy shall not occur within a ghost subprogram or package associated to an assertion level which depends on this level. gcc/ada/ChangeLog: * sem_prag.adb (Analyze_Pragma): Add ghost level check to Assertion_Policy. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 9175490eca27..172dc3d6f3ec 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14845,6 +14845,22 @@ package body Sem_Prag is ("invalid assertion kind for pragma%", Arg); end if; + + -- An Assertion_Policy pragma specifying an + -- Assertion_Level policy shall not occur within a ghost + -- subprogram or package associated to an assertion level + -- which depends on this level (SPARK RM 6.9(19)). + + if Ghost_Config.Ghost_Mode > None + and then Is_Same_Or_Depends_On_Level + (Ghost_Config.Ghost_Mode_Assertion_Level, + Level) + then + Error_Msg_Name_2 := Chars (Level); + Error_Pragma + ("pragma % cannot appear within ghost subprogram or " + & "package that depends on %"); + end if; end if; Check_Arg_Is_One_Of (Arg, Policy_Names); From patchwork Mon Sep 15 13:01:27 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120279 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 458833857B8F for ; Mon, 15 Sep 2025 13:34:04 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 458833857B8F Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=KrZ0hLBl X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 02A493857439 for ; Mon, 15 Sep 2025 13:02:09 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 02A493857439 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 02A493857439 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42f ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941330; cv=none; b=CvXvCeZ2roUO6n6mxlIFDIu47JifF4Vijeg/9tjBpyUvkEit2xYqI+rN4rddJFq7J02+rZenPh21SvLtFiN6Am4MQIosvLSNRf9JXX2IDgFQXlBYgUGPizBeLus6ETY3xBarVBjKPST03fRm3dJ1rBQdN3t8epAUPKgYHfEeBys= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941330; c=relaxed/simple; bh=rZ/DOB5HkVCOREXJVOdZfP6hWxNbfTw/p4LhxAAnqRY=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=bavi/LMyM6smR776vEMvkmREbU8xHO2NlBYU7GSAl/rkrqfLjFkK4O0VTNgDjW9Kdzeh/nYgel3gv1WlMiafBx1qMMCUtAExoEoFLdL/7OEX6NzwKzfzMkc2EUBfx8L1TQTrqW/wWwBOGtMR9jgWdwo9BkQpT82wOMsOC2/Qhg0= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 02A493857439 Received: by mail-wr1-x42f.google.com with SMTP id ffacd0b85a97d-3c46686d1e6so2958414f8f.3 for ; Mon, 15 Sep 2025 06:02:09 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941328; x=1758546128; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=J9kC5XRRhFSJ5WDVPjkNGZozwOxUyFp7mZ4T3QBjH7U=; b=KrZ0hLBl04ogm1ZrFc9HwuFwK9XNeciH6om6sSaZMoKs1wJQ0q60v7CprxRiSMI6Mg 8o6Q0VCleMdOdCypvHpqEO1iPP5kD9GmyIhYJO5CCwVFtuXL5gtrC9W0A7I6evwJd8Pt z20OnmmNegq5nHhmP+1Y60G1xhIMLPahMZq9S+Gv7SKnIv44aRhTJHgM3H6vgl84AF4k BJwW0idqhMyX8cYqRg2X+XYr3QHoe15Zqp5mqJL7SnIFT1GiEOUx60UXPgdEWkJBFtdM QtO/Rfyj0Ua0yb3BTEj5JFZwZ5ip4PUtqSCvNr86+hvwuGr99n3K6IgS36hiSmQl/9GC UOTA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941328; x=1758546128; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=J9kC5XRRhFSJ5WDVPjkNGZozwOxUyFp7mZ4T3QBjH7U=; b=TP1RSBkC7wnNiBwIfp8W5IDPykb04A4prBWFmtCLl3Y8bXgvyDK4V8FxmnNBQzPKo8 SWSpy5EKzGCrfdyhR2as5L2hD32+lo3OBxuVwZD9bnNQxniiBzyV+L3OYWnR1gN9Kig7 TKmPXPw2qnAoBNGqfy1DxTlJ4aNttThffM5ZBdsQ6/NE18O5nPn1rPqly449/BRUxd4T sPpIrV3IAmMsPIYhjIZQIPwaEiSArRlC7YoM8XRadyXNDCJlAzNbctFpASkSXatjTue+ JrsEyYxdoqRIFPDOBYdeW94aUqvaz7sI+hiBRRej7IdO3WRzS7aNq9DoE/Aly7d+KbKU WgVw== X-Gm-Message-State: AOJu0Yxou9qjWdfW9mhYdh8vzlyCsjnWH/8nBiZmc3NgC8/VujESyrn5 L+qaG5vNps4mSrgv+qSivOCXGCQN7C/45L8qIi6evi6+gLDhkFQCEi1pQr9ou86re1eOAeWY6Td awL0= X-Gm-Gg: ASbGncuE+f0ZYhT00jTjNDBptit/tU3UI8Cw+/Pd7qnVKkddCCXDmtu1iBqMVFgFwW+ n8jQqfwVT/VWV1xOvV8+yyFeRtaY7j9R6vNY0y55TMSsj/jBpThwvCCIgO6drDrQ1gYceyfwzz/ WLreMrRFCYkoJnBtCZ0wetnAVaAtGBaAIZRKTTXGTO8tByfZMJMEFLRIV7eygZJR98qeS7ZK4nE Q9seyRAZ8abq6O/yzzw+pN+IGYOGI6YghEoZSoJ7QRr4RkiWhRlGtn0GA0QII0mcMpLYRNmQfdh cq2v93XjyJ2G+oHNTOBFwrM3VBvq5XvJszsWSm1yXKQQLMLD9j7Z7HyLrdPWba9reW9Zp1GyETM 5Zu934MzUfdDEItyUUjVlf4lhohNc630zebOd3UxGZFAAMU1Gk/sQ+Irmj9mT4MHLf5Rq5QFkxR J1/e/KouElzReFKi3Y4YEjXTOSOqahR92xDuzQcA== X-Google-Smtp-Source: AGHT+IHPXXXid/ahmasNG7PVCWSSj5FZHqSEOGma8wy5xBW1/DUTLViR4GxV968ImlWL/dxMzQm3/Q== X-Received: by 2002:a05:6000:430c:b0:3e9:d34c:17a0 with SMTP id ffacd0b85a97d-3e9d34c1a24mr4200364f8f.34.1757941327666; Mon, 15 Sep 2025 06:02:07 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.07 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:07 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [COMMITTED 21/27] ada: C_Pass_By_Copy convention incorrectly ignored Date: Mon, 15 Sep 2025 15:01:27 +0200 Message-ID: <20250915130135.2720894-21-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Steve Baird In some cases involving a convention-C anonymous access-to-subprogram type with a parameter whose type has a convention of C_Pass_By_Copy, that C_Pass_By_Copy convention is incorrectly ignored. gcc/ada/ChangeLog: * freeze.adb (Freeze_Entity): In the case of an anonymous access-to-subprogram type where Do_Freeze_Profile is True, freeze the designated subprogram type. (Should_Freeze_Type): Do not call Unit_Declaration_Node with a parentless argument. * sem_ch3.adb (Analyze_Object_Declaration): When calling Freeze_Before, override the default value for Do_Freeze_Profile. This is needed in some cases to prevent premature freezing in the case of an object of an anonymous access-to-subprogram type. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/freeze.adb | 26 +++++++++++++++++++++++++- gcc/ada/sem_ch3.adb | 5 ++++- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 9de4fa409c0f..346789ff7573 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6790,6 +6790,27 @@ package body Freeze is Set_Is_Frozen (E); + -- Freeze profile of anonymous access-to-subprogram type + + if Do_Freeze_Profile + and then Ekind (E) = E_Anonymous_Access_Subprogram_Type + then + declare + Skip_Because_In_Generic : constant Boolean := + In_Generic_Scope (E) or else + (Is_Itype (E) + and then Nkind (Parent (Associated_Node_For_Itype (E))) + = N_Generic_Subprogram_Declaration); + begin + if not Skip_Because_In_Generic then + if not Freeze_Profile (Designated_Type (E)) then + goto Leave; + end if; + Freeze_Subprogram (Designated_Type (E)); + end if; + end; + end if; + -- Case of entity being frozen is other than a type if not Is_Type (E) then @@ -11032,7 +11053,10 @@ package body Freeze is E : Entity_Id; N : Node_Id) return Boolean is - Decl : constant Node_Id := Original_Node (Unit_Declaration_Node (E)); + Decl : constant Node_Id := + (if Ekind (E) = E_Subprogram_Type and then No (Parent (E)) + then Empty + else Original_Node (Unit_Declaration_Node (E))); function Is_Dispatching_Call_Or_Tagged_Result_Or_Aggregate (N : Node_Id) return Traverse_Result; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 5978d6779586..293682eef39d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4632,7 +4632,10 @@ package body Sem_Ch3 is Set_Has_Delayed_Freeze (T); elsif not Preanalysis_Active then - Freeze_Before (N, T); + -- Do_Freeze_Profile matters in the case of an object + -- of an anonymous access-to-subprogram type. + + Freeze_Before (N, T, Do_Freeze_Profile => False); end if; end if; From patchwork Mon Sep 15 13:01:28 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120265 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 50C753857B8F for ; Mon, 15 Sep 2025 13:14:04 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 50C753857B8F Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=KFSFG8g+ X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42e.google.com (mail-wr1-x42e.google.com [IPv6:2a00:1450:4864:20::42e]) by sourceware.org (Postfix) with ESMTPS id 1F88D3857B90 for ; Mon, 15 Sep 2025 13:02:10 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1F88D3857B90 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 1F88D3857B90 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42e ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941330; cv=none; b=PTI7qsF8mIapd/DH9Gf3IcMIizu2kA2MjrURmtBNjm2AQ2YtEPRTFGf+3ebhjSrkBS6yN44ZiYOY+h6Jin5bdC/T6HjaNOUugMk97ogR0/jg4YNymyRzb8mLIstU2c1sp+2BPY6bki1+kIZhQb0DKUYpVFwRDxoCbv7iwsFSlTU= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941330; c=relaxed/simple; bh=XigB2e1WDLxXSLwUIiFCvWdDI0gZBrLt1z72tOtq744=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=J8ieCCf9nJSx6Qv3lrZzoAOML/TrXfbfWnRgLrdObbi5xNsXd3H78Vp0psLdjWDgrHBWT38lQqhwEtmgLWOxgiDjLjTP58+jdqhAq4pw/b7GTHIP4GYmzLvUE2veHX+ssPsBuI2dcKb7fFpaDRD1tQtgsv3fXo4kHVuJsI8Hyss= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1F88D3857B90 Received: by mail-wr1-x42e.google.com with SMTP id ffacd0b85a97d-3e8123c07d7so1020598f8f.0 for ; Mon, 15 Sep 2025 06:02:10 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941329; x=1758546129; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=GgDEOCTr3x+GepUGg21qIA7ZwYdjltdf+F/WbQb4BV4=; b=KFSFG8g+JbOXNUGKGSU0RpanE8g4FCpbL+Fv6tSv2KY4eUhifLK9nE5obXjuIAr8qy FRhVOJ5mSpP0qebQQ8iApA8weJVSpc6LINHSyP+8wfBjVws7gpLA8RUlyysNtgqTk/xA RCX1BY2zTNhO5P7h3XKCVKXfzWpZEMlzjXN3nDfQTiN3+xb93Nn3lzRaC80z8MeCXRA1 NY5n/R0teusckcgP0TjfFAasNPL4fYMxpF3WCpIRGsOuEAxJ+v2xzOI12UwFyQ/dnQvk aKHtFq563CTndWIN4785XAwSPl4gGdaPbu+k2dgszbyFjqT4FQHn2FMcW22vYMf6DP65 wrBQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941329; x=1758546129; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=GgDEOCTr3x+GepUGg21qIA7ZwYdjltdf+F/WbQb4BV4=; b=mp6BWeDE4e/jB6pg5HpEdE2zFOPSq4IOddIYR6E8RQVqrUZto9etEu7UJWeV646kc4 OMPobPKmc4+H6DvBzqN2TofqAhrRKR6gu60oEbuBa0fpNrO3oRze0z4WNr6acRynbs+E vKQAaVyTYCYvY6OA/3+NBZUWu9InGDj+AmID7k7Tk2CzYDuTRa7HnchS0g7hBrU8TXKH pVjzyxUmCdmmcMhzdEZlvm/zqXL+hpxzHM/kaHmkCi4NhFZsAozzZdo4w1spcksP3NKr o9OWgxY5MIg5f4tmbV6MKuRwVsYfoNXJx6GmxxDC8rq2gUnBYLgQ25NRx7hpRE27F4Cf SZIA== X-Gm-Message-State: AOJu0Yy5VftVzSmWhaSiKIw7ErEA2VZaPVw6XpRck4WeOub7UJqidt/D sIflptrvcks6VRSY2DjYkTYXeWso2XHP+M4ru4Ih5o8/2ok7XR/tLvw5Fu20+3ik7pl5H2Ar87n D/og= X-Gm-Gg: ASbGncsIeBQTrpG4G1BIdlOdLLKOVlY0PIfpp5UR0E8623EOMcX+0f3mdUfeTBrJgO7 ttR8sMjFNve+NXdlywAsjUocUkX0DP0YMGdbQSJJAyCOyzeOGnJj1IbPGnj5ZmZ5akWQkg33bty QOJmMGMqGI+fYEGLR+yGrsL3wuUMi18CdukybdqbfXJyow7lR8vtPOUYzZoLOP+Ivqdjg9gv13k w4w5l/odgf2TP4OjlZEkuCdLwZRGrTrhl8EHteXmoV2pet+ym2zH9pf9V3OB4Rl8uhOkUUWF/KD xIv/kdq+8TWKMsBLI1AKPM6o6eFTQ1lFT/Ps83v1ST6ej+dt1dqyYOUJfOzImVzZhohpW7Q862v cYWj4h7TCzBt8jSKPwsFfZPSB7IoXggVnDfq0i4yuXyDKxBBRGbOEqkrhg4/sDsi6W3aVRVbBDp gZXKQE/lorsxjklVJ+NEFWNbAfcYAQe59Fkd7q2g== X-Google-Smtp-Source: AGHT+IH1QbPD1zy31QmUOKWvHbV9NmWlwMtL2oOgmyCQADs2bDoQFxi1pxSq9F/brjJwL7w+7C/++Q== X-Received: by 2002:a05:6000:178e:b0:3e7:6424:1b47 with SMTP id ffacd0b85a97d-3e765792eb0mr11959153f8f.6.1757941328530; Mon, 15 Sep 2025 06:02:08 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.07 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:08 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 22/27] ada: Match assertion levels by name Date: Mon, 15 Sep 2025 15:01:28 +0200 Message-ID: <20250915130135.2720894-22-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus Since Assertion_Levels cannot be named after valid assertion names we no longer need the policies to be matched by entity. gcc/ada/ChangeLog: * sem_prag.adb (Get_Applicable_Policy): Match assertion levels by name. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 172dc3d6f3ec..b1fefa8a2972 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -34217,7 +34217,7 @@ package body Sem_Prag is or else P_Nam = Name_Assertion or else (P_Nam = Name_Statement_Assertions and then Is_Statement_Assertion (Nam)) - or else (Present (Level) and then Entity (P_Arg) = Level) + or else (Present (Level) and then P_Nam = Chars (Level)) then return Chars (Get_Pragma_Arg (Last (Assocs))); end if; From patchwork Mon Sep 15 13:01:29 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120271 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A34DA3858C24 for ; Mon, 15 Sep 2025 13:21:48 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A34DA3858C24 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=R+Wv2adI X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 0ECBF385C6F0 for ; Mon, 15 Sep 2025 13:02:12 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 0ECBF385C6F0 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 0ECBF385C6F0 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42f ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941332; cv=none; b=LgrSohx+2S8rwzzWyisw3k+fyz7n9/2WWb4Meyj++RnpMX9r+ifdigVVPAca7KyVtx8tr3mwZ9Ini137Rtm311GvhmvQfqyos8NkbXheE5w2lHsIDTiCWwSil8RrCrepVKudG5Nhy/LCdS7DjvOPAG56KwSaq8UHzjJkBPVEdGg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941332; c=relaxed/simple; bh=nc/LI5JGsTvMjV4gORBl40/HyfRWHoQTfVpu3gx34Zk=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=dNh2hvqKsTUbROFZ7gMAQOaI3OpRyK++/TeHtpbAgWZulOHBwBugapqvaMDbzqlsO8xHtUesNmGi/8vZtE4eFc3EmJDKNPq4p4gygbxNjq5qMvES9As+EqAZI6cwuEuZhE3ZMvaLEpTAOZMmr2OhfTgYrAbt0NokiW03uzAu0Rs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 0ECBF385C6F0 Received: by mail-wr1-x42f.google.com with SMTP id ffacd0b85a97d-3ea7af25f42so748470f8f.0 for ; Mon, 15 Sep 2025 06:02:12 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941331; x=1758546131; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=VP+1Q8V7JKg7UJ4pPqgPU1VfCYK1kgMzKtWamx5pHqc=; b=R+Wv2adIH6WOCzGJTLli98WhJO+lRpJMiHXj+MGB1sy9qY57+1UMx2oDKs77MGzcG2 4b3bVqcNaiuGzBW7qeuhFZbCwIAAzWoNUZhNpimhQZ1c5eHlw+bCqwmVRVMyD3COh4Zb sDuTdIJrt6KfIXLjYXMRP9NJ20oXGlbQLETu5qhZxZVLf4cO+FJlgf8j+O+PDCG7AbAi ws7+MvluqMPeRPAH+9bywC41Cxx7dzr7PopGqdy8X21Frjb0b9i7RPOaJKQexkRFuDIz P3GUyua9DYfaJPCOBQFuslZyVm6oEiMv+pwUn6UJTqS4QBsXtce8Gqu772wY8lavmCoa EmUA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941331; x=1758546131; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=VP+1Q8V7JKg7UJ4pPqgPU1VfCYK1kgMzKtWamx5pHqc=; b=J5sAWnnEEsL8lSj5sJ6GYkKtwOFeHfNyb1RIJk7Qb4ZLMg7RJ74sGceLv3VNP7EPBB VJ0UWZdfZRKCtMXx6ib+CvCwjGMu/oxuxnka2cPrxURHToUOz3m5r/QWuvl94R0IEy27 ++/Y7lHbsq/04vMHp8KbmlRzMSChMNvux031I9tjrwPdsPTtfhnKv8fGVEe0G8Ys5kN7 YtUaEhWYMuVRi0rH3m9awB0k9Wmoa3F4butfpXw5DvAhIksN9c7ywojdYrkq8H1JYwpu GXAwlqp0r23FkNNr0Cc8XG2tLsyQQQtUNNTp/IpxyDnNVJgJCPiNi0CPem0ERmBl9s43 Ib5Q== X-Gm-Message-State: AOJu0YyMt5zDFKeCS+9eK4NuhJE8VogfjSWIoJC26uiiGJDekN8lTA6y ZbXruJO16iQ2XEd0DQCy8qdwG6h5GMqknmqgsop/qaVLm44sp5vmr9OCwxGszMtvP7IC3fJoi/k PQV0= X-Gm-Gg: ASbGncsgr5WUO8kbg1vaYh6c7f8y1yrcvB0kqDfCMR4vhMcSk8lm6qN7+llVanj+pOD IhdmMag9QwoWsEfpH56ODM/T19dAaZC7Xxh3uYZs1Xp7KaaUmmm0ZILwixbjIzG1Nzr5RGG684D 9CclcinVtfJS8E3hWk5SyP5U0yO/x0bcoh16BNaWluyQG1AZ9EwXxgPl8FMNodXA1q/Fe6FDAfk Kw9+YeagUA6pMa/INiGUPwPTm6hSzqkGhRKQc73ZskHE3+Ry0c/24lEKAhc+Y3m/7QglzwvwUz7 AI7P9Vs7k5B/r8p4Lyx3itWzXCF/dv4jEi7K8hwXuSShKoZcdFUc2OcgshrlXZU9X8bJD/WVN/A /zTxlMlyUhtbN2FVEYUTt7sGKQphEMh0/CU7ftFbQe8RMZUGlwQgTeLFc9obct6kzyywcGhMzj3 Aps0fI9E3y/Rv0P1FBHXSw5DG076Ygm8jdsI5cOg== X-Google-Smtp-Source: AGHT+IEyyNzDzp0gIMWE7y4z5OCoWFqYVr2+DZXuUGX+S9Kwq3IX4ruVxnSZ91GvyLUNukLpxfEaDA== X-Received: by 2002:a05:6000:186a:b0:3ea:c893:95cc with SMTP id ffacd0b85a97d-3eac893992amr2934041f8f.28.1757941329283; Mon, 15 Sep 2025 06:02:09 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.08 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:08 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 23/27] ada: Avoid ghost context errors when preanalyzing Loop_Invariant Date: Mon, 15 Sep 2025 15:01:29 +0200 Message-ID: <20250915130135.2720894-23-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus gcc/ada/ChangeLog: * sem_prag.adb (Analyze_Pragma): Disable context checks for the preanalysis of the expression for Loop_Invariant pragmas as the ghost region for the pragma has not been set up yet. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b1fefa8a2972..f75f1f7eb4d1 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14455,9 +14455,15 @@ package body Sem_Prag is -- Perform preanalysis to deal with embedded Loop_Entry -- attributes. + -- + -- But ignore the ghost context checks for now. The expression + -- will be reanalyzed with the correct ghost region once the + -- pragma has been converted to pragma check. + Ghost_Context_Checks_Disabled := True; Preanalyze_And_Resolve_Assert_Expression (Arg_Check, Any_Boolean); + Ghost_Context_Checks_Disabled := False; end if; -- Implement Assert[_And_Cut]/Assume/Loop_Invariant by generating From patchwork Mon Sep 15 13:01:30 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120283 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9F62B3857BA7 for ; Mon, 15 Sep 2025 13:40:57 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9F62B3857BA7 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=V8VjhM7c X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42a.google.com (mail-wr1-x42a.google.com [IPv6:2a00:1450:4864:20::42a]) by sourceware.org (Postfix) with ESMTPS id 16CE8385C6DD for ; Mon, 15 Sep 2025 13:02:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 16CE8385C6DD Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 16CE8385C6DD Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941333; cv=none; b=rVlLPVvjeUTuNStYGIGbMYMlKliJVLeVRRd3KOU9D29dCHYiq63B0cPKfXNQ1F4nb/GbfBA3QgsDFJpa0OBq0LJ65FrJb3mke+YHnSRfe5yxasjRA9MQYMUb//xp2GstJOByWr7g6zj0tRZ+cTgcFpbGR2yWlFB/pfiXqYQ+Tcw= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941333; c=relaxed/simple; bh=F5ReCrqDsVc2Jb2Mw5bF9qhIf3bZB+eHykZqYbsTwW8=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=mR+7nlj6coUulCnY2/YHGw64mdcnmC32DXkI105UZJsTfsOl1blB/ForoDj7bl6R2FwyB/3KCuuBI1PTj4sKeqZrP7fynud59Bvdhbfr86n3iqUO9q7mfQLmSuidqM7Aqf5n1RirfOvYxioqjZyobfjlKllGXWaLvOtk8UE70bc= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 16CE8385C6DD Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-3e9c5faa858so1605857f8f.3 for ; Mon, 15 Sep 2025 06:02:13 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941332; x=1758546132; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=1WqXoY0KGVi2CpnkUHJGlUU9DVC+lvuESWcH5xf72zY=; b=V8VjhM7cmeBVTHN/o0zjhtexxg8ioNjkan9bpGxRtwW2mpmqh1zWjHcwUqoOO8egBc Qy1wypmJRljU8tIOmEgVUh80h0JzrxwQJYghciAl3PuBZ92bUj/FiQ8YACvvUqLLHKRg pg62RggO0TdI8ipcBPfRBALSPc52PUbu8NcjiBzyBNqZH/ULBX8OBrPSXQ4FqliLCgLL /D4BXpdqnyGwPfMb+/bbuvXlOGce517wpoNieR6PGMnDc92PrdkiQEh0J2LAz3kHP6Yc ScuhYXX2ei/pcbEM0YMYTgGTorjy90VSgx4BZNCJ4E03IpEzdGfrqHMwjNhG1GwHUSaL Tc5Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941332; x=1758546132; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=1WqXoY0KGVi2CpnkUHJGlUU9DVC+lvuESWcH5xf72zY=; b=pWLF4et+r8WQhdJJP3/2ogMVpUMPXmwPyPe4NFtFnUyGzoklmIz2udXe0HB5CojKyh +Uhnws2kBNP3g/54+Wqnlsg5QBDZWVxYClrtRMTU5YUFY36QEdKSw2QD1Uy1N9j2CwIO 4vZN2mlBHhZAyvgCKVvTOaIREivcf0af1KX6a14+8/H4T/ln4uxlpAmor5zAAFEyvG2Q CfQ6DKSBadBnPV0tO+M+vJykN+3bInHruu/4sP4WeQZHD6/+4vgIaiHL/r5SXy1GFchH 2ArRxmEru6KfuakyFCgqwzl8HwmoWwU+Ap4mFYabIHQJGI0M3BqtUquWYm3hB+7tZC8X x1Vg== X-Gm-Message-State: AOJu0YyQGV+tRbBvWAiFeed46WLA/isrnzxbIYsa6bmiMwtJkCG/fKcv jKCU/GwLyLtJN8hWMs13kFwrgvI1QdsIOv53rfkuY0L/JIO6JOmwVhJ24KZiO2ubpzRk87RwKKH DSRA= X-Gm-Gg: ASbGncsFnUs9Be5F71BIYxCRwBetDrorkAkIIC9J4uzIPYg6RSeob3dRsh+mvql5BVu yZxUC8kACZyGiA3Pj7GcvrP49jpOlsJviPUGBK8dPUGRcdr2gtVQWoMsT2R9+CQUmr9ZcIFcKV6 3gpAzq0d2GZayYyixvkpe90BWev1HMvhnO1c+HOztnT5r8LZ9NdtcQXzaFJ583uVrrtSKjuHD4O d5AByYfVitBYSayI6JGbS4HIq7OPI0HzPAMYhdO+yk9WSbhh9jwI+5Euj6qB8FvgJjTy7ct+/WG 1WKlMafNt0UPiMNKI4sOtYQcYFxBLz5us9Rg5spWhyVzbtn/wzN9FD2PBVsd7FeBzJuClVe+Tbl u2lPTyXqXsYhfzE8V09yEFXASeZLqgq8KvpZ7X6EEHJ4pan4ZQ8Bwu7sJjJYrNs0Ef82rhnCuHT hNYp+wEqNgCAO0GpiPwG3sBhg3I8stAG+AFRTQDw== X-Google-Smtp-Source: AGHT+IG5U76a5UDuR1shVsOWmJCwKUjBvg5Vs4qBjfrYxzZHYFNUuctLQr6YVXgEeNnYkSsMQTBIRA== X-Received: by 2002:a05:6000:2903:b0:3e7:4271:8c6b with SMTP id ffacd0b85a97d-3e76578f738mr10068128f8f.2.1757941330114; Mon, 15 Sep 2025 06:02:10 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.09 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:09 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Jose Ruiz Subject: [COMMITTED 24/27] ada: Document hardening features not supported by LLVM Date: Mon, 15 Sep 2025 15:01:30 +0200 Message-ID: <20250915130135.2720894-24-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Jose Ruiz gcc/ada/ChangeLog: * doc/gnat_rm/security_hardening_features.rst: clarify that hardening options are not supported by the LLVM back end. * gnat_rm.texi: Regenerate. * gnat_ugn.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/doc/gnat_rm/security_hardening_features.rst | 2 ++ gcc/ada/gnat_rm.texi | 2 ++ gcc/ada/gnat_ugn.texi | 2 +- 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/gcc/ada/doc/gnat_rm/security_hardening_features.rst b/gcc/ada/doc/gnat_rm/security_hardening_features.rst index 015b9ce35331..169d58b43ea1 100644 --- a/gcc/ada/doc/gnat_rm/security_hardening_features.rst +++ b/gcc/ada/doc/gnat_rm/security_hardening_features.rst @@ -10,6 +10,8 @@ are provided by GNAT. The features in this chapter are currently experimental and subject to change. +These features are supported only by the GCC back end, not by LLVM. + .. Register Scrubbing: Register Scrubbing diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index e2ede5ea1b74..5b831377b5e9 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -32729,6 +32729,8 @@ are provided by GNAT. The features in this chapter are currently experimental and subject to change. +These features are supported only by the GCC back end, not by LLVM. + @c Register Scrubbing: @menu diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 5ab6a0520b85..e0c2d2571f61 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -30295,8 +30295,8 @@ to permit their use in free software. @printindex ge -@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @anchor{d2}@w{ } +@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @c %**end of body @bye From patchwork Mon Sep 15 13:01:31 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120276 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4BE453857B9E for ; Mon, 15 Sep 2025 13:28:12 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 4BE453857B9E Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=kgPrz6aT X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x429.google.com (mail-wr1-x429.google.com [IPv6:2a00:1450:4864:20::429]) by sourceware.org (Postfix) with ESMTPS id 7CDEB385C6F7 for ; Mon, 15 Sep 2025 13:02:12 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 7CDEB385C6F7 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 7CDEB385C6F7 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::429 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941332; cv=none; b=qcK8R7dVRbo/RQswD53RXLVTwN5QukHZkmpMc8ZF1DpWpsBv5MpUj6zMWI9o2yOGt1B8dxHbvOe/ep3xOhB4RAfbeAZd0B4FRM2MJbb6ilYVwqmSo60E5+8iAssfQnMIJFPNG9gQQ5Q9LjKPANf47YWLVCtGtejvjV0sFJa5f/o= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941332; c=relaxed/simple; bh=nFFCBeCkdw6wTXcNVG8ClcE0qL0RHWlSeBGqd2d2dyo=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=ZQ+1aRaUKLhMWnQ0M8gzOMtM18IPeMay1b/gJ3Zo4lBmzSyACtKay9leUc8AucX3VMvnbRY38QR3g8PWwaC/i5WvJW2sYZj7746RM0dfoHd+xhiIdKkydLx+MAQ/IxNAvyf6rqrS9LY/LmxVzHVKXNxWmfcrt06dzuO/qa2ZhiM= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7CDEB385C6F7 Received: by mail-wr1-x429.google.com with SMTP id ffacd0b85a97d-3dae49b117bso3234250f8f.1 for ; Mon, 15 Sep 2025 06:02:12 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941331; x=1758546131; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=LKoZWEOTEBOw0J4oEFZNdrScmWM6Vi/gXJmReyOO3Rc=; b=kgPrz6aTCWqwKFLqTBCtkYmVhNwS2TqjMLIT/B2qslqW2KYTK7izllX8mKG9nSwpu6 qs16a1vA075Kpd26VXXWWzwTar2Aeou/InN8qMgLW9gqwuU4qkv7/rxa+wFN2GD/oD1J bdUR1mVLdPg0odLw7nOKFMo6XbNDX6K51iKRsX5+MKhOf0nVxEK10HrUWu4GWZgZqzse mULNzU3a/XfMgbPCYoCzhL6HOVOC6pXK/lF1QmZVuUP12+n4XayqvXPjfFaY4b2d8i8b ZKQRWR1KiLghYOc1MydnIjdzUA6NmqZaHTym7GClwrB/HSC+biV+AlbVaQ0oHEJtqOW4 UQpw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941331; x=1758546131; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=LKoZWEOTEBOw0J4oEFZNdrScmWM6Vi/gXJmReyOO3Rc=; b=XcrV/bns63koR618kKb+ySVqQ23SJ79gCf+0zIRPZnN36a1pG5y73eb39CHMp6YNIM +2MLTovNYSwv7cAxXrAcQtCSIgFZEsr0UFIM3fHNLNEYg/WNP/Y6rP804dtWZrnHtEAy 9NX87q6hbynjfAZjvD12Q3uTeN1Sh6NEhHTyvI9DvLZaGQYx0MHy/02t0oSqqmCraf6g lS67podR+btETmdyhfWK1nfe5c6EE2aPRD1F56svGB59k9gcNGmyP4CErlqbCuQm7Jv4 WSdbU40MRFj7zAR/r5/4QB03IUAvnxxsxAuijrPg8laibyfveL/O9sgviT2lBlh0RMUv +m9Q== X-Gm-Message-State: AOJu0Yy6sk8RObjilEYS6PjiDxJ+Eq2DLKgEIqiLPKXfCmcEosTxOcOv AODtv7zNWPWcpY6XOc3Aa1pqnqeRrcoGx7vcBNuE3anQQk9f/pSIAUFt+ZEYmwP2fA5FN8zrbWn 4+08= X-Gm-Gg: ASbGncuX3zaFcK0u5tcKcO2OsONkQieoWaU8U8cV15Bv/ibB2792WPpa67XAsIkOZgB 4Q96W6eeq7zNM9HmkTIQhLS88dkaDHGixFqqy/ZOHqnQpqG9nA99O6YPhyzn1cnTvbCxxHrCjL8 005j5quAPwbMtpVOX1pcjlQJOnZeqI7J1UqNboODn/3V6hI83/ScOwryhx8PGEkUmdeX/mVPtJ+ nAVD3QnfezCubvwt7R/GiPp9AWKw2F6WAFtcWH3hfLIQQx1xFtCsQnoSN77QJCkMCV3j94smIzO OfEgD8/L5oqGh5mM5Vzmvc0RG5AKSLPScbTZ+KiJF7bht9W+HvXrsRSmqTJ9Yya9e294DY0AdE0 LaFBdCMlWe/7NQRZvitGW6jicJ/0ZSGzgakbBKA4jVJIbkhC4OiMMHVhtebPuL4rfFNtwoyEL+9 tYgrR4og660o7pCj0jaOLJpXoV5kcSdXp0y/C8UQ1qlkb1rgvMQRrFB2qFaVQ= X-Google-Smtp-Source: AGHT+IHVyvFiLtGRjCTy2fQ2n9qKPFzHp3u3CYBb3dnzU7S2oz3JghEmaJZGxihzrL9J/o4un1+haQ== X-Received: by 2002:a5d:5c84:0:b0:3e4:f71e:2d7e with SMTP id ffacd0b85a97d-3e765798576mr10272357f8f.23.1757941330991; Mon, 15 Sep 2025 06:02:10 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.10 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:10 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 25/27] ada: Fix wrong finalization of aliased array of bounded vector Date: Mon, 15 Sep 2025 15:01:31 +0200 Message-ID: <20250915130135.2720894-25-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Eric Botcazou The problem is that Apply_Discriminant_Check introduces an unnecessary temporary for an assignment where both sides have the same constrained subtype but the left-hand side is an aliased component. This comes from an approximation in the implementation introduced long time ago to deal with aliased unconstrained objects in Ada 95, more specifically to still generate a check when both sides have the same unconstrained subtype in this case; it is replaced by an explicit test that the common subtype is constrained. gcc/ada/ChangeLog: * checks.adb (Apply_Discriminant_Check): Remove undocumented test on Is_Aliased_View applied to the left-hand side to skip the check in the case where the subtypes are the same, and replace it with a test that the subtypes are constrained. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/checks.adb | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index a9bebee3e139..c30e5f1bf199 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1585,21 +1585,18 @@ package body Checks is return; end if; - -- Suppress checks if the subtypes are the same. The check must be - -- preserved in an assignment to a formal, because the constraint is - -- given by the actual. + -- Suppress checks if the subtypes are the same and constrained. The + -- check must be preserved in an assignment to a formal, because the + -- constraint is given by the actual. if Nkind (Original_Node (N)) /= N_Allocator + and then (if Do_Access then Designated_Type (Typ) else Typ) = S_Typ + and then Is_Constrained (S_Typ) and then (No (Lhs) or else not Is_Entity_Name (Lhs) or else No (Param_Entity (Lhs))) then - if (Etype (N) = Typ - or else (Do_Access and then Designated_Type (Typ) = S_Typ)) - and then (No (Lhs) or else not Is_Aliased_View (Lhs)) - then - return; - end if; + return; -- We can also eliminate checks on allocators with a subtype mark that -- coincides with the context type. The context type may be a subtype From patchwork Mon Sep 15 13:01:32 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120273 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 62F333858C55 for ; Mon, 15 Sep 2025 13:26:47 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 62F333858C55 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=IpEHgxGU X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42c.google.com (mail-wr1-x42c.google.com [IPv6:2a00:1450:4864:20::42c]) by sourceware.org (Postfix) with ESMTPS id 8333D385C6F5 for ; Mon, 15 Sep 2025 13:02:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 8333D385C6F5 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 8333D385C6F5 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42c ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941333; cv=none; b=LMlexuJ/N2mHMCDkk5ZYV2xyuS+t+vXHJFurAXVQ83fpElULL8l/H1AFWCJ2bH19M/k8yya3vrz1MgWoutWuggsZ5KLERABtyNQ34eFiiJc3bhAlRiJhjeB3M/0XXTyxzrPxrM+jWsrqhElc3kkET/72GHgLQAPV4IZ6U/iG+Q4= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941333; c=relaxed/simple; bh=AjEWQEpvqYT2V651Aa9dGFiD6yMkWsu+hqojSNuInGw=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=cs+YrMw5CTmD94eJuGVSVbfgSsOoN65XxEuMTkDlOEymNC66IjRkcrbHxyKkVJe+3tmqcjRgCIuVU32tJLwCBrZPDiY9Ks4KZUOMCBXYH9PDLN+Clz4Xd2qXO0dKCOMyvp4Np631Sn3h06bmZAAszpDVl3m/vOmX7oVBo6VGzvo= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8333D385C6F5 Received: by mail-wr1-x42c.google.com with SMTP id ffacd0b85a97d-3e8123c07d7so1020638f8f.0 for ; Mon, 15 Sep 2025 06:02:13 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941332; x=1758546132; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=1iPfyD0UOd+MJBXRlrozou7t4NwenulOoHBKmrgzGVI=; b=IpEHgxGUJHla9mDES7PcgdTca2osK98ZvzzK3sGdeTM2wHJuDmnH1bKeD3WcvPEJye 4YNQB9p4nI6/QceSyv7ODGc0qGj4OOrMXQGomd4axCk5+mXar/rw66vRlM65c/JNEnB9 JEyKYRPvpRnrAaJoq1mWXLi6q3vw1K8wc7TsYDMPbVWYdK5Ir47xiBsg75XLnc/+Dr3p NSHOGfnNm449f+9oTESHamVtvmp3E9DIJF4zLz5q1x5FGzGrm4humfP3NjTQIFD6979Q X3QrQHGBlMo/wgTwwFo1xMVlFHVRrcOgBG3ItV6qrRbF5bNBDUH6QvSDSdrrtttL7Nhl tkGA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941332; x=1758546132; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=1iPfyD0UOd+MJBXRlrozou7t4NwenulOoHBKmrgzGVI=; b=vFuqcxejc4xU3HdiJJe2ttKbEjLlWtLDOn3D0SuqxazPcRwkwny7417dC9kpvlaxd3 pJe+g0i284jHwEPF+67QQYcKwF+9zKYc+ruROYJ7JDReLnFixmE2zKl6/sgKH5fl2lKg pmpKYtZ0xodwQKaWaZvv2Em8r13o1xW4kAaBgEuy4YZGnxPG/HehAM3Jsmh8CGDrtMet DnCMl9LpiuTHAgzQephRe5YAWVTke4Q8cgKVkW7b4oHiG+3H6xvQD+QahA4oydxhF1pM 9fxN+cMcJeYrQxB3h5/pS7i6mu0VA0iNhLiWhTBzXTsk0D04PY33tOurhte2AI2NL3Dc N/qg== X-Gm-Message-State: AOJu0Yy2uidnwi943lBQDvIqX60bkX0NvYJ3ukVFxkD3oIzgYV4yVK7q QkS4StqNWvOhya3TBXyT04XTsFy0RqanrfIAhU/IYYkq9TOrOBVu5LcdfJGRdEt53SRaFIiUpkQ Fmz8= X-Gm-Gg: ASbGncstbwtvYWmhuBBgJ9nEp5mQvQaJ973NoCTIJQmXhSEVNEYC+Hgn2m7ACVRscbJ Em+K+tB1/EKgJq92SfOHKEtk8Wf3xU0et5dPifBuhskCodkXxxuhvwZwd9AlPctOhDjBBQhL2oZ 1NJ2lnGHzwW86+7G4bygdamMe5/Rdv3EbjCV7KVMI21HDIpjcGKPohT2KSe/yP/tr7XT18lIagw rC1ibilDVsNAdcz1FU+Pr+zF/Kw+J+XQfmZVnpScGcdHb4uujTj1HL27ATnmJL87vFtsb5vVbtr XPgor0U7gcGIyeWCbNkymE0x5lnuNm0HojyXM91a0uwKjcGxGbVf5+Xb/5HOA9wJyqDKAKVkOpW y3P10s9DVrKxiQf618OAbrquQdVJsVBBZFHrJs3QMtw5xLgEtPEu4fl1B7mPI+SNOFdH8pePX/V UjpFPd+XwPGN775PG6DoxFtI1iou291gWgPdH2BDSRL9kCkgjr X-Google-Smtp-Source: AGHT+IEYKrTM7ALGv0FJr2kv3elFmDa0h9vZexB1Pe7PepRG98lxJhGY/U2A2mu0yq4Hw6MRiEXh4g== X-Received: by 2002:a05:6000:616:b0:3ea:fb3d:c4d1 with SMTP id ffacd0b85a97d-3eafb3dcf71mr2493687f8f.18.1757941331886; Mon, 15 Sep 2025 06:02:11 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.11 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:11 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Gary Dismukes Subject: [COMMITTED 26/27] ada: Remove dependence on secondary stack for type with controlled component Date: Mon, 15 Sep 2025 15:01:32 +0200 Message-ID: <20250915130135.2720894-26-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Gary Dismukes There are cases where GNAT introduces a dependence on the secondary stack in a build-in-place function with a result subtype that is definite, when this dependence could be avoided. In particular this is done for record types that requires finalization due to having a controlled component. At one time such functions required the secondary stack in order to properly handle cases where the function might raise an exception (to avoid improper finalization in the caller), but that is no longer necessary. We remove the dependence of these functions on the SS, along with the BIPalloc formal and the generation of the big if_statement that uses that formal. An additional small change is to revise the condition for determining when to generate SS mark/release within functions. gcc/ada/ChangeLog: * exp_ch6.ads (Make_Build_In_Place_Call_In_Allocator): Simplify comment. * exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Remove obsolete comment about not being able to allocate fixed-size controlled results on the caller side, and replace another obsolete comment with a simpler comment. Call Build_Allocate_Deallocate_Proc when the function doesn't need a BIPalloc formal to ensure that function results with controlled parts allocated on the caller side will be chained for finalization. (Make_Build_In_Place_Call_In_Object_Declaration): Call Needs_BIP_Collection on the function's Entity_Id rather than the function call. (Needs_BIP_Collection): If a BIP function doesn't need a BIPalloc formal then it doesn't need a BIP collection either; return False in that case. (Needs_BIP_Alloc_Form): Remove test of Needs_BIP_Collection. * exp_ch7.adb (Expand_Cleanup_Actions): Move test of Uses_Sec_Stack to be the first conjunct in setting of Needs_Sec_Stack_Mark, and put the other tests in a disjunction subsidiary to that. Improve preceding comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch6.adb | 49 +++++++++++++++------------------------------ gcc/ada/exp_ch6.ads | 6 ++---- gcc/ada/exp_ch7.adb | 20 +++++++++--------- 3 files changed, 28 insertions(+), 47 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 5056b1f990fa..58361e10bd9c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -9093,27 +9093,6 @@ package body Exp_Ch6 is -- tagged, the called function itself must perform the allocation of -- the return object, so we pass parameters indicating that. - -- But that's also the case when the result subtype needs finalization - -- actions because the caller side allocation may result in undesirable - -- finalization. Consider the following example: - -- - -- function Make_Lim_Ctrl return Lim_Ctrl is - -- begin - -- return Result : Lim_Ctrl := raise Program_Error do - -- null; - -- end return; - -- end Make_Lim_Ctrl; - -- - -- Obj : Lim_Ctrl_Ptr := new Lim_Ctrl'(Make_Lim_Ctrl); - -- - -- Even though the size of limited controlled type Lim_Ctrl is known, - -- allocating Obj at the caller side will chain Obj on Lim_Ctrl_Ptr's - -- finalization collection. The subsequent call to Make_Lim_Ctrl will - -- fail during the initialization actions for Result, which means that - -- Result (and Obj by extension) should not be finalized. However Obj - -- will be finalized when access type Lim_Ctrl_Ptr goes out of scope - -- since it is already attached on the its finalization collection. - if Needs_BIP_Alloc_Form (Function_Id) then Temp_Init := Empty; @@ -9278,11 +9257,7 @@ package body Exp_Ch6 is end if; end; - -- When the function has a controlling result, an allocation-form - -- parameter must be passed indicating that the caller is allocating - -- the result object. This is needed because such a function can be - -- called as a dispatching operation and must be treated similarly - -- to functions with unconstrained result subtypes. + -- Add implicit actuals for the BIP formal parameters, if any Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, @@ -9307,6 +9282,14 @@ package body Exp_Ch6 is Add_Access_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, Return_Obj_Actual); + -- If the allocation is done in the caller, create a custom Allocate + -- procedure if need be. + + if not Needs_BIP_Alloc_Form (Function_Id) then + Build_Allocate_Deallocate_Proc + (Declaration_Node (Return_Obj_Access), Mark => Allocator); + end if; + -- Finally, replace the allocator node with a reference to the temp Rewrite (Allocator, New_Occurrence_Of (Return_Obj_Access, Loc)); @@ -9768,7 +9751,7 @@ package body Exp_Ch6 is -- ensure that the heap allocation can properly chain the object -- and later finalize it when the library unit goes out of scope. - if Needs_BIP_Collection (Func_Call) then + if Needs_BIP_Collection (Function_Id) then Build_Finalization_Collection (Typ => Ptr_Typ, For_Lib_Level => True, @@ -10331,6 +10314,12 @@ package body Exp_Ch6 is Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); begin + -- No need for BIP_Collection if allocation is always done in the caller + + if not Needs_BIP_Alloc_Form (Func_Id) then + return False; + end if; + -- A formal for the finalization collection is needed for build-in-place -- functions whose result type needs finalization or is a tagged type. -- Tagged primitive build-in-place functions need such a formal because @@ -10355,12 +10344,6 @@ package body Exp_Ch6 is Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); begin - -- See Make_Build_In_Place_Call_In_Allocator for the rationale - - if Needs_BIP_Collection (Func_Id) then - return True; - end if; - -- A formal giving the allocation method is needed for build-in-place -- functions whose result type is returned on the secondary stack or -- is a tagged type. Tagged primitive build-in-place functions need diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 5919627a4e7e..3867270e71a9 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -301,10 +301,8 @@ package Exp_Ch6 is -- BIP_Alloc_Form parameter (see type BIP_Formal_Kind). function Needs_BIP_Collection (Func_Id : Entity_Id) return Boolean; - -- Ada 2005 (AI-318-02): Return True if the result subtype of function - -- Func_Id might need finalization actions. This includes build-in-place - -- functions with tagged result types, since they can be invoked via - -- dispatching calls, and descendant types may require finalization. + -- Ada 2005 (AI-318-02): Return True if the function needs an implicit + -- BIP_Collection parameter (see type BIP_Formal_Kind). function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean; -- Return True if the function returns an object of a type that has tasks. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 62e9d2cbb73f..d60c6edecdff 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4758,18 +4758,18 @@ package body Exp_Ch7 is -- We mark the secondary stack if it is used in this construct, and -- we're not returning a function result on the secondary stack, except - -- that a build-in-place function that might or might not return on the - -- secondary stack always needs a mark. A run-time test is required in - -- the case where the build-in-place function has a BIP_Alloc extra - -- parameter (see Create_Finalizer). + -- that a build-in-place function that only conditionally returns on + -- the secondary stack will also need a mark. A run-time test for doing + -- the release call is needed in the case where the build-in-place + -- function has a BIP_Alloc_Form parameter (see Create_Finalizer). Needs_Sec_Stack_Mark : constant Boolean := - (Uses_Sec_Stack (Scop) - and then - not Sec_Stack_Needed_For_Return (Scop)) - or else - (Is_Build_In_Place_Function (Scop) - and then Needs_BIP_Alloc_Form (Scop)); + Uses_Sec_Stack (Scop) + and then + (not Sec_Stack_Needed_For_Return (Scop) + or else + (Is_Build_In_Place_Function (Scop) + and then Needs_BIP_Alloc_Form (Scop))); Needs_Custom_Cleanup : constant Boolean := Nkind (N) = N_Block_Statement From patchwork Mon Sep 15 13:01:33 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120280 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id DB54F3857BB9 for ; Mon, 15 Sep 2025 13:34:42 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DB54F3857BB9 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=DARSox1X X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42b.google.com (mail-wr1-x42b.google.com [IPv6:2a00:1450:4864:20::42b]) by sourceware.org (Postfix) with ESMTPS id 3DB873857733 for ; Mon, 15 Sep 2025 13:02:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3DB873857733 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 3DB873857733 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941334; cv=none; b=SyI1h6kUpi1MM0zL7BqS202rhF591B+AkWmbsK7C7ORCx3g6X4SHIbvMOF+lf+7nLXE9UiGJGym4ukcwje5Bp3DhkN3dTh9nIDoJ6xhUOcDouiru6P1x0eDBNOeb/cl80Dq38dQY4KjHAbA71No7F1q9AMAXG/Hc/Ulp6PWPcDM= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941334; c=relaxed/simple; bh=QBU0CMafUtWuAvEB9Z8G5pVECtTg8tBPeAM4RyVg6lc=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=by9J0nUZ6vMnAUcDFmHWu2jUx+PCgmry2WOrBD3RujnilfhRalmbyw0UPDm7tlI87Zd1LlqVaQrw1xHvyPIP4gqxfIAOKK+sk8uafKT4HDRkG0JhOfn0AgVggRd84Z2iaaV65q2aiiVtuWHZbo5STUs2TjGhZvZUozoAIMFoPo8= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3DB873857733 Received: by mail-wr1-x42b.google.com with SMTP id ffacd0b85a97d-3e957ca53d1so1294703f8f.0 for ; Mon, 15 Sep 2025 06:02:14 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941333; x=1758546133; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=4yRdM7LyDd+D4Ji6DHk/zJciloowyUM+pJf0R3WFg7g=; b=DARSox1Xj27+MuRTG+XSjn89rFhLjBCutyaCkRQ9lJtx2AlaFYa4vRCPAYK3/6VJvx szrYUnP26tTXwtcM/jsufVvozSNAU8ULEBbxfAto+6MHlvgmJ5t3eWIN7USF7ohQGAhe gtU0S0U3MxJldj7uIl76w8dPzlbhHeV4l8voaQzUhQ0ae0RhJgsKktrdG8MJk2DRkD97 Xv4ppx1Xo3a9hUru9IpGAD4dG70P0xfWd1z5WsZuq1BT4azaDLVzBr2LnVqDOs7g7H+A foBqOkODw61MKoG0Q/0whmzGcIVJ9k8KMrlBQ3NR5n+tTAYBsrqqnyK4wbE2cPt10K3W 9kOg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941333; x=1758546133; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=4yRdM7LyDd+D4Ji6DHk/zJciloowyUM+pJf0R3WFg7g=; b=dSbYu2TZJpHHap/UV1fXwcryMg6WdphmFMdIC65qdcnfRPCffHr7NUG0aPAdcbi1m9 JGjzEQti0SRqlbkHn32EnvLD0G52ASBm4Ljdbi7DCaMS067t+J7/xFk9e9//zE5/1CXR EVAAT3w2z6yWlofBY2FAZnLDbcJSeiryRmPgqAdHyCdaRu9L8okSYag+QnZysdBCnsup l0L/sc8bztWcZpPYbXHBrPZE5VQqk80n+D9fBczSMdKfjWrocpj5SN92Upt0RhlvfkP5 c1dJVS01XDT4d5miwUpA2ThmwuS0vbA+UiUanyujH6lpqy1HmmTt4kaoh2hjtOt0lAin BQ4g== X-Gm-Message-State: AOJu0Yz1xTiT0HAjcBo21AM5fFaChR1cAemfQgyo2t88El6xpY9hRPy6 n5OxKW5/TUbZvAPRAid266FZ8LIQ2aY6eA/sqPkf8o78gSkfkhhyjbY5Ku/XQGFM6am+La18G25 oq50= X-Gm-Gg: ASbGnctMG6+BhR2CEXX0i8CpAwA++i6kmhv27UOrHblUadtgflGJrSNfBj4ckXC2MvN ZkAoq0e+xy9+km1RxxS39c1nkt6Ju20UyhKcxioRPGOEm+mRSF0PbfEm2TKt7iSVoOcJQvb4MA2 aP2/Cy2N68nEYQNai0x2Thn+bHGoHmjDRORxaKoQWZC7Xqyys6TXCqYTp4h8+LG3j0APNfEzznY jq8kE9hKclrZZOApX56HJKg39e53RFuqFk2B1nLCTG0YiAqAs2pN2kqIJbzswmELqG3eO1gp/pj whZBPknBl2H7+qKG6+h6+rUZm6UvYl4quuuWP7+QUO431wPiQSeErxaQmKyjdAyO/ualz5MCMxf GUuNzDfhOrDeM08PE4cN/+nGslIZXv8fISD9I1WZlAqcoUdO66LZME3IHnca5XJCHJAddez0AA/ 0vnsDCbLk0iXoGLbR4F7jk9CoAf3bV/w2bHW+lCwMxF7MMUG6U X-Google-Smtp-Source: AGHT+IEl0TGG1Nc+mdluA5KyDRiASWwtfJ4WWBWpdVMWpDzaH6WomFc+v++uilUYE7w4esKzx1SZuA== X-Received: by 2002:a05:6000:24c5:b0:3e8:b4cb:c3dc with SMTP id ffacd0b85a97d-3e8b4cbc97dmr6798126f8f.3.1757941332709; Mon, 15 Sep 2025 06:02:12 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.12 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:12 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 27/27] ada: Fix internal error on aspect in complex object declaration Date: Mon, 15 Sep 2025 15:01:33 +0200 Message-ID: <20250915130135.2720894-27-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Eric Botcazou The sufficient conditions are that the aspect be deferred and the object be rewritten as a renaming because of the complex initialization expression. gcc/ada/ChangeLog: * gcc-interface/trans.cc (gnat_to_gnu) : Deal with objects whose elaboration is deferred. (process_freeze_entity): Deal with renamed objects whose elaboration is deferred. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/trans.cc | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index e8baa5ca55cd..ea083f79a084 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -6893,9 +6893,22 @@ gnat_to_gnu (Node_Id gnat_node) && (Is_Array_Type (Etype (gnat_temp)) || Is_Record_Type (Etype (gnat_temp)) || Is_Concurrent_Type (Etype (gnat_temp))))) - gnat_to_gnu_entity (gnat_temp, - gnat_to_gnu (Renamed_Object (gnat_temp)), - true); + { + gnu_expr = gnat_to_gnu (Renamed_Object (gnat_temp)); + + /* The elaboration of object renamings present in the source code + never needs to be deferred. But regular objects may be turned + into renamings during expansion and their elaboration may need + to be deferred, in which case we expect the renamed references + to have been stabilized, so we do not do it again here. */ + if (Present (Freeze_Node (gnat_temp))) + { + gcc_assert (!Comes_From_Source (gnat_node)); + save_gnu_tree (gnat_node, gnu_expr, true); + } + else + gnat_to_gnu_entity (gnat_temp, gnu_expr, true); + } break; case N_Exception_Renaming_Declaration: @@ -9818,10 +9831,15 @@ process_freeze_entity (Node_Id gnat_node) } else { + /* For an object whose elaboration is deferred, the GCC tree of the + declaration, if any, is the initialization expression. */ + const Node_Id gnat_decl = Declaration_Node (gnat_entity); tree gnu_init - = (Nkind (Declaration_Node (gnat_entity)) == N_Object_Declaration - && present_gnu_tree (Declaration_Node (gnat_entity))) - ? get_gnu_tree (Declaration_Node (gnat_entity)) : NULL_TREE; + = (Nkind (gnat_decl) == N_Object_Declaration + || Nkind (gnat_decl) == N_Object_Renaming_Declaration) + && Present (Freeze_Node (gnat_entity)) + && present_gnu_tree (gnat_decl) + ? get_gnu_tree (gnat_decl) : NULL_TREE; gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, true); }