From: charlet Date: Mon, 22 Apr 2013 10:41:08 +0000 (+0000) Subject: 2013-04-22 Yannick Moy X-Git-Tag: upstream/4.9.2~6532 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=4b9eadab17ba08dc673fc5fe6b824e6da20e29e5;p=platform%2Fupstream%2Flinaro-gcc.git 2013-04-22 Yannick Moy * par-prag.adb, sem_attr.adb, sem_ch6.adb, sem_prag.adb, sem_warn.adb, snames.ads-tmpl, sinfo.ads, sem_util.ads: Remove all references to Pragma_Contract_Case and Name_Contract_Case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198128 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e1d5a5f..5c02323 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 2013-04-22 Yannick Moy + * par-prag.adb, sem_attr.adb, sem_ch6.adb, sem_prag.adb, sem_warn.adb, + snames.ads-tmpl, sinfo.ads, sem_util.ads: Remove all references to + Pragma_Contract_Case and Name_Contract_Case. + +2013-04-22 Yannick Moy + * aspects.ads, aspects.adb, sem_ch13.adb: Removal of references to Contract_Case. * gnat_ugn.texi, gnat_rm.texi Description of Contract_Case replaced by diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 214a150..180bf7c 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1121,7 +1121,6 @@ begin Pragma_Compile_Time_Error | Pragma_Compile_Time_Warning | Pragma_Compiler_Unit | - Pragma_Contract_Case | Pragma_Contract_Cases | Pragma_Convention_Identifier | Pragma_CPP_Class | diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 42615c1..974a57b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4265,10 +4265,7 @@ package body Sem_Attr is if Nkind (Prag) /= N_Pragma then Error_Attr ("% attribute can only appear in postcondition", P); - elsif Get_Pragma_Id (Prag) = Pragma_Contract_Case - or else - Get_Pragma_Id (Prag) = Pragma_Test_Case - then + elsif Get_Pragma_Id (Prag) = Pragma_Test_Case then declare Arg_Ens : constant Node_Id := Get_Ensures_From_CTC_Pragma (Prag); @@ -4281,13 +4278,7 @@ package body Sem_Attr is end loop; if Arg /= Arg_Ens then - if Get_Pragma_Id (Prag) = Pragma_Contract_Case then - Error_Attr - ("% attribute misplaced inside contract case", P); - else - Error_Attr - ("% attribute misplaced inside test case", P); - end if; + Error_Attr ("% attribute misplaced inside test case", P); end if; end; @@ -4681,10 +4672,7 @@ package body Sem_Attr is ("% attribute can only appear in postcondition of function", P); - elsif Get_Pragma_Id (Prag) = Pragma_Contract_Case - or else - Get_Pragma_Id (Prag) = Pragma_Test_Case - then + elsif Get_Pragma_Id (Prag) = Pragma_Test_Case then declare Arg_Ens : constant Node_Id := Get_Ensures_From_CTC_Pragma (Prag); @@ -4697,13 +4685,7 @@ package body Sem_Attr is end loop; if Arg /= Arg_Ens then - if Get_Pragma_Id (Prag) = Pragma_Contract_Case then - Error_Attr - ("% attribute misplaced inside contract case", P); - else - Error_Attr - ("% attribute misplaced inside test case", P); - end if; + Error_Attr ("% attribute misplaced inside test case", P); end if; end; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 6f2bee5..7d947c8 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7051,7 +7051,7 @@ package body Sem_Ch6 is -- -- List of subprograms inherited by this subprogram -- We ignore postconditions "True" or "False" and contract-cases which - -- have similar Ensures components, which we call "trivial", when + -- have similar consequence expressions, which we call "trivial", when -- issuing warnings, since these postconditions and contract-cases -- purposedly ignore the post-state. @@ -7064,15 +7064,16 @@ package body Sem_Ch6 is Attribute_Result_Mentioned : Boolean := False; -- Whether attribute 'Result is mentioned in a non-trivial postcondition - -- or contract-case. + -- or contract-cases. No_Warning_On_Some_Postcondition : Boolean := False; - -- Whether there exists a non-trivial postcondition or contract-case + -- Whether there exists a non-trivial postcondition or contract-cases -- without a corresponding warning. Post_State_Mentioned : Boolean := False; - -- Whether some expression mentioned in a postcondition or contract-case - -- can have a different value in the post-state than in the pre-state. + -- Whether some expression mentioned in a postcondition or + -- contract-cases can have a different value in the post-state than + -- in the pre-state. function Check_Attr_Result (N : Node_Id) return Traverse_Result; -- Check if N is a reference to the attribute 'Result, and if so set @@ -7218,7 +7219,7 @@ package body Sem_Ch6 is while Present (Post_Case) loop Conseq := Expression (Post_Case); - -- Ignore trivial contract-case when consequence is "True" + -- Ignore trivial contract-cases when consequence is "True" -- or "False". if not Is_Trivial_Post_Or_Ensures (Conseq) then @@ -11266,11 +11267,6 @@ package body Sem_Ch6 is -- evaluate case guards and trigger consequence expressions. Subp_Id -- denotes the related subprogram. - function Grab_CC return Node_Id; - -- Prag contains an analyzed contract case pragma. This function copies - -- relevant components of the pragma, creates the corresponding Check - -- pragma and returns the Check pragma as the result. - function Grab_PPC (Pspec : Entity_Id := Empty) return Node_Id; -- Prag contains an analyzed precondition or postcondition pragma. This -- function copies the pragma, changes it to the corresponding Check @@ -11786,89 +11782,6 @@ package body Sem_Ch6 is Append_To (Plist, Conseq_Checks); end Expand_Contract_Cases; - ------------- - -- Grab_CC -- - ------------- - - function Grab_CC return Node_Id is - Loc : constant Source_Ptr := Sloc (Prag); - CP : Node_Id; - Req : Node_Id; - Ens : Node_Id; - Post : Node_Id; - - -- As with postcondition, the string is "failed xx from yy" where - -- xx is in all lower case. The reason for this different wording - -- compared to other Check cases is that the failure is not at the - -- point of occurrence of the pragma, unlike the other Check cases. - - Msg : constant String := - "failed contract case from " & Build_Location_String (Loc); - - begin - -- Copy the Requires and Ensures expressions - - Req := New_Copy_Tree - (Expression (Get_Requires_From_CTC_Pragma (Prag)), - New_Scope => Current_Scope); - - Ens := New_Copy_Tree - (Expression (Get_Ensures_From_CTC_Pragma (Prag)), - New_Scope => Current_Scope); - - -- Build the postcondition (not Requires'Old or else Ensures) - - Post := - Make_Or_Else (Loc, - Left_Opnd => - Make_Op_Not (Loc, - Make_Attribute_Reference (Loc, - Prefix => Req, - Attribute_Name => Name_Old)), - Right_Opnd => Ens); - - -- For a contract case pragma within a generic, generate a - -- postcondition pragma for later expansion. This is also used - -- when an error was detected, thus setting Expander_Active to False. - - if not Expander_Active then - CP := - Make_Pragma (Loc, - Chars => Name_Postcondition, - Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Loc, - Chars => Name_Check, - Expression => Post), - - Make_Pragma_Argument_Association (Loc, - Chars => Name_Message, - Expression => Make_String_Literal (Loc, Msg)))); - - -- Otherwise, create the Check pragma - - else - CP := - Make_Pragma (Loc, - Chars => Name_Check, - Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Loc, - Chars => Name_Name, - Expression => Make_Identifier (Loc, Name_Postcondition)), - - Make_Pragma_Argument_Association (Loc, - Chars => Name_Check, - Expression => Post), - - Make_Pragma_Argument_Association (Loc, - Chars => Name_Message, - Expression => Make_String_Literal (Loc, Msg)))); - end if; - - -- Return the Postcondition or Check pragma - - return CP; - end Grab_CC; - -------------- -- Grab_PPC -- -------------- @@ -12300,7 +12213,7 @@ package body Sem_Ch6 is Spec_Postconditions : declare procedure Process_Contract_Cases (Spec : Node_Id); -- This processes the Spec_CTC_List from Spec, processing any - -- contract-case from the list. The caller has checked that + -- contract-cases from the list. The caller has checked that -- Spec_CTC_List is non-Empty. procedure Process_Post_Conditions @@ -12317,22 +12230,11 @@ package body Sem_Ch6 is procedure Process_Contract_Cases (Spec : Node_Id) is begin - -- Loop through Contract_Case pragmas from spec + -- Loop through Contract_Cases pragmas from spec Prag := Spec_CTC_List (Contract (Spec)); loop - if Pragma_Name (Prag) = Name_Contract_Case then - if Plist = No_List then - Plist := Empty_List; - end if; - - if not Expander_Active then - Prepend (Grab_CC, Declarations (N)); - else - Append (Grab_CC, Plist); - end if; - - elsif Pragma_Name (Prag) = Name_Contract_Cases then + if Pragma_Name (Prag) = Name_Contract_Cases then Expand_Contract_Cases (Prag, Spec_Id); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 700de0c..1cff29f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -190,8 +190,8 @@ package body Sem_Prag is procedure Preanalyze_CTC_Args (N, Arg_Req, Arg_Ens : Node_Id); -- Preanalyze the boolean expressions in the Requires and Ensures arguments - -- of a Contract_Case or Test_Case pragma if present (possibly Empty). We - -- treat these as spec expressions (i.e. similar to a default expression). + -- of a Test_Case pragma if present (possibly Empty). We treat these as + -- spec expressions (i.e. similar to a default expression). procedure Rewrite_Assertion_Kind (N : Node_Id); -- If N is Pre'Class, Post'Class, Invariant'Class, or Type_Invariant'Class, @@ -306,7 +306,7 @@ package body Sem_Prag is -- Preanalyze the boolean expressions, we treat these as spec -- expressions (i.e. similar to a default expression). - if Nam_In (Pragma_Name (N), Name_Test_Case, Name_Contract_Case) then + if Pragma_Name (N) = Name_Test_Case then Preanalyze_CTC_Args (N, Get_Requires_From_CTC_Pragma (N), @@ -627,17 +627,16 @@ package body Sem_Prag is -- UU_Typ is the related Unchecked_Union type. Flag In_Variant_Part -- should be set when Comp comes from a record variant. - procedure Check_Contract_Or_Test_Case; - -- Called to process a contract-case or test-case pragma. It - -- starts with checking pragma arguments, and the rest of the - -- treatment is similar to the one for pre- and postcondition in - -- Check_Precondition_Postcondition, except the placement rules for the - -- contract-case and test-case pragmas are stricter. These pragmas may - -- only occur after a subprogram spec declared directly in a package - -- spec unit. In this case, the pragma is chained to the subprogram in - -- question (using Spec_CTC_List and Next_Pragma) and analysis of the - -- pragma is delayed till the end of the spec. In all other cases, an - -- error message for bad placement is given. + procedure Check_Test_Case; + -- Called to process a test-case pragma. It starts with checking pragma + -- arguments, and the rest of the treatment is similar to the one for + -- pre- and postcondition in Check_Precondition_Postcondition, except + -- the placement rules for the test-case pragma are stricter. These + -- pragmas may only occur after a subprogram spec declared directly + -- in a package spec unit. In this case, the pragma is chained to the + -- subprogram in question (using Spec_CTC_List and Next_Pragma) and + -- analysis of the pragma is delayed till the end of the spec. In all + -- other cases, an error message for bad placement is given. procedure Check_Duplicate_Pragma (E : Entity_Id); -- Check if a rep item of the same name as the current pragma is already @@ -1526,19 +1525,18 @@ package body Sem_Prag is end if; end Check_Component; - --------------------------------- - -- Check_Contract_Or_Test_Case -- - --------------------------------- + --------------------- + -- Check_Test_Case -- + --------------------- - procedure Check_Contract_Or_Test_Case is + procedure Check_Test_Case is P : Node_Id; PO : Node_Id; procedure Chain_CTC (PO : Node_Id); -- If PO is a [generic] subprogram declaration node, then the - -- contract-case or test-case applies to this subprogram and the - -- processing for the pragma is completed. Otherwise the pragma - -- is misplaced. + -- test-case applies to this subprogram and the processing for + -- the pragma is completed. Otherwise the pragma is misplaced. --------------- -- Chain_CTC -- @@ -1571,8 +1569,8 @@ package body Sem_Prag is -- in this analysis, allowing forward references. The analysis -- happens at the end of Analyze_Declarations. - -- There should not be another contract-case or test-case with the - -- same name associated to this subprogram. + -- There should not be another test-case with the same name + -- associated to this subprogram. declare Name : constant String_Id := Get_Name_From_CTC_Pragma (N); @@ -1584,7 +1582,7 @@ package body Sem_Prag is -- Omit pragma Contract_Cases because it does not introduce -- a unique case name and it does not follow the syntax of - -- Contract_Case and Test_Case. + -- Test_Case. if Pragma_Name (CTC) = Name_Contract_Cases then null; @@ -1606,7 +1604,7 @@ package body Sem_Prag is Set_Spec_CTC_List (Contract (S), N); end Chain_CTC; - -- Start of processing for Check_Contract_Or_Test_Case + -- Start of processing for Check_Test_Case begin -- First check pragma arguments @@ -1647,7 +1645,7 @@ package body Sem_Prag is Pragma_Misplaced; end if; - -- Contract-case or test-case should only appear in package spec unit + -- Test-case should only appear in package spec unit if Get_Source_Unit (N) = No_Unit or else not Nkind_In (Sinfo.Unit (Cunit (Get_Source_Unit (N))), @@ -1665,9 +1663,9 @@ package body Sem_Prag is -- If the previous node is a generic subprogram, do not go to to -- the original node, which is the unanalyzed tree: we need to - -- attach the contract-case or test-case to the analyzed version - -- at this point. They get propagated to the original tree when - -- analyzing the corresponding body. + -- attach the test-case to the analyzed version at this point. + -- They get propagated to the original tree when analyzing the + -- corresponding body. if Nkind (P) not in N_Generic_Declaration then PO := Original_Node (P); @@ -1707,7 +1705,7 @@ package body Sem_Prag is -- If we fall through, pragma was misplaced Pragma_Misplaced; - end Check_Contract_Or_Test_Case; + end Check_Test_Case; ---------------------------- -- Check_Duplicate_Pragma -- @@ -8617,21 +8615,6 @@ package body Sem_Prag is end if; end Component_AlignmentP; - ------------------- - -- Contract_Case -- - ------------------- - - -- pragma Contract_Case - -- ([Name =>] Static_String_EXPRESSION - -- ,[Mode =>] MODE_TYPE - -- [, Requires => Boolean_EXPRESSION] - -- [, Ensures => Boolean_EXPRESSION]); - - -- MODE_TYPE ::= Nominal | Robustness - - when Pragma_Contract_Case => - Check_Contract_Or_Test_Case; - -------------------- -- Contract_Cases -- -------------------- @@ -16973,7 +16956,7 @@ package body Sem_Prag is -- MODE_TYPE ::= Nominal | Robustness when Pragma_Test_Case => - Check_Contract_Or_Test_Case; + Check_Test_Case; -------------------------- -- Thread_Local_Storage -- @@ -18150,7 +18133,6 @@ package body Sem_Prag is Pragma_Complete_Representation => 0, Pragma_Complex_Representation => 0, Pragma_Component_Alignment => -1, - Pragma_Contract_Case => -1, Pragma_Contract_Cases => -1, Pragma_Controlled => 0, Pragma_Convention => 0, diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 3d252a2..a47eb98 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -575,8 +575,7 @@ package Sem_Util is -- Otherwise return Empty. Expression N should have been resolved already. function Get_Ensures_From_CTC_Pragma (N : Node_Id) return Node_Id; - -- Return the Ensures component of Contract_Case or Test_Case pragma N, or - -- Empty otherwise. + -- Return the Ensures component of Test_Case pragma N, or Empty otherwise function Get_Generic_Entity (N : Node_Id) return Entity_Id; -- Returns the true generic entity in an instantiation. If the name in the @@ -616,7 +615,7 @@ package Sem_Util is -- Sem_Ch8 for further details on handling of entity visibility. function Get_Name_From_CTC_Pragma (N : Node_Id) return String_Id; - -- Return the Name component of Contract_Case or Test_Case pragma N + -- Return the Name component of Test_Case pragma N function Get_Pragma_Id (N : Node_Id) return Pragma_Id; pragma Inline (Get_Pragma_Id); @@ -634,8 +633,7 @@ package Sem_Util is -- with any other kind of entity. function Get_Requires_From_CTC_Pragma (N : Node_Id) return Node_Id; - -- Return the Requires component of Contract_Case or Test_Case pragma N, or - -- Empty otherwise. + -- Return the Requires component of Test_Case pragma N, or Empty otherwise function Get_Subprogram_Entity (Nod : Node_Id) return Entity_Id; -- Nod is either a procedure call statement, or a function call, or an diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 630b635..68c3ca8 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1765,8 +1765,8 @@ package body Sem_Warn is SE : constant Entity_Id := Scope (E); function Within_Postcondition return Boolean; - -- Returns True iff N is within a Postcondition or - -- Ensures component in a Contract_Case or Test_Case. + -- Returns True iff N is within a Postcondition, an + -- Ensures component in a Test_Case, or a Contract_Cases. -------------------------- -- Within_Postcondition -- @@ -1779,7 +1779,9 @@ package body Sem_Warn is Nod := Parent (N); while Present (Nod) loop if Nkind (Nod) = N_Pragma - and then Pragma_Name (Nod) = Name_Postcondition + and then Nam_In (Pragma_Name (Nod), + Name_Postcondition, + Name_Contract_Cases) then return True; @@ -1788,8 +1790,7 @@ package body Sem_Warn is if Nkind (P) = N_Pragma and then - Nam_In (Pragma_Name (P), Name_Contract_Case, - Name_Test_Case) + Pragma_Name (P) = Name_Test_Case and then Nod = Get_Ensures_From_CTC_Pragma (P) then diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 49188c7..9631fa8 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -7042,12 +7042,12 @@ package Sinfo is -- Note that this includes precondition/postcondition pragmas generated -- to correspond to Pre/Post aspects. - -- Spec_CTC_List points to a list of Contract_Case and Test_Case pragma + -- Spec_CTC_List points to a list of Contract_Cases and Test_Case pragma -- nodes for contract-cases and test-cases declared in the spec of the -- entry/subprogram. The last pragma encountered is at the head of this -- list, so it is in reverse order of textual appearance. Note that - -- this includes contract-case and test-case pragmas generated from - -- Contract_Case and Test_Case aspects. + -- this includes contract-cases and test-case pragmas generated from + -- Contract_Cases and Test_Case aspects. ------------------- -- Expanded_Name -- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 43e902f..d1854b2 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -473,7 +473,6 @@ package Snames is Name_Common_Object : constant Name_Id := N + $; -- GNAT Name_Complete_Representation : constant Name_Id := N + $; -- GNAT Name_Complex_Representation : constant Name_Id := N + $; -- GNAT - Name_Contract_Case : constant Name_Id := N + $; -- GNAT Name_Contract_Cases : constant Name_Id := N + $; -- GNAT Name_Controlled : constant Name_Id := N + $; Name_Convention : constant Name_Id := N + $; @@ -1775,7 +1774,6 @@ package Snames is Pragma_Common_Object, Pragma_Complete_Representation, Pragma_Complex_Representation, - Pragma_Contract_Case, Pragma_Contract_Cases, Pragma_Controlled, Pragma_Convention,