From patchwork Fri Jun 14 07:36:17 2024 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: 1947697 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=c+Pj4H2h; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rhj2ND0z20Pb for ; Fri, 14 Jun 2024 17:37:25 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7035D388265B for ; Fri, 14 Jun 2024 07:37:22 +0000 (GMT) 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 597C83882178 for ; Fri, 14 Jun 2024 07:36:45 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 597C83882178 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 597C83882178 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=1718350607; cv=none; b=DkqJCbyxS9LRgfaI9UdDPHO2n1uFoTlLmZpr9CW3cPBt61agdIHGuzmAT4dG0+kC/gUjaBddciQ6rlLfSZhV9Ya5+mafyBHYUJWbIoDZyUvP89vKsDHtBdccZfvOcumLdcvnyRM2JPa5vpCHCup6uyB3kGu/tzBo3DESE9fB2JQ= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350607; c=relaxed/simple; bh=lB/3M1q4rmrhr07Q8KguyreOEGsukuCDdFVKlKC45bE=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Q435phWkPfqISfDc404xbIUikItoExBod1eKaFdUcpPc01dKHW9S0zkbQjiNo87HYPhxjxKVv083uSzHRZlbAS8IPfEOgCvfdYpRLxEbmdOafok8O2yGvh3ETi8nx0hMU1476D1IoIQdnLwhlm5yxbr1qjJF4CEIzQyhsjaP+9Q= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-35f1a7386d5so1817832f8f.3 for ; Fri, 14 Jun 2024 00:36:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350604; x=1718955404; 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=76YeIQnHCwlZA+9b93fAzZvMT9ji5knjOvH6RTFhTH4=; b=c+Pj4H2hF1v3oJ5QFcYuLyRpMGI3o79crTjSCwybT9OrVHVFaXkU91iB+k4XzgUr2G OjhO7V74ju9WlaS9XAhjQOvG/yPozf3fk/bR4VXRnWSFsb1fsbBOY0jchHwgzhjsbY5y MwJBDJrVkUHZWNOOK2hBFjpblTo721W5/D2QJneqKNGgWLWKZbjGPnCvS1VsspKV9SQ8 +D+OqFDJRWV1Nk5myD7SbTQ8jCEE6aCHQnoCEw2QvXON+mAuEBPyL/7WLjyQ/h4rnaEn +YWouwepegk1b5YexL1jeAowrd0PeQCs9JeDBIAGnfyrSAsY00E0XZdq9BBSJxegWgW0 zItw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350604; x=1718955404; 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=76YeIQnHCwlZA+9b93fAzZvMT9ji5knjOvH6RTFhTH4=; b=fA88Xc6m5s1OXco08m0YcG4yYqDVyZssY8u/ifUVRisnszE1PMdsMFJ0MZ65YNZyAK w8TSxBUUY/0LSCPNO4RJFJUiYw0OpXkfq62uaxJg1Cith/jZmvDeIVJqO9ur3dTzGo9S fvKtK8TYxMfSLslPtmeSmd+xzjbxHXG8owofR82glLKGct6HkqKV/Oh6qclM89Cgkbdu 2h5778IdCLISGM6bIxp3tVKGVKvDvVwb7GPqCNcbxgE743O7aE4Zko3BthYb4zVoXq9k gwSjZtQixcb9dtQ8CFfUatbyu0TduHDxqAVS1ddiTwz9+u9mtd7mpf0XN/tOyqEPbsq/ HBKQ== X-Gm-Message-State: AOJu0YyrIGUynmP4C0XY9/tHr7BBed8QyGOh3FXr6mva78V1G5ZlzHnd KoOXZHOuLPzxLl1mP37dEf5wvjGSPeXfS5xPp+27BvdynTtZV38E1A6KRzhBFkvGomfhf57U24A = X-Google-Smtp-Source: AGHT+IG5tZPGR5BCdj1BV4679Aa+8TjLuAju31LK2tCcLeoZ0ZCeu9qRC0RDW8qylQdQdFg1Y3XbHA== X-Received: by 2002:a05:6000:82:b0:35f:caa:1ebd with SMTP id ffacd0b85a97d-3607a7b0fc0mr1294801f8f.8.1718350604071; Fri, 14 Jun 2024 00:36:44 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.43 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:43 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 01/16] ada: Remove unused name of aspect from Snames Date: Fri, 14 Jun 2024 09:36:17 +0200 Message-ID: <20240614073633.2089692-1-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou gcc/ada/ * snames.ads-tmpl (Name_Storage_Model): Delete. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/snames.ads-tmpl | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 6cc66566907..699b8df5851 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -165,7 +165,6 @@ package Snames is Name_Relaxed_Initialization : constant Name_Id := N + $; Name_Stable_Properties : constant Name_Id := N + $; Name_Static_Predicate : constant Name_Id := N + $; - Name_Storage_Model : constant Name_Id := N + $; Name_Storage_Model_Type : constant Name_Id := N + $; Name_String_Literal : constant Name_Id := N + $; Name_Synchronization : constant Name_Id := N + $; From patchwork Fri Jun 14 07:36:18 2024 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: 1947700 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=Go7vZ/+b; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rjb0VcHz20Pb for ; Fri, 14 Jun 2024 17:38:11 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5E710388266C for ; Fri, 14 Jun 2024 07:38:09 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lj1-x22e.google.com (mail-lj1-x22e.google.com [IPv6:2a00:1450:4864:20::22e]) by sourceware.org (Postfix) with ESMTPS id BB63C388217B for ; Fri, 14 Jun 2024 07:36:46 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org BB63C388217B 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 BB63C388217B Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::22e ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350609; cv=none; b=n1onl0AkkVVCzymrbT62KC5epmrkxRSwx/Ulo6Q03DELNCtilUMsPProMFTGhm4Acy43nRq+FOD/p7mlp5biMPWiy4EwCuBt3a/7BIz8XwqejT1MKqU2JMdU75Ue7TQhxvpnBL+DFriMfzi6D1Mcp1qIsK07gHDiYquQr8xrd2Q= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350609; c=relaxed/simple; bh=UEIO73BlhM8Xc/RUkK3znZcDKJdjAvERIg4n2K4P1Kg=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=fbad3fKjA7rFgu01Nj/4s4JJdj9pAysR2r30brRhGiP5r4wZqL4kClYSKy7M5c9hI7lIMIb+QED5MBXNPbP6jJ23CK36RBXOLRkW4+wUVhckM4dldJ50j9TDkrCiOxKM/gLT++rpJSAQUs5Ts9BjDNWQonK+o0Q6S5dG7xxw92E= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lj1-x22e.google.com with SMTP id 38308e7fff4ca-2e72224c395so17263621fa.3 for ; Fri, 14 Jun 2024 00:36:46 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350605; x=1718955405; 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=jXIS4x2K0Fb4ckw9TOPt7EJg+Hj3j8xU75fAHr7uKlw=; b=Go7vZ/+bMGbCvQfLRCBBchUqwPvd40Yop5NRvmAe4sCSc9XQf6Igk8sDoB/ccs4p9c YSkoMdEYsTGcJuQFXVnLFEe6/tAcI4mUixJKW2046ChNfHPJysuFU5b7vfdIpVl7qBgk g7C1gZEqRqQSt3pE88ajFzviKekA0M4VbbwkJc/joV6OVVvdLa8KsdkSihgLGz9hGcfJ b81kVntma6PeOPVk7elyOTwYcrcsFN9OkmAdIgMd9P+TWJ9cRYICRpVlgjPh2/hRS4b4 fvhodEAtW8NFMAJYgidLd5N2e9uVGnfUy8a0Hu7vZduj/Z4jZ2UGmg94QrCiGvV+8cnk LGbA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350605; x=1718955405; 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=jXIS4x2K0Fb4ckw9TOPt7EJg+Hj3j8xU75fAHr7uKlw=; b=BoHsaDOM4qDNrqtjxy9k/TJrx5jvX40aV74NMcIno6XRsWn3LinYQE1UzkIJqgzT6l Ot/3Mkx11bagE5FvPDKalma1aN8KNgXAVZ0m1SluFNa0LdvNyhwI8cscRcMJR29nTfPQ vMjTwAj13OMl2dN5ircaN5f0F9kBfDn1krU23ZDWEb1ggiWUWCgpW8yvYqZSIszg84Sz 5zKnYG+wsdl6dP9uS4V0GB61orv08+PGEBFhhCKZrOimCydpc0VAsNqpArGv4m3QW6Um yT9GOoYllEH8OR10Ae5f0iwx5HCx0J9zWT+q54aOuJAaTZo/c7Lhl3uGFUb3OZt4jHY2 8lHg== X-Gm-Message-State: AOJu0YwtCqyKXovknIjV3AIMe9kQHBTxiNhc2aOC+16etvqd9cYwiGOQ 33wmDKwvVo1PQPvgLIxPvMAE/UYVaaprlhpMhAye1msbH+rTIMN1P+ZE2gRgXD8+bd1k83x4lug = X-Google-Smtp-Source: AGHT+IEBLT4SNhTEHi3q6ja07UDiC+5xHnqKPP/I2lfbNlz/YIkgGlux9DplKNBkpbr/936HHAm9YQ== X-Received: by 2002:a2e:94cc:0:b0:2eb:e471:dc39 with SMTP id 38308e7fff4ca-2ec0e5b5efamr12982161fa.10.1718350605089; Fri, 14 Jun 2024 00:36:45 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.44 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:44 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [COMMITTED 02/16] ada: Allow implicit dereferenced for uses of 'Super Date: Fri, 14 Jun 2024 09:36:18 +0200 Message-ID: <20240614073633.2089692-2-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Justin Squirek This patch modifies the experimental 'Super attribute to allow an access-valued prefix to be equivalent to Prefix.all'Super. gcc/ada/ * sem_attr.adb: (Analyze_Attribute): Add check for dereference. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.adb | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 22fbca45ac5..2563a92f2f0 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6688,6 +6688,7 @@ package body Sem_Attr is Error_Msg_GNAT_Extension ("attribute %", Sloc (N)); Check_E0; + Check_Dereference; -- Verify that we are looking at a type with ancestors From patchwork Fri Jun 14 07:36:19 2024 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: 1947699 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=Dy029IR+; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rhp3FC5z20XL for ; Fri, 14 Jun 2024 17:37:30 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9B0B83882677 for ; Fri, 14 Jun 2024 07:37:28 +0000 (GMT) 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 6D4B73882167 for ; Fri, 14 Jun 2024 07:36:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 6D4B73882167 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 6D4B73882167 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=1718350612; cv=none; b=pI4QlSGeZe9+ouCQbarkO+s6MEx5d3HwS8cHYyiF8RsAJjAn5GoQB/NshE2MMl088dmRoEZqt2QFhHCQGF9ukdZrh2ugMEkpwgUaRKPvApdQ0zLbgi3RsZaDQ4rm5c/KFQL0QTG8dE3toFzihvloHCiC15ZP2o9f+JIUtWa2iog= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350612; c=relaxed/simple; bh=5dyt4jlTSlQ2rJBqfQDZcZTHSyi253A0acwKrraLBrQ=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=dDIrJaj/mGgAkjzRvJF5s/03QtDWCFFCyIeGvHb8S/nQ9JF5mTZxvfl93ujfqMc/ghjd1ZL+XCu2OV358vGoH6QaZnCjj0NQ8SBv5dDbWYaeFlno8AipEjVNreA4b2DlMme193ImkF2CNUOuVx8bM4gUaUUHHd0R0yiEKPrg1yg= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x435.google.com with SMTP id ffacd0b85a97d-35f090093d8so1540849f8f.0 for ; Fri, 14 Jun 2024 00:36:47 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350606; x=1718955406; 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=XfbvuKzvkYx+t1hV56kNKA9tL+3oGIVjutHk0qW/EtY=; b=Dy029IR+H2lXaf+W72NCqnc8oWWkhG9HPA5Zgt99YED4dxvPDi9yvpEKbnrCxxY66f AO2x1fShPEAAX2U07++GS6m9ME/A41fRgJZnXYENQPB8hfUEIeC9vONyWwKyo2TKzgFQ dWSRnHuqMHfHeXq+arxo3z3MVa0C32KWbPOkIb04VPHQ29rJu2vC66+bXeANP6v4gQS7 6sAGUfuh/snLDE95RorTh//U3TIJWwZ7hw3g49h1G5KnF0QAknNawB342+SuwRx3d5ps 1q7OAOo9VgVnRUuZGnMeKZ31lhi60PtsrUBi8NIrg46WWjjog3Aabhv3CO7vRiri2rys /mcA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350606; x=1718955406; 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=XfbvuKzvkYx+t1hV56kNKA9tL+3oGIVjutHk0qW/EtY=; b=GWyLP/KrdMxjZ3J5lg6A8TjXQBZOj3arpZuAAwNPO7urSzRw2IVITHAKI4CMKsG6RY /TT5bUDlpfDOVXikUIIMyTlwm3ATkp8XHfNQG62ens9rVyQGWu1QvTYm7Np6wjEF2rVR dbjyIeUq3PQ4RoFv/qBh+6tda+YXyFD5Ib/qqu4DIHMRYvsqhIPfkBhUCqljIx4laAnr 6DwRNUQ0z1gejuQmUvZT8NZaIW9D3Lo9ljXYYTpabJsryzsygs41+yph18eLovGcv8IY Rp1O45WTDOuKYlmAgw8gqiZceqFH+zuwlLt93NtOYroAB1DIL/MaVxs+LAwDAmvkE43k iJow== X-Gm-Message-State: AOJu0YwEfhZFmX5dYe3yxSSnMiFjuDi0ad9ePO0fPhgffrkT9wBHYFFd v5/iAuhaaeet4IjsKBrEj8WeCqS0zx5qsvDq5epfAPhFHLFBv1ylTLx2kaYpmN96D/VfRmJMtWs = X-Google-Smtp-Source: AGHT+IHTwARhlbRp2hDAEN8MuOv0lEBXRjUTF7av6r0JaETa1xc5zONaT3YaJfLD2py6slRpaLeupg== X-Received: by 2002:a05:6000:154b:b0:35f:25aa:1b0e with SMTP id ffacd0b85a97d-3607a77abbemr1739721f8f.44.1718350606130; Fri, 14 Jun 2024 00:36:46 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.45 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:45 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 03/16] ada: Couple of small cleanups in semantic analysis of aspects Date: Fri, 14 Jun 2024 09:36:19 +0200 Message-ID: <20240614073633.2089692-3-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-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, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou The first cleanup is to expose a consistent interface from Sem_Ch13 for the analysis of aspects at various points of the program. The second cleanup is to fix the awkward implementation of the analysis of the specification for the aspects Stable_Properties, Designated_Storage_Model, Storage_Model_Type and Aggregate, which are always delayed, and the incorrect placement of that of the aspect Local_Restrictions, which is never delayed. gcc/ada/ * freeze.adb (Freeze_All): Call Check_Aspects_At_End_Of_Declarations to perform the visibility check for aspects. * sem_ch13.ads (Check_Aspects_At_End_Of_Declarations): Declare. (Check_Aspect_At_Freeze_Point): Move to... (Check_Aspect_At_End_Of_Declarations): Move to... * sem_ch13.adb (Check_Aspect_At_Freeze_Point): ...here. (Check_Aspect_At_End_Of_Declarations): ...here. (Analyze_Aspect_Specifications): Remove peculiar processing for Stable_Properties, Designated_Storage_Model, Storage_Model_Type and Aggregate. Move that of Local_Restrictions around. Reset Aitem at the beginning of the loop for each aspect. (Check_Aspects_At_End_Of_Declarations): New procedure. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/freeze.adb | 17 +-------- gcc/ada/sem_ch13.adb | 87 ++++++++++++++++++++++++++------------------ gcc/ada/sem_ch13.ads | 14 +++---- 3 files changed, 58 insertions(+), 60 deletions(-) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index c4c524f4685..523b026cc21 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2645,22 +2645,7 @@ package body Freeze is -- for a description of how we handle aspect visibility). elsif Has_Delayed_Aspects (E) then - declare - Ritem : Node_Id; - - begin - Ritem := First_Rep_Item (E); - while Present (Ritem) loop - if Nkind (Ritem) = N_Aspect_Specification - and then Entity (Ritem) = E - and then Is_Delayed_Aspect (Ritem) - then - Check_Aspect_At_End_Of_Declarations (Ritem); - end if; - - Next_Rep_Item (Ritem); - end loop; - end; + Check_Aspects_At_End_Of_Declarations (E); end if; -- If an incomplete type is still not frozen, this may be a diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index d065dd8dfda..46a359fd7d6 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -150,6 +150,15 @@ package body Sem_Ch13 is -- is inserted before the freeze node, and the body of the function is -- inserted after the freeze node. + procedure Check_Aspect_At_End_Of_Declarations (ASN : Node_Id); + -- Performs the processing of an aspect at the freeze all point and issues + -- appropriate error messages if the visibility has indeed changed. ASN is + -- the N_Aspect_Specification node for the aspect. + + procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id); + -- Performs the processing of an aspect at the freeze point. ASN is the + -- N_Aspect_Specification node for the aspect. + procedure Check_Pool_Size_Clash (Ent : Entity_Id; SP, SS : Node_Id); -- Called if both Storage_Pool and Storage_Size attribute definition -- clauses (SP and SS) are present for entity Ent. Issue error message. @@ -1669,7 +1678,6 @@ package body Sem_Ch13 is -- Local variables Aspect : Node_Id; - Aitem : Node_Id := Empty; Ent : Node_Id; L : constant List_Id := Aspect_Specifications (N); @@ -1722,7 +1730,12 @@ package body Sem_Ch13 is Loc : constant Source_Ptr := Sloc (Aspect); Nam : constant Name_Id := Chars (Id); A_Id : constant Aspect_Id := Get_Aspect_Id (Nam); + + Aitem : Node_Id := Empty; + -- The associated N_Pragma or N_Attribute_Definition_Clause + Anod : Node_Id; + -- An auxiliary node Delay_Required : Boolean; -- Set False if delay is not required @@ -2949,19 +2962,6 @@ package body Sem_Ch13 is end if; end case; - if Delay_Required - and then (A_Id = Aspect_Stable_Properties - or else A_Id = Aspect_Designated_Storage_Model - or else A_Id = Aspect_Storage_Model_Type - or else A_Id = Aspect_Aggregate) - -- ??? It seems like we should do this for all aspects, not - -- just these, but that causes as-yet-undiagnosed regressions. - - then - Set_Has_Delayed_Aspects (E); - Set_Is_Delayed_Aspect (Aspect); - end if; - -- Check 13.1(9.2/5): A representation aspect of a subtype or type -- shall not be specified (whether by a representation item or an -- aspect_specification) before the type is completely defined @@ -3307,6 +3307,9 @@ package body Sem_Ch13 is -- External_Name, Link_Name + -- Only the legality checks are done during the analysis, thus + -- no delay is required. + when Aspect_External_Name | Aspect_Link_Name => @@ -4126,30 +4129,20 @@ package body Sem_Ch13 is end if; end if; - Aitem := Empty; - when Aspect_Aggregate => -- We will be checking that the aspect is not specified on a -- non-array type in Check_Aspect_At_Freeze_Point Validate_Aspect_Aggregate (Expr); - Record_Rep_Item (E, Aspect); - goto Continue; - - when Aspect_Local_Restrictions => - Validate_Aspect_Local_Restrictions (E, Expr); - Record_Rep_Item (E, Aspect); - goto Continue; when Aspect_Stable_Properties => Validate_Aspect_Stable_Properties (E, Expr, Class_Present => Class_Present (Aspect)); - Record_Rep_Item (E, Aspect); - goto Continue; when Aspect_Designated_Storage_Model => if not All_Extensions_Allowed then Error_Msg_GNAT_Extension ("aspect %", Loc); + goto Continue; elsif not Is_Type (E) or else Ekind (E) /= E_Access_Type @@ -4157,14 +4150,13 @@ package body Sem_Ch13 is Error_Msg_N ("can only be specified for pool-specific access type", Aspect); + goto Continue; end if; - Record_Rep_Item (E, Aspect); - goto Continue; - when Aspect_Storage_Model_Type => if not All_Extensions_Allowed then Error_Msg_GNAT_Extension ("aspect %", Loc); + goto Continue; elsif not Is_Type (E) or else not Is_Immutably_Limited_Type (E) @@ -4172,11 +4164,9 @@ package body Sem_Ch13 is Error_Msg_N ("can only be specified for immutably limited type", Aspect); + goto Continue; end if; - Record_Rep_Item (E, Aspect); - goto Continue; - when Aspect_Integer_Literal | Aspect_Real_Literal | Aspect_String_Literal @@ -4193,16 +4183,13 @@ package body Sem_Ch13 is (No_Implementation_Aspect_Specifications, N); end if; - Aitem := Empty; - -- Case 3b: The aspects listed below don't correspond to -- pragmas/attributes and don't need delayed analysis. -- Implicit_Dereference - -- For Implicit_Dereference, External_Name and Link_Name, only - -- the legality checks are done during the analysis, thus no - -- delay is required. + -- Only the legality checks are done during the analysis, thus + -- no delay is required. when Aspect_Implicit_Dereference => Analyze_Aspect_Implicit_Dereference; @@ -4220,6 +4207,11 @@ package body Sem_Ch13 is Analyze_Aspect_Dimension_System (N, Id, Expr); goto Continue; + when Aspect_Local_Restrictions => + Validate_Aspect_Local_Restrictions (E, Expr); + Record_Rep_Item (E, Aspect); + goto Continue; + -- Case 4: Aspects requiring special handling -- Pre/Post/Test_Case/Contract_Cases/Always_Terminates/ @@ -4806,6 +4798,7 @@ package body Sem_Ch13 is end if; end; end if; + exception when Aspect_Exit => null; end Analyze_One_Aspect; @@ -11157,6 +11150,28 @@ package body Sem_Ch13 is end if; end Check_Aspect_At_End_Of_Declarations; + ------------------------------------------ + -- Check_Aspects_At_End_Of_Declarations -- + ------------------------------------------ + + procedure Check_Aspects_At_End_Of_Declarations (E : Entity_Id) is + ASN : Node_Id; + + begin + ASN := First_Rep_Item (E); + + while Present (ASN) loop + if Nkind (ASN) = N_Aspect_Specification + and then Entity (ASN) = E + and then Is_Delayed_Aspect (ASN) + then + Check_Aspect_At_End_Of_Declarations (ASN); + end if; + + Next_Rep_Item (ASN); + end loop; + end Check_Aspects_At_End_Of_Declarations; + ---------------------------------- -- Check_Aspect_At_Freeze_Point -- ---------------------------------- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 3c48a493c75..2bdca957826 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -312,18 +312,16 @@ package Sem_Ch13 is -- Quite an awkward approach, but this is an awkard requirement procedure Analyze_Aspects_At_Freeze_Point (E : Entity_Id); - -- Analyze all the delayed aspects for entity E at freezing point. This + -- Analyzes all the delayed aspects for entity E at freezing point. This -- includes dealing with inheriting delayed aspects from the parent type - -- in the case where a derived type is frozen. + -- in the case where a derived type is frozen. Callers should check that + -- Has_Delayed_Aspects (E) is True before calling this routine. - procedure Check_Aspect_At_Freeze_Point (ASN : Node_Id); - -- Performs the processing described above at the freeze point, ASN is the - -- N_Aspect_Specification node for the aspect. - - procedure Check_Aspect_At_End_Of_Declarations (ASN : Node_Id); + procedure Check_Aspects_At_End_Of_Declarations (E : Entity_Id); -- Performs the processing described above at the freeze all point, and -- issues appropriate error messages if the visibility has indeed changed. - -- Again, ASN is the N_Aspect_Specification node for the aspect. + -- Callers should check that Has_Delayed_Aspects (E) is True before calling + -- this routine. procedure Inherit_Aspects_At_Freeze_Point (Typ : Entity_Id); -- Given an entity Typ that denotes a derived type or a subtype, this From patchwork Fri Jun 14 07:36:20 2024 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: 1947698 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=SBjRV19u; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rhn5pDjz20Pb for ; Fri, 14 Jun 2024 17:37:29 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 10BBF3882161 for ; Fri, 14 Jun 2024 07:37:28 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lj1-x22b.google.com (mail-lj1-x22b.google.com [IPv6:2a00:1450:4864:20::22b]) by sourceware.org (Postfix) with ESMTPS id BB241388216F for ; Fri, 14 Jun 2024 07:36:48 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org BB241388216F 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 BB241388216F Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::22b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350613; cv=none; b=sD0lXcR2d9y3KczBH0uI1RHKn4pbOIagZpGMxygOg9w0KeAt3gptb/JHccOgG6XFPhWwsY1/UJBJNHYldAI1S4Uv+FiHB/vrNAlZdQ65kWR58JROKQkc17fy+gd/Q5Gq1X0mB4183eCSQKctg+KDoNjU/r032IyDd5IlVcuWcPM= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350613; c=relaxed/simple; bh=03lf+H1H7wXmu5wWJ6bH8g/eIGTwP4o5ZLiUvZPowfE=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=DY7M3f8e6KvEs16ljWXFCvCK2q5qbEQKEPJNBDn9WGUNaFICDfxthm8pzot9ROp7viAeI82qgHQ5cO/Z9LBh5uAeTSVyn7xwVvjU/VA7omqErTl9BzqsEivGEiqavz+LEDZwtJANI/ANkAObEJpG4meZbP14dXP20ZtTrPd0IHc= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lj1-x22b.google.com with SMTP id 38308e7fff4ca-2eadaac1d28so18153001fa.3 for ; Fri, 14 Jun 2024 00:36:48 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350607; x=1718955407; 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=TvaH5sogXhyRWv2Fr2XJZ/cJKBnE9qzmFlQ1mN2DK0M=; b=SBjRV19uY9E+WH12dDA4WoHVSXF2CMZn9uyL0HLtrUauidgjV4Ww7kp4vFP8KWxG56 ltcEWllgny/qFmICx7DIs0hMvsri5/0XPlP/+AW57DzEeXEoyEOoiUFUqCbTI/WpuTHJ EUt6vAvSxKNSpvfnLqrAWpf2hTNi8OnRyTYSZyZNO0Qho+CqNMl2Cmq88jxInlEVJpg6 zqvwyU1BcReTuMZsfnt9UJ+iJgeIWUfMLwt2SJg3hcFQbSzi8nAFzUbDpPIQ8PwyJ+vF mOGa/88lQp+pWsTLqN41l9Zi88j6HffM7yhhMME1OojBdt7E7vN5HN0KyoKrLksgct99 9Jsg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350607; x=1718955407; 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=TvaH5sogXhyRWv2Fr2XJZ/cJKBnE9qzmFlQ1mN2DK0M=; b=j1Y0i8WdvGIQeNlOvEpxpxlQ/T5W5FthE4MiZ2UZZhEv/XRF6WuhTqdVYa7AXWV3dZ Ti82gJcLsokNUdBJ2fHB8Q32tkuZapBYnFuQPxUUvJMBvsdjj/uXZePAwLSk+pC2p+jb gJxhslWQq4sqjhXsDbPH6VCtBrxbzI/Z/FOfRJuMZhuSI++W++Z7NtT5LLY9lmOjHoIP cNklNGuoM0YQd0EXTS6efqVJYxXdFeZT9mC93i6gPJ4QkfMdayrIavOAdpSLdJfqdben BO0EVdneUY9lO1CM0xyYpSkIme5/kR0lob+g1A/A1UjTwKJa/uXRdj7UMKXob0ZuJ4px Sm3g== X-Gm-Message-State: AOJu0YzY7PmsgYYiQCBjCpR1pb6hTFNTVC77KNfGa4hnVRuvAxU2Z949 OaS/PUh2nEZ+rOIiSRsKtjO7LMQT6rpb5sDf5LzO8JzWML9SREZv3C53dwAh6LZH8xk4p3WMAMM = X-Google-Smtp-Source: AGHT+IEO/fNCTdKSwNwYDfR5kQSXTr6mcAWzzCBWu/Swm3oDTnLyp0W2KP+Yeq7YeAPPNBj6UuOtwA== X-Received: by 2002:a2e:99d8:0:b0:2ea:eb96:b952 with SMTP id 38308e7fff4ca-2ec0e46ec08mr13193741fa.22.1718350606946; Fri, 14 Jun 2024 00:36:46 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.46 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:46 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [COMMITTED 04/16] ada: Missing initialization of multidimensional array using sliding Date: Fri, 14 Jun 2024 09:36:20 +0200 Message-ID: <20240614073633.2089692-4-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Javier Miranda When a multidimensional array is initialized with an array aggregate, and inner dimensions of the array are initialized with array subaggregates using sliding, the code generated by the compiler does not initialize the inner dimensions of the array. gcc/ada/ * exp_aggr.adb (Must_Slide): Add missing support for multidimensional arrays. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 54 +++++++++++++++++++++++++++----------------- 1 file changed, 33 insertions(+), 21 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 796b0f1e0de..2686f5b3b82 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -154,8 +154,8 @@ package body Exp_Aggr is -- case the aggregate must slide, and we must introduce an intermediate -- temporary to hold it. -- - -- The same holds in an assignment to one-dimensional array of arrays, - -- when a component may be given with bounds that differ from those of the + -- The same holds in an assignment to multi-dimensional arrays, when + -- components may be given with bounds that differ from those of the -- component type. function Number_Of_Choices (N : Node_Id) return Nat; @@ -9550,32 +9550,44 @@ package body Exp_Aggr is elsif Is_Others_Aggregate (Aggr) then return False; - else - -- Sliding can only occur along the first dimension - -- If any the bounds of non-static sliding is required - -- to force potential range checks. + -- Check if sliding is required + else declare - Bounds1 : constant Range_Nodes := - Get_Index_Bounds (First_Index (Typ)); - Bounds2 : constant Range_Nodes := - Get_Index_Bounds (First_Index (Obj_Type)); + Obj_Index : Node_Id := First_Index (Obj_Type); + Obj_Bounds : Range_Nodes; + Typ_Index : Node_Id := First_Index (Typ); + Typ_Bounds : Range_Nodes; begin - if not Is_OK_Static_Expression (Bounds1.First) or else - not Is_OK_Static_Expression (Bounds2.First) or else - not Is_OK_Static_Expression (Bounds1.Last) or else - not Is_OK_Static_Expression (Bounds2.Last) - then - return True; + while Present (Typ_Index) loop + pragma Assert (Present (Obj_Index)); - else - return Expr_Value (Bounds1.First) /= Expr_Value (Bounds2.First) - or else - Expr_Value (Bounds1.Last) /= Expr_Value (Bounds2.Last); - end if; + Typ_Bounds := Get_Index_Bounds (Typ_Index); + Obj_Bounds := Get_Index_Bounds (Obj_Index); + + if not Is_OK_Static_Expression (Typ_Bounds.First) or else + not Is_OK_Static_Expression (Obj_Bounds.First) or else + not Is_OK_Static_Expression (Typ_Bounds.Last) or else + not Is_OK_Static_Expression (Obj_Bounds.Last) + then + return True; + + elsif Expr_Value (Typ_Bounds.First) + /= Expr_Value (Obj_Bounds.First) + or else Expr_Value (Typ_Bounds.Last) + /= Expr_Value (Obj_Bounds.Last) + then + return True; + end if; + + Next_Index (Typ_Index); + Next_Index (Obj_Index); + end loop; end; end if; + + return False; end Must_Slide; --------------------- From patchwork Fri Jun 14 07:36:21 2024 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: 1947703 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=JaaY7weT; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rkc2JCfz20Pb for ; Fri, 14 Jun 2024 17:39:04 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A1EEF388265B for ; Fri, 14 Jun 2024 07:39:02 +0000 (GMT) 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 F30FB3882168 for ; Fri, 14 Jun 2024 07:36:48 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org F30FB3882168 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 F30FB3882168 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=1718350614; cv=none; b=BljSslIOuJqwvin6L3aaDlK0BgopCN7ghScUnz8Ib6bmn8klSo5lAnvGlRQ1LFk+ynhqlUgJbu+mMLxRADyJEVKfm33tVwAvOSp/JEXO48PEqenQ9Z5QyEA/9MZD16vYNmPqH+8oG3cgn56vE4OXMvb3iKzRBYIgkxjbPbXhnmY= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350614; c=relaxed/simple; bh=G8HtaRi6wmkq1gQbGe7ysJtoqH54hoNbFGG9RUOsnA0=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=uL9iSGIdWlg4odL0APPHjTIAsAuYDjPlz5625veXl0TEoM3XmK+rGdk0Ida7xzyZ7mFAY5UEFWreVr/nxDbG+q/Rfi2Bn181Vy3z3HKXqZeXqgy/6/Ai0WafRJD75q28B3pmw3Mehtp+W4Ol38pEySL6OlKkW81fFCK2yYl9LKA= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x429.google.com with SMTP id ffacd0b85a97d-35f1c490c13so2087519f8f.3 for ; Fri, 14 Jun 2024 00:36:48 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350608; x=1718955408; 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=Jkg8xpMX9flMtyUcWgUenBLUCtAB9VxV46YV7i0kbPo=; b=JaaY7weTdJU+dEwsL/BDig0HPGtuhOdSq8ZFBxN0mXczpRIbCSJOWxk3Q8e9Csu+Lk cfPC6n/E1HqsevJElo7p4zsw3Gh2TT+eOERZGhlXgN6nCYEwMWRt5pgVHp4HFpxPeDCQ SUpbNT3r93CRhWaHC9pocSt9ECTkDcxmW67/wNyQl8smz/JIf5zFDHXShi4zT9/GTM/r 6o3yET087gk8wbpsJaaX2eq4cvQhaBLnO3yiDh56+HozkoOfGbMe/YLa+zeNnTzHkpXI H2DtmOt59/vrQIzg8YWMaY3jjlRtYjmPxUDV0k7ZorqYpjMZp0ukMB8bZcmts5yfWS9f OgOQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350608; x=1718955408; 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=Jkg8xpMX9flMtyUcWgUenBLUCtAB9VxV46YV7i0kbPo=; b=lDKbahdNr3a43GLkblEzt0kgvYfOS9g5cMrz0TrqXHwb/gcE3F+nV7cwlCH2UtocJD WulA5WgcVUbShBjInXC16g5SnP2Y1GZklHe2kvDLWgHg/i4uEPpEZsPXXcuy+FwZ2TM5 Gk/H9AxG8WDfIidF7/zA9/DEFLj8D2dkpsFzBZxMFusUu72Y7prYTdDhujgaLhoQjiq3 nFQ9/0ndbp5hptMOuWRo+F+J2rCy+B8YPKsxWkygTobvt9T5SmAYx3ytPWNE/fn7BGTt yyjbeaJqWrsGD0mRkbf3yKkFZ/x/zxge0+xIbXeDdcTqhrYDRcckthcfWKInNLvRIh1J +2rA== X-Gm-Message-State: AOJu0YzNamCKG5a+w9I9wdf/KTkV5Fnc9IUcXwIbpKyyNpnsSFK9sW62 wyP2l5mvfpFuy5xZim1hHpU+AnEH1gw/JfYo5UFsUWWAAf7R1I4/WCoCzyWN5VLCVXi7/b/e8QU = X-Google-Smtp-Source: AGHT+IE6JnOhiVWHvDn14PHWejStfmw1PFc69ueDty92xJ+qwyg56hSAixJyt5r9PxAaL0dq0hQTTg== X-Received: by 2002:a05:6000:1842:b0:35e:ebe7:de43 with SMTP id ffacd0b85a97d-3607a761571mr1900490f8f.21.1718350607832; Fri, 14 Jun 2024 00:36:47 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.47 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:47 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 05/16] ada: Minor tweaks to processing of Aggregate aspect Date: Fri, 14 Jun 2024 09:36:21 +0200 Message-ID: <20240614073633.2089692-5-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou The main one is to give the error for Aggregate applied to array types from Analyze_Aspects_At_Freeze_Point instead of Check_Aspect_At_Freeze_Point, as for the other aspects. The message is also changed to be more direct. gcc/ada/ * aspects.ads (Operational_Aspect): Alphabetize. * sem_ch13.ads (Analyze_Aspects_At_Freeze_Point): Fix description. * sem_ch13.adb (Analyze_Aspects_At_Freeze_Point) : Give the error for array types here instead of... (Analyze_Aspect_Specifications) : Adjust comment. (Check_Aspect_At_Freeze_Point) : ...here. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.ads | 4 ++-- gcc/ada/sem_ch13.adb | 17 ++++++++--------- gcc/ada/sem_ch13.ads | 9 +++++---- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 3cc62de3411..1acbec87824 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -325,12 +325,12 @@ package Aspects is -- List is currently incomplete ??? Operational_Aspect : constant array (Aspect_Id) of Boolean := - (Aspect_Constant_Indexing => True, + (Aspect_Aggregate => True, + Aspect_Constant_Indexing => True, Aspect_Default_Iterator => True, Aspect_Iterator_Element => True, Aspect_Iterable => True, Aspect_Variable_Indexing => True, - Aspect_Aggregate => True, others => False); -- The following array indicates aspects for which multiple occurrences of diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 46a359fd7d6..caebe2e793e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1367,7 +1367,11 @@ package body Sem_Ch13 is Validate_Storage_Model_Type_Aspect (E, ASN); when Aspect_Aggregate => - null; + if Is_Array_Type (E) then + Error_Msg_N + ("aspect Aggregate may not be applied to array type", + ASN); + end if; when others => null; @@ -1384,7 +1388,7 @@ package body Sem_Ch13 is Next_Rep_Item (ASN); end loop; - -- Make a second pass for a Full_Access_Only entry + -- Make a second pass for a Full_Access_Only entry, see above why ASN := First_Rep_Item (E); while Present (ASN) loop @@ -4130,8 +4134,8 @@ package body Sem_Ch13 is end if; when Aspect_Aggregate => - -- We will be checking that the aspect is not specified on a - -- non-array type in Check_Aspect_At_Freeze_Point + -- We will be checking that the aspect is not specified on + -- an array type in Analyze_Aspects_At_Freeze_Point. Validate_Aspect_Aggregate (Expr); @@ -11378,11 +11382,6 @@ package body Sem_Ch13 is return; when Aspect_Aggregate => - if Is_Array_Type (Entity (ASN)) then - Error_Msg_N - ("aspect& can only be applied to non-array type", - Ident); - end if; Resolve_Aspect_Aggregate (Entity (ASN), Expression (ASN)); return; diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 2bdca957826..aeacda833d1 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -312,10 +312,11 @@ package Sem_Ch13 is -- Quite an awkward approach, but this is an awkard requirement procedure Analyze_Aspects_At_Freeze_Point (E : Entity_Id); - -- Analyzes all the delayed aspects for entity E at freezing point. This - -- includes dealing with inheriting delayed aspects from the parent type - -- in the case where a derived type is frozen. Callers should check that - -- Has_Delayed_Aspects (E) is True before calling this routine. + -- Analyzes all the delayed aspects for entity E at the freeze point. Note + -- that this does not include dealing with inheriting delayed aspects from + -- the parent or base type in the case where a derived type or a subtype is + -- frozen. Callers should check that Has_Delayed_Aspects (E) is True before + -- calling this routine. procedure Check_Aspects_At_End_Of_Declarations (E : Entity_Id); -- Performs the processing described above at the freeze all point, and From patchwork Fri Jun 14 07:36:22 2024 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: 1947701 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=QEl3s4it; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rkS3Hlzz20Pb for ; Fri, 14 Jun 2024 17:38:56 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A958C388211C for ; Fri, 14 Jun 2024 07:38:54 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lj1-x232.google.com (mail-lj1-x232.google.com [IPv6:2a00:1450:4864:20::232]) by sourceware.org (Postfix) with ESMTPS id 4C32E3882169 for ; Fri, 14 Jun 2024 07:36:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4C32E3882169 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 4C32E3882169 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::232 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350614; cv=none; b=GpS3JThVv6yHzM66T70fPBQRRKlnwwzxyn/wedLVt0BC/xSUJ+rpUtHrKGjqAjhCKDoucupMI1l8S1aUGkHn7dHdoe9+DQJ3kjW1gmWZzg00DQiHGnI4YUfWcFkgr32FlfR5pldtYAWXQAohUxl7xrxTDqWAq2ResfQNKFUTP7c= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350614; c=relaxed/simple; bh=FIFkIhXJOJHYRs0Qy23uQMGhRP6neitFs+/x/7ptcdo=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=IGxnLIOFxp6VFoiEqe3vp3XL7Tc6etI8BLiD1VbpS8Uv3flpv1NsbpQunTUFWWCyPBJrEuL+cRz6Prw3G8fKenUGq8zoZf3aoju3thXqq0od1pEqKp2dzIxXK3HjsxyJt1W+S//DsElz14LRi0z3r/Ycc7JbiUwSeyCPmo4Jt/4= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lj1-x232.google.com with SMTP id 38308e7fff4ca-2ec1620a956so4896111fa.1 for ; Fri, 14 Jun 2024 00:36:50 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350609; x=1718955409; 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=op0JBXfkSt/vp/7RGyGPOERRDh4sVLynJBRk3uHrgbY=; b=QEl3s4itww6UwPQmuHTMWAKl59LTDR+9Td3B3fPEsUMx9iG3imAoia806dGZCKAysq /b5C2PIOUUe0u0TRjAT37suj6unbah1Vu07rQBw3rKN8yrav59OhgXUMGSg/1+xTsQjr nxiYQ5/sfUvbeFI7PZjW4Atw02BWFbAhasZcmopngKphNaeu7PSJNo5sLc+ojsltphBn JcqcA4cwsgKH4jCwkktBV2P/lImjDsBPipgnVaUjEgMSFwBNOoEaEfm2MQj23bNE1Ll9 5x/sqETLzgC/o0+/WVNB0ABumaO/2K6un6bBga/F+Cl/7yZ74snRP3ngXPpKsaGIwa/g LYMQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350609; x=1718955409; 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=op0JBXfkSt/vp/7RGyGPOERRDh4sVLynJBRk3uHrgbY=; b=jSLI05rbXxO0WCz8GXP/5NHIRUeaD6pwTzKaoppLfbui5x6vriJ6MDxgIyzyt7fZaz VbL5JaWCCv7u7S5fMYo8E6hCQlq8eiA4dlS3HDtzOOWDGdBQZjfbXF2pmIbvCZDW1mig UwbaIrT5tGO54FZA+CzKH7gQGYRZIWvuDXJ1HkFAquinB00IVU0RATpibaiadYUkROa9 RTWDD1rHTUEIvBBkQfjhkqfpEzPiGPXKA+Kwb6qq4eFkPZ+1mPYNBQ+lQKhDN6XGi4Yh c7vWPoDyCqnB7u57wFnXF208Gm3G/NTITXQ09dtnSpqTOrEed6uzGU0Uh5xdRf9lzv7Q OfKw== X-Gm-Message-State: AOJu0Yz1uuV8pRbZP1RM2tpehGuCUhYE7bMU3PQw5vD0c9393YcBYdI9 58fN2EtOHUtkK6Kiogwm7vGt32w78k89LL2WFLkdCwF7hY61cdn+XtdHdROrMe9PZzi8/Y8HWpo = X-Google-Smtp-Source: AGHT+IHjD+c1zs1aHVssmTtKbwyNKNU9kEM6emUlVmeedFyEaaKcb9adXjL7rKAQqwqvS4uFnOrtTQ== X-Received: by 2002:a2e:6a10:0:b0:2eb:ecba:444a with SMTP id 38308e7fff4ca-2ec0e5d05c8mr11480321fa.23.1718350608658; Fri, 14 Jun 2024 00:36:48 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.47 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:48 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [COMMITTED 06/16] ada: Crash checking accessibility level on private type Date: Fri, 14 Jun 2024 09:36:22 +0200 Message-ID: <20240614073633.2089692-6-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Justin Squirek This patch fixes an issue in the compiler whereby calculating a static accessibility level on a private type with an access discriminant resulted in a compile time crash when No_Dynamic_Accessibility_Checks is enabled. gcc/ada/ * accessibility.adb: (Accessibility_Level): Replace call Get_Full_View with call to Full_View since Get_Full_View only works with incomplete types. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index 47b3a7af10a..da4d1d9ce2e 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -2227,7 +2227,11 @@ package body Accessibility is -- that of the type. elsif Ekind (Def_Ent) = E_Discriminant then - return Scope_Depth (Get_Full_View (Scope (Def_Ent))); + return Scope_Depth + (if Present (Full_View (Scope (Def_Ent))) then + Full_View (Scope (Def_Ent)) + else + Scope (Def_Ent)); end if; end if; From patchwork Fri Jun 14 07:36:23 2024 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: 1947711 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=bF/QkxJ+; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rnn2y62z20X9 for ; Fri, 14 Jun 2024 17:41:49 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 983BD388266D for ; Fri, 14 Jun 2024 07:41:47 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32c.google.com (mail-wm1-x32c.google.com [IPv6:2a00:1450:4864:20::32c]) by sourceware.org (Postfix) with ESMTPS id 8E5423882165 for ; Fri, 14 Jun 2024 07:36:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 8E5423882165 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 8E5423882165 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32c ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350619; cv=none; b=m/dAmQzJtcMLXIm49iXOhy82oeOAeMX+mWo40IdVAlt8qHPRbNj8fzrFaSf3o4kz56GwDMug0f5L/RPh939rYM+9p6lVHhQdV2Hydz3EDXzp7kCsttqfIwvVVjOjX7uigRfv174Hn1fmxqvpI34KXHtyg+tPw0xN+hy7E3Sve4A= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350619; c=relaxed/simple; bh=sDVp8/M8cfkbdY0wpIua2qTvjwBwXMYA2BiSuHs4x5Y=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=QoO3Tj+eQp9PluULHHpIcm4Uka127vt0xDOIirPZUtb1t/csj4aOTY64RdVxKdqJpCB5sDJW7GGZGT0aOinzX0v04/5JhRkelJqYZsXVArkNuHNoRESkGfOZcltJWQqSY50rYZCXOqDS0UVSGp7526e1obbLbVa4NyUd6iu52E8= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32c.google.com with SMTP id 5b1f17b1804b1-421a1b834acso17127415e9.3 for ; Fri, 14 Jun 2024 00:36:52 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350611; x=1718955411; 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=usxZ5hDqt/WPMZCdx/X+NuPMVd935DbNKYzqJY+XB1A=; b=bF/QkxJ+OGpoBqv/joLMgIxaiJwys1IhymSukb2W6Im/5BoBFlJsgD5pIjchbkEQNZ qXAGMq0wsjDOlgM7UNF80i2u/E1nmKoQOt6lZobjPDP6HGTCdxjgkcWqIvp2bp8/l88C fiwn3WHTXS0Tf1uqucDlbuYL0pD7JgnnFadh6i/ZXiNmHMIfKhUr/rQtT+8TdSQ9AZgl 4PbQA34EG9cUiIAiQREr9ESm5gjGdZe7rzKYV9S6XAv5HLjcKphB1gL/CjY0gaeBWSxK IhPJyiT78X8wEcaiJMvE4Z4Eh6+U0OqRAplmAAFC7w7AOY6+dgBDSYR0h6hRhkUh1CpG eJUw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350611; x=1718955411; 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=usxZ5hDqt/WPMZCdx/X+NuPMVd935DbNKYzqJY+XB1A=; b=VcPZ8Ci92fehIPsCtsE968pSBHAzAnaJeWimLHhBVsFrCUvAE/xbns4rJqJHlXZiPN EePheUuoEtdJZ4qDUgjHCBvp8/BIV6D2cBUKnDR3r7g9hiScIlGASC9C6wa7y0WccnVl iHirDwjNjgsvUvOO5lUijOnDSePgJa/n2eBW76QzGMdKUlu0sQFRnT3wFeFyShqLNR+y Ada+cnc4h+DArBnXLamdrEIQL5OfwQ6dm5fMX5JCzeI7CIm5/kTCwbomRPfiFS+DbtZ0 z3ZEPHcRxcBSuNLu68xOmuBohpjlo+slHv50cIeTKg44RXioap92VKCPHyjqJa22Iu37 o2eQ== X-Gm-Message-State: AOJu0YycxH9qUe/hDsPpiNq3/7tsHjNsi9kN/OeT2z2YvOk1c5dSmto1 PRyoOOVsW48pNT5q+biQpfyfkbfdjNMWKsb/V8lUtxj5C4qWNiq9r/wFxUUEvQB5nN+V9DuOb1M = X-Google-Smtp-Source: AGHT+IFpgOaKuWTTbevKeQ08naCJPTWuSNIT3Mx7d69JrNMIo6Lgtbc9Nfo3if2EM971OdRzx4IgbQ== X-Received: by 2002:a7b:ce0e:0:b0:421:8345:7891 with SMTP id 5b1f17b1804b1-42304829481mr21108745e9.16.1718350609971; Fri, 14 Jun 2024 00:36:49 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.48 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:49 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [COMMITTED 07/16] ada: Add prototype for mutably tagged types Date: Fri, 14 Jun 2024 09:36:23 +0200 Message-ID: <20240614073633.2089692-7-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Justin Squirek This patch implements mutably tagged types via the new Size'Class aspect. gcc/ada/ * doc/gnat_rm/gnat_language_extensions.rst: Add documentation for mutably tagged type feature. * aspects.ads: Add registration for 'Size'Class. * einfo.ads: Add documentation for new components Class_Wide_Equivalent_Type and Is_Mutably_Tagged_Type. * exp_aggr.adb (Gen_Assign): Assume associated mutably tagged type when class-wide equivalent type is encountered. (Contains_Mutably_Tagged_Type): New subprogram. (Convert_To_Positional): Assume associated mutably tagged type when class-wide equivalent type is encountered. (Is_Static_Element): Assume associated mutably tagged type when class-wide equivalent type is encountered. (Expand_Array_Aggregate): Assume associated mutably tagged type when class-wide equivalent type is encountered. (Expand_Record_Aggregate): Force mutably tagged records to be expanded into assignments. * exp_ch3.adb (Build_Array_Init_Proc): Assume associated mutably tagged type when class-wide equivalent type is encountered. (Simple_Initialization_OK): Disallow simple initialization for class-wide equivalent types. (Build_Init_Statements): Assume associated mutably tagged type when class-wide equivalent type is encountered. (Expand_Freeze_Array_Type): Ignore building of record init procs for mutably tagged types. (Expand_N_Full_Type_Declaration): Replace mutably tagged type declarations with their associated class-wide equivalent types. (Default_Initialize_Object): Add special handling for mutably tagged types. * exp_ch4.adb (Expand_N_Allocator): Add initialization for mutably tagged types. (Expand_Record_Equality): Generate mutably tagged unchecked conversions. * exp_ch5.adb (Expand_N_Assignment_Statement): Generate a special assignment case for class-wide equivalent types which does tag assignments and ignores certain checks. * exp_ch6.adb (Expand_Call_Helper): Propagate constrained extra formal actuals for mutably tagged types. * exp_ch7.adb (Make_Init_Call): Handle mutably tagged type initialization. * exp_util.adb (Make_CW_Equivalent_Type): Modify to handle mutably tagged objects which contain no initialization expression. (Make_Subtype_From_Expr): Modify call to Make_CW_Equivalent_Type. * exp_util.ads (Make_CW_Equivalent_Type): Move declaration from body to spec. * freeze.adb (Size_Known): No longer return false automatically when a class-wide type is encountered. (Freeze_Entity): Ignore error messages about size not being known for mutably tagged types. * gen_il-fields.ads: Register new fields Class_Wide_Equivalent_Type and Is_Mutably_Tagged_Type. * gen_il-gen-gen_entities.adb: Register new fields Class_Wide_Equivalent_Type and Is_Mutably_Tagged_Type for type entities. * mutably_tagged.adb, mutably_tagged.ads (Corresponding_Mutably_Tagged_Type): New subprogram. (Depends_On_Mutably_Tagged_Ext_Comp): New subprogram. (Get_Corresponding_Mutably_Tagged_Type_If_Present): New subprogram. (Get_Corresponding_Tagged_Type_If_Present): New subprogram. (Is_Mutably_Tagged_Conversion): New subprogram. (Is_Mutably_Tagged_CW_Equivalent_Type): New subprogram. (Make_Mutably_Tagged_Conversion): New subprogram. (Make_CW_Size_Compile_Check): New subprogram. (Make_Mutably_Tagged_CW_Check): New subprogram. * sem_aggr.adb (Resolve_Array_Aggregate): Skip tag checks for class-wide equivalent types. (Resolve_Aggr_Expr): Assume associated mutably tagged type when class-wide equivalent type is encountered. * sem_attr.adb (Analyze_Attribute): Allow 'Tag on mutably tagged types. (Resolve_Attribute): Detect errors for dependence of mutably tagged extension type component. * sem_ch12.adb (Instantiate_Object): Detect errors for dependence of mutably tagged extension type component. * sem_ch13.adb (Analyze_One_Aspect): Propagate 'Size'Class to class-wide type. (Analyze_Attribute_Definition_Clause): Add handling of 'Size'Class by generating class-wide equivalent types and checking for illegal uses. * sem_ch2.adb (Analyze_Identifier): Generate unchecked conversion for class-wide equivalent types. * sem_ch3.adb (Analyze_Component_Declaration): Avoid unconstrained errors on mutably tagged types. (Analyze_Object_Declaration): Rewrite declarations of mutably tagged types to use class-wide equivalent types. (Array_Type_Declaration): Modify arrays of mutably tagged types to use their corresponding class-wide equivalent types. (Derived_Type_Declaration): Add various checks for mutably tagged derived types. * sem_ch4.adb (Analyze_Allocator): Replace reference to mutably tagged type with cooresponding tagged type. (Process_Indexed_Component): Generate unchecked conversion for class-wide equivalent type. (Analyze_One_Call): Generate unchecked conversion for class-wide equivalent types. (Analyze_Selected_Component): Assume reference to class-wide equivalent type is associated mutably tagged type. (Analyze_Type_Conversion): Generate unchecked conversion for class-wide equivalent type. * sem_ch5.adb (Analyze_Assignment): Assume associated mutably tagged type when class-wide equivalent type is encountered. (Analyze_Iterator_Specification): Detect errors for dependence of mutably tagged extension type component. * sem_ch6.adb (Create_Extra_Formals): Add code to generate extra formal for mutably tagged types to signal if they are constrained. * sem_ch8.adb (Analyze_Object_Renaming): Detect error on renaming of mutably tagged extension type component. (Analyze_Renaming_Primitive_Operation): Detect error on renaming of mutably tagged extension type component. * sem_res.adb (Resolve_Actuals): Allow class-wide arguments on class-wide equivalent types. (Valid_Conversion): Assume associated mutably tagged type when class-wide equivalent type is encountered. * sem_util.adb (Is_Fully_Initialized_Type): Flag mutably tagged types as fully initialized. (Needs_Simple_Initalization): Flag class-wide equivalent types as needing initialization. * gnat_rm.texi: Regenerate. * gcc-interface/Make-lang.in: Add entry for mutably_tagged.o. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.ads | 1 + .../doc/gnat_rm/gnat_language_extensions.rst | 38 ++ gcc/ada/einfo.ads | 8 + gcc/ada/exp_aggr.adb | 66 +++- gcc/ada/exp_ch3.adb | 64 +++- gcc/ada/exp_ch4.adb | 51 ++- gcc/ada/exp_ch5.adb | 80 ++++- gcc/ada/exp_ch6.adb | 6 +- gcc/ada/exp_ch7.adb | 3 + gcc/ada/exp_util.adb | 64 ++-- gcc/ada/exp_util.ads | 20 ++ gcc/ada/freeze.adb | 8 +- gcc/ada/gcc-interface/Make-lang.in | 1 + gcc/ada/gen_il-fields.ads | 2 + gcc/ada/gen_il-gen-gen_entities.adb | 2 + gcc/ada/gnat_rm.texi | 106 ++++-- gcc/ada/mutably_tagged.adb | 337 ++++++++++++++++++ gcc/ada/mutably_tagged.ads | 120 +++++++ gcc/ada/sem_aggr.adb | 24 +- gcc/ada/sem_attr.adb | 10 +- gcc/ada/sem_ch12.adb | 5 + gcc/ada/sem_ch13.adb | 74 ++++ gcc/ada/sem_ch2.adb | 7 + gcc/ada/sem_ch3.adb | 122 ++++++- gcc/ada/sem_ch4.adb | 61 +++- gcc/ada/sem_ch5.adb | 36 +- gcc/ada/sem_ch6.adb | 10 +- gcc/ada/sem_ch8.adb | 9 + gcc/ada/sem_res.adb | 17 + gcc/ada/sem_util.adb | 13 + 30 files changed, 1235 insertions(+), 130 deletions(-) create mode 100644 gcc/ada/mutably_tagged.adb create mode 100644 gcc/ada/mutably_tagged.ads diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 1acbec87824..d4aafb1a4f1 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -260,6 +260,7 @@ package Aspects is Aspect_Post => True, Aspect_Read => True, Aspect_Write => True, + Aspect_Size => True, Aspect_Stable_Properties => True, Aspect_Type_Invariant => True, others => False); diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst index c703e1c7e3f..cf1ad60f13c 100644 --- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst +++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst @@ -496,3 +496,41 @@ case statement with composite selector type". Link to the original RFC: https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-pattern-matching.rst + +Mutably Tagged Types with Size'Class Aspect +------------------------------------------- + +The `Size'Class` aspect can be applied to a tagged type to specify a size +constraint for the type and its descendants. When this aspect is specified +on a tagged type, the class-wide type of that type is considered to be a +"mutably tagged" type - meaning that objects of the class-wide type can have +their tag changed by assignment from objects with a different tag. + +When the aspect is applied to a type, the size of each of its descendant types +must not exceed the size specified for the aspect. + +Example: + +.. code-block:: ada + + type Base is tagged null record + with Size'Class => 16 * 8; -- Size in bits (128 bits, or 16 bytes) + + type Derived_Type is new Base with record + Data_Field : Integer; + end record; -- ERROR if Derived_Type exceeds 16 bytes + +Class-wide types with a specified `Size'Class` can be used as the type of +array components, record components, and stand-alone objects. + +.. code-block:: ada + + Inst : Base'Class; + type Array_of_Base is array (Positive range <>) of Base'Class; + +Note: Legality of the `Size'Class` aspect is subject to certain restrictions on +the tagged type, such as being undiscriminated, having no dynamic composite +subcomponents, among others detailed in the RFC. + +Link to the original RFC: +https://github.com/AdaCore/ada-spark-rfcs/blob/topic/rfc-finally/considered/rfc-class-size.md diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 0b0529a39cf..8ee419b3e07 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -633,6 +633,10 @@ package Einfo is -- the corresponding implicitly declared class-wide type. For a -- class-wide type, returns itself. Set to Empty for untagged types. +-- Class_Wide_Equivalent_Type +-- Defined in all type entities. Used to store an internally generated +-- class-wide equivalent type for an associated mutably tagged type. + -- Cloned_Subtype -- Defined in E_Record_Subtype and E_Class_Wide_Subtype entities. -- Each such entity can either have a Discriminant_Constraint, in @@ -2980,6 +2984,10 @@ package Einfo is -- Is_Modular_Integer_Type (synthesized) -- Applies to all entities. True if entity is a modular integer type +-- Is_Mutably_Tagged_Type +-- Defined in all type entities. Used to signify that a given type is a +-- "mutably tagged" class-wide type where 'Size'Class has been specified. + -- Is_Non_Static_Subtype -- Defined in all type and subtype entities. It is set in some (but not -- all) cases in which a subtype is known to be non-static. Before this diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 2686f5b3b82..d564fd4f755 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -43,6 +43,7 @@ with Exp_Tss; use Exp_Tss; with Freeze; use Freeze; with Itypes; use Itypes; with Lib; use Lib; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nmake; use Nmake; with Nlists; use Nlists; @@ -1370,8 +1371,8 @@ package body Exp_Aggr is Expr_Q := Unqualify (Expr); if Present (Etype (N)) and then Etype (N) /= Any_Composite then - Comp_Typ := Component_Type (Etype (N)); - pragma Assert (Comp_Typ = Ctype); -- AI-287 + Comp_Typ := Get_Corresponding_Mutably_Tagged_Type_If_Present + (Component_Type (Etype (N))); elsif Present (Next (First (New_Indexes))) then @@ -4474,7 +4475,8 @@ package body Exp_Aggr is Dims : constant Nat := Number_Dimensions (Typ); Max_Others_Replicate : constant Nat := Max_Aggregate_Size (N); - Static_Components : Boolean := True; + Ctyp : Entity_Id := Component_Type (Typ); + Static_Components : Boolean := True; procedure Check_Static_Components; -- Check whether all components of the aggregate are compile-time known @@ -4908,9 +4910,9 @@ package body Exp_Aggr is end if; end Is_Flat; - ------------------------- - -- Is_Static_Element -- - ------------------------- + ----------------------- + -- Is_Static_Element -- + ----------------------- function Is_Static_Element (N : Node_Id; Dims : Nat) return Boolean is Expr : constant Node_Id := Expression (N); @@ -4935,7 +4937,7 @@ package body Exp_Aggr is -- but only at the innermost level for a multidimensional array. elsif Dims = 1 then - Preanalyze_And_Resolve (Expr, Component_Type (Typ)); + Preanalyze_And_Resolve (Expr, Ctyp); return Compile_Time_Known_Value (Expr); else @@ -4986,6 +4988,10 @@ package body Exp_Aggr is return; end if; + -- Special handling for mutably taggeds + + Ctyp := Get_Corresponding_Mutably_Tagged_Type_If_Present (Ctyp); + Check_Static_Components; -- If the size is known, or all the components are static, try to @@ -5076,9 +5082,10 @@ package body Exp_Aggr is procedure Expand_Array_Aggregate (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Etype (N); - Ctyp : constant Entity_Id := Component_Type (Typ); + Typ : constant Entity_Id := Etype (N); -- Typ is the correct constrained array subtype of the aggregate + + Ctyp : Entity_Id := Component_Type (Typ); -- Ctyp is the corresponding component type. Aggr_Dimension : constant Pos := Number_Dimensions (Typ); @@ -6027,6 +6034,10 @@ package body Exp_Aggr is pragma Assert (not Raises_Constraint_Error (N)); + -- Special handling for mutably taggeds + + Ctyp := Get_Corresponding_Mutably_Tagged_Type_If_Present (Ctyp); + -- STEP 1a -- Check that the index range defined by aggregate bounds is @@ -7931,6 +7942,10 @@ package body Exp_Aggr is -- NOTE: This sets the global Static_Components to False in most, but -- not all, cases when it returns False. + function Contains_Mutably_Tagged_Component + (Typ : Entity_Id) return Boolean; + -- Determine if some component of Typ is mutably tagged + function Has_Per_Object_Constraint (L : List_Id) return Boolean; -- Return True if any element of L has Has_Per_Object_Constraint set. -- L should be the Choices component of an N_Component_Association. @@ -8433,6 +8448,30 @@ package body Exp_Aggr is return True; end Component_OK_For_Backend; + --------------------------------------- + -- Contains_Mutably_Tagged_Component -- + --------------------------------------- + + function Contains_Mutably_Tagged_Component + (Typ : Entity_Id) return Boolean + is + Comp : Entity_Id; + begin + -- Move through Typ's components looking for mutably tagged ones + + Comp := First_Component (Typ); + while Present (Comp) loop + -- When we find one, return True + + if Is_Mutably_Tagged_CW_Equivalent_Type (Etype (Comp)) then + return True; + end if; + + Next_Component (Comp); + end loop; + return False; + end Contains_Mutably_Tagged_Component; + ------------------------------- -- Has_Per_Object_Constraint -- ------------------------------- @@ -8515,7 +8554,8 @@ package body Exp_Aggr is end if; -- If the pragma Aggregate_Individually_Assign is set, always convert to - -- assignments. + -- assignments so that proper tag assignments and conversions can be + -- generated. if Aggregate_Individually_Assign then Convert_To_Assignments (N, Typ); @@ -8554,6 +8594,12 @@ package body Exp_Aggr is Build_Back_End_Aggregate; end if; + -- When we have any components which are mutably tagged types then + -- special processing is required. + + elsif Contains_Mutably_Tagged_Component (Typ) then + Convert_To_Assignments (N, Typ); + -- Gigi doesn't properly handle temporaries of variable size so we -- generate it in the front-end diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f03cda62149..3d8b8023988 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -49,6 +49,7 @@ with Exp_Util; use Exp_Util; with Freeze; use Freeze; with Ghost; use Ghost; with Lib; use Lib; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -631,8 +632,13 @@ package body Exp_Ch3 is --------------------------- procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is - Comp_Type : constant Entity_Id := Component_Type (A_Type); - Comp_Simple_Init : constant Boolean := + -- Obtain the corresponding mutably tagged type's parent subtype to + -- handle default initialization. + + Comp_Type : constant Entity_Id := + Get_Corresponding_Tagged_Type_If_Present (Component_Type (A_Type)); + + Comp_Simple_Init : constant Boolean := Needs_Simple_Initialization (Typ => Comp_Type, Consider_IS => @@ -1367,6 +1373,7 @@ package body Exp_Ch3 is return not (Present (Obj_Id) and then Is_Internal (Obj_Id)) + and then not Is_Mutably_Tagged_CW_Equivalent_Type (Typ) and then Needs_Simple_Initialization (Typ => Typ, @@ -3709,7 +3716,11 @@ package body Exp_Ch3 is (Subtype_Indication (Component_Definition (Decl)), Checks); Id := Defining_Identifier (Decl); - Typ := Etype (Id); + + -- Obtain the corresponding mutably tagged type's parent subtype + -- to handle default initialization. + + Typ := Get_Corresponding_Tagged_Type_If_Present (Etype (Id)); -- Leave any processing of component requiring late initialization -- for the second pass. @@ -4125,7 +4136,11 @@ package body Exp_Ch3 is while Present (Decl) loop Comp_Loc := Sloc (Decl); Id := Defining_Identifier (Decl); - Typ := Etype (Id); + + -- Obtain the corresponding mutably tagged type's parent + -- subtype to handle default initialization. + + Typ := Get_Corresponding_Tagged_Type_If_Present (Etype (Id)); if Initialization_Control.Requires_Late_Init (Decl, Rec_Type) then @@ -5407,7 +5422,12 @@ package body Exp_Ch3 is procedure Expand_Freeze_Array_Type (N : Node_Id) is Typ : constant Entity_Id := Entity (N); Base : constant Entity_Id := Base_Type (Typ); - Comp_Typ : constant Entity_Id := Component_Type (Typ); + + -- Obtain the corresponding mutably tagged type if necessary + + Comp_Typ : constant Entity_Id := + Get_Corresponding_Mutably_Tagged_Type_If_Present + (Component_Type (Typ)); begin if not Is_Bit_Packed_Array (Typ) then @@ -6436,7 +6456,9 @@ package body Exp_Ch3 is -- Do not need init for interfaces on virtual targets since they're -- abstract. - if Tagged_Type_Expansion or else not Is_Interface (Typ) then + if not Is_Mutably_Tagged_CW_Equivalent_Type (Typ) + and then (Tagged_Type_Expansion or else not Is_Interface (Typ)) + then Build_Record_Init_Proc (Typ_Decl, Typ); end if; @@ -6695,6 +6717,29 @@ package body Exp_Ch3 is end; end if; + -- Handle mutably tagged types by replacing their declarations with + -- their class-wide equivalent types. + + declare + Comp : Entity_Id; + begin + if Is_Array_Type (Def_Id) then + Comp := First_Entity (Component_Type (Def_Id)); + else + Comp := First_Entity (Def_Id); + end if; + + while Present (Comp) loop + if Ekind (Etype (Comp)) /= E_Void + and then Is_Mutably_Tagged_Type (Etype (Comp)) + then + Set_Etype + (Comp, Class_Wide_Equivalent_Type (Etype (Comp))); + end if; + Next_Entity (Comp); + end loop; + end; + Par_Id := Etype (B_Id); -- The parent type is private then we need to inherit any TSS operations @@ -7244,7 +7289,12 @@ package body Exp_Ch3 is -- Or else build the fully-fledged initialization if need be - Init_Stmts := Build_Default_Initialization (N, Typ, Def_Id); + if Is_Mutably_Tagged_Type (Typ) then + Init_Stmts := + Build_Default_Initialization (N, Etype (Typ), Def_Id); + else + Init_Stmts := Build_Default_Initialization (N, Typ, Def_Id); + end if; -- Insert the whole initialization sequence into the tree. If the -- object has a delayed freeze, as will be the case when it has diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index bf90b46249a..7349dfc306f 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -47,6 +47,7 @@ with Exp_Util; use Exp_Util; with Freeze; use Freeze; with Inline; use Inline; with Lib; use Lib; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -4888,10 +4889,17 @@ package body Exp_Ch4 is Temp := Make_Temporary (Loc, 'P'); - Init_Stmts := - Build_Default_Initialization (N, Etyp, Temp, - For_CW => Is_Class_Wide_Type (Dtyp), - Target_Ref => Target_Ref); + if Is_Mutably_Tagged_Type (Dtyp) then + Init_Stmts := + Build_Default_Initialization (N, Etype (Etyp), Temp, + For_CW => False, + Target_Ref => Target_Ref); + else + Init_Stmts := + Build_Default_Initialization (N, Etyp, Temp, + For_CW => Is_Class_Wide_Type (Dtyp), + Target_Ref => Target_Ref); + end if; if Present (Init_Stmts) then -- We set the allocator as analyzed so that when we analyze @@ -12743,6 +12751,9 @@ package body Exp_Ch4 is New_Lhs : Node_Id; New_Rhs : Node_Id; Check : Node_Id; + Lhs_Sel : Node_Id; + Rhs_Sel : Node_Id; + C_Typ : Entity_Id := Etype (C); begin if First_Time then @@ -12753,17 +12764,31 @@ package body Exp_Ch4 is New_Rhs := New_Copy_Tree (Rhs); end if; + Lhs_Sel := + Make_Selected_Component (Loc, + Prefix => New_Lhs, + Selector_Name => New_Occurrence_Of (C, Loc)); + Rhs_Sel := + Make_Selected_Component (Loc, + Prefix => New_Rhs, + Selector_Name => New_Occurrence_Of (C, Loc)); + + -- Generate mutably tagged conversions in case we encounter a + -- special class-wide equivalent type. + + if Is_Mutably_Tagged_CW_Equivalent_Type (Etype (C)) then + C_Typ := Corresponding_Mutably_Tagged_Type (Etype (C)); + Make_Mutably_Tagged_Conversion (Lhs_Sel, C_Typ); + Make_Mutably_Tagged_Conversion (Rhs_Sel, C_Typ); + end if; + Check := Expand_Composite_Equality - (Outer_Type => Typ, Nod => Nod, Comp_Type => Etype (C), - Lhs => - Make_Selected_Component (Loc, - Prefix => New_Lhs, - Selector_Name => New_Occurrence_Of (C, Loc)), - Rhs => - Make_Selected_Component (Loc, - Prefix => New_Rhs, - Selector_Name => New_Occurrence_Of (C, Loc))); + (Outer_Type => Typ, + Nod => Nod, + Comp_Type => C_Typ, + Lhs => Lhs_Sel, + Rhs => Rhs_Sel); -- If some (sub)component is an unchecked_union, the whole -- operation will raise program error. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index b97e3bb7eee..35c2628fe25 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -41,6 +41,7 @@ with Exp_Pakd; use Exp_Pakd; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Inline; use Inline; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -2398,8 +2399,14 @@ package body Exp_Ch5 is Lhs : constant Node_Id := Name (N); Loc : constant Source_Ptr := Sloc (N); Rhs : constant Node_Id := Expression (N); - Typ : constant Entity_Id := Underlying_Type (Etype (Lhs)); - Exp : Node_Id; + + -- Obtain the relevant corresponding mutably tagged type if necessary + + Typ : constant Entity_Id := + Get_Corresponding_Mutably_Tagged_Type_If_Present + (Underlying_Type (Etype (Lhs))); + + Exp : Node_Id; begin -- Special case to check right away, if the Componentwise_Assignment @@ -2776,7 +2783,9 @@ package body Exp_Ch5 is Apply_Discriminant_Check (Rhs, Typ, Lhs); end if; - elsif Is_Array_Type (Typ) and then Is_Constrained (Typ) then + elsif Is_Array_Type (Typ) and then + (Is_Constrained (Typ) or else Is_Mutably_Tagged_Conversion (Lhs)) + then Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs)); if not Suppress_Assignment_Checks (N) then @@ -3072,13 +3081,64 @@ package body Exp_Ch5 is Attribute_Name => Name_Address))); end if; - Append_To (L, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_Ne (Loc, - Left_Opnd => Lhs_Tag, - Right_Opnd => Rhs_Tag), - Reason => CE_Tag_Check_Failed)); + -- Handle assignment to a mutably tagged type + + if Is_Mutably_Tagged_Conversion (Lhs) + or else Is_Mutably_Tagged_Type (Typ) + or else Is_Mutably_Tagged_Type (Etype (Lhs)) + then + -- Create a tag check when we have the extra + -- constrained formal and it is true (meaning we + -- are not dealing with a mutably tagged object). + + if Is_Entity_Name (Name (N)) + and then Is_Formal (Entity (Name (N))) + and then Present + (Extra_Constrained (Entity (Name (N)))) + then + Append_To (L, + Make_If_Statement (Loc, + Condition => + New_Occurrence_Of + (Extra_Constrained + (Entity (Name (N))), Loc), + Then_Statements => New_List ( + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => Lhs_Tag, + Right_Opnd => Rhs_Tag), + Reason => CE_Tag_Check_Failed)))); + end if; + + -- Generate a tag assignment before the actual + -- assignment so we dispatch to the proper + -- assign version. + + Append_To (L, + Make_Assignment_Statement (Loc, + Name => + Make_Selected_Component (Loc, + Prefix => Duplicate_Subexpr (Lhs), + Selector_Name => + Make_Identifier (Loc, Name_uTag)), + Expression => + Make_Selected_Component (Loc, + Prefix => Duplicate_Subexpr (Rhs), + Selector_Name => + Make_Identifier (Loc, Name_uTag)))); + + -- Otherwise generate a normal tag check + + else + Append_To (L, + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => Lhs_Tag, + Right_Opnd => Rhs_Tag), + Reason => CE_Tag_Check_Failed)); + end if; end; end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 2e873c9c908..da19c031c3d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4224,8 +4224,10 @@ package body Exp_Ch6 is -- because the object has underlying discriminants with defaults. if Present (Extra_Constrained (Formal)) then - if Is_Private_Type (Etype (Prev)) - and then not Has_Discriminants (Base_Type (Etype (Prev))) + if Is_Mutably_Tagged_Type (Etype (Actual)) + or else (Is_Private_Type (Etype (Prev)) + and then not Has_Discriminants + (Base_Type (Etype (Prev)))) then Add_Extra_Actual (Expr => New_Occurrence_Of (Standard_False, Loc), diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index eacdd17fc4c..e3e9bac2b34 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -8288,6 +8288,9 @@ package body Exp_Ch7 is if Has_Controlled_Component (Utyp) then Proc := TSS (Utyp, Deep_Name_Of (Initialize_Case)); + elsif Is_Mutably_Tagged_Type (Utyp) then + Proc := Find_Prim_Op (Etype (Utyp), Name_Of (Initialize_Case)); + Check_Visibly_Controlled (Initialize_Case, Etype (Typ), Proc, Ref); else Proc := Find_Prim_Op (Utyp, Name_Of (Initialize_Case)); Check_Visibly_Controlled (Initialize_Case, Typ, Proc, Ref); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 58ab557a250..528001ea70a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -181,22 +181,6 @@ package body Exp_Util is -- Determine whether pragma Default_Initial_Condition denoted by Prag has -- an assertion expression that should be verified at run time. - function Make_CW_Equivalent_Type - (T : Entity_Id; - E : Node_Id) return Entity_Id; - -- T is a class-wide type entity, E is the initial expression node that - -- constrains T in case such as: " X: T := E" or "new T'(E)". This function - -- returns the entity of the Equivalent type and inserts on the fly the - -- necessary declaration such as: - -- - -- type anon is record - -- _parent : Root_Type (T); constrained with E discriminants (if any) - -- Extension : String (1 .. expr to match size of E); - -- end record; - -- - -- This record is compatible with any object of the class of T thanks to - -- the first field and has the same size as E thanks to the second. - function Make_Literal_Range (Loc : Source_Ptr; Literal_Typ : Entity_Id) return Node_Id; @@ -10160,13 +10144,13 @@ package body Exp_Util is -- representation of the extension part.) function Make_CW_Equivalent_Type - (T : Entity_Id; - E : Node_Id) return Entity_Id + (T : Entity_Id; + E : Node_Id; + List_Def : out List_Id) return Entity_Id is Loc : constant Source_Ptr := Sloc (E); Root_Typ : constant Entity_Id := Root_Type (T); Root_Utyp : constant Entity_Id := Underlying_Type (Root_Typ); - List_Def : constant List_Id := Empty_List; Comp_List : constant List_Id := New_List; Equiv_Type : Entity_Id; @@ -10177,6 +10161,8 @@ package body Exp_Util is Size_Expr : Node_Id; begin + List_Def := New_List; + -- If the root type is already constrained, there are no discriminants -- in the expression. @@ -10214,7 +10200,10 @@ package body Exp_Util is -- need to convert it first to the class-wide type to force a call to -- the _Size primitive operation. - if Has_Tag_Of_Type (E) then + if No (E) then + Size_Attr := Make_Integer_Literal (Loc, RM_Size (T)); + + elsif Has_Tag_Of_Type (E) then if not Has_Discriminants (Etype (E)) or else Is_Constrained (Etype (E)) then @@ -10237,7 +10226,7 @@ package body Exp_Util is Attribute_Name => Name_Size); end if; - if not Is_Interface (Root_Typ) then + if not Is_Interface (Root_Typ) and then Present (E) then -- subtype rg__xx is -- Storage_Offset range 1 .. (Exp'size - Typ'object_size) @@ -10317,11 +10306,15 @@ package body Exp_Util is Set_Is_Class_Wide_Equivalent_Type (Equiv_Type); - -- A class-wide equivalent type does not require initialization + -- A class-wide equivalent type does not require initialization unless + -- no expression is present - in which case initialization gets + -- generated as part of the mutably tagged type machinery. - Set_Suppress_Initialization (Equiv_Type); + if Present (E) then + Set_Suppress_Initialization (Equiv_Type); + end if; - if not Is_Interface (Root_Typ) then + if not Is_Interface (Root_Typ) and Present (E) then Append_To (Comp_List, Make_Component_Declaration (Loc, Defining_Identifier => @@ -10346,6 +10339,8 @@ package body Exp_Util is Aliased_Present => False, Subtype_Indication => New_Occurrence_Of (RTE (RE_Tag), Loc)))); + + Set_Is_Tag (Defining_Identifier (Last (Comp_List))); end if; Append_To (Comp_List, @@ -10366,17 +10361,6 @@ package body Exp_Util is Component_Items => Comp_List, Variant_Part => Empty)))); - -- Suppress all checks during the analysis of the expanded code to avoid - -- the generation of spurious warnings under ZFP run-time. - - Insert_Actions (E, List_Def, Suppress => All_Checks); - - -- In the case of an interface type mark the tag for First_Tag_Component - - if Is_Interface (Root_Typ) then - Set_Is_Tag (First_Entity (Equiv_Type)); - end if; - return Equiv_Type; end Make_CW_Equivalent_Type; @@ -10765,6 +10749,7 @@ package body Exp_Util is declare CW_Subtype : constant Entity_Id := New_Class_Wide_Subtype (Unc_Typ, E); + Equiv_Def : List_Id; begin -- A class-wide equivalent type is not needed on VM targets @@ -10788,7 +10773,14 @@ package body Exp_Util is end if; Set_Equivalent_Type - (CW_Subtype, Make_CW_Equivalent_Type (Unc_Typ, E)); + (CW_Subtype, Make_CW_Equivalent_Type (Unc_Typ, E, Equiv_Def)); + + -- Suppress all checks during the analysis of the expanded + -- code to avoid the generation of spurious warnings under + -- ZFP run-time. + + Insert_Actions + (E, Equiv_Def, Suppress => All_Checks); end if; Set_Cloned_Subtype (CW_Subtype, Base_Type (Unc_Typ)); diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 8d64b11d750..16d8e14976c 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -885,6 +885,26 @@ package Exp_Util is -- list. If Warn is True, a warning will be output at the start of N -- indicating the deletion of the code. + function Make_CW_Equivalent_Type + (T : Entity_Id; + E : Node_Id; + List_Def : out List_Id) return Entity_Id; + -- T is a class-wide type entity, and E is the initial expression node that + -- constrains T in cases such as: " X: T := E" or "new T'(E)". When there + -- is no E present then it is assumed that T is an unconstrained mutably + -- tagged class-wide type. + -- + -- This function returns the entity of the Equivalent type and inserts + -- on the fly the necessary declaration into List_Def such as: + -- + -- type anon is record + -- _parent : Root_Type (T); constrained with E discriminants (if any) + -- Extension : String (1 .. expr to match size of E); + -- end record; + -- + -- This record is compatible with any object of the class of T thanks to + -- the first field and has the same size as E thanks to the second. + function Make_Invariant_Call (Expr : Node_Id) return Node_Id; -- Generate a call to the Invariant_Procedure associated with the type of -- expression Expr. Expr is passed as an actual parameter in the call. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 523b026cc21..5dbf7198cb4 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1012,15 +1012,10 @@ package body Freeze is elsif Is_Record_Type (T) then - -- A class-wide type is never considered to have a known size - - if Is_Class_Wide_Type (T) then - return False; - -- A subtype of a variant record must not have non-static -- discriminated components. - elsif T /= Base_Type (T) + if T /= Base_Type (T) and then not Static_Discriminated_Components (T) then return False; @@ -7819,6 +7814,7 @@ package body Freeze is if (Has_Size_Clause (E) or else Has_Object_Size_Clause (E)) and then not Size_Known_At_Compile_Time (E) + and then not Is_Mutably_Tagged_Type (E) then -- Suppress this message if errors posted on E, even if we are -- in all errors mode, since this is often a junk message diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 3cbbf5042f1..ebf1f70de78 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -376,6 +376,7 @@ GNAT_ADA_OBJS = \ ada/namet.o \ ada/nlists.o \ ada/nmake.o \ + ada/mutably_tagged.o \ ada/opt.o \ ada/osint-c.o \ ada/osint.o \ diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 54a5703d1a5..5aa246d1fb6 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -460,6 +460,7 @@ package Gen_IL.Fields is Class_Postconditions, Class_Preconditions, Class_Preconditions_Subprogram, + Class_Wide_Equivalent_Type, Class_Wide_Type, Cloned_Subtype, Component_Alignment, @@ -744,6 +745,7 @@ package Gen_IL.Fields is Is_Local_Anonymous_Access, Is_Loop_Parameter, Is_Machine_Code_Subprogram, + Is_Mutably_Tagged_Type, Is_Non_Static_Subtype, Is_Null_Init_Proc, Is_Obsolescent, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index f5b1b434e42..c3595bb3dd6 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -459,6 +459,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Associated_Node_For_Itype, Node_Id), Sm (Can_Use_Internal_Rep, Flag, Base_Type_Only, Pre => "Ekind (Base_Type (N)) in Access_Subprogram_Kind"), + Sm (Class_Wide_Equivalent_Type, Node_Id), Sm (Class_Wide_Type, Node_Id), Sm (Contract, Node_Id), Sm (Current_Use_Clause, Node_Id), @@ -504,6 +505,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Is_Fixed_Lower_Bound_Array_Subtype, Flag), Sm (Is_Fixed_Lower_Bound_Index_Subtype, Flag), Sm (Is_Generic_Actual_Type, Flag), + Sm (Is_Mutably_Tagged_Type, Flag), Sm (Is_Non_Static_Subtype, Flag), Sm (Is_Private_Composite, Flag), Sm (Is_RACW_Stub_Type, Flag), diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 2764ebdaf04..4dfb896e42f 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -904,6 +904,7 @@ Experimental Language Extensions * Pragma Storage_Model:: * Simpler accessibility model:: * Case pattern matching:: +* Mutably Tagged Types with Size’Class Aspect:: Security Hardening Features @@ -29228,6 +29229,7 @@ particular the @code{Shift_Left} and @code{Shift_Right} intrinsics. * Pragma Storage_Model:: * Simpler accessibility model:: * Case pattern matching:: +* Mutably Tagged Types with Size’Class Aspect:: @end menu @@ -29259,7 +29261,7 @@ while removing dynamic accessibility checking. Here is a link to the full RFC: @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-simpler-accessibility.md} -@node Case pattern matching,,Simpler accessibility model,Experimental Language Extensions +@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{44b} @subsection Case pattern matching @@ -29391,8 +29393,48 @@ case statement with composite selector type”. Link to the original RFC: @indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/master/prototyped/rfc-pattern-matching.rst} +@node Mutably Tagged Types with Size’Class Aspect,,Case pattern matching,Experimental Language Extensions +@anchor{gnat_rm/gnat_language_extensions mutably-tagged-types-with-size-class-aspect}@anchor{44c} +@subsection Mutably Tagged Types with Size’Class Aspect + + +The @cite{Size’Class} aspect can be applied to a tagged type to specify a size +constraint for the type and its descendants. When this aspect is specified +on a tagged type, the class-wide type of that type is considered to be a +“mutably tagged” type - meaning that objects of the class-wide type can have +their tag changed by assignment from objects with a different tag. + +When the aspect is applied to a type, the size of each of its descendant types +must not exceed the size specified for the aspect. + +Example: + +@example +type Base is tagged null record + with Size'Class => 16 * 8; -- Size in bits (128 bits, or 16 bytes) + +type Derived_Type is new Base with record + Data_Field : Integer; +end record; -- ERROR if Derived_Type exceeds 16 bytes +@end example + +Class-wide types with a specified @cite{Size’Class} can be used as the type of +array components, record components, and stand-alone objects. + +@example +Inst : Base'Class; +type Array_of_Base is array (Positive range <>) of Base'Class; +@end example + +Note: Legality of the @cite{Size’Class} aspect is subject to certain restrictions on +the tagged type, such as being undiscriminated, having no dynamic composite +subcomponents, among others detailed in the RFC. + +Link to the original RFC: +@indicateurl{https://github.com/AdaCore/ada-spark-rfcs/blob/topic/rfc-finally/considered/rfc-class-size.md} + @node Security Hardening Features,Obsolescent Features,GNAT language extensions,Top -@anchor{gnat_rm/security_hardening_features doc}@anchor{44c}@anchor{gnat_rm/security_hardening_features id1}@anchor{44d}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} +@anchor{gnat_rm/security_hardening_features doc}@anchor{44d}@anchor{gnat_rm/security_hardening_features id1}@anchor{44e}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15} @chapter Security Hardening Features @@ -29414,7 +29456,7 @@ change. @end menu @node Register Scrubbing,Stack Scrubbing,,Security Hardening Features -@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{44e} +@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{44f} @section Register Scrubbing @@ -29450,7 +29492,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{44f} +@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{450} @section Stack Scrubbing @@ -29594,7 +29636,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{450} +@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{451} @section Hardened Conditionals @@ -29684,7 +29726,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{451} +@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{452} @section Hardened Booleans @@ -29745,7 +29787,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{452} +@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{453} @section Control Flow Redundancy @@ -29913,7 +29955,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{453}@anchor{gnat_rm/obsolescent_features id1}@anchor{454}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} +@anchor{gnat_rm/obsolescent_features doc}@anchor{454}@anchor{gnat_rm/obsolescent_features id1}@anchor{455}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} @chapter Obsolescent Features @@ -29932,7 +29974,7 @@ compatibility purposes. @end menu @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id2}@anchor{455}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{456} +@anchor{gnat_rm/obsolescent_features id2}@anchor{456}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{457} @section pragma No_Run_Time @@ -29945,7 +29987,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{457}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{458} +@anchor{gnat_rm/obsolescent_features id3}@anchor{458}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{459} @section pragma Ravenscar @@ -29954,7 +29996,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{459}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{45a} +@anchor{gnat_rm/obsolescent_features id4}@anchor{45a}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{45b} @section pragma Restricted_Run_Time @@ -29964,7 +30006,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{45b}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{45c} +@anchor{gnat_rm/obsolescent_features id5}@anchor{45c}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{45d} @section pragma Task_Info @@ -29990,7 +30032,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{45d}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{45e} +@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{45e}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{45f} @section package System.Task_Info (@code{s-tasinf.ads}) @@ -30000,7 +30042,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{45f}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{460} +@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{460}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{461} @chapter Compatibility and Porting Guide @@ -30022,7 +30064,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{461}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{462} +@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{462}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{463} @section Writing Portable Fixed-Point Declarations @@ -30144,7 +30186,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{463}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{464} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{464}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{465} @section Compatibility with Ada 83 @@ -30172,7 +30214,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{465}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{466} +@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{466}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{467} @subsection Legal Ada 83 programs that are illegal in Ada 95 @@ -30272,7 +30314,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{467}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{468} +@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{468}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{469} @subsection More deterministic semantics @@ -30300,7 +30342,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{469}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{46a} +@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{46a}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{46b} @subsection Changed semantics @@ -30342,7 +30384,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{46b}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{46c} +@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{46c}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{46d} @subsection Other language compatibility issues @@ -30375,7 +30417,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{46d}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{46e} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{46e}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{46f} @section Compatibility between Ada 95 and Ada 2005 @@ -30447,7 +30489,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{46f}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{470} +@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{470}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{471} @section Implementation-dependent characteristics @@ -30470,7 +30512,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{471}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{472} +@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{472}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{473} @subsection Implementation-defined pragmas @@ -30492,7 +30534,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{473}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{474} +@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{474}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{475} @subsection Implementation-defined attributes @@ -30506,7 +30548,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{475}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{476} +@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{476}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{477} @subsection Libraries @@ -30535,7 +30577,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{477}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{478} +@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{478}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{479} @subsection Elaboration order @@ -30571,7 +30613,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{479}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{47a} +@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{47a}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{47b} @subsection Target-specific aspects @@ -30584,10 +30626,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus Ada 2005 and Ada 2012) 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{47b,,Representation Clauses}. +GNAT’s approach to these issues is described in @ref{47c,,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{47c}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{47d} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{47d}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{47e} @section Compatibility with Other Ada Systems @@ -30630,7 +30672,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{47e}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{47b} +@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{47f}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{47c} @section Representation Clauses @@ -30723,7 +30765,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{47f}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{480} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{480}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{481} @section Compatibility with HP Ada 83 @@ -30753,7 +30795,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{481}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{482} +@anchor{share/gnu_free_documentation_license doc}@anchor{482}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{483} @chapter GNU Free Documentation License diff --git a/gcc/ada/mutably_tagged.adb b/gcc/ada/mutably_tagged.adb new file mode 100644 index 00000000000..34b032f08c8 --- /dev/null +++ b/gcc/ada/mutably_tagged.adb @@ -0,0 +1,337 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- M U T A B L Y _ T A G G E D -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024-2024, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Atree; use Atree; +with Casing; use Casing; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; +with Exp_Util; use Exp_Util; +with Namet; use Namet; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Rtsfind; use Rtsfind; +with Snames; use Snames; +with Sem_Util; use Sem_Util; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; +with Stringt; use Stringt; +with Tbuild; use Tbuild; + +package body Mutably_Tagged is + + --------------------------------------- + -- Corresponding_Mutably_Tagged_Type -- + --------------------------------------- + + function Corresponding_Mutably_Tagged_Type + (CW_Equiv_Typ : Entity_Id) return Entity_Id + is + begin + return Class_Wide_Type (Parent_Subtype (CW_Equiv_Typ)); + end Corresponding_Mutably_Tagged_Type; + + ---------------------------------------- + -- Depends_On_Mutably_Tagged_Ext_Comp -- + ---------------------------------------- + + function Depends_On_Mutably_Tagged_Ext_Comp (N : Node_Id) return Boolean is + Typ : Entity_Id; + Typ_Comp : Entity_Id; + Curr : Node_Id; + Prev : Node_Id; + begin + -- Move through each prefix until we hit a type conversion from a + -- mutably tagged type then check if the referenced component exists in + -- the root type or an extension. + + Curr := N; + while Has_Prefix (Curr) loop + Prev := Curr; + Curr := Prefix (Curr); + + -- Find a prefix which is a type conversion from a mutably tagged + -- type in some form - either class-wide equivalent type or + -- directly a mutably tagged type. + + if Nkind (Curr) in N_Unchecked_Type_Conversion + | N_Type_Conversion + and then (Is_Mutably_Tagged_CW_Equivalent_Type + (Etype (Expression (Curr))) + or else Is_Mutably_Tagged_Type + (Etype (Expression (Curr)))) + + -- Verify that the prefix references a component + + and then Is_Entity_Name (Selector_Name (Prev)) + and then Ekind (Entity (Selector_Name (Prev))) + = E_Component + then + -- Obtain the root type + + Typ := Etype (if Is_Mutably_Tagged_Type + (Etype (Expression (Curr))) + then + Etype (Expression (Curr)) + else + Corresponding_Mutably_Tagged_Type + (Etype (Expression (Curr)))); + + -- Move through the components of the root type looking for a + -- match to the reference component. + + Typ_Comp := First_Component (Typ); + while Present (Typ_Comp) loop + + -- When there is a match we know the component reference + -- doesn't depend on a type extension. + + if Chars (Typ_Comp) = Chars (Entity (Selector_Name (Prev))) then + return False; + end if; + + Next_Component (Typ_Comp); + end loop; + + -- Otherwise, the component must depend on an extension + + return True; + end if; + end loop; + + -- If we get here then we know we don't have any sort of relevant type + -- conversion from a mutably tagged object. + + return False; + end Depends_On_Mutably_Tagged_Ext_Comp; + + ------------------------------------------------------ + -- Get_Corresponding_Mutably_Tagged_Type_If_Present -- + ------------------------------------------------------ + + function Get_Corresponding_Mutably_Tagged_Type_If_Present + (Typ : Entity_Id) return Entity_Id + is + begin + if Is_Mutably_Tagged_CW_Equivalent_Type (Typ) then + return Corresponding_Mutably_Tagged_Type (Typ); + end if; + + return Typ; + end Get_Corresponding_Mutably_Tagged_Type_If_Present; + + ---------------------------------------------- + -- Get_Corresponding_Tagged_Type_If_Present -- + ---------------------------------------------- + + function Get_Corresponding_Tagged_Type_If_Present + (Typ : Entity_Id) return Entity_Id + is + begin + -- Obtain the related tagged type for the class-wide mutably + -- tagged type associated with the class-wide equivalent type. + + if Is_Mutably_Tagged_CW_Equivalent_Type (Typ) then + return Parent_Subtype (Typ); + end if; + + return Typ; + end Get_Corresponding_Tagged_Type_If_Present; + + ---------------------------------- + -- Is_Mutably_Tagged_Conversion -- + ---------------------------------- + + function Is_Mutably_Tagged_Conversion (N : Node_Id) return Boolean is + begin + return Nkind (N) = N_Unchecked_Type_Conversion + and then Is_Mutably_Tagged_CW_Equivalent_Type + (Etype (Expression (N))); + end Is_Mutably_Tagged_Conversion; + + ------------------------------------------ + -- Is_Mutably_Tagged_CW_Equivalent_Type -- + ------------------------------------------ + + function Is_Mutably_Tagged_CW_Equivalent_Type + (Typ : Entity_Id) return Boolean + is + begin + -- First assure Typ is OK to test since this function can be called in + -- a context where analysis failed. + + return Present (Typ) + and then not Error_Posted (Typ) + + -- Finally check Typ is a class-wide equivalent type which has an + -- associated mutably tagged class-wide type (e.g. it is a class-wide + -- type with a size clause). + + and then Is_Class_Wide_Equivalent_Type (Typ) + and then Present (Parent_Subtype (Typ)) + and then Present (Class_Wide_Type (Parent_Subtype (Typ))) + and then Has_Size_Clause (Corresponding_Mutably_Tagged_Type (Typ)); + end Is_Mutably_Tagged_CW_Equivalent_Type; + + -------------------------------- + -- Make_CW_Size_Compile_Check -- + -------------------------------- + + function Make_CW_Size_Compile_Check + (New_Typ : Entity_Id; + Mut_Tag_Typ : Entity_Id) return Node_Id + is + Loc : constant Source_Ptr := Sloc (New_Typ); + begin + -- Generate a string literal for New_Typ's name which is needed for + -- printing within the Compile_Time_Error. + + Get_Decoded_Name_String (Chars (New_Typ)); + Set_Casing (Mixed_Case); + + -- Build a pragma Compile_Time_Error to force the backend to + -- preform appropriate sizing checks. + + -- Generate: + -- pragma Compile_Time_Error + -- (New_Typ'Size < Mut_Tag_Typ'Size, + -- "class size for by-reference type ""New_Typ"" too small") + + return + Make_Pragma (Loc, + Chars => Name_Compile_Time_Error, + Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => ( + Make_Op_Gt (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Size, + Prefix => + New_Occurrence_Of (New_Typ, Loc)), + Right_Opnd => + Make_Integer_Literal (Loc, + RM_Size (Mut_Tag_Typ))))), + Make_Pragma_Argument_Association (Loc, + Expression => + + -- Is it possible to print the size of New_Typ via + -- Validate_Compile_Time_Warning_Or_Error after the back-end + -- has run to generate the error message manually ??? + + Make_String_Literal (Loc, + "class size for by-reference type """ + & To_String (String_From_Name_Buffer) + & """ too small")))); + end Make_CW_Size_Compile_Check; + + ------------------------------------ + -- Make_Mutably_Tagged_Conversion -- + ------------------------------------ + + procedure Make_Mutably_Tagged_Conversion + (N : Node_Id; + Typ : Entity_Id := Empty; + Force : Boolean := False) + is + Conv_Typ : constant Entity_Id := + + -- When Typ is not present, we obtain it at this point + + (if Present (Typ) then + Typ + else + Corresponding_Mutably_Tagged_Type (Etype (N))); + + begin + -- Allow "forcing" the rewrite to an unchecked conversion + + if Force + + -- Otherwise, don't make the conversion when N is on the left-hand + -- side of the assignment, is already part of an unchecked conversion, + -- or is part of a renaming. + + or else (not Known_To_Be_Assigned (N, Only_LHS => True) + and then (No (Parent (N)) + or else Nkind (Parent (N)) + not in N_Selected_Component + | N_Unchecked_Type_Conversion + | N_Object_Renaming_Declaration)) + then + -- Exclude the case where we have a 'Size so that we get the proper + -- size of the class-wide equivalent type. Are there other cases ??? + + if Present (Parent (N)) + and then Nkind (Parent (N)) = N_Attribute_Reference + and then Attribute_Name (Parent (N)) in Name_Size + then + return; + end if; + + -- Create the conversion + + Rewrite (N, + Unchecked_Convert_To + (Conv_Typ, Relocate_Node (N))); + end if; + end Make_Mutably_Tagged_Conversion; + + ---------------------------------- + -- Make_Mutably_Tagged_CW_Check -- + ---------------------------------- + + function Make_Mutably_Tagged_CW_Check + (N : Node_Id; + Tag : Node_Id) return Node_Id + is + Loc : constant Source_Ptr := Sloc (N); + + -- Displace the pointer to the base of the objects applying 'Address, + -- which is later expanded into a call to RE_Base_Address. + + N_Tag : constant Node_Id := + Make_Explicit_Dereference (Loc, + Prefix => + Unchecked_Convert_To (RTE (RE_Tag_Ptr), + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr (N), + Attribute_Name => Name_Address))); + begin + -- Generate the runtime call to test class-wide membership + + return + Make_Raise_Constraint_Error (Loc, + Reason => CE_Tag_Check_Failed, + Condition => + Make_Op_Not (Loc, + Make_Function_Call (Loc, + Parameter_Associations => New_List (N_Tag, Tag), + Name => + New_Occurrence_Of (RTE (RE_CW_Membership), Loc)))); + end Make_Mutably_Tagged_CW_Check; + +end Mutably_Tagged; diff --git a/gcc/ada/mutably_tagged.ads b/gcc/ada/mutably_tagged.ads new file mode 100644 index 00000000000..b1e393f98ad --- /dev/null +++ b/gcc/ada/mutably_tagged.ads @@ -0,0 +1,120 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- M U T A B L Y _ T A G G E D -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024-2024, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Semantic and expansion utility routines dealing with mutably tagged types + +with Types; use Types; + +package Mutably_Tagged is + + -------------------------------------------- + -- Implementation of Mutably Tagged Types -- + -------------------------------------------- + + -- This package implements mutably tagged types via the Size'class aspect + -- which enables the creation of class-wide types with a specific maximum + -- size. This allows such types to be used directly in record components, + -- in object declarations without an initial expression, and to be + -- assigned a value from any type in a mutably tagged type's hierarchy. + + -- For example, this structure allows Base_Type and its derivatives to be + -- treated as components with a predictable size: + + -- type Base_Type is tagged null record + -- with Size'Class => 128; + + -- type Container is record + -- Component : Base_Type'Class; + -- end record; + + -- The core of thier implementation involve creating an "equivalent" type + -- for each class-wide type that adheres to the Size'Class constraint. This + -- is achieved using the function Make_CW_Equivalent_Type, which + -- generates a type that is compatible in size and structure with any + -- derived type of the base class-wide type. + + -- Once the class-wide equivalent type is generated, all references to + -- mutably tagged typed object declarations get rewritten to be + -- declarations of said equivalent type. References to these objects also + -- then get wrapped in unchecked conversions to the proper mutably tagged + -- class-wide type. + + function Corresponding_Mutably_Tagged_Type + (CW_Equiv_Typ : Entity_Id) return Entity_Id; + -- Given a class-wide equivalent type obtain the related mutably tagged + -- class-wide type. + + function Depends_On_Mutably_Tagged_Ext_Comp (N : Node_Id) return Boolean; + -- Return true if the given node N contains a reference to a component + -- of a mutably tagged object which comes from a type extension. + + function Get_Corresponding_Mutably_Tagged_Type_If_Present + (Typ : Entity_Id) return Entity_Id; + -- Obtain the corresponding mutably tagged type associated with Typ when + -- Typ is a mutably tagged class-wide equivalent type. Otherwise, just + -- return Typ. + + function Get_Corresponding_Tagged_Type_If_Present + (Typ : Entity_Id) return Entity_Id; + -- Obtain the corresponding tag type associated with Typ when + -- Typ is a mutably tagged class-wide equivalent type. Otherwise, Just + -- return Typ. + + -- This function is mostly used when we need a concrete type to generate + -- initialization for mutably tagged types. + + function Is_Mutably_Tagged_Conversion (N : Node_Id) return Boolean; + -- Return True if expression N is an object of a mutably tagged class-wide + -- equivalent type which has been expanded into a type conversion to + -- its related mutably tagged class-wide type. + + function Is_Mutably_Tagged_CW_Equivalent_Type + (Typ : Entity_Id) return Boolean; + -- Determine if Typ is a class-wide equivalent type + + procedure Make_Mutably_Tagged_Conversion + (N : Node_Id; + Typ : Entity_Id := Empty; + Force : Boolean := False); + -- Expand a reference N to a given mutably tagged type Typ. When Typ is not + -- present the closest associated mutably tagged type in the hierarchy is + -- used. + + -- Force is used to ignore certain predicates which avoid generating the + -- conversion (e.g. when N is on the left-hand side of an assignment). + + function Make_CW_Size_Compile_Check + (New_Typ : Entity_Id; + Mut_Tag_Typ : Entity_Id) return Node_Id; + -- Generate a type size check on New_Typ based on the size set in + -- the mutably tagged type Mut_Tag_Typ. + + function Make_Mutably_Tagged_CW_Check + (N : Node_Id; + Tag : Node_Id) return Node_Id; + -- Generate class-wide membership test for a given expression N based on + -- Tag. + +end Mutably_Tagged; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 249350d21de..1dbde1fae31 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -37,6 +37,7 @@ with Freeze; use Freeze; with Itypes; use Itypes; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Namet.Sp; use Namet.Sp; with Nmake; use Nmake; @@ -2699,7 +2700,18 @@ package body Sem_Aggr is Full_Analysis := Save_Analysis; Expander_Mode_Restore; - if Is_Tagged_Type (Etype (Expr)) then + -- Skip tagged checking for mutably tagged CW equivalent + -- types. + + if Is_Tagged_Type (Etype (Expr)) + and then Is_Class_Wide_Equivalent_Type + (Component_Type (Etype (N))) + then + null; + + -- Otherwise perform the dynamic tag check + + elsif Is_Tagged_Type (Etype (Expr)) then Check_Dynamically_Tagged_Expression (Expr => Expr, Typ => Component_Type (Etype (N)), @@ -5344,6 +5356,12 @@ package body Sem_Aggr is Relocate := True; end if; + -- Obtain the corresponding mutably tagged types if we are looking + -- at a special internally generated class-wide equivalent type. + + Expr_Type := + Get_Corresponding_Mutably_Tagged_Type_If_Present (Expr_Type); + Analyze_And_Resolve (Expr, Expr_Type); Check_Expr_OK_In_Limited_Aggregate (Expr); Check_Non_Static_Context (Expr); @@ -5351,7 +5369,9 @@ package body Sem_Aggr is -- Check wrong use of class-wide types - if Is_Class_Wide_Type (Etype (Expr)) then + if Is_Class_Wide_Type (Etype (Expr)) + and then not Is_Mutably_Tagged_Type (Expr_Type) + then Error_Msg_N ("dynamically tagged expression not allowed", Expr); end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 2563a92f2f0..9c3bc62d321 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -46,6 +46,7 @@ with Gnatvsn; use Gnatvsn; with Itypes; use Itypes; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; @@ -6753,7 +6754,10 @@ package body Sem_Attr is Check_E0; Check_Dereference; - if not Is_Tagged_Type (P_Type) then + if Is_Mutably_Tagged_CW_Equivalent_Type (P_Type) then + null; + + elsif not Is_Tagged_Type (P_Type) then Error_Attr_P ("prefix of % attribute must be tagged"); -- Next test does not apply to generated code why not, and what does @@ -11785,6 +11789,10 @@ package body Sem_Attr is Error_Msg_F ("illegal attribute for discriminant-dependent component", P); + + elsif Depends_On_Mutably_Tagged_Ext_Comp (P) then + Error_Msg_F + ("illegal attribute for mutably tagged component", P); end if; -- Check static matching rule of 3.10.2(27). Nominal subtype diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 93e81fd9539..d05c7b61194 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -40,6 +40,7 @@ with Itypes; use Itypes; with Lib; use Lib; with Lib.Load; use Lib.Load; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Nlists; use Nlists; with Namet; use Namet; with Nmake; use Nmake; @@ -11497,6 +11498,10 @@ package body Sem_Ch12 is Error_Msg_N ("illegal discriminant-dependent component for in out parameter", Actual); + elsif Depends_On_Mutably_Tagged_Ext_Comp (Actual) then + Error_Msg_N + ("illegal mutably tagged component for in out parameter", + Actual); end if; -- The actual has to be resolved in order to check that it is a diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index caebe2e793e..2fbddf3f952 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -43,6 +43,7 @@ with Freeze; use Freeze; with Ghost; use Ghost; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -3069,6 +3070,15 @@ package body Sem_Ch13 is end if; end if; + -- Propagate the 'Size'Class aspect to the class-wide type + + if A_Id = Aspect_Size and then Class_Present (Aspect) then + Ent := + Make_Attribute_Reference (Loc, + Prefix => Ent, + Attribute_Name => Name_Class); + end if; + -- Construct the attribute_definition_clause. The expression -- in the aspect specification is simply shared with the -- constructed attribute, because it will be fully analyzed @@ -7337,6 +7347,70 @@ package body Sem_Ch13 is & "supported", N); end if; + -- Handle extension aspect 'Size'Class which allows for + -- "mutably tagged" types. + + if Ekind (Etyp) = E_Class_Wide_Type then + Error_Msg_GNAT_Extension + ("attribute size class", Sloc (N)); + + -- Check for various restrictions applied to mutably + -- tagged types. + + if Is_Derived_Type (Etype (Etyp)) then + Error_Msg_N + ("cannot be specified on derived types", Nam); + + elsif Ekind (Etype (Prefix (Nam))) = E_Record_Subtype then + Error_Msg_N + ("cannot be specified on a subtype", Nam); + + elsif Is_Interface (Etype (Etyp)) then + Error_Msg_N + ("cannot be specified on interface types", Nam); + + elsif Has_Discriminants (Etype (Etyp)) then + Error_Msg_N + ("cannot be specified on discriminated type", Nam); + + elsif Present (Incomplete_Or_Partial_View (Etype (Etyp))) + and then Is_Tagged_Type + (Incomplete_Or_Partial_View (Etype (Etyp))) + then + Error_Msg_N + ("cannot be specified on a type whose partial view" + & " is tagged", Nam); + + -- Otherwise, the declaration is valid + + else + declare + Actions : List_Id; + begin + -- Generate our class-wide equivalent type which + -- is sized according to the value specified by + -- 'Size'Class. + + Set_Class_Wide_Equivalent_Type (Etyp, + Make_CW_Equivalent_Type (Etyp, Empty, Actions)); + + -- Add a Compile_Time_Error sizing check as a hint + -- to the backend. + + Append_To (Actions, + Make_CW_Size_Compile_Check + (Etype (Etyp), U_Ent)); + + -- Set the expansion to occur during freezing when + -- everything is analyzed + + Append_Freeze_Actions (Etyp, Actions); + + Set_Is_Mutably_Tagged_Type (Etyp); + end; + end if; + end if; + Set_Has_Size_Clause (U_Ent); end; end if; diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index db17023db28..aae9990eb4d 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -27,6 +27,7 @@ with Atree; use Atree; with Einfo; use Einfo; with Einfo.Utils; use Einfo.Utils; with Ghost; use Ghost; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; @@ -81,6 +82,12 @@ package body Sem_Ch2 is Find_Direct_Name (N); end if; + -- Generate a conversion when we see an expanded mutably tagged type + + if Is_Mutably_Tagged_CW_Equivalent_Type (Etype (N)) then + Make_Mutably_Tagged_Conversion (N); + end if; + -- A Ghost entity must appear in a specific context. Only do this -- checking on non-overloaded expressions, as otherwise we need to -- wait for resolution, and the checking is done in Resolve_Entity_Name. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 633e1367aee..76e5cdcbf5d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -48,6 +48,7 @@ with Itypes; use Itypes; with Layout; use Layout; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -2162,6 +2163,7 @@ package body Sem_Ch3 is -- and thus unconstrained. Regular components must be constrained. if not Is_Definite_Subtype (T) + and then not Is_Mutably_Tagged_Type (T) and then Chars (Id) /= Name_uParent then if Is_Class_Wide_Type (T) then @@ -4802,8 +4804,30 @@ package body Sem_Ch3 is null; elsif Is_Class_Wide_Type (T) then - Error_Msg_N - ("initialization required in class-wide declaration", N); + + -- Case of a mutably tagged type + + if Is_Mutably_Tagged_Type (T) then + Act_T := Class_Wide_Equivalent_Type (T); + + Rewrite (Object_Definition (N), + New_Occurrence_Of (Act_T, Loc)); + + Insert_After (N, + Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (Init_Proc (Etype (T)), Loc), + Parameter_Associations => New_List ( + Unchecked_Convert_To + (Etype (T), New_Occurrence_Of (Id, Loc))))); + + Freeze_Before (N, Act_T); + + -- Otherwise an initial expression is required + + else + Error_Msg_N + ("initialization required in class-wide declaration", N); + end if; else Error_Msg_N @@ -4900,6 +4924,17 @@ package body Sem_Ch3 is goto Leave; end if; + -- Rewrite mutably tagged class-wide type declarations to be that + -- of the corresponding class-wide equivalent type. + + elsif Is_Mutably_Tagged_Type (T) then + Act_T := Class_Wide_Equivalent_Type (T); + + Rewrite (Object_Definition (N), + New_Occurrence_Of (Act_T, Loc)); + + Freeze_Before (N, Act_T); + else -- Ensure that the generated subtype has a unique external name -- when the related object is public. This guarantees that the @@ -6679,7 +6714,11 @@ package body Sem_Ch3 is -- that all the indexes are unconstrained but we still need to make sure -- that the element type is constrained. - if not Is_Definite_Subtype (Element_Type) then + if Is_Mutably_Tagged_Type (Element_Type) then + Set_Component_Type (T, + Class_Wide_Equivalent_Type (Element_Type)); + + elsif not Is_Definite_Subtype (Element_Type) then Error_Msg_N ("unconstrained element type in array declaration", Subtype_Indication (Component_Def)); @@ -17774,6 +17813,83 @@ package body Sem_Ch3 is Build_Derived_Type (N, Parent_Type, T, Is_Completion, Derive_Subps => not Is_Underlying_Record_View (T)); + -- Check for special mutably tagged type declarations + + if Is_Tagged_Type (Parent_Type) + and then not Error_Posted (T) + then + declare + Actions : List_Id; + CW_Typ : constant Entity_Id := Class_Wide_Type (T); + Root_Class_Typ : constant Entity_Id := + Class_Wide_Type (Root_Type (Parent_Type)); + begin + -- Perform various checks when we are indeed looking at a + -- mutably tagged declaration. + + if Present (Root_Class_Typ) + and then Is_Mutably_Tagged_Type (Root_Class_Typ) + then + -- Verify the level of the descendant's declaration is not + -- deeper than the root type since this could cause leaking + -- of the type. + + if Scope (Root_Class_Typ) /= Scope (T) + and then Deepest_Type_Access_Level (Root_Class_Typ) + < Deepest_Type_Access_Level (T) + then + Error_Msg_NE + ("descendant of mutably tagged type cannot be deeper than" + & " its root", N, Root_Type (T)); + + elsif Present (Incomplete_Or_Partial_View (T)) + and then Is_Tagged_Type (Incomplete_Or_Partial_View (T)) + then + Error_Msg_N + ("descendant of mutably tagged type cannot a have partial" + & " view which is tagged", N); + + -- Mutably tagged types cannot have discriminants + + elsif Present (Discriminant_Specifications (N)) then + Error_Msg_N + ("descendant of mutably tagged type cannot have" + & " discriminates", N); + + elsif Present (Interfaces (T)) + and then not Is_Empty_Elmt_List (Interfaces (T)) + then + Error_Msg_N + ("descendant of mutably tagged type cannot implement" + & " an interface", N); + + -- We have a valid descendant type + + else + -- Set inherited attributes + + Set_Has_Size_Clause (CW_Typ); + Set_RM_Size (CW_Typ, RM_Size (Root_Class_Typ)); + Set_Is_Mutably_Tagged_Type (CW_Typ); + + -- Generate a new class-wide equivalent type + + Set_Class_Wide_Equivalent_Type (CW_Typ, + Make_CW_Equivalent_Type (CW_Typ, Empty, Actions)); + + Insert_List_After_And_Analyze (N, Actions); + + -- Add a Compile_Time_Error sizing check as a hint + -- to the backend since we don't know the true size of + -- anything at this point. + + Insert_After_And_Analyze (N, + Make_CW_Size_Compile_Check (T, Root_Class_Typ)); + end if; + end if; + end; + end if; + -- AI-419: The parent type of an explicitly limited derived type must -- be a limited type or a limited interface. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index b59a56c139b..e75f8dfb6bc 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -36,6 +36,7 @@ with Exp_Util; use Exp_Util; with Itypes; use Itypes; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Namet.Sp; use Namet.Sp; with Nlists; use Nlists; @@ -623,6 +624,12 @@ package body Sem_Ch4 is Make_Index_Or_Discriminant_Constraint (Loc, Constraints => Constr))); end; + + -- Rewrite the mutably tagged type to a non-class-wide type for + -- proper initialization. + + elsif Is_Mutably_Tagged_Type (Type_Id) then + Rewrite (E, New_Occurrence_Of (Etype (Type_Id), Loc)); end if; end if; @@ -2885,6 +2892,12 @@ package body Sem_Ch4 is Set_Etype (N, Component_Type (Array_Type)); Check_Implicit_Dereference (N, Etype (N)); + -- Generate conversion to class-wide type + + if Is_Mutably_Tagged_CW_Equivalent_Type (Etype (N)) then + Make_Mutably_Tagged_Conversion (N); + end if; + if Present (Index) then Error_Msg_N ("too few subscripts in array reference", First (Exprs)); @@ -4069,6 +4082,17 @@ package body Sem_Ch4 is Next_Actual (Actual); Next_Formal (Formal); + -- Generate a class-wide type conversion for instances of + -- class-wide equivalent types to their corresponding + -- mutably tagged type. + + elsif Is_Mutably_Tagged_CW_Equivalent_Type (Etype (Actual)) + and then Etype (Formal) = Parent_Subtype (Etype (Actual)) + then + Make_Mutably_Tagged_Conversion (Actual); + Next_Actual (Actual); + Next_Formal (Formal); + -- Handle failed type check else @@ -5294,6 +5318,11 @@ package body Sem_Ch4 is Prefix_Type := Implicitly_Designated_Type (Prefix_Type); end if; + -- Handle mutably tagged types + + elsif Is_Class_Wide_Equivalent_Type (Prefix_Type) then + Prefix_Type := Parent_Subtype (Prefix_Type); + -- If we have an explicit dereference of a remote access-to-class-wide -- value, then issue an error (see RM-E.2.2(16/1)). However we first -- have to check for the case of a prefix that is a controlling operand @@ -5389,7 +5418,6 @@ package body Sem_Ch4 is Check_Implicit_Dereference (N, Etype (Comp)); elsif Is_Record_Type (Prefix_Type) then - -- Find a component with the given name. If the node is a prefixed -- call, do not examine components whose visibility may be -- accidental. @@ -5559,6 +5587,13 @@ package body Sem_Ch4 is Set_Etype (N, Etype (Comp)); end if; + -- Force the generation of a mutably tagged type conversion + -- when we encounter a special class-wide equivalent type. + + if Is_Mutably_Tagged_CW_Equivalent_Type (Etype (Name)) then + Make_Mutably_Tagged_Conversion (Name, Force => True); + end if; + Check_Implicit_Dereference (N, Etype (N)); return; end if; @@ -6328,6 +6363,30 @@ package body Sem_Ch4 is ("formal parameter cannot be converted to class-wide type when " & "Extensions_Visible is False", Expr); end if; + + -- Perform special checking for access to mutably tagged type since they + -- are not compatible with interfaces. + + if Is_Access_Type (Typ) + and then Is_Access_Type (Etype (Expr)) + and then not Error_Posted (N) + then + + if Is_Mutably_Tagged_Type (Directly_Designated_Type (Typ)) + and then Is_Interface (Directly_Designated_Type (Etype (Expr))) + then + Error_Msg_N + ("argument of conversion to mutably tagged access type cannot " + & "be access to interface", Expr); + + elsif Is_Mutably_Tagged_Type (Directly_Designated_Type (Etype (Expr))) + and then Is_Interface (Directly_Designated_Type (Typ)) + then + Error_Msg_N + ("argument of conversion to interface access type cannot " + & "be access to mutably tagged type", Expr); + end if; + end if; end Analyze_Type_Conversion; ---------------------- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 1e09e57919e..b92ceb17b1b 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -39,6 +39,7 @@ with Freeze; use Freeze; with Ghost; use Ghost; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -676,11 +677,17 @@ package body Sem_Ch5 is Set_Assignment_Type (Lhs, T1); - -- If the target of the assignment is an entity of a mutable type and - -- the expression is a conditional expression, its alternatives can be - -- of different subtypes of the nominal type of the LHS, so they must be - -- resolved with the base type, given that their subtype may differ from - -- that of the target mutable object. + -- When analyzing a mutably tagged class-wide equivalent type pretend we + -- are actually looking at the mutably tagged type itself for proper + -- analysis. + + T1 := Get_Corresponding_Mutably_Tagged_Type_If_Present (T1); + + -- If the target of the assignment is an entity of a mutably tagged type + -- and the expression is a conditional expression, its alternatives can + -- be of different subtypes of the nominal type of the LHS, so they must + -- be resolved with the base type, given that their subtype may differ + -- from that of the target mutable object. if Is_Entity_Name (Lhs) and then Is_Assignable (Entity (Lhs)) @@ -2500,6 +2507,13 @@ package body Sem_Ch5 is Error_Msg_N ("iterable name cannot be a discriminant-dependent " & "component of a mutable object", N); + + elsif Depends_On_Mutably_Tagged_Ext_Comp + (Original_Node (Iter_Name)) + then + Error_Msg_N + ("iterable name cannot depend on a mutably tagged component", + N); end if; Check_Subtype_Definition (Component_Type (Typ)); @@ -2630,6 +2644,13 @@ package body Sem_Ch5 is Error_Msg_N ("container cannot be a discriminant-dependent " & "component of a mutable object", N); + + elsif Depends_On_Mutably_Tagged_Ext_Comp + (Orig_Iter_Name) + then + Error_Msg_N + ("container cannot depend on a mutably tagged " + & "component", N); end if; end if; end; @@ -2716,6 +2737,11 @@ package body Sem_Ch5 is Error_Msg_N ("container cannot be a discriminant-dependent " & "component of a mutable object", N); + + elsif Depends_On_Mutably_Tagged_Ext_Comp (Obj) then + Error_Msg_N + ("container cannot depend on a mutably tagged" + & " component", N); end if; end; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3252af79748..e97afdaf12e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9182,9 +9182,15 @@ package body Sem_Ch6 is -- If the type does not have a completion yet, treat as prior to -- Ada 2012 for consistency. - if Has_Discriminants (Formal_Type) + -- Note that we need also to handle mutably tagged types in the + -- same way as discriminated types since they can be constrained + -- or unconstrained as well. + + if (Has_Discriminants (Formal_Type) + or else Is_Mutably_Tagged_Type (Formal_Type)) and then not Is_Constrained (Formal_Type) - and then Is_Definite_Subtype (Formal_Type) + and then (Is_Definite_Subtype (Formal_Type) + or else Is_Mutably_Tagged_Type (Formal_Type)) and then (Ada_Version < Ada_2012 or else No (Underlying_Type (Formal_Type)) or else not diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 125ccc6c433..d2752af320e 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -39,6 +39,7 @@ with Lib; use Lib; with Lib.Load; use Lib.Load; with Lib.Xref; use Lib.Xref; with Local_Restrict; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Namet.Sp; use Namet.Sp; with Nlists; use Nlists; @@ -1511,6 +1512,10 @@ package body Sem_Ch8 is if Is_Dependent_Component_Of_Mutable_Object (Nam) then Error_Msg_N ("illegal renaming of discriminant-dependent component", Nam); + elsif Depends_On_Mutably_Tagged_Ext_Comp (Nam) then + Error_Msg_N + ("illegal renaming of mutably tagged dependent component", + Nam); end if; -- If the renaming comes from source and the renamed object is a @@ -2094,6 +2099,10 @@ package body Sem_Ch8 is Error_Msg_N ("illegal renaming of discriminant-dependent component", Nam); + elsif Depends_On_Mutably_Tagged_Ext_Comp (Nam) then + Error_Msg_N + ("illegal renaming of mutably tagged dependent component", + Nam); end if; else Error_Msg_N ("expect object name in renaming", Nam); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d2eca7c5459..a0dd1f7962b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -47,6 +47,7 @@ with Itypes; use Itypes; with Lib; use Lib; with Lib.Xref; use Lib.Xref; with Local_Restrict; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nmake; use Nmake; with Nlists; use Nlists; @@ -5034,12 +5035,21 @@ package body Sem_Res is -- Skip this check on helpers and indirect-call wrappers built to -- support class-wide preconditions. + -- We make special exception here for mutably tagged types and + -- related calls to their initialization procedures. + if (Is_Class_Wide_Type (A_Typ) or else Is_Dynamically_Tagged (A)) and then not Is_Class_Wide_Type (F_Typ) and then not Is_Controlling_Formal (F) and then not In_Instance and then (not Is_Subprogram (Nam) or else No (Class_Preconditions_Subprogram (Nam))) + + -- Ignore mutably tagged types and their use in calls to init + -- procs. + + and then not Is_Mutably_Tagged_CW_Equivalent_Type (A_Typ) + and then not Is_Init_Proc (Nam) then Error_Msg_N ("class-wide argument not allowed here!", A); @@ -14069,6 +14079,13 @@ package body Sem_Res is end; end if; + -- When we encounter a class-wide equivalent type used to represent + -- a fully sized mutably tagged type, pretend we are actually looking + -- at the class-wide mutably tagged type instead. + + Opnd_Type := + Get_Corresponding_Mutably_Tagged_Type_If_Present (Opnd_Type); + -- Deal with conversion of integer type to address if the pragma -- Allow_Integer_Address is in effect. We convert the conversion to -- an unchecked conversion in this case and we are all done. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1705b5817b9..b1d47f22416 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -38,6 +38,7 @@ with Freeze; use Freeze; with Itypes; use Itypes; with Lib; use Lib; with Lib.Xref; use Lib.Xref; +with Mutably_Tagged; use Mutably_Tagged; with Namet.Sp; use Namet.Sp; with Nlists; use Nlists; with Nmake; use Nmake; @@ -17166,6 +17167,13 @@ package body Sem_Util is -- Record types elsif Is_Record_Type (Typ) then + -- Mutably tagged types get default initialized to their parent + -- subtype's default values. + + if Is_Mutably_Tagged_CW_Equivalent_Type (Typ) then + return True; + end if; + if Has_Defaulted_Discriminants (Typ) and then Is_Fully_Initialized_Variant (Typ) then @@ -22684,6 +22692,11 @@ package body Sem_Util is then return True; + -- Mutably tagged types require default initialization + + elsif Is_Mutably_Tagged_CW_Equivalent_Type (Typ) then + return True; + -- If Initialize/Normalize_Scalars is in effect, string objects also -- need initialization, unless they are created in the course of -- expanding an aggregate (since in the latter case they will be From patchwork Fri Jun 14 07:36:24 2024 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: 1947704 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=AUE22ASm; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rlK0V1qz20Pb for ; Fri, 14 Jun 2024 17:39:41 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5E3123882AC2 for ; Fri, 14 Jun 2024 07:39:39 +0000 (GMT) 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 3A62F3882166 for ; Fri, 14 Jun 2024 07:36:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3A62F3882166 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 3A62F3882166 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=1718350614; cv=none; b=iP22oLRWJ4i8mUd+TeEsLbrLf25OpPeG9nF2SxshXKi5fsL7RGRU9iUPK8MKcQm8HilP9Y7+CdXfRrKuDtml9LUTkeHO/2lINRE6iw0yWqFNhH6GSFb+RCyDDpoqhGJQgJ2zcdl7WnK6YlZ5UtO+vR8amwIOa7Wf5gegjotSjv0= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350614; c=relaxed/simple; bh=fKD1AY5gyzqjWDUs8j8r6rqy6Hu9YboxF+Mrc0ubKSY=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=X1gJnQuS6dQulRfQ2rzUdQQalg9ko6FyL2rXwAYdNaMSqZRLpKiSrxacxj2h+98+GNmYtBZ/tPEJuQ2FBNUz0SiRsGOT5cR0Zd6B4OZFll6IjVNp7/EfMe/7WtpDzuW80PnzVvdR2hOFxNgL6PL61Hi9G8w+objUNJfJDfkuVQc= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x329.google.com with SMTP id 5b1f17b1804b1-421eab59723so14882055e9.3 for ; Fri, 14 Jun 2024 00:36:52 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350611; x=1718955411; 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=85NGsN8hEowCbcNqt5bvGFzOzmOrebdaSGLRmuXY2Lk=; b=AUE22ASm510zgqAc19gKWE/zdPLQciZGPzD17zg1vbwubHZL41+ySo8SZJ50ZOuJi+ DiQLx/3k1WRlGW7AS8gllisBchMX6/9KHTIF+h3jR0UPO0dzQlhavYsvYGXm9RxvUV5s lmjayo6iPvqgrPaWHBYGUB2q9YM1Fk+udhy3MMV/RfJs7UzEkjs17GxCMUkHMQKlcUdA CZckzxulwcFpXeYBnK3PMgVso3dCOHT4F4vHvV4/SJN0N0EoAw1MmsyiYjJwcTCY5ucF gjAQldzvUGqeV59UNmS2s6GXf65HmMeHf/uo3U6+UjNdZ8dCD58wdsZasY2Ik8Ow8PwU A2ug== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350611; x=1718955411; 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=85NGsN8hEowCbcNqt5bvGFzOzmOrebdaSGLRmuXY2Lk=; b=CNe+vrAaoBVjzHBxQUN4W7KUrJQTFk5htKd5Tv8w1s+r6wPPxwjq9CmP5z+OsrTA6T tsMIF2FswVte5jpuvf12BwxVTdFkCvC/6k75bdGOOXNWYAJtk0kKTrq9NeAo+6bQ1pVI ghE18I3ygeJZNMKEDPHAXw7IWlSQFRIf1ayYhlsmimrM5dvoyCnxVSNrujwYG6DOAWzj gjmneYW5a8KnIkKD5X/u2/bRN2JAYEAl9SLYvRiUd5mzGA8U8QideeicEjURMw7ON//X pwgHYZiRc9ORQ+//9pgGkxVwjet53y4/6l+mw38/oZXhSQ2CGCT7Ayi7NSptC4nIRsr4 d6eg== X-Gm-Message-State: AOJu0YxGMafS37Op99MKlhYSuodFdT2UiVHHTlE70jgp+DrbkaAAgrUY lGmd9Uu/OD5zye25IcK7Ap4RfilQ8P39itnNPpEy3vflHLhZngFk1grq9aQYcAqryKkq0RoqCS4 = X-Google-Smtp-Source: AGHT+IHraHbvnOVUTX4VI+OQqMzSSeOfjHZ7S59l4nKuqWiV152lZMEL50Ylct2rXHvA8Oshr92cdw== X-Received: by 2002:a05:600c:1c91:b0:421:8060:f772 with SMTP id 5b1f17b1804b1-423047cbb79mr18838405e9.0.1718350610989; Fri, 14 Jun 2024 00:36:50 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.50 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:50 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 08/16] ada: Minor tweak in Snames Date: Fri, 14 Jun 2024 09:36:24 +0200 Message-ID: <20240614073633.2089692-8-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou gcc/ada/ * snames.ads-tmpl (Name_Present): Move to Repinfo section. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/snames.ads-tmpl | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 699b8df5851..d2f724f86ca 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -903,10 +903,6 @@ package Snames is Name_Warn : constant Name_Id := N + $; Name_Working_Storage : constant Name_Id := N + $; - -- used by Repinfo JSON I/O - - Name_Present : constant Name_Id := N + $; - -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These -- attributes are implemented in all Ada modes in GNAT. @@ -1372,6 +1368,7 @@ package Snames is Name_Discriminant : constant Name_Id := N + $; Name_Operands : constant Name_Id := N + $; + Name_Present : constant Name_Id := N + $; -- Other miscellaneous names used in front end -- Note that the UP_ prefix means use the rest of the name in uppercase, From patchwork Fri Jun 14 07:36:25 2024 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: 1947702 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=US/Ylj8h; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rkY5kddz20Pb for ; Fri, 14 Jun 2024 17:39:01 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1B7583882161 for ; Fri, 14 Jun 2024 07:39:00 +0000 (GMT) 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 30E9E388264A for ; Fri, 14 Jun 2024 07:36:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 30E9E388264A 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 30E9E388264A 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=1718350615; cv=none; b=QwYjiDOZvkpdTAMXhyYJ14HotD2r8nEEPjFBcUBaiKHJLurFU436mcpNeNYuB85sLPEuR//VLzqqc/BPCot5ULdNDU6MCddZSwFMCY45IogccJANIQ7RnzIHHiOCqZ8GGnlIanTux+soOEG8iaoJLAbimJxp23xd1PnEA952O/Q= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350615; c=relaxed/simple; bh=JcvsjAOZ4BjvnDg+FHSitcgU2UnMnmaAxx3+JCBNrII=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=PU3O2ORCGHu8yqcc5CxP7q8q/sVQ29/ySAONjkyFW6g6UwnLwb7UwVnPGi3l6PVfhfykeZQ0iTSaXTahkWCIEhwC+RzMQ1UeNaLg9qAqIH5ja6QvVZ87wfZLQXr1IF4xFb8jrYvEILdhAV64Tuj/21q3Km3eppQo3ANR16HDkeI= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32d.google.com with SMTP id 5b1f17b1804b1-42165f6645fso16325135e9.2 for ; Fri, 14 Jun 2024 00:36:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350612; x=1718955412; 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=AF6EsGnrTz5pfCX9S0w8NjA5UP6W/pE4vMhUq1zS0ug=; b=US/Ylj8hwxgORTe1rhyLwa/EVvChIGLCvEmgVE5BQOcidi+c8VnXcGQjQ6ixPRbR8G rqagP71i87biccaxdNJlzTmRvfzveSAtdS/jbPpVdmsxEABPHpYatPkoEfP4ZYDO/DZj vThYAaY42hVS9N8m8mR5bPNcv1pzDN6wMJkTDrd+KaFPdZA0ocBb67Pwmd7z4Gtkrf5z qdYo8ENi1n/zYop+VBod8RpGiQuk1+dbHfFhMvEd1XRQdxudbCOnRqvy/2R2K6Zcsjvl Y2ERb3lG0VJwBGLjDoniyG3wzAuI8rl8yO7liFUs3VIjDXfnx6guh5qPCkQgPvHd92qQ 7ALg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350612; x=1718955412; 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=AF6EsGnrTz5pfCX9S0w8NjA5UP6W/pE4vMhUq1zS0ug=; b=TRs1SzH3znEk1JBUGsb+qlOUODhNJ4eNzkfrg1/h6y+PQuuHmzD9sbvji6zeHQnItA BfRDmctvCPfIy6/XoiB8NxkRUu1XkTHiroBym5GNub/JzWyrrigpmWJe9/bZOZYiq68T CfvJRuwVd8nrDRpASSZCrrz9j0V5USykVobp40NhcdJJutW22k2fAz/001D/9aUUKGnR oNU6gasL+7uEr3h3zF6d71x4zfmezvsJ1bSPiSMCkyCTiCc160sFo8glbZdNaxPPfpe5 HLV+CuHjUypy8XL+hCmqM3Oo8OOrOOkdrffDPEL4tyADZOaxwFYS+X8pDplMUBBPp2WP kK8Q== X-Gm-Message-State: AOJu0YwKQR3XA7qecfTXu7qhvtY5Wr6PKVCMOWKQdt9LDn3dVaESPKEj uyHAWKlXeqZZh1dGIBYwQptlKwjz4KPhLT3EC8Gdo+imBVIoCgui4YcugLFghALGva39UV4Xv5k = X-Google-Smtp-Source: AGHT+IFqCQcxpXDpicQUO3Yd78XWOa3Wrx0c/r305JDGH/n8w2H0sqkp99NNXK2VnBKLHvm+jZRxxQ== X-Received: by 2002:a05:600c:4691:b0:421:de31:7a with SMTP id 5b1f17b1804b1-423048228dcmr17682105e9.8.1718350611930; Fri, 14 Jun 2024 00:36:51 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:51 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Jerome Guitton Subject: [COMMITTED 09/16] ada: Simplify handling of VxWorks-specific error codes for ENOENT Date: Fri, 14 Jun 2024 09:36:25 +0200 Message-ID: <20240614073633.2089692-9-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Jerome Guitton These error codes were defined on older versions of VxWorks (5, 6, 7 SR0540) and now they are either not defined or they fallback to ENOENT. To handle these cases without using complex tests against vxworks versions, leverage on __has_include and provide a fallback to ENOENT if these error codes are not defined. gcc/ada/ * sysdep.c (S_dosFsLib_FILE_NOT_FOUND, S_nfsLib_NFSERR_NOENT): New macros, falback to ENOENT when not already defined. (__gnat_is_file_not_found_error): Use these new macros to remove tests against VxWorks flavors. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sysdep.c | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index 443b11f4302..254c736bec4 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -35,18 +35,35 @@ #ifdef __vxworks #include "vxWorks.h" #include "ioLib.h" -#if ! defined (VTHREADS) +/* VxWorks 5, 6 and 7 SR0540 expose error codes that need to be handled + as ENOENT. On later versions: + - either they are defined as ENOENT (vx7r2); + - or the corresponding system includes are not provided (Helix Cert). */ + +#if __has_include ("dosFsLib.h") +/* On helix-cert, this include is only provided for RTPs. */ #include "dosFsLib.h" #endif -#if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__)) + +#ifndef S_dosFsLib_FILE_NOT_FOUND +#define S_dosFsLib_FILE_NOT_FOUND ENOENT +#endif + +#if __has_include ("nfsLib.h") +/* This include is not provided for RTPs or on helix-cert. */ # include "nfsLib.h" #endif + +#ifndef S_nfsLib_NFSERR_NOENT +#define S_nfsLib_NFSERR_NOENT ENOENT +#endif + #include "selectLib.h" #include "version.h" #if defined (__RTP__) # include "vwModNum.h" #endif /* __RTP__ */ -#endif +#endif /* __vxworks */ #ifdef __ANDROID__ #undef __linux__ @@ -912,14 +929,10 @@ __gnat_is_file_not_found_error (int errno_val) /* In the case of VxWorks, we also have to take into account various * filesystem-specific variants of this error. */ -#if ! defined (VTHREADS) && (_WRS_VXWORKS_MAJOR < 7) else if (errno_val == S_dosFsLib_FILE_NOT_FOUND) return 1; -#endif -#if ! defined (__RTP__) && (! defined (VTHREADS) || defined (__VXWORKSMILS__)) else if (errno_val == S_nfsLib_NFSERR_NOENT) return 1; -#endif #if defined (__RTP__) /* An RTP can return an NFS file not found, and the NFS bits must first be masked on to check the errno. */ From patchwork Fri Jun 14 07:36:26 2024 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: 1947707 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=ZoR6tt/B; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rmH3CXpz20X9 for ; Fri, 14 Jun 2024 17:40:31 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 62C0D3882AE7 for ; Fri, 14 Jun 2024 07:40:29 +0000 (GMT) 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 2F7973882657 for ; Fri, 14 Jun 2024 07:36:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 2F7973882657 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 2F7973882657 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=1718350616; cv=none; b=Lg/jP9iVkxxKhxUMWGg3DDTiW2ISYeX1r+szYskKFBYRcIK/YV1s3Tk+Yt5k7bc3P2IWXq/7GYkX9WPOdNjlTZSH1vGxGqk7J2r2X5JV5fbBGQH1CGBMCICGHhoEH85mv+1uibJ2D3d3lcvohhFMKkwW/lAeNIABsfrs5t5ozJk= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350616; c=relaxed/simple; bh=VQpkeKfSwu7lGHx9c+nWrJc82VrGE2bMgNe1Kp+MQ3s=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=TBEBUnF5wnNTOxce4H5CTq4PDnPqUFSRe6AXCn0w3QVsGZUuZFxEWVcRuwPZ8jsyFHsJ1YJgBiLpCXMmt2/IJNRtnQkMpAS7kBdJfDrowOevvNBDZjSdK2EkqmUcVT+92TPJlbMSRJitH5TJOpPq7d9Kn/f1C2cDBg//VCb1Qkk= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x436.google.com with SMTP id ffacd0b85a97d-35f0d6255bdso1709437f8f.1 for ; Fri, 14 Jun 2024 00:36:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350613; x=1718955413; 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=yuAxBYsTgxaJ7qIx4gs+mpI+dxXeOAeth56rHPrnbjw=; b=ZoR6tt/BWrnWX6cw2C84e7AK2zYGX8TqmNgEZunubyNWIcwKTw7GkE7KmE3bKrIZEx g0pEq1Qpub6hzMS4qF8mEHMZpn6n09CZWIuOs4/ntFCaMDHtFfcHNcayAtt9i8V+SUD0 taYgfhSx64mjCqbU6kMnyY09h37PJjJfkUbUAcTGB3aFZtZqnhWyvkNoLOU9bYQIV+VH /bG8aYhQorCmnv3z/VrzjrG68ov90hlpq0ug+yyrOf9c5aawaGkjitYGP0GzPb/Li/Sd JbcxdC3VwmTFYTxY5iQer1xD5NmOjMbhg2VdA7lC6oAAy3WZhD20x4hZcK99VAA2hDXg mAnw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350613; x=1718955413; 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=yuAxBYsTgxaJ7qIx4gs+mpI+dxXeOAeth56rHPrnbjw=; b=QvMgOKaEbALmzDTtZa7/GOp+Ln2ulmCgFLBqijoe3H4pIXzJHk1w80732w3mpsR5ML Ppa8H+pmThhlB+5iibguBtJuC9UNHQlSNph4gn8kmC1LHJN0MTne+bFRYMnKEvIxqXfM ZwB92wnKp8IsnL+KDl7y8lxOD3cmsRduIFrgmGT+IZt/z30QNqLulXftaLJaPU8fgrD0 peINL1m/aVbKJAjyP0V+iEaSTWXXjWLDGTtU4PGLFacaeMqxNcZlH82esutKz5RaSqm0 7/jEqWwM7Q4eEtZBKbbtvPxA9v0GOdg5wpeQvZo5Rhh7bIA99BjjUKtrxc7V0IFzXqxf nh5w== X-Gm-Message-State: AOJu0YzKq/KHbxMos28u0G4ZiU1PO/7iTfOYW9p9sRBPydPZXT8udL25 AvE7elmJkuznrxNHYl6KHKr+OUXuApRSvPvAjBsfXR8xNlKmSkoiTQ6RZ8ykb9SuGlNlpVK0sTY = X-Google-Smtp-Source: AGHT+IEf5HzwkqL8wnRlGoWwX5eRKCReNA1Wwt/pJlPw/0z3u+5+RwRQFgGcAj35/H1UZ+s0ZI9gpQ== X-Received: by 2002:a05:6000:1564:b0:357:73ca:9c00 with SMTP id ffacd0b85a97d-3607a7660fbmr1400474f8f.32.1718350612909; Fri, 14 Jun 2024 00:36:52 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.52 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:52 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [COMMITTED 10/16] ada: Bad tree built for Obj.Discrim_Dep_Component'Loop_Entry in assertion Date: Fri, 14 Jun 2024 09:36:26 +0200 Message-ID: <20240614073633.2089692-10-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Steve Baird The Etype for an N_Selected_Component node usually should not match the Etype of the referenced component if the component is subject to a discriminant-dependent constraint. Instead Build_Actual_Subtype_Of_Component should be called. Fix a case where this rule was not being followed (because B_A_S_O_C is not called during preanalysis of a component selection), resulting in a tree that confused CodePeer because the subtype was wrong. gcc/ada/ * exp_attr.adb (Expand_Loop_Entry_Attribute): Ensure that Etype of the saved expression is set correctly. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_attr.adb | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 1396007a2d1..5c85b4912d2 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1780,14 +1780,25 @@ package body Exp_Attr is begin Aux_Decl := Empty; - -- Generate a nominal type for the constant when the prefix is of - -- a constrained type. This is achieved by setting the Etype of - -- the relocated prefix to its base type. Since the prefix is now - -- the initialization expression of the constant, its freezing - -- will produce a proper nominal type. - Temp_Expr := Relocate_Node (Pref); - Set_Etype (Temp_Expr, Base_Typ); + + -- For Etype (Temp_Expr) in some cases we cannot use either + -- Etype (Pref) or Base_Typ. So we set Etype (Temp_Expr) to null + -- and mark Temp_Expr as requiring analysis. Rather than trying + -- to sort out exactly when this is needed, we do it + -- unconditionally. + -- One case where this is needed is when + -- 1) Pref is an N_Selected_Component name that + -- refers to a component which is subject to a + -- discriminant-dependent constraint; and + -- 2) The prefix of that N_Selected_Component refers to a + -- formal parameter with an unconstrained subtype; and + -- 3) Pref has only been preanalyzed (so that + -- Build_Actual_Subtype_Of_Component has not been called + -- and Etype (Pref) equals the Etype of the component). + + Set_Etype (Temp_Expr, Empty); + Set_Analyzed (Temp_Expr, False); -- Generate: -- Temp : constant Base_Typ := Pref; From patchwork Fri Jun 14 07:36:27 2024 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: 1947709 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=hC0AXUFV; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rml0YSwz20X9 for ; Fri, 14 Jun 2024 17:40:55 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5C8843882677 for ; Fri, 14 Jun 2024 07:40:53 +0000 (GMT) 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 3A15F388264B for ; Fri, 14 Jun 2024 07:36:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3A15F388264B 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 3A15F388264B 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=1718350618; cv=none; b=jaPCGbELvzDQxip7OSU5QfQEBtsGXkDhCvx6l0kYyVaPHdWOZmlbhSNFHSIT9Pjq3tEXwC+4g31cWkUnRz5PoAebUyAhHDvhYxqE+V0lamBFB7J8kKlUyOz7rZgndFPvv614Wav43GGBq6YAPHpq8HRB4xu7dH3A+I9E4t5fy1U= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350618; c=relaxed/simple; bh=6uQ02hOrQAo0F9f2Qhci8mDRX/2v8IeGVpM4SHICUQo=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=bWix4DlrqzP21I9mzeY74k/Uc5jubtUwoaXKGetsG9HSbgUTyyV4Js90IEbO0lv76p7lVSz6SQpPX2iVrBlr8Kyiz6bDir1lHZ3Tj+JHih9cKf7qM0mhvq40yc+8jFLw66SkVbFRo5At9VEB+Jozmw+BL2q5JZOzpjKbxs1wOdM= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-35f1e35156cso1791640f8f.1 for ; Fri, 14 Jun 2024 00:36:55 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350614; x=1718955414; 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=k4C5bmcwtdRX5A3ZqlIuO+BCXqrnuJsawgVL8yAaeCU=; b=hC0AXUFVD9lgtM2cILah/O5DYffg8j9zQcHoJMG9uMV+fYoIb07x53LB+OXSInitKp bkDbku/Nz+nAWxN82QUSYQStmnNR7jVBmdMDtwYKIhMeDmKwvlfNXwlGv9CindkGowkK ex3xf/N/hzw6oL5t6CAqtBIA4wpFz3eDX++VDaV3Exvie3ykBA7/Wpc9+PeGkX7M/m5T xqJD7QgJiW6mRN6XgjtPLMaBWnt47djfn6HQKQCXkZyrdQRcrBzjPOgGMz1KkzOjilDM fNLvqgiM0xKS2znlzvH/S8GcvRMFj0EPpunZYeEPsnfYMPG0JwuGBULkjetZwJkwNRKe ZHeg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350614; x=1718955414; 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=k4C5bmcwtdRX5A3ZqlIuO+BCXqrnuJsawgVL8yAaeCU=; b=EiW+XNS5ydIGgaI4mEgaHSdx0sVWIUuyqH/qoKNcQZSQgn+9YisNRK8DCgTRgK7CxG Nud1s7cu0Y1gnVAVW/NaRRu012hgYQv7Dtf3MbJ+//cA7FBIYdKeqPJ0ZIz5jMSgaeff 6ySkj0g7nb5Yt2r334cj6KRMr0QiBBNfNccH/7qROFXKzjAmNNW1hr43GgSE64LU5Af5 kTZJrdQP63n7nwpT1sWcBMQvWl076o+OEibWi6fAVbfkGLEdTorqiYDXA+HGmgxcQJNr +od4a+pVlKVbUJKy4L18gdNqm8tTFjh4gDSADpWwrV2Si6HEtsCyBeAw0x5OByhDzbdp AsKw== X-Gm-Message-State: AOJu0YzDDXIRUbOIXoblyRL4P1PKXdC8WlgKc3F3O9IeDOGHin8oUqBx gmgogBqaGLuW7sL+ZMugBQra76/5T3bnrpmeEGFnPgulU5dwralTDZ0/Y+IvldcsLD564DvdI68 = X-Google-Smtp-Source: AGHT+IFV3W36zT2YdrkreCrOMU2ZD1DK3Dp25DBSK9zcZIMan0Yod0zCLl1O8EzO9yLpgss7L0Yi0Q== X-Received: by 2002:adf:eccc:0:b0:35f:2197:dbff with SMTP id ffacd0b85a97d-3607a7b65fdmr1165561f8f.24.1718350613959; Fri, 14 Jun 2024 00:36:53 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.53 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:53 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 11/16] ada: Fix parts of classification of aspects Date: Fri, 14 Jun 2024 09:36:27 +0200 Message-ID: <20240614073633.2089692-11-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou Many aspects are (correctly) marked as GNAT-specific but nevertheless not listed in the Implementation_Defined_Aspect array, so this aligns the two sides and also removes Default_Initial_Condition and Object_Size from the list, since they are defined in Ada 2022. This also moves No_Controlled_Parts and No_Task_Parts to the subclass of boolean aspects, and completes the list of nonoverridable aspects defined in Ada 2022. gcc/ada/ * aspects.ads (Aspect_Id): Alphabetize, remove the GNAT tag from Default_Initial_Condition and Object_Size, move No_Controlled_Parts and No_Task_Parts to boolean subclass. (Nonoverridable_Aspect_Id): Add missing Ada 2022 aspects. (Implementation_Defined_Aspect): Add all missing aspects, remove Max_Entry_Queue_Length and Object_Size (Aspect_Argument): Remove specific entries for No_Controlled_Parts and No_Task_Parts, list boolean aspects last. (Is_Representation_Aspect ): Move boolean aspects last. (Aspect_Names): Alphabetize. * sem_ch13.adb (Analyze_Aspect_Disable_Controlled): Adjust. (Analyze_Aspect_Specifications): Move around processing for No_Controlled_Parts and No_Task_Parts. (Check_Aspect_At_Freeze_Point): Remove specific entries for No_Controlled_Parts and No_Task_Parts Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.ads | 94 ++++++++++++++++++++++++++++---------------- gcc/ada/sem_ch13.adb | 69 +++++++++++++++++++------------- 2 files changed, 101 insertions(+), 62 deletions(-) diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index d4aafb1a4f1..202d42193d1 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -64,10 +64,14 @@ with Types; use Types; package Aspects is - -- Type defining recognized aspects + -- Type enumerating the recognized aspects. The GNAT tag must be in keeping + -- with the Implementation_Defined_Aspect array below. type Aspect_Id is (No_Aspect, -- Dummy entry for no aspect + + -- The following aspects do not have a (static) boolean value + Aspect_Abstract_State, -- GNAT Aspect_Address, Aspect_Aggregate, @@ -81,7 +85,7 @@ package Aspects is Aspect_Convention, Aspect_CPU, Aspect_Default_Component_Value, - Aspect_Default_Initial_Condition, -- GNAT + Aspect_Default_Initial_Condition, Aspect_Default_Iterator, Aspect_Default_Storage_Pool, Aspect_Default_Value, @@ -104,8 +108,8 @@ package Aspects is Aspect_Integer_Literal, Aspect_Interrupt_Priority, Aspect_Invariant, -- GNAT - Aspect_Iterator_Element, Aspect_Iterable, -- GNAT + Aspect_Iterator_Element, Aspect_Link_Name, Aspect_Linker_Section, -- GNAT Aspect_Local_Restrictions, -- GNAT @@ -113,9 +117,7 @@ package Aspects is Aspect_Max_Entry_Queue_Depth, -- GNAT Aspect_Max_Entry_Queue_Length, Aspect_Max_Queue_Length, -- GNAT - Aspect_No_Controlled_Parts, - Aspect_No_Task_Parts, -- GNAT - Aspect_Object_Size, -- GNAT + Aspect_Object_Size, Aspect_Obsolescent, -- GNAT Aspect_Output, Aspect_Part_Of, -- GNAT @@ -186,10 +188,10 @@ package Aspects is Aspect_Atomic, Aspect_Atomic_Components, Aspect_Constant_After_Elaboration, -- GNAT - Aspect_Disable_Controlled, -- GNAT - Aspect_Discard_Names, Aspect_CUDA_Device, -- GNAT Aspect_CUDA_Global, -- GNAT + Aspect_Disable_Controlled, -- GNAT + Aspect_Discard_Names, Aspect_Effective_Reads, -- GNAT Aspect_Effective_Writes, -- GNAT Aspect_Exclusive_Functions, @@ -206,9 +208,11 @@ package Aspects is Aspect_Interrupt_Handler, Aspect_Lock_Free, -- GNAT Aspect_No_Caching, -- GNAT + Aspect_No_Controlled_Parts, Aspect_No_Inline, -- GNAT Aspect_No_Return, Aspect_No_Tagged_Streams, -- GNAT + Aspect_No_Task_Parts, -- GNAT Aspect_Pack, Aspect_Persistent_BSS, -- GNAT Aspect_Preelaborable_Initialization, @@ -242,12 +246,13 @@ package Aspects is | Aspect_Constant_Indexing | Aspect_Default_Iterator | Aspect_Implicit_Dereference + | Aspect_Integer_Literal | Aspect_Iterator_Element | Aspect_Max_Entry_Queue_Length | Aspect_No_Controlled_Parts + | Aspect_Real_Literal + | Aspect_String_Literal | Aspect_Variable_Indexing; - -- ??? No_Controlled_Parts not yet in Aspect_Id enumeration see RM - -- 13.1.1(18.7). -- The following array indicates aspects that accept 'Class @@ -275,9 +280,13 @@ package Aspects is Aspect_Async_Writers => True, Aspect_Constant_After_Elaboration => True, Aspect_Contract_Cases => True, + Aspect_CUDA_Device => True, + Aspect_CUDA_Global => True, Aspect_Depends => True, + Aspect_Designated_Storage_Model => True, Aspect_Dimension => True, Aspect_Dimension_System => True, + Aspect_Disable_Controlled => True, Aspect_Effective_Reads => True, Aspect_Effective_Writes => True, Aspect_Exceptional_Cases => True, @@ -287,16 +296,30 @@ package Aspects is Aspect_Ghost_Predicate => True, Aspect_Global => True, Aspect_GNAT_Annotate => True, + Aspect_Initial_Condition => True, + Aspect_Initializes => True, Aspect_Inline_Always => True, Aspect_Invariant => True, + Aspect_Iterable => True, + Aspect_Linker_Section => True, + Aspect_Local_Restrictions => True, Aspect_Lock_Free => True, Aspect_Max_Entry_Queue_Depth => True, - Aspect_Max_Entry_Queue_Length => True, Aspect_Max_Queue_Length => True, - Aspect_Object_Size => True, + Aspect_No_Caching => True, + Aspect_No_Elaboration_Code_All => True, + Aspect_No_Inline => True, + Aspect_No_Tagged_Streams => True, + Aspect_No_Task_Parts => True, + Aspect_Obsolescent => True, + Aspect_Part_Of => True, Aspect_Persistent_BSS => True, Aspect_Predicate => True, Aspect_Pure_Function => True, + Aspect_Refined_Depends => True, + Aspect_Refined_Global => True, + Aspect_Refined_Post => True, + Aspect_Refined_State => True, Aspect_Relaxed_Initialization => True, Aspect_Remote_Access_Type => True, Aspect_Scalar_Storage_Order => True, @@ -305,16 +328,21 @@ package Aspects is Aspect_Side_Effects => True, Aspect_Simple_Storage_Pool => True, Aspect_Simple_Storage_Pool_Type => True, + Aspect_SPARK_Mode => True, + Aspect_Storage_Model_Type => True, Aspect_Subprogram_Variant => True, Aspect_Suppress_Debug_Info => True, Aspect_Suppress_Initialization => True, Aspect_Thread_Local_Storage => True, Aspect_Test_Case => True, + Aspect_Unimplemented => True, Aspect_Universal_Aliasing => True, Aspect_Unmodified => True, Aspect_Unreferenced => True, Aspect_Unreferenced_Objects => True, + Aspect_User_Aspect => True, Aspect_Value_Size => True, + Aspect_Volatile_Full_Access => True, Aspect_Volatile_Function => True, Aspect_Warnings => True, others => False); @@ -329,8 +357,8 @@ package Aspects is (Aspect_Aggregate => True, Aspect_Constant_Indexing => True, Aspect_Default_Iterator => True, - Aspect_Iterator_Element => True, Aspect_Iterable => True, + Aspect_Iterator_Element => True, Aspect_Variable_Indexing => True, others => False); @@ -425,8 +453,6 @@ package Aspects is Aspect_Max_Entry_Queue_Depth => Expression, Aspect_Max_Entry_Queue_Length => Expression, Aspect_Max_Queue_Length => Expression, - Aspect_No_Controlled_Parts => Optional_Expression, - Aspect_No_Task_Parts => Optional_Expression, Aspect_Object_Size => Expression, Aspect_Obsolescent => Optional_Expression, Aspect_Output => Name, @@ -473,8 +499,8 @@ package Aspects is Aspect_Warnings => Name, Aspect_Write => Name, - Boolean_Aspects => Optional_Expression, - Library_Unit_Aspects => Optional_Expression); + Library_Unit_Aspects => Optional_Expression, + Boolean_Aspects => Optional_Expression); -- The following array indicates what aspects are representation aspects @@ -484,20 +510,14 @@ package Aspects is Aspect_Address => True, Aspect_Aggregate => False, Aspect_Alignment => True, - Aspect_Always_Terminates => False, Aspect_Annotate => False, - Aspect_Async_Readers => False, - Aspect_Async_Writers => False, Aspect_Attach_Handler => False, Aspect_Bit_Order => True, Aspect_Component_Size => True, - Aspect_Constant_After_Elaboration => False, Aspect_Constant_Indexing => False, Aspect_Contract_Cases => False, Aspect_Convention => True, Aspect_CPU => False, - Aspect_CUDA_Device => False, - Aspect_CUDA_Global => False, Aspect_Default_Component_Value => True, Aspect_Default_Initial_Condition => False, Aspect_Default_Iterator => False, @@ -509,14 +529,10 @@ package Aspects is Aspect_Dimension_System => False, Aspect_Dispatching_Domain => False, Aspect_Dynamic_Predicate => False, - Aspect_Effective_Reads => False, - Aspect_Effective_Writes => False, Aspect_Exceptional_Cases => False, Aspect_Exclusive_Functions => False, - Aspect_Extensions_Visible => False, Aspect_External_Name => False, Aspect_External_Tag => False, - Aspect_Ghost => False, Aspect_Ghost_Predicate => False, Aspect_Global => False, Aspect_GNAT_Annotate => False, @@ -536,9 +552,6 @@ package Aspects is Aspect_Max_Entry_Queue_Depth => False, Aspect_Max_Entry_Queue_Length => False, Aspect_Max_Queue_Length => False, - Aspect_No_Caching => False, - Aspect_No_Controlled_Parts => False, - Aspect_No_Task_Parts => False, Aspect_Object_Size => True, Aspect_Obsolescent => False, Aspect_Output => False, @@ -561,7 +574,6 @@ package Aspects is Aspect_Relaxed_Initialization => False, Aspect_Scalar_Storage_Order => True, Aspect_Secondary_Stack_Size => True, - Aspect_Side_Effects => False, Aspect_Simple_Storage_Pool => True, Aspect_Size => True, Aspect_Small => True, @@ -583,36 +595,49 @@ package Aspects is Aspect_User_Aspect => False, Aspect_Value_Size => True, Aspect_Variable_Indexing => False, - Aspect_Volatile_Function => False, Aspect_Warnings => False, Aspect_Write => False, Library_Unit_Aspects => False, + Aspect_Always_Terminates => False, Aspect_Asynchronous => True, + Aspect_Async_Readers => False, + Aspect_Async_Writers => False, Aspect_Atomic => True, Aspect_Atomic_Components => True, + Aspect_Constant_After_Elaboration => False, + Aspect_CUDA_Device => False, + Aspect_CUDA_Global => False, Aspect_Disable_Controlled => False, Aspect_Discard_Names => True, + Aspect_Effective_Reads => False, + Aspect_Effective_Writes => False, Aspect_Export => True, + Aspect_Extensions_Visible => False, Aspect_Favor_Top_Level => False, Aspect_Full_Access_Only => True, + Aspect_Ghost => False, + Aspect_Import => True, Aspect_Independent => True, Aspect_Independent_Components => True, - Aspect_Import => True, Aspect_Inline => False, Aspect_Inline_Always => False, Aspect_Interrupt_Handler => False, Aspect_Lock_Free => False, + Aspect_No_Caching => False, + Aspect_No_Controlled_Parts => False, Aspect_No_Inline => False, Aspect_No_Return => False, Aspect_No_Tagged_Streams => False, + Aspect_No_Task_Parts => False, Aspect_Pack => True, Aspect_Persistent_BSS => True, Aspect_Preelaborable_Initialization => False, Aspect_Pure_Function => False, Aspect_Remote_Access_Type => False, Aspect_Shared => True, + Aspect_Side_Effects => False, Aspect_Simple_Storage_Pool_Type => True, Aspect_Static => False, Aspect_Suppress_Debug_Info => False, @@ -626,6 +651,7 @@ package Aspects is Aspect_Volatile => True, Aspect_Volatile_Components => True, Aspect_Volatile_Full_Access => True, + Aspect_Volatile_Function => False, Aspect_Yield => False); ----------------------------------------- @@ -699,8 +725,8 @@ package Aspects is Aspect_Interrupt_Handler => Name_Interrupt_Handler, Aspect_Interrupt_Priority => Name_Interrupt_Priority, Aspect_Invariant => Name_Invariant, - Aspect_Iterator_Element => Name_Iterator_Element, Aspect_Iterable => Name_Iterable, + Aspect_Iterator_Element => Name_Iterator_Element, Aspect_Link_Name => Name_Link_Name, Aspect_Linker_Section => Name_Linker_Section, Aspect_Lock_Free => Name_Lock_Free, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2fbddf3f952..cd47f734462 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1869,6 +1869,8 @@ package body Sem_Ch13 is procedure Analyze_Aspect_Disable_Controlled is begin + Error_Msg_Name_1 := Nam; + -- The aspect applies only to controlled records if not (Ekind (E) = E_Record_Type @@ -3796,32 +3798,6 @@ package body Sem_Ch13 is Insert_Pragma (Aitem); goto Continue; - -- No_Controlled_Parts, No_Task_Parts - - when Aspect_No_Controlled_Parts | Aspect_No_Task_Parts => - - -- Check appropriate type argument - - if not Is_Type (E) then - Error_Msg_N - ("aspect % can only be applied to types", E); - end if; - - -- Disallow subtypes - - if Nkind (Declaration_Node (E)) = N_Subtype_Declaration then - Error_Msg_N - ("aspect % cannot be applied to subtypes", E); - end if; - - -- Resolve the expression to a boolean - - if Present (Expr) then - Check_Expr_Is_OK_Static_Expression (Expr, Any_Boolean); - end if; - - goto Continue; - -- Obsolescent when Aspect_Obsolescent => declare @@ -4503,6 +4479,45 @@ package body Sem_Ch13 is elsif A_Id = Aspect_Full_Access_Only then Error_Msg_Ada_2022_Feature ("aspect %", Loc); + -- No_Controlled_Parts, No_Task_Parts + + elsif A_Id in Aspect_No_Controlled_Parts + | Aspect_No_Task_Parts + then + Error_Msg_Name_1 := Nam; + + -- Disallow formal types + + if Nkind (Original_Node (N)) = N_Formal_Type_Declaration + then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + + -- Disallow subtypes + + elsif Nkind (Original_Node (N)) = N_Subtype_Declaration + then + Error_Msg_N + ("aspect % not allowed for subtype declaration", + Aspect); + + -- Accept all other types + + elsif not Is_Type (E) then + Error_Msg_N + ("aspect % can only be specified for a type", + Aspect); + end if; + + -- Resolve the expression to a boolean + + if Present (Expr) then + Check_Expr_Is_OK_Static_Expression (Expr, Any_Boolean); + end if; + + goto Continue; + -- Ada 2022 (AI12-0075): static expression functions elsif A_Id = Aspect_Static then @@ -11539,8 +11554,6 @@ package body Sem_Ch13 is | Aspect_Max_Entry_Queue_Depth | Aspect_Max_Entry_Queue_Length | Aspect_Max_Queue_Length - | Aspect_No_Controlled_Parts - | Aspect_No_Task_Parts | Aspect_Obsolescent | Aspect_Part_Of | Aspect_Post From patchwork Fri Jun 14 07:36:28 2024 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: 1947708 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=X9JUnDla; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rmS2XN6z20X9 for ; Fri, 14 Jun 2024 17:40:40 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9EA9F388266D for ; Fri, 14 Jun 2024 07:40:38 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x433.google.com (mail-wr1-x433.google.com [IPv6:2a00:1450:4864:20::433]) by sourceware.org (Postfix) with ESMTPS id D6B5B388264C for ; Fri, 14 Jun 2024 07:36:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D6B5B388264C 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 D6B5B388264C Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::433 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350618; cv=none; b=SFOLcQRJeSmZx9ihsLVNy8I/C4tdevijdr1A1K/jCUrZ8SI6E0jx1daCmwacWE9rW27ON2o7pKXv77xLhhcQOQc1nIecePty5JMHT3V+5QYeGOXyrKpbRCKk6rZPFjdiqVsfl836hQqX6+2U3e3E+4V+FduhaKpMr7EmM+kHE9U= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350618; c=relaxed/simple; bh=j+P7XpDheTp0ajPTDCEQear+vEMh9edELV4eaa9V9mg=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=p9E0Fezfc+t41BtXkt33Gt34m20eovudzoQ4QAipaANgcbbNfxkiOCQjvGVu97T6vKhbTZJ8YzBhxv9ag6WxhP6hunoasM/WeOPmjsqw4kw1J2AXhYK4HTME5tBi/Yt9Wu/0KiR+z+I59h9QYZSokBs+2lw2FE1/inall2bPUi0= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x433.google.com with SMTP id ffacd0b85a97d-35f188e09a8so1497547f8f.2 for ; Fri, 14 Jun 2024 00:36:55 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350614; x=1718955414; 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=lkatLZtPmiiXReC8jvWY0e9cha8pfseI5hlQNmdVRMU=; b=X9JUnDlal7eFydNUNYEW1HX0VsjvAF1QG+EVYTF0F7UQJ0rmmR47f40bKNZ6HCK0b7 A/3rZ7XbavG29RQhdKXWwRZQo5DYye8IG/tHEDWP8HDY0dP0uO2s5+8Qav2gkG/8alMe ycxL0PuImN51pqxwO6kxJ+2yon//7U02nB8DKarsJTh6HE6yU3TcMdw/uyS6swq1jGOH xuvZe18/D549nbhCEdlUQLdQF8zDQZqCAXCh2IMwIIdxk3KbAe4x3c1h90nIPXCoJf9q 3wn5mAM9XTDljpl54wr+dd6n/x5+iaTVfWzjpNkv5VbFGoHMyykHlOLy6ay+nL3Hfp4w 0uyg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350614; x=1718955414; 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=lkatLZtPmiiXReC8jvWY0e9cha8pfseI5hlQNmdVRMU=; b=gXX4QUfFOQfy6JHrxvVmJ8/WRntvxQdkBVyaCaFlt9g3pRd1HC3xKpzB2WzYEY+CWn GyUCJU/HJybWzcRYA6pabgxTduv0/iUrnLZTaoz6wn9kxL94tiFYUmRhk7nKjMZjuTTB Sgg9inkZPAU2dVEE+QGpIaJTKjTJoB+oQUchQuJYKDt0o4AOAGY55OS/SaH8xK8Xcd+p F/xXnB+a2U7n0LnXy3n4Z8vXD4jb8sv8e22Kw/bSCidgR2QctYXP/M+7e4l3dNu75gnn BVW/o8z9s0Opn2Q0Ne1bhDZDrW5seb9LHQJBO0zzqLrm7iwpqxepyDhNdo9/LTo8eaFZ 3OEw== X-Gm-Message-State: AOJu0YzPR488bdLnenKLXsz6x8rAJqVdkBMry5b742gZM01BMk+2E/6G 97YM1MxCpqbAJw+i4LFDe5uST9F2LJ4pC2R8hppSqWFUD01XZrR9u/pUpMveg6ihSw9nym0vMWo = X-Google-Smtp-Source: AGHT+IFh23+uFOVIxkrOoxTxg+/+DOhsU5Z6wakPX4vDRc95iUg+1MPE+w9GPj0M8Pq9Dent/j9dRQ== X-Received: by 2002:a5d:4e82:0:b0:360:7d8d:a362 with SMTP id ffacd0b85a97d-3607d8da45amr764641f8f.0.1718350614611; Fri, 14 Jun 2024 00:36:54 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.54 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:54 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: =?utf-8?q?Marc_Poulhi=C3=A8s?= Subject: [COMMITTED 12/16] ada: Typo and indentation fix Date: Fri, 14 Jun 2024 09:36:28 +0200 Message-ID: <20240614073633.2089692-12-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Fixes typo in comments and 2 instances of bad indentation. gcc/ada/ * gcc-interface/decl.cc (gnat_to_gnu_entity): Typo fix. (gnat_to_gnu_component_type): Indent fix. * gcc-interface/gigi.h (build_call_alloc_dealloc): Typo fix. * gcc-interface/utils.cc (make_dummy_type): Typo fix. * gcc-interface/utils2.cc (gnat_protect_expr): Indent fix. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/decl.cc | 8 ++++---- gcc/ada/gcc-interface/gigi.h | 2 +- gcc/ada/gcc-interface/utils.cc | 2 +- gcc/ada/gcc-interface/utils2.cc | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 8b72c96c439..23983742605 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -1384,7 +1384,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) volatile_flag = false; gnu_size = NULL_TREE; - /* In case this was a aliased object whose nominal subtype is + /* In case this was an aliased object whose nominal subtype is unconstrained, the pointer above will be a thin pointer and build_allocator will automatically make the template. @@ -2103,7 +2103,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) 1. the array type (suffix XUA) containing the actual data, - 2. the template type (suffix XUB) containng the bounds, + 2. the template type (suffix XUB) containing the bounds, 3. the fat pointer type (suffix XUP) representing a pointer or a reference to the unconstrained array type: @@ -5445,8 +5445,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, if (gnu_comp_align > TYPE_ALIGN (gnu_type)) gnu_comp_align = 0; } - else - gnu_comp_align = 0; + else + gnu_comp_align = 0; gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, gnu_comp_align, gnat_array, true, definition, true); diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index f3205a8a25d..6ed74d6879e 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -906,7 +906,7 @@ extern tree build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, Entity_Id gnat_pool, Node_Id gnat_node); /* Build a GCC tree to correspond to allocating an object of TYPE whose - initial value if INIT, if INIT is nonzero. Convert the expression to + initial value is INIT, if INIT is nonzero. Convert the expression to RESULT_TYPE, which must be some type of pointer. Return the tree. GNAT_PROC and GNAT_POOL optionally give the procedure to call and diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index ae520542ace..771cb1a17ca 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -499,7 +499,7 @@ make_dummy_type (Entity_Id gnat_type) if (No (gnat_equiv)) gnat_equiv = gnat_type; - /* If it there already a dummy type, use that one. Else make one. */ + /* If there is already a dummy type, use that one. Else make one. */ if (PRESENT_DUMMY_NODE (gnat_equiv)) return GET_DUMMY_NODE (gnat_equiv); diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc index 4b7e2739f6a..70271cf2836 100644 --- a/gcc/ada/gcc-interface/utils2.cc +++ b/gcc/ada/gcc-interface/utils2.cc @@ -2884,7 +2884,7 @@ gnat_protect_expr (tree exp) if (code == NON_LVALUE_EXPR || CONVERT_EXPR_CODE_P (code) || code == VIEW_CONVERT_EXPR) - return build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0))); + return build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0))); /* If we're indirectly referencing something, we only need to protect the address since the data itself can't change in these situations. */ From patchwork Fri Jun 14 07:36:29 2024 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: 1947706 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=AuEXVzoM; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rlw17Mgz20X9 for ; Fri, 14 Jun 2024 17:40:12 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 6FB193882169 for ; Fri, 14 Jun 2024 07:40:10 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x12a.google.com (mail-lf1-x12a.google.com [IPv6:2a00:1450:4864:20::12a]) by sourceware.org (Postfix) with ESMTPS id 4A1323882664 for ; Fri, 14 Jun 2024 07:36:57 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4A1323882664 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 4A1323882664 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::12a ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350619; cv=none; b=Van9FOye4TqTRPpH9t55GzT/amuaYX7V2TZUXt9vak2hnHiw2wU8vDKhOXymC9XlBFgciM5XLuU/zWeBRB/ZhoqcdAgaKvxJS23loujkDIas2Y+A179rIgHQCnG4aLbskU5RlIFlIkxfnFYi48s3c+cakRiz+beD9HXMAHQ2xt0= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350619; c=relaxed/simple; bh=ofVuKmYAqkmPv/0LFUMocgHE6DWwVqkJ5donU1jSSSc=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=LXO9QC7TILNntFjiAuFViqd2ClAt35Qf8fHBObC5yuJfceFYG980gsM7mbNwCuIIQ5HYlFI8M6cXYhBeCOBEdkCPYaiinViGLnllGEGoiT3eW9Y5pK9xOUx2pKhdcC66recVEQOMO+iblpVhAbhMTL/M64SOdmu2HHn/QWDQGkc= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lf1-x12a.google.com with SMTP id 2adb3069b0e04-52bd48cf36bso2307984e87.3 for ; Fri, 14 Jun 2024 00:36:57 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350616; x=1718955416; 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=YGqi1E0m4WC9dslJz81B7ZgUliyPijFhsHmKXEW+tPU=; b=AuEXVzoMhZupNJ1Gf2+LaY7OWOBQ+hVsjXPUpf6CogVi4tWpvQirtpE1VsqLjHMVL5 ufg1s2rBkjKxSJP8UCMfw7xrVS1l9dBKcO0cjrWyOK2WPZRVR/lretFghcJK3Nkx3T4t I5B8FGUqKs25gF6q/b1A4g11K7ys2BUMKfuyuOtK8U6zO3tBrUYCf7DDNokbydNKJeUX G5wEbzXmaCqLMqkhiPmsIIr7m7cD/Xp5P2pBbMk7M400lEOZOWceBxgMLEsx8cWhhLK/ QwkiqAOiqNYxrB9aUd3ZJDpYFVo/tb95HckSCJw5yGcakdh1JFX8uagx1+PGq3ae4KR2 6koQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350616; x=1718955416; 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=YGqi1E0m4WC9dslJz81B7ZgUliyPijFhsHmKXEW+tPU=; b=wEE15gOoJrdVwnc+8zJKja3NKGZkJ83iiVJEbo/wkawxycOLHQqJBgVsAF65Qnzz2D wwFG+oAK3HQgD8n0zu9hRfBrKXVkikQtiCnH3TuzJD7HP6kFtRoSJE5EFxPx6Yt7GXKG t1PZY/l1jLH5xvjYCv5sZFMhjVbTTdRTz2xifsI50rYSGQuciQ7LeEUhk9nFRub6rgrJ XInB9uwrJMIwmqXg2Ck0liUzxlaEhACDnb4wmHa+KIb5StEUxNdzwMkd/kJQbXlAGVSI /tuEyUFftr3KhNBbLVs5cppB3rLOlza6GyHuyyq4UXaEa8FRiJ44Kuyi55Gia/2cDOxm JNKg== X-Gm-Message-State: AOJu0Yz+IROboSwmDjfRUCSf3bPwcf8+fiLR82dpGXTWLrENBXo4E/qt 90Emo37URVU1kKUP10RdSEwOqP5g8ym4whzFnIW5UMc/4Qg81MWEDgjrLRpaK6tpda/TI0xTM5s = X-Google-Smtp-Source: AGHT+IEWVocMR0OSpXQjBov9EAVJTiEamQCDoOjURCCktQMQd9uv57LDp1EvOz2/ijUWWuWjR0Qe6g== X-Received: by 2002:ac2:5b4f:0:b0:52b:c222:5237 with SMTP id 2adb3069b0e04-52ca6e6597amr1337254e87.22.1718350615786; Fri, 14 Jun 2024 00:36:55 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.54 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:55 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 13/16] ada: Do not create null GCC thunks Date: Fri, 14 Jun 2024 09:36:29 +0200 Message-ID: <20240614073633.2089692-13-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou This prevents Gigi from creating null GCC thunks, i.e. thunks that have all their internal parameters set to zero, replacing them with aliases. They can arise in degenerate cases and null thunks would trip on an assertion in former_thunk_p when they are later optimized. gcc/ada/ PR ada/109817 * gcc-interface/trans.cc (maybe_make_gnu_thunk): Create an alias instead of a null thunk. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/trans.cc | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 93978c0f0ba..5256095dfeb 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -11093,6 +11093,16 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk) tree gnu_interface_offset = gnu_interface_tag ? byte_position (gnu_interface_tag) : NULL_TREE; + /* But we generate a call to the Thunk_Entity in the thunk. */ + tree gnu_target + = gnat_to_gnu_entity (Thunk_Entity (gnat_thunk), NULL_TREE, false); + + /* If the target is local, then thunk and target must have the same context + because cgraph_node::expand_thunk can only forward the static chain. */ + if (DECL_STATIC_CHAIN (gnu_target) + && DECL_CONTEXT (gnu_thunk) != DECL_CONTEXT (gnu_target)) + return false; + /* There are three ways to retrieve the offset between the interface view and the base object. Either the controlling type covers the interface type and the offset of the corresponding tag is fixed, in which case it @@ -11111,6 +11121,15 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk) virtual_value = 0; virtual_offset = NULL_TREE; indirect_offset = 0; + + /* Do not create a null thunk, instead make it an alias. */ + if (fixed_offset == 0) + { + SET_DECL_ASSEMBLER_NAME (gnu_thunk, DECL_ASSEMBLER_NAME (gnu_target)); + (void) cgraph_node::get_create (gnu_target); + (void) cgraph_node::create_alias (gnu_thunk, gnu_target); + return true; + } } else if (!gnu_interface_offset && !Is_Variable_Size_Record (gnat_controlling_type)) @@ -11132,16 +11151,6 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk) indirect_offset = (HOST_WIDE_INT) (POINTER_SIZE / BITS_PER_UNIT); } - /* But we generate a call to the Thunk_Entity in the thunk. */ - tree gnu_target - = gnat_to_gnu_entity (Thunk_Entity (gnat_thunk), NULL_TREE, false); - - /* If the target is local, then thunk and target must have the same context - because cgraph_node::expand_thunk can only forward the static chain. */ - if (DECL_STATIC_CHAIN (gnu_target) - && DECL_CONTEXT (gnu_thunk) != DECL_CONTEXT (gnu_target)) - return false; - /* If the target returns by invisible reference and is external, apply the same transformation as Subprogram_Body_to_gnu here. */ if (TREE_ADDRESSABLE (TREE_TYPE (gnu_target)) From patchwork Fri Jun 14 07:36:30 2024 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: 1947713 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=TsC6odnY; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rr20y0Cz20X9 for ; Fri, 14 Jun 2024 17:43:46 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 67A143882165 for ; Fri, 14 Jun 2024 07:43:44 +0000 (GMT) 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 0F655388264F for ; Fri, 14 Jun 2024 07:36:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 0F655388264F 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 0F655388264F 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=1718350619; cv=none; b=Sphy9/07bNT6G6XZVn76sNXRJUceZVADpYzyoBawTw75j2ZLmEA+7wQBI23t/W+zoKUw9LHRF/NWPNM96rE76awnJLoP7FOXsctTEC6zfkosJCbY6hG6dQYGTjFltVuyM5MUoomHwoiuYAPd9Mm5TYZdgepX9zh2bcYEgOKGbCg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350619; c=relaxed/simple; bh=tWGgpQMoL1/C9pPSOlVCWUSEz20OrX034aauZCAap1U=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Y/AJ1WkadvBhTPRvleaodnN9ptZhv2ezGg7TznaTiOL0SH8+lawsYmmR7g4lF8O9HF/617rvsAMh1yarW6L3bTaFQE0xsnoss3wc5Wl8QvzCLlLQMQAWIVyyCGza8tl1RpA9NMvet7+ToQAEcDMrwZwOorVMLbpbqM/WQ3GnLIg= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x430.google.com with SMTP id ffacd0b85a97d-35f23f3da44so1728664f8f.0 for ; Fri, 14 Jun 2024 00:36:57 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350617; x=1718955417; 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=hySU+sQz9d4ahzXEQ/7+ZODI08vb30gXHd2HZmQiUEM=; b=TsC6odnY3MLdfxDM/tbx0ct48rY7jVw8Rcu4GYS85zK8Zm5M5gUqurYo8PwPoZLzRU BFZD/3OaJ4cRMG5t0vD78LxsP5RdT6S6nSene6NRpKRTX5KeaitjPHP16ERhatQc7mFd 54ZxUfr0bnuVGhXW3CbsN3XyTgrD9+LPLinl5kAjr/dETLrDd/bWZQeTyAWfWSzKQdG8 +3BZNqHyBUuO/VaEWklkPLm5NqmRGilP26nxHqWpK1H6hObSGReHfRAE8e1I98bUypLW JEcjfPfi12siQhOmXWZo6oSTPy2YBJswPzUyXe+LbLdGWOkBzmCF/TGWVyj4BACZHHz/ Q/VA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350617; x=1718955417; 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=hySU+sQz9d4ahzXEQ/7+ZODI08vb30gXHd2HZmQiUEM=; b=VnN30QEdgid0et9BdVKEQ0YmqPMT3mE4UJS7Xh6/wsuux3eQGMjjScuZ+5Nb+bORxv dxzlfHAlNBf03tHSb0dWEpLaVB4ltefjEchgV2t28/UbjLFv5qvfGXcWTL81BJiwdPax CDSdcBVeEd+mKN6UFT7eHqqNbd1uECsf86/E8MSEuhnwqkaesZxY6j4LuaUuGC7ijvQk qKG2DcQBQAMv16zk6nEcOmPFHVfeHOZbG6/rbdNOj2A9shtSgfcnTzIy04OAwy5edz7q aoQem6Tqlq/bGovkeFTCYmnP3qrWiKYv6I+HEXWYkzc7HkoBAhDFLesJyuFioTRSQDVd nB0g== X-Gm-Message-State: AOJu0YyjDqudZ6hIcKUvXUCWwvhOpQuTx63+eZUVuvcNE9JTE6dm9Twz sG0iK8M0KiZI1T47DQvJxMXIHIERXdCMwNWR4pHNnBguvQm96YE1/0relvlo8df2uBu4YrS6JHQ = X-Google-Smtp-Source: AGHT+IF0GFEShEFUomWlkLuRG5Iv2+5GXPJgZfEYh4gDqZgHYaecT90ajiUnwQdgrMU2H1pFwpVJTA== X-Received: by 2002:a05:6000:181b:b0:35f:16c9:aa9c with SMTP id ffacd0b85a97d-3607a7c13acmr1218223f8f.40.1718350616759; Fri, 14 Jun 2024 00:36:56 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.55 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:56 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Yannick Moy Subject: [COMMITTED 14/16] ada: Skip subprogram body entities inside scopes Date: Fri, 14 Jun 2024 09:36:30 +0200 Message-ID: <20240614073633.2089692-14-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Yannick Moy Entities of kind E_Subprogram_Body, used on bodies of subprograms for which there is a separate declaration, have been added in the entities linked from a scope in order to get the representation information on their enclosed object and type declarations. Skip these entities in gigi. gcc/ada/ * gcc-interface/trans.cc (elaborate_all_entities_for_package) (process_freeze_entity): Skip entities of kind E_Subprogram_Body. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/trans.cc | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 5256095dfeb..e68fb3fd776 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -9321,6 +9321,10 @@ elaborate_all_entities_for_package (Entity_Id gnat_package) if (kind == E_Package_Body) continue; + /* Skip subprogram bodies. */ + if (kind == E_Subprogram_Body) + continue; + /* Skip limited views that point back to the main unit. */ if (IN (kind, Incomplete_Kind) && From_Limited_With (gnat_entity) @@ -9427,6 +9431,10 @@ process_freeze_entity (Node_Id gnat_node) if (Is_Subprogram (gnat_entity) && Present (Interface_Alias (gnat_entity))) return; + /* Skip subprogram bodies. */ + if (kind == E_Subprogram_Body) + return; + /* Check for an old definition if this isn't an object with address clause, since the saved GCC tree is the address expression in that case. */ gnu_old From patchwork Fri Jun 14 07:36:31 2024 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: 1947712 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=Zy0PdR61; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rqZ1l3kz20X9 for ; Fri, 14 Jun 2024 17:43:22 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 84073388264F for ; Fri, 14 Jun 2024 07:43:20 +0000 (GMT) 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 CBE573882178 for ; Fri, 14 Jun 2024 07:36:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org CBE573882178 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 CBE573882178 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=1718350627; cv=none; b=mxxVCHC5fdzIwvnGs5r48N1cx/iRnlkzUKoOmUzrRAwVGSXO0yq37gJaMriD0fjjIgYDi7FsqJxfjsNbr1MOANKvVDYt+OgSRhFoDoCa98kX797Az1SqeA+nh1hvAn14PI1NaL2B5O+Izx6NDi8Cbg1bd+AJZ1BujnYtQVUhMsg= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350627; c=relaxed/simple; bh=S8L12mlR8A8RPcFMuF5QxlaZy3GzvSVPH8Tgyjsk7k0=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=s+PFrBxi0dcQOdP9etU6xAbnJyQhdkWumHI2wWNWASBHzb1tgkr5FYVYpchqZNpqq3OS6g/MbPiWL3HvHrLaapUkbzeK3hwMeKBbYpDua36mUm0E4gJURPKt9ZjL4bkSxQd5TrJsAzuNxKKDKMoFzgF0Awo91Ejw0IHOtqVV02w= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-35f1bc63981so1796283f8f.1 for ; Fri, 14 Jun 2024 00:36:58 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350617; x=1718955417; 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=/fbSlnxH2boEzVMn74U3To1YgYvvBMkhdIYJuVUC5M8=; b=Zy0PdR61P0rT1bMfYvHf7Fhiatmc3IghJfHkUSVtkTRQb1s4YXpgvDP+jWyY9O7MBw 992O1kzqR9YGtFH+D4YLR3A/WpUwlRjwENRumhLe2SGbdj3urdMvt3Zw3j+7YLnBN0uQ nvLzp+bEnrXdMkMSp0ojkHDipdoBQskWHsGdU5RpDL9338YTdTGBk4BNfgE5zVUdCuXI DPloIIuzbc4bpie+3GBpd5kv9R58Sf22DMa9mqlFseL0GptsQLfPARLXtvvnTMUs8pYg 3hd+gzOPCEucVELeOZ2J/PPVlkxAKe+NcxXglYNtvgDgGb06spK3ruFpAoRBQwIxvBHy aeKQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350617; x=1718955417; 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=/fbSlnxH2boEzVMn74U3To1YgYvvBMkhdIYJuVUC5M8=; b=jZtTNgLdq8/oDhFJy4fAzB3lURj/ioi4AKcxGRwA2K+gexQs3vz3iMKNV4fYs0SLTd FmqTok1oXB8dttulke1qmVm5qZYbRY0cKr233J/1ldWxYQwg/7pokRxcZ4NoGTH0eNrK 9ruF1uoPiaRJe+CaFlCv1ylYaPG9qLgj/UCtCn8HbdPYL32oJgq9/2Co6wFc2z9KvHdP H2E3Tlq/T9ZJbkO9AROUpoZ03GCmf6zXIE8w0H6u1FPBlAZKjSJ3bWeiAgC0oPldA0vJ n2OeoLXlcNM5ST8yo+E3A2InurxacrJwf0by04OiHWSmW58qwuchVjjg5HcGHU3g4sQR 5G4A== X-Gm-Message-State: AOJu0YyQbP5BnbPcN6nJB2RFfMrA3aW5EzbgP1vYq7eAIc6B9kVbtw9x 02Q2K5nYUFdbqMbN4SPWiW9sacOcp44RJoxeWacUjhtLKpnfXuiOt3wzaCrmJgVMI5pI2ZIIKPM = X-Google-Smtp-Source: AGHT+IFhiwPhDuD+EwFqLJ4VEJ8Tuvtx5Ow0DdDaaN7WgsFkXdbv6oLlPhEEdBV9HRES8Uy5ugJUWw== X-Received: by 2002:a5d:4050:0:b0:360:7dcd:e836 with SMTP id ffacd0b85a97d-3607dcde9e3mr941291f8f.17.1718350617616; Fri, 14 Jun 2024 00:36:57 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.56 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:57 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 15/16] ada: Fix return mechanism reported by -gnatRm Date: Fri, 14 Jun 2024 09:36:31 +0200 Message-ID: <20240614073633.2089692-15-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou The return mechanism of functions is reported when the -gnatRm switch is specified, but it is incorrect when the result type is not a by-reference type in the language sense but is nevertheless returned by reference. gcc/ada/ * gcc-interface/decl.cc: Include function.h. (gnat_to_gnu_param): Minor comment tweaks. (gnat_to_gnu_subprog_type): Take into account the default for the computation of the return mechanism. Give a warning if a by-copy specified mechanism cannot be honored. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/decl.cc | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 23983742605..aa31a888818 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -27,6 +27,7 @@ #include "system.h" #include "coretypes.h" #include "target.h" +#include "function.h" #include "tree.h" #include "gimple-expr.h" #include "stringpool.h" @@ -5703,6 +5704,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, input_location = saved_location; + /* Warn if we are asked to pass by copy but cannot. */ if (mech == By_Copy && (by_ref || by_component_ptr)) post_error ("??cannot pass & by copy", gnat_param); @@ -5735,12 +5737,13 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, DECL_RESTRICTED_ALIASING_P (gnu_param) = restricted_aliasing_p; Sloc_to_locus (Sloc (gnat_param), &DECL_SOURCE_LOCATION (gnu_param)); - /* If no Mechanism was specified, indicate what we're using, then - back-annotate it. */ + /* If no Mechanism was specified, indicate what we will use. */ if (mech == Default) mech = (by_ref || by_component_ptr) ? By_Reference : By_Copy; + /* Back-annotate the mechanism in all cases. */ Set_Mechanism (gnat_param, mech); + return gnu_param; } @@ -6129,11 +6132,6 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, associate_subprog_with_dummy_type (gnat_subprog, gnu_return_type); incomplete_profile_p = true; } - - if (kind == E_Function) - Set_Mechanism (gnat_subprog, return_by_direct_ref_p - || return_by_invisi_ref_p - ? By_Reference : By_Copy); } /* A procedure (something that doesn't return anything) shouldn't be @@ -6636,6 +6634,28 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, if (warn_shadow) post_error ("'G'C'C builtin not found for&!??", gnat_subprog); } + + /* Finally deal with the return mechanism for a function. */ + if (kind == E_Function) + { + /* We return by reference either if this is required by the semantics + of the language or if this is the default for the function. */ + const bool by_ref = return_by_direct_ref_p + || return_by_invisi_ref_p + || aggregate_value_p (gnu_return_type, gnu_type); + Mechanism_Type mech = Mechanism (gnat_subprog); + + /* Warn if we are asked to return by copy but cannot. */ + if (mech == By_Copy && by_ref) + post_error ("??cannot return from & by copy", gnat_subprog); + + /* If no mechanism was specified, indicate what we will use. */ + if (mech == Default) + mech = by_ref ? By_Reference : By_Copy; + + /* Back-annotate the mechanism in all cases. */ + Set_Mechanism (gnat_subprog, mech); + } } *param_list = gnu_param_list; From patchwork Fri Jun 14 07:36:32 2024 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: 1947710 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=LTf+5wKF; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4W0rn44RbVz20X9 for ; Fri, 14 Jun 2024 17:41:12 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D5834388266F for ; Fri, 14 Jun 2024 07:41:10 +0000 (GMT) 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 B71A73882678 for ; Fri, 14 Jun 2024 07:36:59 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org B71A73882678 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 B71A73882678 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=1718350627; cv=none; b=t6gPklo/j3TNpAYbhpMhxsMmShrZVcYzCNV+KonihcWfh4FzW+sOwnPouj+6/httiN/sccmSkKtxHuSI8JuBvfZKyMtBYDGsmFYz23WRCrF0eQajdDLGA7MmoZIYOHg7VFWZDTL/8pbOEijBNzw1L3YtYU0V1nHE1VvDceaVXnI= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718350627; c=relaxed/simple; bh=XnQmNjzj2imQ5IyoIHdMrqkdAOkfJkt2eOOhPe84wtY=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=XVOSTMe3RT1YajMCk7/dRkqExinytOt0ivAieDgBkakH1Y4xcJSFEuBf11IKt3NYeuj1aK52Oa+NIUOpYK1L7UGiuvMBzl1tfo+W3JmVvV9bGaBAIKBurrW111XCQrMpJ8aufHXRMI65JdD9JYEtIIutxJ054LGmPUuECuBhuI4= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x42f.google.com with SMTP id ffacd0b85a97d-35f2c9e23d3so1944216f8f.0 for ; Fri, 14 Jun 2024 00:36:59 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1718350618; x=1718955418; 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=aYgeW/G6/zgljGedeTs6aR8m4GaQ1931flnjV1QyF0c=; b=LTf+5wKFBl2WeBM41oYJHBvthQYCL79PsTNxBvDrhJOQ11uEu8AXWXjD8IezvF9E9P ZZGxyw6xhxOPhwPBv6z8rzjPS/2Cxz8IP02yl5sUneQFCJ/A/TVcklpmIfwInwdWl6Dp S5195vmgWQWbyeY4bhj9ZlIsdNtE1baIjfonhEQ46exSREMRNg0OAwrzrNZh0bhTHQig RzI5HmOGrRYpf/KktjymWIiLSNluPIAyPaUUimmoCyig8DVetMkU+IiFGxsSA/h0DtoN wBtEHrUJdfZywwfDCoNJ0xDkw5nF+83OItAB/8h1uF8YUM7EiAiRf7Z2j/RZZFNFILOG Kjew== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1718350618; x=1718955418; 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=aYgeW/G6/zgljGedeTs6aR8m4GaQ1931flnjV1QyF0c=; b=IS7Kn1LvKUPgQOfkHo8CyJiwk7gkddmKL73Hgee3W/xIjQSym+1R3XD4RfmsQqkkmU O/Gyi7/ghCal/1+eeoMNKLy5RnojAxB0LEajhCgn5jyiRSKYAx6MvrciGS3QS86+qgWC nSHr5vsAwHZqt//md7O01MGoQKJYa/T22td8VECqxkxLJWJkDZI0Z2Vi3qnWrhacodyH PSgcrAqhtZiagrz3pn00r/+WG0I8ODxSxiS6T9mQae72+Z4D2WcFPyvIUxL4ZuW2HhQu 5GPi88k71edFv5JW2UDzdJQGthWYTD45qBoXH4CiNNfbb4K+pFWUUIQtdl8SyFP6iHcC AWWg== X-Gm-Message-State: AOJu0YzZfVegmHKduOBADYdUCVKRYdoiqPuNoUh4I0z5GpTlkmcjVxnF eaJGahXPzi13ab56quAep+lV39cidrmLqhTPXg0UMJ2jgilxkn1ZKURewNfMAeV42DUHg9Ki2O0 = X-Google-Smtp-Source: AGHT+IEY8X4sf/iBJxAXGw6Xdpin6iRlhTvkO5xHE4VnXxed5kASgEe9l1S3HxTSnhizsRILR9hiTw== X-Received: by 2002:a5d:6d87:0:b0:360:6e1c:558f with SMTP id ffacd0b85a97d-3607a4c860amr2075894f8f.5.1718350618493; Fri, 14 Jun 2024 00:36:58 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cb5c:2e27:9d1c:5033]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36075093636sm3558191f8f.14.2024.06.14.00.36.57 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Jun 2024 00:36:57 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 16/16] ada: Do not include target-specific makefile fragments Date: Fri, 14 Jun 2024 09:36:32 +0200 Message-ID: <20240614073633.2089692-16-poulhies@adacore.com> X-Mailer: git-send-email 2.45.1 In-Reply-To: <20240614073633.2089692-1-poulhies@adacore.com> References: <20240614073633.2089692-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou They are unused in this context. gcc/ada/ * gcc-interface/Makefile.in (tmake_file): Remove all references. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/Makefile.in | 6 ------ 1 file changed, 6 deletions(-) diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 0666fc00bb8..29db89c6f52 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -148,7 +148,6 @@ host_vendor=@host_vendor@ host_os=@host_os@ target_cpu_default = @target_cpu_default@ xmake_file = @xmake_file@ -tmake_file = @tmake_file@ #version=`sed -e 's/.*\"\([^ \"]*\)[ \"].*/\1/' < $(srcdir)/version.c` #mainversion=`sed -e 's/.*\"\([0-9]*\.[0-9]*\).*/\1/' < $(srcdir)/version.c` @@ -209,11 +208,6 @@ all: all.indirect # This tells GNU Make version 3 not to put all variables in the environment. .NOEXPORT: -# target overrides -ifneq ($(tmake_file),) -include $(tmake_file) -endif - # host overrides ifneq ($(xmake_file),) include $(xmake_file)