From patchwork Mon Jul 4 10:06:03 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 644061 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3rjjN34p3mz9sdn for ; Mon, 4 Jul 2016 20:06:27 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=Tdh2Tcko; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=LDVfETKRBA2KarvagpGaJt7TzNnUBjyCquWn6/rBxfdWcK/PLP btaOLBCE4D+5CDdOMJRI9mMbysh7rQaImj1rq590vCAGuhoGanZl/FlKUElypOzR 98BS/fbGKYxHo+asMZmaZ1J8M0hNSDN/F68cHLW9hQDOtzPODUUsDERdk= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=zfEScPt08PBxEhoBCaulSPCHYNs=; b=Tdh2TckoUcx5UDvD/8RR tUneLZVWNXlpIOzXAVdLgPlicdpvAjjG7cnXA1yHItaWF+ugNoghFzwW5+IJcOOt tGpEI7jFNODVtpp/b8Y0h99aJil4bw4zL/JBodEAQLou54eco+lbi0HA7SESWnYc /JUWFEGkwYT7NYjbsWz51Cw= Received: (qmail 119306 invoked by alias); 4 Jul 2016 10:06:16 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 119288 invoked by uid 89); 4 Jul 2016 10:06:15 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.6 required=5.0 tests=BAYES_50, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=no version=3.3.2 spammy=concerning, appearing, Duplicate, inherits X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Mon, 04 Jul 2016 10:06:05 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 7F32111687C; Mon, 4 Jul 2016 06:06:03 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id s-ynpe01W5BZ; Mon, 4 Jul 2016 06:06:03 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 0E016116878; Mon, 4 Jul 2016 06:06:03 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 0B49F445; Mon, 4 Jul 2016 06:06:03 -0400 (EDT) Date: Mon, 4 Jul 2016 06:06:03 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [Ada] Confusing pragma unreferenced Message-ID: <20160704100603.GA76608@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) Two pragmas exist - Unmodified and Unreferenced which issue warnings if the respective entities contained get written or read repectivly. Additionally, pragma Unreferenced will surpress compiler generated warnings for unread variables. However, this can lead to confusion about pragma Unreferenced whereby the assumed meaning would encompass writing as well as reading and to achive this effect both pragmas would have to be utilized which is inefficient. This patch adds a new pragma "Unused" to serve as a combination of Unmodified and Unreferenced. ------------ -- Source -- ------------ -- main.adb with Ada.Text_IO; -- Context clause pragma Unused (Ada.Text_IO); -- Warn Unused pragma Unmodified (Ada.Text_IO); -- Warn Unmodified pragma Unreferenced (Ada.Text_IO); -- Valid procedure Main is -- Improper use X, Y, Z : Boolean := False; -- Non-variable procedure Test is begin null; end; pragma Unmodified (Test); -- Warn Unmodified pragma Unused (Test); -- Warn Unused pragma Unreferenced (Test); -- Valid -- Equivalence of Unused to Unmodified + Unreferenced pragma Unmodified (X); -- Valid pragma Unmodified (X); -- Warn Unmodified pragma Unreferenced (X); -- Valid pragma Unused (Y); -- Valid -- Duplicate error messages pragma Unreferenced (X); -- Warn Unreferenced pragma Unused (X); -- Warn Unmodified and Unreferenced pragma Unused (Y); -- Warn Unused pragma Unmodified (Y); -- Warn Unused pragma Unreferenced (Y); -- Warn Unused -- Proper use A, B, C, D : Boolean := True; pragma Unmodified (A); -- Valid pragma Unreferenced (B); -- Valid pragma Unmodified (C); -- Valid pragma Unreferenced (C); -- Valid pragma Unused (D); -- Valid begin X := True; -- Warn Unmodified Z := X; -- Warn Unreferenced Y := True; -- Warn Unused Z := Y; -- Warn Unused Z := A; -- Valid B := False; -- Valid end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -gnatl -c main.adb [...] 1. with Ada.Text_IO; 2. 3. -- Context clause 4. pragma Unused (Ada.Text_IO); -- Warn Unused | >>> pragma "Unused" argument must be in same declarative part 5. pragma Unmodified (Ada.Text_IO); -- Warn Unmodified | >>> pragma "Unmodified" argument must be in same declarative part 6. pragma Unreferenced (Ada.Text_IO); -- Valid 7. 8. procedure Main is 9. 10. -- Improper use 11. X, Y, Z : Boolean := False; 12. 13. -- Non-variable 14. procedure Test is begin null; end; 15. pragma Unmodified (Test); -- Warn Unmodified | >>> pragma "Unmodified" can only be applied to a variable 16. pragma Unused (Test); -- Warn Unused | >>> pragma "Unused" can only be applied to a variable 17. pragma Unreferenced (Test); -- Valid 18. 19. -- Equivalence of Unused to Unmodified + Unreferenced 20. pragma Unmodified (X); -- Valid 21. pragma Unmodified (X); -- Warn Unmodified | >>> warning: pragma Unmodified given for "X" 22. pragma Unreferenced (X); -- Valid 23. pragma Unused (Y); -- Valid 24. 25. -- Duplicate error messages 26. pragma Unreferenced (X); -- Warn Unreferenced | >>> warning: pragma Unreferenced given for "X" 27. pragma Unused (X); -- Warn Unmodified and Unreferenced | >>> warning: pragma Unmodified given for "X" >>> warning: pragma Unreferenced given for "X" 28. pragma Unused (Y); -- Warn Unused | >>> warning: pragma Unused given for "Y" 29. pragma Unmodified (Y); -- Warn Unused | >>> warning: pragma Unused given for "Y" 30. pragma Unreferenced (Y); -- Warn Unused | >>> warning: pragma Unused given for "Y" 31. 32. -- Proper use 33. A, B, C, D : Boolean := True; 34. pragma Unmodified (A); -- Valid 35. pragma Unreferenced (B); -- Valid 36. pragma Unmodified (C); -- Valid 37. pragma Unreferenced (C); -- Valid 38. pragma Unused (D); -- Valid 39. 40. begin 41. X := True; -- Warn Unmodified | >>> warning: pragma Unmodified given for "X" 42. Z := X; -- Warn Unreferenced | >>> warning: pragma Unreferenced given for "X" 43. Y := True; -- Warn Unused | >>> warning: pragma Unused given for "Y" 44. Z := Y; -- Warn Unused | >>> warning: pragma Unused given for "Y" 45. Z := A; -- Valid 46. B := False; -- Valid 47. end Main; 47 lines: 4 errors, 11 warnings Tested on x86_64-pc-linux-gnu, committed on trunk 2016-07-04 Justin Squirek * einfo.adb (Has_Pragma_Unused): Create this function as a setter for a new flag294 (Set_Has_Pragma_Unused): Create this procedure as a getter for flag294 (Write_Entity_Flags): Register the new flag with an alias * einfo.ads Add comment documenting Has_Pragma_Unused (flag294) and subsequent getter and setter declarations. * lib-xref.adb (Generate_Reference): Recognize Has_Pragma_Unused flag to print appropriate warning messages. * par-prag.adb (Prag): Classify Pragma_Unused into "All Other Pragmas." * snames.ads-tmpl Add a new name to the name constants and a new pramga to Pragma_Id for pramga Unused. * sem_prag.adb (Analyze_Pragma): Create case for Pragma_Unused and move the block for Pragma_Unmodified and Pragma_Unreferenced out and into local subprograms. (Analyze_Unmodified, Analyze_Unreferenced): From the old pragma blocks that have been separated in to local subprograms add a parameter to indicate the if they are being called in the context of Pragma_Unused and handle it accordingly. (Is_Non_Significant_Pragma_Reference): Add an entry for Pragma_Unused and correct the position of Pragma_Unevaluated_Use_Of_Old. * sem_util.adb (Note_Possible_Modification): Recognize Has_Pragma_Unused flag to print appropriate warning messages. Index: einfo.adb =================================================================== --- einfo.adb (revision 237957) +++ einfo.adb (working copy) @@ -608,8 +608,8 @@ -- Has_Inherited_Invariants Flag291 -- Is_Partial_Invariant_Procedure Flag292 -- Is_Actual_Subtype Flag293 + -- Has_Pragma_Unused Flag294 - -- (unused) Flag294 -- (unused) Flag295 -- (unused) Flag296 -- (unused) Flag297 @@ -1761,6 +1761,11 @@ return Flag212 (Id); end Has_Pragma_Unreferenced_Objects; + function Has_Pragma_Unused (Id : E) return B is + begin + return Flag294 (Id); + end Has_Pragma_Unused; + function Has_Predicates (Id : E) return B is begin pragma Assert (Is_Type (Id)); @@ -4768,6 +4773,11 @@ Set_Flag212 (Id, V); end Set_Has_Pragma_Unreferenced_Objects; + procedure Set_Has_Pragma_Unused (Id : E; V : B := True) is + begin + Set_Flag294 (Id, V); + end Set_Has_Pragma_Unused; + procedure Set_Has_Predicates (Id : E; V : B := True) is begin pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void); @@ -9162,6 +9172,7 @@ W ("Has_Pragma_Unmodified", Flag233 (Id)); W ("Has_Pragma_Unreferenced", Flag180 (Id)); W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id)); + W ("Has_Pragma_Unused", Flag294 (Id)); W ("Has_Predicates", Flag250 (Id)); W ("Has_Primitive_Operations", Flag120 (Id)); W ("Has_Private_Ancestor", Flag151 (Id)); Index: einfo.ads =================================================================== --- einfo.ads (revision 237957) +++ einfo.ads (working copy) @@ -1902,13 +1902,20 @@ -- that clients should generally not test this flag directly, but instead -- use function Has_Unreferenced. +-- ??? this real description was clobbered + -- Has_Pragma_Unreferenced_Objects (Flag212) --- Defined in type and subtype entities. Set if a valid pragma --- Unreferenced_Objects applies to the type, indicating that no warning --- should be given for objects of such a type for being unreferenced --- (but unlike the case with pragma Unreferenced, it is ok to reference --- such an object and no warning is generated. +-- Defined in all entities. Set if a valid pragma Unused applies to an +-- entity, indicating that warnings should be given if the entity is +-- modified or referenced. This pragma is equivalent to a pair of +-- Unmodified and Unreferenced pragmas. +-- Has_Pragma_Unused (Flag294) +-- Defined in all entries. Set if a valid pragma Unused applies to a +-- variable or entity, indicating that warnings should not be given if +-- it is never modified or referenced. Note: This pragma is exactly +-- equivalent Unmodified and Unreference combined. + -- Has_Predicates (Flag250) -- Defined in type and subtype entities. Set if a pragma Predicate or -- Predicate aspect applies to the type or subtype, or if it inherits a @@ -5397,6 +5404,7 @@ -- Has_Pragma_Thread_Local_Storage (Flag169) -- Has_Pragma_Unmodified (Flag233) -- Has_Pragma_Unreferenced (Flag180) + -- Has_Pragma_Unused (Flag294) -- Has_Private_Declaration (Flag155) -- Has_Qualified_Name (Flag161) -- Has_Stream_Size_Clause (Flag184) @@ -6976,6 +6984,7 @@ function Has_Pragma_Unmodified (Id : E) return B; function Has_Pragma_Unreferenced (Id : E) return B; function Has_Pragma_Unreferenced_Objects (Id : E) return B; + function Has_Pragma_Unused (Id : E) return B; function Has_Predicates (Id : E) return B; function Has_Primitive_Operations (Id : E) return B; function Has_Private_Ancestor (Id : E) return B; @@ -7649,6 +7658,7 @@ procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True); procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True); procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True); + procedure Set_Has_Pragma_Unused (Id : E; V : B := True); procedure Set_Has_Predicates (Id : E; V : B := True); procedure Set_Has_Primitive_Operations (Id : E; V : B := True); procedure Set_Has_Private_Ancestor (Id : E; V : B := True); @@ -8439,6 +8449,7 @@ pragma Inline (Has_Pragma_Unmodified); pragma Inline (Has_Pragma_Unreferenced); pragma Inline (Has_Pragma_Unreferenced_Objects); + pragma Inline (Has_Pragma_Unused); pragma Inline (Has_Predicates); pragma Inline (Has_Primitive_Operations); pragma Inline (Has_Private_Ancestor); Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 237960) +++ sem_prag.adb (working copy) @@ -3502,6 +3502,16 @@ -- related subprogram. Body_Id is the entity of the subprogram body. -- Flag Legal is set when the pragma is legal. + procedure Analyze_Unmodified_Or_Unused (Is_Unused : Boolean := False); + -- Perform full analysis of pragma Unmodified and the write aspect of + -- pragma Unused. Flag Is_Unused should be set when verifying the + -- semantics of pragma Unused. + + procedure Analyze_Unreferenced_Or_Unused (Is_Unused : Boolean := False); + -- Perform full analysis of pragma Unreferenced and the read aspect of + -- pragma Unused. Flag Is_Unused should be set when verifying the + -- semantics of pragma Unused. + procedure Check_Ada_83_Warning; -- Issues a warning message for the current pragma if operating in Ada -- 83 mode (used for language pragmas that are not a standard part of @@ -4465,6 +4475,274 @@ end if; end Analyze_Refined_Depends_Global_Post; + ---------------------------------- + -- Analyze_Unmodified_Or_Unused -- + ---------------------------------- + + procedure Analyze_Unmodified_Or_Unused (Is_Unused : Boolean := False) is + Arg : Node_Id; + Arg_Expr : Node_Id; + Arg_Id : Entity_Id; + + Ghost_Error_Posted : Boolean := False; + -- 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. + + begin + GNAT_Pragma; + Check_At_Least_N_Arguments (1); + + -- Loop through arguments + + Arg := Arg1; + while Present (Arg) loop + Check_No_Identifier (Arg); + + -- Note: the analyze call done by Check_Arg_Is_Local_Name will + -- in fact generate reference, so that the entity will have a + -- reference, which will inhibit any warnings about it not + -- being referenced, and also properly show up in the ali file + -- as a reference. But this reference is recorded before the + -- Has_Pragma_Unreferenced flag is set, so that no warning is + -- generated for this reference. + + Check_Arg_Is_Local_Name (Arg); + Arg_Expr := Get_Pragma_Arg (Arg); + + if Is_Entity_Name (Arg_Expr) then + Arg_Id := Entity (Arg_Expr); + + -- Skip processing the argument if already flagged + + if Is_Assignable (Arg_Id) + and then not Has_Pragma_Unmodified (Arg_Id) + and then not Has_Pragma_Unused (Arg_Id) + then + Set_Has_Pragma_Unmodified (Arg_Id); + + if Is_Unused then + 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_Pragma_As_Ghost (N, Arg_Id); + + -- Capture the entity of the first Ghost 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; + + -- Otherwise the variable 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 " + & "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); + end if; + + -- Warn if already flagged as Unused or Unmodified + + elsif Has_Pragma_Unmodified (Arg_Id) then + if Has_Pragma_Unused (Arg_Id) then + Error_Msg_NE + ("??pragma Unused given for &!", Arg_Expr, Arg_Id); + else + Error_Msg_NE + ("??pragma Unmodified given for &!", Arg_Expr, Arg_Id); + end if; + + -- Otherwise the pragma referenced an illegal entity + + else + Error_Pragma_Arg + ("pragma% can only be applied to a variable", Arg_Expr); + end if; + end if; + + Next (Arg); + end loop; + end Analyze_Unmodified_Or_Unused; + + ----------------------------------- + -- Analyze_Unreference_Or_Unused -- + ----------------------------------- + + procedure Analyze_Unreferenced_Or_Unused + (Is_Unused : Boolean := False) + is + Arg : Node_Id; + Arg_Expr : Node_Id; + Arg_Id : Entity_Id; + Citem : Node_Id; + + Ghost_Error_Posted : Boolean := False; + -- 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. + + begin + GNAT_Pragma; + Check_At_Least_N_Arguments (1); + + -- Check case of appearing within context clause + + if not Is_Unused and then Is_In_Context_Clause then + + -- The arguments must all be units mentioned in a with clause in + -- the same context clause. Note that Par.Prag already checked + -- that the arguments are either identifiers or selected + -- components. + + Arg := Arg1; + while Present (Arg) loop + Citem := First (List_Containing (N)); + while Citem /= N loop + Arg_Expr := Get_Pragma_Arg (Arg); + + if Nkind (Citem) = N_With_Clause + and then Same_Name (Name (Citem), Arg_Expr) + then + Set_Has_Pragma_Unreferenced + (Cunit_Entity + (Get_Source_Unit + (Library_Unit (Citem)))); + Set_Elab_Unit_Name (Arg_Expr, Name (Citem)); + exit; + end if; + + Next (Citem); + end loop; + + if Citem = N then + Error_Pragma_Arg + ("argument of pragma% is not withed unit", Arg); + end if; + + Next (Arg); + end loop; + + -- Case of not in list of context items + + else + Arg := Arg1; + while Present (Arg) loop + Check_No_Identifier (Arg); + + -- Note: the analyze call done by Check_Arg_Is_Local_Name will + -- in fact generate reference, so that the entity will have a + -- reference, which will inhibit any warnings about it not + -- being referenced, and also properly show up in the ali file + -- as a reference. But this reference is recorded before the + -- Has_Pragma_Unreferenced flag is set, so that no warning is + -- generated for this reference. + + Check_Arg_Is_Local_Name (Arg); + Arg_Expr := Get_Pragma_Arg (Arg); + + if Is_Entity_Name (Arg_Expr) then + Arg_Id := Entity (Arg_Expr); + + -- Warn if already flagged as Unused or Unreferenced and + -- skip processing the argument. + + if Has_Pragma_Unreferenced (Arg_Id) then + if Has_Pragma_Unused (Arg_Id) then + Error_Msg_NE + ("??pragma Unused given for &!", Arg_Expr, Arg_Id); + else + Error_Msg_NE + ("??pragma Unreferenced given for &!", Arg_Expr, + Arg_Id); + end if; + + -- Apply Unreferenced to the entity + + else + -- If the entity is overloaded, the pragma applies to the + -- most recent overloading, as documented. In this case, + -- name resolution does not generate a reference, so it + -- must be done here explicitly. + + if Is_Overloaded (Arg_Expr) then + Generate_Reference (Arg_Id, N); + end if; + + Set_Has_Pragma_Unreferenced (Arg_Id); + + if Is_Unused then + 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_Pragma_As_Ghost (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; + end if; + end if; + + Next (Arg); + end loop; + end if; + end Analyze_Unreferenced_Or_Unused; + -------------------------- -- Check_Ada_83_Warning -- -------------------------- @@ -22270,6 +22548,30 @@ Set_Is_Unchecked_Union (Base_Type (Typ)); end Unchecked_Union; + ---------------------------- + -- Unevaluated_Use_Of_Old -- + ---------------------------- + + -- pragma Unevaluated_Use_Of_Old (Error | Warn | Allow); + + when Pragma_Unevaluated_Use_Of_Old => + GNAT_Pragma; + Check_Arg_Count (1); + Check_No_Identifiers; + Check_Arg_Is_One_Of (Arg1, Name_Error, Name_Warn, Name_Allow); + + -- Suppress/Unsuppress can appear as a configuration pragma, or in + -- a declarative part or a package spec. + + if not Is_Configuration_Pragma then + Check_Is_In_Decl_Part_Or_Package_Spec; + end if; + + -- Store proper setting of Uneval_Old + + Get_Name_String (Chars (Get_Pragma_Arg (Arg1))); + Uneval_Old := Fold_Upper (Name_Buffer (1)); + ------------------------ -- Unimplemented_Unit -- ------------------------ @@ -22281,10 +22583,9 @@ -- body, not in the spec). when Pragma_Unimplemented_Unit => Unimplemented_Unit : declare - Cunitent : constant Entity_Id := + Cunitent : constant Entity_Id := Cunit_Entity (Get_Source_Unit (Loc)); - Ent_Kind : constant Entity_Kind := - Ekind (Cunitent); + Ent_Kind : constant Entity_Kind := Ekind (Cunitent); begin GNAT_Pragma; @@ -22350,93 +22651,9 @@ -- pragma Unmodified (LOCAL_NAME {, LOCAL_NAME}); - when Pragma_Unmodified => Unmodified : declare - Arg : Node_Id; - Arg_Expr : Node_Id; - Arg_Id : Entity_Id; + when Pragma_Unmodified => + Analyze_Unmodified_Or_Unused; - Ghost_Error_Posted : Boolean := False; - -- 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. - - begin - GNAT_Pragma; - Check_At_Least_N_Arguments (1); - - -- Loop through arguments - - Arg := Arg1; - while Present (Arg) loop - Check_No_Identifier (Arg); - - -- Note: the analyze call done by Check_Arg_Is_Local_Name will - -- in fact generate reference, so that the entity will have a - -- reference, which will inhibit any warnings about it not - -- being referenced, and also properly show up in the ali file - -- as a reference. But this reference is recorded before the - -- Has_Pragma_Unreferenced flag is set, so that no warning is - -- generated for this reference. - - Check_Arg_Is_Local_Name (Arg); - Arg_Expr := Get_Pragma_Arg (Arg); - - if Is_Entity_Name (Arg_Expr) then - Arg_Id := Entity (Arg_Expr); - - if Is_Assignable (Arg_Id) then - Set_Has_Pragma_Unmodified (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_Pragma_As_Ghost (N, Arg_Id); - - -- Capture the entity of the first Ghost 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; - - -- Otherwise the variable 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 " - & "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); - end if; - - -- Otherwise the pragma referenced an illegal entity - - else - Error_Pragma_Arg - ("pragma% can only be applied to a variable", Arg_Expr); - end if; - end if; - - Next (Arg); - end loop; - end Unmodified; - ------------------ -- Unreferenced -- ------------------ @@ -22447,134 +22664,9 @@ -- pragma Unreferenced (library_unit_NAME {, library_unit_NAME} - when Pragma_Unreferenced => Unreferenced : declare - Arg : Node_Id; - Arg_Expr : Node_Id; - Arg_Id : Entity_Id; - Citem : Node_Id; + when Pragma_Unreferenced => + Analyze_Unreferenced_Or_Unused; - Ghost_Error_Posted : Boolean := False; - -- 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. - - begin - GNAT_Pragma; - Check_At_Least_N_Arguments (1); - - -- Check case of appearing within context clause - - if Is_In_Context_Clause then - - -- The arguments must all be units mentioned in a with clause - -- in the same context clause. Note we already checked (in - -- Par.Prag) that the arguments are either identifiers or - -- selected components. - - Arg := Arg1; - while Present (Arg) loop - Citem := First (List_Containing (N)); - while Citem /= N loop - Arg_Expr := Get_Pragma_Arg (Arg); - - if Nkind (Citem) = N_With_Clause - and then Same_Name (Name (Citem), Arg_Expr) - then - Set_Has_Pragma_Unreferenced - (Cunit_Entity - (Get_Source_Unit - (Library_Unit (Citem)))); - Set_Elab_Unit_Name (Arg_Expr, Name (Citem)); - exit; - end if; - - Next (Citem); - end loop; - - if Citem = N then - Error_Pragma_Arg - ("argument of pragma% is not withed unit", Arg); - end if; - - Next (Arg); - end loop; - - -- Case of not in list of context items - - else - Arg := Arg1; - while Present (Arg) loop - Check_No_Identifier (Arg); - - -- Note: the analyze call done by Check_Arg_Is_Local_Name - -- will in fact generate reference, so that the entity will - -- have a reference, which will inhibit any warnings about - -- it not being referenced, and also properly show up in the - -- ali file as a reference. But this reference is recorded - -- before the Has_Pragma_Unreferenced flag is set, so that - -- no warning is generated for this reference. - - Check_Arg_Is_Local_Name (Arg); - Arg_Expr := Get_Pragma_Arg (Arg); - - if Is_Entity_Name (Arg_Expr) then - Arg_Id := Entity (Arg_Expr); - - -- If the entity is overloaded, the pragma applies to the - -- most recent overloading, as documented. In this case, - -- name resolution does not generate a reference, so it - -- must be done here explicitly. - - if Is_Overloaded (Arg_Expr) then - Generate_Reference (Arg_Id, N); - end if; - - Set_Has_Pragma_Unreferenced (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_Pragma_As_Ghost (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; - end if; - - Next (Arg); - end loop; - end if; - end Unreferenced; - -------------------------- -- Unreferenced_Objects -- -------------------------- @@ -22681,30 +22773,16 @@ Ada_2005_Pragma; Process_Suppress_Unsuppress (Suppress_Case => False); - ---------------------------- - -- Unevaluated_Use_Of_Old -- - ---------------------------- + ------------ + -- Unused -- + ------------ - -- pragma Unevaluated_Use_Of_Old (Error | Warn | Allow); + -- pragma Unused (LOCAL_NAME {, LOCAL_NAME}); - when Pragma_Unevaluated_Use_Of_Old => - GNAT_Pragma; - Check_Arg_Count (1); - Check_No_Identifiers; - Check_Arg_Is_One_Of (Arg1, Name_Error, Name_Warn, Name_Allow); + when Pragma_Unused => + Analyze_Unmodified_Or_Unused (Is_Unused => True); + Analyze_Unreferenced_Or_Unused (Is_Unused => True); - -- Suppress/Unsuppress can appear as a configuration pragma, or in - -- a declarative part or a package spec. - - if not Is_Configuration_Pragma then - Check_Is_In_Decl_Part_Or_Package_Spec; - end if; - - -- Store proper setting of Uneval_Old - - Get_Name_String (Chars (Get_Pragma_Arg (Arg1))); - Uneval_Old := Fold_Upper (Name_Buffer (1)); - ------------------- -- Use_VADS_Size -- ------------------- @@ -26386,8 +26464,8 @@ then Error_Msg_N ("cannot modify inherited condition (SPARK RM 6.1.1(1))", - Parent (Subp)); - Error_Msg_Sloc := Sloc (New_E); + Parent (Subp)); + Error_Msg_Sloc := Sloc (New_E); Error_Msg_Node_2 := Subp; Error_Msg_NE ("\overriding of&# forces overriding of&", @@ -28378,6 +28456,7 @@ Pragma_Type_Invariant => -1, Pragma_Type_Invariant_Class => -1, Pragma_Unchecked_Union => 0, + Pragma_Unevaluated_Use_Of_Old => 0, Pragma_Unimplemented_Unit => 0, Pragma_Universal_Aliasing => 0, Pragma_Universal_Data => 0, @@ -28386,7 +28465,7 @@ Pragma_Unreferenced_Objects => 0, Pragma_Unreserve_All_Interrupts => 0, Pragma_Unsuppress => 0, - Pragma_Unevaluated_Use_Of_Old => 0, + Pragma_Unused => 0, Pragma_Use_VADS_Size => 0, Pragma_Validity_Checks => 0, Pragma_Volatile => 0, Index: sem_util.adb =================================================================== --- sem_util.adb (revision 237957) +++ sem_util.adb (working copy) @@ -17618,11 +17618,20 @@ if Comes_From_Source (Exp) or else Modification_Comes_From_Source then - -- Give warning if pragma unmodified given and we are + -- Give warning if pragma unmodified is given and we are -- sure this is a modification. if Has_Pragma_Unmodified (Ent) and then Sure then - Error_Msg_NE ("??pragma Unmodified given for &!", N, Ent); + + -- Note that the entity may be present only as a result + -- of pragma Unused. + + if Has_Pragma_Unused (Ent) then + Error_Msg_NE ("??pragma Unused given for &!", N, Ent); + else + Error_Msg_NE + ("??pragma Unmodified given for &!", N, Ent); + end if; end if; Set_Never_Set_In_Source (Ent, False); Index: par-prag.adb =================================================================== --- par-prag.adb (revision 237957) +++ par-prag.adb (working copy) @@ -1487,6 +1487,7 @@ Pragma_Unreferenced_Objects | Pragma_Unreserve_All_Interrupts | Pragma_Unsuppress | + Pragma_Unused | Pragma_Use_VADS_Size | Pragma_Volatile | Pragma_Volatile_Components | Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 237957) +++ snames.ads-tmpl (working copy) @@ -653,6 +653,7 @@ Name_Unreferenced : constant Name_Id := N + $; -- GNAT Name_Unreferenced_Objects : constant Name_Id := N + $; -- GNAT Name_Unreserve_All_Interrupts : constant Name_Id := N + $; -- GNAT + Name_Unused : constant Name_Id := N + $; -- GNAT Name_Volatile : constant Name_Id := N + $; Name_Volatile_Components : constant Name_Id := N + $; Name_Volatile_Full_Access : constant Name_Id := N + $; -- GNAT @@ -1965,6 +1966,7 @@ Pragma_Unreferenced, Pragma_Unreferenced_Objects, Pragma_Unreserve_All_Interrupts, + Pragma_Unused, Pragma_Volatile, Pragma_Volatile_Components, Pragma_Volatile_Full_Access, Index: lib-xref.adb =================================================================== --- lib-xref.adb (revision 237957) +++ lib-xref.adb (working copy) @@ -841,6 +841,8 @@ -- Check for pragma Unreferenced given and reference is within -- this source unit (occasion for possible warning to be issued). + -- Note that the entity may be marked as unreferenced by pragma + -- Unused. if Has_Unreferenced (E) and then In_Same_Extended_Unit (E, N) @@ -875,8 +877,13 @@ BE := First_Entity (Current_Scope); while Present (BE) loop if Chars (BE) = Chars (E) then - Error_Msg_NE -- CODEFIX - ("??pragma Unreferenced given for&!", N, BE); + if Has_Pragma_Unused (E) then + Error_Msg_NE -- CODEFIX + ("??pragma Unused given for&!", N, BE); + else + Error_Msg_NE -- CODEFIX + ("??pragma Unreferenced given for&!", N, BE); + end if; exit; end if; @@ -886,6 +893,9 @@ -- Here we issue the warning, since this is a real reference + elsif Has_Pragma_Unused (E) then + Error_Msg_NE -- CODEFIX + ("??pragma Unused given for&!", N, E); else Error_Msg_NE -- CODEFIX ("??pragma Unreferenced given for&!", N, E);