From patchwork Mon Sep 15 13:01:22 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 120269 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id AD56D3857C7A for ; Mon, 15 Sep 2025 13:21:05 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AD56D3857C7A Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=OcqGGQyd X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x333.google.com (mail-wm1-x333.google.com [IPv6:2a00:1450:4864:20::333]) by sourceware.org (Postfix) with ESMTPS id 2F90F385C6E6 for ; Mon, 15 Sep 2025 13:02:05 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 2F90F385C6E6 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 2F90F385C6E6 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::333 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941325; cv=none; b=iWMqlOVXEROEk41EFXPQi40jny5QLE3EA1WKsBscsCy029t5w4AfgfT7cLu6uq3leZChHA4BROfQ/+nNrpmEIc9uioMUesM/dQW9+G31IFUihoY4tlJwmfiQZKP+2XN4jbmqYsnRlwmZdwP/7DruyrdPYb89cA7EXlM/B4OsCqw= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757941325; c=relaxed/simple; bh=Mkioi2RxG4vNkrsMhSiWEpwvQFNqJ7sdbXydMAI2Oa8=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=AhRlppejFK9/HU2PzlbBv3yHYiXXST/cw64f9oadAbgWgmjsKWDaOWgM6fA0xBc9s5phccCrDY42a7oTGgaIp92i3tVcP+5OxiOqJ+JDGBti8PSbBTnAiwDn/y13RIJeP5gl5fSL/8jkrDs/tq3PFuhxFQHHS+NikIMSprcfLmk= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 2F90F385C6E6 Received: by mail-wm1-x333.google.com with SMTP id 5b1f17b1804b1-45dec026c78so43233575e9.0 for ; Mon, 15 Sep 2025 06:02:05 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1757941324; x=1758546124; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=TL/Bec5u2LWyWlRX/8zBR1iiUtAmSH61JXVp7KbZzSE=; b=OcqGGQyde6b4zHuaGJMkJE1dt7rgw4kQGN1XVuHImSkRJ9qcxUeeUhhEm1c654CI/A DMLDc4Gc24g6jxG5SZ3hNaMje5dkfMSXT6zFlHqI2fESG4qY8tFveI5eDZajg31777Ld g1DHeCFHIvjajzHGIH12iBqhOTbdQP9VqVTBvEEYQddZnLCWlroNnpzqHcUUsDASpIsJ cAyeWz4Pwie15kGaDqs03rNn+5GQ3QR6X2YNcSOvcXo9zXSLSbN044eafaSnlRlMQJW2 XHnHuTrHn1en/mLIui9w7wmTBi9EkYbXvcysiqGPHuu1chbJvHgzlvufYnJhRS/XTYJP cpAg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1757941324; x=1758546124; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=TL/Bec5u2LWyWlRX/8zBR1iiUtAmSH61JXVp7KbZzSE=; b=GEyHV0gFZk6lig8ksqiNiOHgq7ICQAu34w2YOfL6d79YKEMZMIqWIesmiVpG2nei2J K1CPiHsqAvpkwosGXBLqpUSXgY3HaER5Z/O2MwXCRvWhcoX6MAOk6P791wCR1l4Chi2l oaM+xNZsq9pru4mDaPx3e74032tTnN0c0TtSAYmdUSIV6LAAVV67qhBx8cJaQcfEm8/S 9LjMUZlhWrftajzUo4NaZ+fy8VQUIYYtWVbS8HPkU9z6HTgoademwhKJFwJgA4Pg37bz LZPz2GVwJkiuMCbjaVbYpuzxEVrR6mTLISNnv+RmnIK7DwSZKCwbiMid/MQN8M924b0N atJg== X-Gm-Message-State: AOJu0Yx0c+LmdfvnKInUGbH4uNcgl0M2IFFGC4K81Q/PkanMb7FzJBa3 KDCzcBQT1larNa1HcYqsEVHw5koqpwf57nj6uOnki4J4stAPjiKmDzU2Gu+rSBraKlpd+9MTCGZ wff8= X-Gm-Gg: ASbGncs1/5CFPsJ2oipL6wLpwPKpvQdpf1YcrRr8peHXtFty2460PeftgroHU4UpG7D OzZQwGi8mfsuPPcN3EWcktr9l1KIC4uJLQxjWxiVw1dAsgezYD8JySFrC7iBD09qwGyoGoX/t3m OQCTHqnvH1Xhi5V83pvIdAVmNAfGn/yDPCtwNtY2DMO1qehHM0dVWHc6MKgZunrqm8rGNzYALq2 gSLBop/K7y1t7qnfiLUgprgwTzS0NgyGjcg1MSNTXp7Zk/vy5EB9rldmupd2pmEGeusOSueD3EO jNwcxMLNS/TgMLZ5Eua3phW+bzMOsKfYUCgfxWvVxadz1K780N/t9n5lnTWmWyOhD45xP0qcLPZ BZlDa62wsImeVuj43/7pbsX0Y04OSylv7l/oi/UEn1UF1PKPiKpDV25SpvYNAEh9FcanjkrWdOD cWKgrTC8a0Hs2H3/RtL1pyA3ZSApJGyHbD/3nIEoAy0/YBF04P X-Google-Smtp-Source: AGHT+IHIyEnwXf/DZJPZJVEJituDoiSbhsj4G3AwPvkdrANLMAU9tg8F4Gniua7yAQBO2vdq7P5FlA== X-Received: by 2002:a05:600c:4585:b0:45d:98be:ee9e with SMTP id 5b1f17b1804b1-45f211ca331mr115346825e9.1.1757941323467; Mon, 15 Sep 2025 06:02:03 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-3ea4b52b7fcsm5428733f8f.33.2025.09.15.06.02.02 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 Sep 2025 06:02:02 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Viljar Indus Subject: [COMMITTED 16/27] ada: Refactor ghost argument consistency checks Date: Mon, 15 Sep 2025 15:01:22 +0200 Message-ID: <20250915130135.2720894-16-poulhies@adacore.com> X-Mailer: git-send-email 2.43.0 In-Reply-To: <20250915130135.2720894-1-poulhies@adacore.com> References: <20250915130135.2720894-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org From: Viljar Indus Create a new method for checking and emitting errors on pragmas Unused, Unrefefrenced, Unreferenced_Objects, Inline and No_Return that support specifying multiple entities as arguments. Emit an error when one argument is ghost and the other is not and when one argument has a ghost policy check and the other has ghost policy ignore. Update the Suppressed_Ghost_Policy_Check_Pragma list pragma Inline that should be there to avoid an incorrect invalid pragma context error. gcc/ada/ChangeLog: * sem_prag.adb (Check_Inconsistent_Argument_Ghostliness): new method for handling the ghost constency errors between different arguments. Use this method in the processing for pragmas Unused, Unrefefrenced, Unreferenced_Objects, Inline and No_Return. * sem_prag.ads (Suppressed_Ghost_Policy_Check_Pragma): add missing entry for pragma Inline. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 329 ++++++++++++++++++++++--------------------- gcc/ada/sem_prag.ads | 1 + 2 files changed, 172 insertions(+), 158 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a17d9d2b8138..9289e02b56ad 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5054,6 +5054,16 @@ package body Sem_Prag is -- Common checks for pragmas that appear within a main program -- (Priority, Main_Storage, Time_Slice, Relative_Deadline, CPU). + procedure Check_Inconsistent_Argument_Ghostliness + (Arg1 : Entity_Id; + Arg2 : Entity_Id; + Ghost_Error_Posted : in out Boolean); + -- Reports an error and sets Ghost_Error_Posted when: + -- * One argument is ghost and the other is not ghost + -- * One argument is checked ghost and the other is ignored ghost + -- + -- Checks are avoided when Ghost_Error_Posted is already set. + procedure Check_Interrupt_Or_Attach_Handler; -- Common processing for first argument of pragma Interrupt_Handler or -- pragma Attach_Handler. @@ -6033,9 +6043,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost variables is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost variable encountered while - -- processing the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing the + -- arguments of the pragma. This is used as a reference for assessing + -- the ghostliness of other arguments. begin GNAT_Pragma; @@ -6073,41 +6084,22 @@ package body Sem_Prag is Set_Has_Pragma_Unused (Arg_Id); end if; - -- A pragma that applies to a Ghost entity becomes Ghost for - -- the purposes of legality checks and removal of ignored - -- Ghost code. - - Mark_Ghost_Pragma (N, Arg_Id); - - -- Capture the entity of the first Ghost variable being + -- Capture the entity of the first variable being -- processed for error detection purposes. - if Is_Ghost_Entity (Arg_Id) then - if No (Ghost_Id) then - Ghost_Id := Arg_Id; - end if; + if No (First_Arg_Id) then + First_Arg_Id := Arg_Id; - -- Otherwise the variable is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities - -- (SPARK RM 6.9). + -- A pragma that applies to a Ghost entity becomes Ghost + -- for the purposes of legality checks and removal of + -- ignored Ghost code. - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost " - & "variables", N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Arg_Id); - Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id); + Mark_Ghost_Pragma (N, Arg_Id); end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Arg_Id, Ghost_Error_Posted); + -- Warn if already flagged as Unused or Unmodified elsif Has_Pragma_Unmodified (Arg_Id) then @@ -6149,9 +6141,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost names is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost name encountered while processing - -- the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing the + -- arguments of the pragma. This is used as a reference for assessing + -- the ghostliness of other arguments. begin GNAT_Pragma; @@ -6214,6 +6207,19 @@ package body Sem_Prag is if Is_Entity_Name (Arg_Expr) then Arg_Id := Entity (Arg_Expr); + -- Capture the entity of the first variable being + -- processed for error detection purposes. + + if No (First_Arg_Id) then + First_Arg_Id := Arg_Id; + + -- A pragma that applies to a Ghost entity becomes Ghost + -- for the purposes of legality checks and removal of + -- ignored Ghost code. + + Mark_Ghost_Pragma (N, Arg_Id); + end if; + -- Warn if already flagged as Unused or Unreferenced and -- skip processing the argument. @@ -6253,36 +6259,8 @@ package body Sem_Prag is Mark_Ghost_Pragma (N, Arg_Id); - -- Capture the entity of the first Ghost name being - -- processed for error detection purposes. - - if Is_Ghost_Entity (Arg_Id) then - if No (Ghost_Id) then - Ghost_Id := Arg_Id; - end if; - - -- Otherwise the name is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities - -- (SPARK RM 6.9). - - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost " - & "names", N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE - ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Arg_Id); - Error_Msg_NE - ("\& # declared as non-ghost", N, Arg_Id); - end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Arg_Id, Ghost_Error_Posted); end if; end if; @@ -7012,6 +6990,91 @@ package body Sem_Prag is end if; end Check_In_Main_Program; + --------------------------------------------- + -- Check_Inconsistent_Argument_Ghostliness -- + --------------------------------------------- + + procedure Check_Inconsistent_Argument_Ghostliness + (Arg1 : Entity_Id; + Arg2 : Entity_Id; + Ghost_Error_Posted : in out Boolean) + is + + procedure Report_Ghost_Argument_Mismatch + (Ghost_Arg : Entity_Id; Non_Ghost_Arg : Entity_Id); + -- Constructs an error message when both a ghost and a non-ghost + -- argument are used in the same pragma. + + procedure Report_Ghost_Policy_Mismatch + (Checked_Arg : Entity_Id; Ignored_Arg : Entity_Id); + -- Constructs an error message when both a checked ghost and an + -- ignored ghost argument are used in the same pragma. + + ------------------------------------ + -- Report_Ghost_Argument_Mismatch -- + ------------------------------------ + + procedure Report_Ghost_Argument_Mismatch + (Ghost_Arg : Entity_Id; Non_Ghost_Arg : Entity_Id) is + + begin + Error_Msg_Name_1 := Pname; + Error_Msg_N + ("pragma % cannot mention ghost and non-ghost " & "variables", + N); + + Error_Msg_Sloc := Sloc (Ghost_Arg); + Error_Msg_NE ("\& # declared as ghost", N, Ghost_Arg); + + Error_Msg_Sloc := Sloc (Non_Ghost_Arg); + Error_Msg_NE ("\& # declared as non-ghost", N, Non_Ghost_Arg); + end Report_Ghost_Argument_Mismatch; + + ---------------------------------- + -- Report_Ghost_Policy_Mismatch -- + ---------------------------------- + + procedure Report_Ghost_Policy_Mismatch + (Checked_Arg : Entity_Id; Ignored_Arg : Entity_Id) is + + begin + Error_Msg_Name_1 := Pname; + Error_Msg_N + ("pragma % cannot mention checked ghost and ignored ghost " + & "variables", + N); + + Error_Msg_Sloc := Sloc (Checked_Arg); + Error_Msg_NE + ("\& # declared with a checked policy", N, Checked_Arg); + + Error_Msg_Sloc := Sloc (Ignored_Arg); + Error_Msg_NE + ("\& # declared with an ignored policy", N, Ignored_Arg); + end Report_Ghost_Policy_Mismatch; + begin + if Ghost_Error_Posted then + null; + elsif Is_Ghost_Entity (Arg1) and then not Is_Ghost_Entity (Arg2) then + Report_Ghost_Argument_Mismatch (Arg1, Arg2); + Ghost_Error_Posted := True; + elsif not Is_Ghost_Entity (Arg1) and then Is_Ghost_Entity (Arg2) + then + Report_Ghost_Argument_Mismatch (Arg2, Arg1); + Ghost_Error_Posted := True; + elsif Is_Checked_Ghost_Entity (Arg1) + and then Is_Ignored_Ghost_Entity (Arg2) + then + Report_Ghost_Policy_Mismatch (Arg1, Arg2); + Ghost_Error_Posted := True; + elsif Is_Ignored_Ghost_Entity (Arg1) + and then Is_Checked_Ghost_Entity (Arg2) + then + Report_Ghost_Policy_Mismatch (Arg2, Arg1); + Ghost_Error_Posted := True; + end if; + end Check_Inconsistent_Argument_Ghostliness; + --------------------------------------- -- Check_Interrupt_Or_Attach_Handler -- --------------------------------------- @@ -10688,9 +10751,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost subprograms is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost subprogram encountered while - -- processing the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing the + -- arguments of the pragma. This is used as a reference for assessing + -- the ghostliness of other arguments. procedure Check_Inline_Always_Placement (Spec_Id : Entity_Id); -- Verify the placement of pragma Inline_Always with respect to the @@ -11178,36 +11242,21 @@ package body Sem_Prag is end if; end case; - -- A pragma that applies to a Ghost entity becomes Ghost for the - -- purposes of legality checks and removal of ignored Ghost code. - - Mark_Ghost_Pragma (N, Subp); - - -- Capture the entity of the first Ghost subprogram being + -- Capture the entity of the first variable being -- processed for error detection purposes. - if Is_Ghost_Entity (Subp) then - if No (Ghost_Id) then - Ghost_Id := Subp; - end if; + if No (First_Arg_Id) then + First_Arg_Id := Subp; - -- Otherwise the subprogram is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities (SPARK RM 6.9). + -- A pragma that applies to a Ghost entity becomes Ghost + -- for the purposes of legality checks and removal of + -- ignored Ghost code. - elsif Present (Ghost_Id) and then not Ghost_Error_Posted then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost subprograms", - N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Subp); - Error_Msg_NE ("\& # declared as non-ghost", N, Subp); + Mark_Ghost_Pragma (N, Subp); end if; + + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Subp, Ghost_Error_Posted); end Set_Inline_Flags; -- Start of processing for Process_Inline @@ -22377,9 +22426,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost subprograms is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost procedure encountered while - -- processing the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing + -- the arguments of the pragma. This is used as a reference for + -- assessing the ghostliness of other arguments. begin Ada_2005_Pragma; @@ -22476,42 +22526,22 @@ package body Sem_Prag is Set_No_Return (E); end if; - -- A pragma that applies to a Ghost entity becomes - -- Ghost for the purposes of legality checks and - -- removal of ignored Ghost code. + -- Capture the entity of the first variable being + -- processed for error detection purposes. - Mark_Ghost_Pragma (N, E); + if No (First_Arg_Id) then + First_Arg_Id := E; - -- Capture the entity of the first Ghost procedure - -- being processed for error detection purposes. + -- A pragma that applies to a Ghost entity becomes + -- Ghost for the purposes of legality checks and + -- removal of ignored Ghost code. - if Is_Ghost_Entity (E) then - if No (Ghost_Id) then - Ghost_Id := E; - end if; - - -- Otherwise the subprogram is non-Ghost. It is - -- illegal to mix references to Ghost and non-Ghost - -- entities (SPARK RM 6.9). - - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost " - & "procedures", N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE - ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (E); - Error_Msg_NE ("\& # declared as non-ghost", N, E); + Mark_Ghost_Pragma (N, E); end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, E, Ghost_Error_Posted); + -- Set flag on any alias as well if Is_Overloadable (E) @@ -27985,9 +28015,10 @@ package body Sem_Prag is -- Flag set when an error concerning the illegal mix of Ghost and -- non-Ghost types is emitted. - Ghost_Id : Entity_Id := Empty; - -- The entity of the first Ghost type encountered while processing - -- the arguments of the pragma. + First_Arg_Id : Entity_Id := Empty; + -- The entity of the first variable encountered while processing + -- the arguments of the pragma. This is used as a reference for + -- assessing the ghostliness of other arguments. begin GNAT_Pragma; @@ -28002,43 +28033,25 @@ package body Sem_Prag is if Is_Entity_Name (Arg_Expr) then Arg_Id := Entity (Arg_Expr); - if Is_Type (Arg_Id) then - Set_Has_Pragma_Unreferenced_Objects (Arg_Id); + -- Capture the entity of the first Ghost type being + -- processed for error detection purposes. + + if No (First_Arg_Id) then + First_Arg_Id := Arg_Id; -- A pragma that applies to a Ghost entity becomes Ghost -- for the purposes of legality checks and removal of -- ignored Ghost code. Mark_Ghost_Pragma (N, Arg_Id); + end if; - -- Capture the entity of the first Ghost type being - -- processed for error detection purposes. + if Is_Type (Arg_Id) then + Set_Has_Pragma_Unreferenced_Objects (Arg_Id); - if Is_Ghost_Entity (Arg_Id) then - if No (Ghost_Id) then - Ghost_Id := Arg_Id; - end if; + Check_Inconsistent_Argument_Ghostliness + (First_Arg_Id, Arg_Id, Ghost_Error_Posted); - -- Otherwise the type is non-Ghost. It is illegal to mix - -- references to Ghost and non-Ghost entities - -- (SPARK RM 6.9). - - elsif Present (Ghost_Id) - and then not Ghost_Error_Posted - then - Ghost_Error_Posted := True; - - Error_Msg_Name_1 := Pname; - Error_Msg_N - ("pragma % cannot mention ghost and non-ghost types", - N); - - Error_Msg_Sloc := Sloc (Ghost_Id); - Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id); - - Error_Msg_Sloc := Sloc (Arg_Id); - Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id); - end if; else Error_Pragma_Arg ("argument for pragma% must be type or subtype", Arg); diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 49552fdd3fe6..1262ede04db8 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -283,6 +283,7 @@ package Sem_Prag is Pragma_Favor_Top_Level => True, Pragma_Import => True, Pragma_Independent_Components => True, + Pragma_Inline => True, Pragma_Interface => True, Pragma_No_Return => True, Pragma_Obsolescent => True,