From patchwork Mon May 6 09:18:41 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: 1931874 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=fizB1cl1; 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 4VXwzF0ZYlz1yZk for ; Mon, 6 May 2024 19:27:05 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3E2213858410 for ; Mon, 6 May 2024 09:27:03 +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 E26CF3858CD1 for ; Mon, 6 May 2024 09:18:43 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org E26CF3858CD1 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 E26CF3858CD1 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=1714987127; cv=none; b=bky/Dxoke6qf/hycQ1uceo6wMrzPgWwNYaRUs+kEJXgfLoEzkk1qi05OxGe3EAKNd9gpvFR8ZncTHIvYDtCKSmpTUV/HbRAHwhc5EcEwhE6xxr08YA1WL2cxwJVCzrM+GyoYO4t7qxZ8ftRyzE7K6cmKcvFfN0SPhKu/vF549dk= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1714987127; c=relaxed/simple; bh=txIhEZlGCdkZOFFCEr2+0GcR3UVPMjqm3m45hisQ7v4=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=HVoM7IGTjqCa6urv7kkwSexISMGR0T3t3dBf9KiNVHlAnYuCPQZXPyyr/lmS0dlVVpppul2mRl0i8jCqR8YGTBm6wn8WQyMxnR8S47xrDL8L8IEpIHnxnQHn305QWlF0t9hC1ilcTCreND8bFCNYUSD/WQqNThQtadA7LvSr/6c= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x436.google.com with SMTP id ffacd0b85a97d-34e667905d2so1320410f8f.1 for ; Mon, 06 May 2024 02:18:43 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1714987122; x=1715591922; 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=/2y//MArxb86e85x0Rde4EQIRL8L5f5gcOQrvOSDEMU=; b=fizB1cl1w/KmRFduzjsjYJQvSsJmoTntEg97ECkAO/4/Is6b2A6DmYcKCao13NRpsV LxmsLfot5aAZ0afcUHZEMRfa7nH7tzQFFQ6Ef2bs4kXbOVj9Ujpvsl3G6fAld1zjAdRb fzTYPFsa6yLChE4ZPpv7TNyhchMnKZ6ZVtkoXFdBO7LvG9JvU14jz9f83PbrJ3FdhU/N eg+n4zafjYpLo9DVoR+4xCGY6h1h8hN+Dwlb3Z1xuqcnafMWQsDH/by2W86pV1YwDpi4 fl92lSyF70JQhFnrUHjgIBiBO875iKniaJFR7wXHAG5aU1WtJyKMzfGJM4PJ+0pTMgDW I55w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1714987122; x=1715591922; 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=/2y//MArxb86e85x0Rde4EQIRL8L5f5gcOQrvOSDEMU=; b=cQZ72C7wcK+vPpkEzAwPYtMCwFemVjoYPj5dkPuk7EJxnxcv8AwoOZ6rFcWNETdAt7 e4DfiRro9+Hpnd+qtP6HXasNIEcGPmyhjljY2wMcj2D507FB2NwTU/k0TTD+FNaHh/Ml LIyU6K6PmcWF2H7McRDsJMjFA368byFCcx8tgobHBQy7zQfVDN6tapKG2n+LXSnn1Wj+ bq/x6b8KctASUX7Hp6dfmRc1cjCOqiP4OWPMas5Bw31OGsf9o2UOfV5++SVjD2MSkQys sG6yhlpdIHgkt/YlTP+BVQ6TOdPICCfhGFq+b/DsuCdqYaoRxXB4ss0VsxRrGQoPgd8t NXqQ== X-Gm-Message-State: AOJu0YwwxSuxIBQd40wRaXd45F1wXe4tH6rQrcAt/6rqJ6BH+WhmMKp/ Chyw6YmTehyNsZ4r+1dBKL8Bd9B9fm776o9/ctXKAy1nmyyQ2p+F3XeyHahWSYXyVQEnAkC/ar8 = X-Google-Smtp-Source: AGHT+IF6eGMRDhXFo09Hxtqo8gfrlPGhztxHXTX2au5d5NfhWs3PDQGxdMJ6RnVTesdvbdY5yvmepw== X-Received: by 2002:a05:6000:1cb:b0:34d:a738:798c with SMTP id t11-20020a05600001cb00b0034da738798cmr5470811wrx.64.1714987122680; Mon, 06 May 2024 02:18:42 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:9ea2:39d7:df74:396d]) by smtp.gmail.com with ESMTPSA id d18-20020adfef92000000b0034c71090653sm10170694wro.57.2024.05.06.02.18.42 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 06 May 2024 02:18:42 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [COMMITTED] ada: Give error for reference to nonvisible library unit Date: Mon, 6 May 2024 11:18:41 +0200 Message-ID: <20240506091841.1586590-1-poulhies@adacore.com> X-Mailer: git-send-email 2.43.2 MIME-Version: 1.0 X-Spam-Status: No, score=-13.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Bob Duff This patch fixes a bug where the compiler would allow a name X to refer to a library unit that is not visible. In particular, this happens when the name X occurs in the private part of a library package, and the parent of that package contains an instantiation of a generic package, and the spec of that generic package has "private with X;", but there is no "private with X;" or "with X;" that applies to the place where the name X occurs. Also misc cleanup. gcc/ada/ * sem_ch10.adb (Expand_With_Clause): Misc cleanup. (Install_Private_With_Clauses): Avoid installing a private with_clause that comes from an instantiated generic (it is marked as Implicit_With, but doesn't come from a parent with). Fix typo in comment, and other minor cleanups. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch10.adb | 49 ++++++++++++++++++++++++++------------------ 1 file changed, 29 insertions(+), 20 deletions(-) diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 43adbbc54bf..7fc623b6278 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -3425,17 +3425,15 @@ package body Sem_Ch10 is -- Local variables Ent : constant Entity_Id := Entity (Nam); - Withn : Node_Id; + Withn : constant Node_Id := + Make_With_Clause + (Loc, Name => Build_Unit_Name (Nam), + First_Name => True, Last_Name => True); -- Start of processing for Expand_With_Clause begin - Withn := - Make_With_Clause (Loc, - Name => Build_Unit_Name (Nam)); - Set_Corresponding_Spec (Withn, Ent); - Set_First_Name (Withn); Set_Implicit_With (Withn); Set_Library_Unit (Withn, Parent (Unit_Declaration_Node (Ent))); Set_Parent_With (Withn); @@ -3570,7 +3568,6 @@ package body Sem_Ch10 is P : constant Node_Id := Parent_Spec (Child_Unit); P_Unit : Node_Id := Unit (P); P_Name : constant Entity_Id := Get_Parent_Entity (P_Unit); - Withn : Node_Id; function Build_Ancestor_Name (P : Node_Id) return Node_Id; -- Build prefix of child unit name. Recurse if needed @@ -3655,21 +3652,25 @@ package body Sem_Ch10 is return; end if; - Withn := Make_With_Clause (Loc, Name => Build_Unit_Name); + declare + Withn : constant Node_Id := + Make_With_Clause + (Loc, Name => Build_Unit_Name, + First_Name => True, Last_Name => True); + begin + Set_Corresponding_Spec (Withn, P_Name); + Set_Implicit_With (Withn); + Set_Library_Unit (Withn, P); + Set_Parent_With (Withn); - Set_Corresponding_Spec (Withn, P_Name); - Set_First_Name (Withn); - Set_Implicit_With (Withn); - Set_Library_Unit (Withn, P); - Set_Parent_With (Withn); + -- Node is placed at the beginning of the context items, so that + -- subsequent use clauses on the parent can be validated. - -- Node is placed at the beginning of the context items, so that - -- subsequent use clauses on the parent can be validated. + Prepend (Withn, Context_Items (N)); + Mark_Rewrite_Insertion (Withn); - Prepend (Withn, Context_Items (N)); - Mark_Rewrite_Insertion (Withn); - - Install_With_Clause (Withn); + Install_With_Clause (Withn); + end; if Is_Child_Spec (P_Unit) then Implicit_With_On_Parent (P_Unit, N); @@ -4524,13 +4525,21 @@ package body Sem_Ch10 is if Nkind (Parent (Decl)) = N_Compilation_Unit then Item := First (Context_Items (Parent (Decl))); while Present (Item) loop + -- If Item is a private with clause, install it, but do not + -- install implicit private with's that come from (for example) + -- with's on instantiated generics. DO install implicit private + -- with's that come from parents, which is necessary in general, + -- but ???not quite right if the former (generic) case also + -- applies. + if Nkind (Item) = N_With_Clause and then Private_Present (Item) + and then (not Implicit_With (Item) or else Parent_With (Item)) then -- If the unit is an ancestor of the current one, it is the -- case of a private limited with clause on a child unit, and -- the compilation of one of its descendants, in that case the - -- limited view is errelevant. + -- limited view is irrelevant. if Limited_Present (Item) then if not Limited_View_Installed (Item)