From patchwork Mon May 13 08:36:49 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: 1934630 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=YuFBXMFL; 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 4VdCnt0K5zz1ymw for ; Mon, 13 May 2024 18:48:50 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4152838708EE for ; Mon, 13 May 2024 08:48:48 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32f.google.com (mail-wm1-x32f.google.com [IPv6:2a00:1450:4864:20::32f]) by sourceware.org (Postfix) with ESMTPS id 3F6C0384385F for ; Mon, 13 May 2024 08:36:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3F6C0384385F 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 3F6C0384385F Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32f ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715589452; cv=none; b=mBY2q13QkXUONTzzP6O8EfzWaW+q+UpWVvvCL1fcePo8d02c4OSW6Xy5gF8A2w+9/7AdNe+B/CBLvKMYOlNRbXV6Vp2NaLoKwCcglM/DIywwCqsUBCztbNq5gSQrE3XNcoJ5LAQLUJpg1LvLCeRiCGVGdE+GL6AZGVOOrbmclQc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715589452; c=relaxed/simple; bh=h1ukLqu++Lf2am7efziz0RYV1OqHa61KL9WUCeEkwK8=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Togg3eagNGvSnVjOYfU7AaYkGndZXcpinNi6l7bxDkJ/B5FaxGMh9fGs0VCPPgRk6O2WDR116lQwmceSqa61U+aFnM6xnw/Bns/h/8VF+CBLyaV8LzTSjR5SP1LsIkRty21aMlj2cTUK9qcaqkY4JCNSXB+/HABK7Lzv2dT68aU= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32f.google.com with SMTP id 5b1f17b1804b1-41fc2f7fbb5so21460265e9.1 for ; Mon, 13 May 2024 01:36:52 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1715589411; x=1716194211; 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=XObbNXeLD3AdkkaDYltI12kQq6J/1rhtQ4LtF60CThs=; b=YuFBXMFL0I9Njln8Ls6jeCPvnY3iwJ6BYiu/I5RtPrwzf64hfV6vNEeZO8PV9NOUiZ hXNYAi2Me+cij4hCc5TG+GDpA9DVjsW9qxVdzit9hU28Vtr4oJGMSsPKW4CRKiUkE6Ea /LppJJKOEFGTux27OVyMC5GlSbdMx/Hmug8TXo68MbLXGOIaC1FoHly+PUnazn++0YV0 tLeyVKBNdWrK0cehKOaC2mKVNQPctwYFs4HQliWXNa8rhadCZwUzFmeetThIun0WLXMc mwQsnADmZ9PLFPcBJgoMUEOxxgaRVw5mzvZ6DJmukdCe1kpgDkZNvuKzNpIUXnc8fEz1 IQ0g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1715589411; x=1716194211; 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=XObbNXeLD3AdkkaDYltI12kQq6J/1rhtQ4LtF60CThs=; b=IWXUNTmkgdsNQAlEYM24XCinKo5C5G+Fvjf6dHaAjLLrtxYm1Ao1aVm3C7psoNZ2mZ ncmlDQVjxp5x3l77Qyr9lmcE2vsXpV6v0SaogeKUs5EdNBVTDMDT3pIfTConu17doJxp 1OtgHA7Irw8EJ4kvLLko7Evv3tCTkXZxjo/jUCV5fc6zlI/kNO6xgS18jl+LMHMbN5HG 2C2n8ETo0LMz7dXYy00ugxLEgoQFYUxzvEDFupMATfNCOwrzDFEoU/1LEGQOlYdkxxe4 PD2qMO1yYIzbUMQaY/qIVUW01aHFzpVUr1fE87coAhcjw1NsrR1HfwCHsSxFtSNr59ZL 2CnQ== X-Gm-Message-State: AOJu0Yzz3OjwTd4mDD182Wg5nAPbmDBCEfq0kAJ37tGBI2baZE6sPtgv KJZCDHDXhC6IHNT7TRu6ZfefIM66MgqgWg2p1l5xjZ3aX2oZGVEaWPAnG/fdSjurE0nfNEz3Tn0 = X-Google-Smtp-Source: AGHT+IFW8s8NsHmxRB9ygrZgtTnD/AGb/aCOtn+zJaWJxJ/Z5By74hPsKNPbX3cKfP+eLxzKOlHRLg== X-Received: by 2002:a05:600c:4f06:b0:418:2981:c70f with SMTP id 5b1f17b1804b1-41fbcfb8473mr106930665e9.19.1715589410965; Mon, 13 May 2024 01:36:50 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:cf0f:cd6c:7a6a:cbed]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3502baacfffsm10562736f8f.75.2024.05.13.01.36.50 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 13 May 2024 01:36:50 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Move Init_Proc_Level_Formal from Exp_Ch3 to Exp_Util Date: Mon, 13 May 2024 10:36:49 +0200 Message-ID: <20240513083649.166413-1-poulhies@adacore.com> X-Mailer: git-send-email 2.43.2 MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou This makes it possible to remove clauses from the Accessibility package. gcc/ada/ * accessibility.adb: Remove clauses for Exp_Ch3. * exp_ch3.ads (Init_Proc_Level_Formal): Move declaration to... * exp_ch3.adb (Init_Proc_Level_Formal): Move body to... * exp_util.ads (Init_Proc_Level_Formal): ...here. (Inside_Init_Proc): Alphabetize. * exp_util.adb (Init_Proc_Level_Formal): ...here. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 1 - gcc/ada/exp_ch3.adb | 25 ------------------------- gcc/ada/exp_ch3.ads | 5 ----- gcc/ada/exp_util.adb | 26 ++++++++++++++++++++++++++ gcc/ada/exp_util.ads | 10 +++++++--- 5 files changed, 33 insertions(+), 34 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index 75ab9667436..bb81ae49f41 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -32,7 +32,6 @@ with Elists; use Elists; with Errout; use Errout; with Einfo.Utils; use Einfo.Utils; with Exp_Atag; use Exp_Atag; -with Exp_Ch3; use Exp_Ch3; with Exp_Ch7; use Exp_Ch7; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f9989373a62..2477a221c96 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1462,31 +1462,6 @@ package body Exp_Ch3 is return Agg; end Build_Equivalent_Record_Aggregate; - ---------------------------- - -- Init_Proc_Level_Formal -- - ---------------------------- - - function Init_Proc_Level_Formal (Proc : Entity_Id) return Entity_Id is - Form : Entity_Id; - begin - -- Move through the formals of the initialization procedure Proc to find - -- the extra accessibility level parameter associated with the object - -- being initialized. - - Form := First_Formal (Proc); - while Present (Form) loop - if Chars (Form) = Name_uInit_Level then - return Form; - end if; - - Next_Formal (Form); - end loop; - - -- No formal was found, return Empty - - return Empty; - end Init_Proc_Level_Formal; - ------------------------------- -- Build_Initialization_Call -- ------------------------------- diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index 5a4b1133916..1e0f76ae18f 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -146,11 +146,6 @@ package Exp_Ch3 is -- type is valid only when Normalize_Scalars or Initialize_Scalars is -- active, or if N is the node for a 'Invalid_Value attribute node. - function Init_Proc_Level_Formal (Proc : Entity_Id) return Entity_Id; - -- Fetch the extra formal from an initalization procedure "proc" - -- corresponding to the level of the object being initialized. When none - -- is present Empty is returned. - procedure Init_Secondary_Tags (Typ : Entity_Id; Target : Node_Id; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index efc9ef0ed38..1dcfb61b333 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7267,6 +7267,32 @@ package body Exp_Util is return False; end In_Unconditional_Context; + ---------------------------- + -- Init_Proc_Level_Formal -- + ---------------------------- + + function Init_Proc_Level_Formal (Proc : Entity_Id) return Entity_Id is + Form : Entity_Id; + + begin + -- Go through the formals of the initialization procedure Proc to find + -- the extra accessibility level parameter associated with the object + -- being initialized. + + Form := First_Formal (Proc); + while Present (Form) loop + if Chars (Form) = Name_uInit_Level then + return Form; + end if; + + Next_Formal (Form); + end loop; + + -- No formal was found, return Empty + + return Empty; + end Init_Proc_Level_Formal; + ------------------- -- Insert_Action -- ------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index b968f448bba..3fd3a151ddb 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -724,9 +724,6 @@ package Exp_Util is -- chain, counting only entries in the current scope. If an entity is not -- overloaded, the returned number will be one. - function Inside_Init_Proc return Boolean; - -- Returns True if current scope is within an init proc - function In_Library_Level_Package_Body (Id : Entity_Id) return Boolean; -- Given an arbitrary entity, determine whether it appears at the library -- level of a package body. @@ -737,6 +734,13 @@ package Exp_Util is -- unconditionally executed, i.e. it is not within a loop or a conditional -- or a case statement etc. + function Init_Proc_Level_Formal (Proc : Entity_Id) return Entity_Id; + -- Return the extra formal of an initialization procedure corresponding to + -- the level of the object being initialized, or Empty if none is present. + + function Inside_Init_Proc return Boolean; + -- Return True if current scope is within an init proc + function Integer_Type_For (S : Uint; Uns : Boolean) return Entity_Id; -- Return a suitable standard integer type containing at least S bits and -- of the signedness given by Uns. See also Small_Integer_Type_For.