From 327b1ba4bd731c191f167d74ec3766939ab923de Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 24 Apr 2013 16:22:24 +0200 Subject: [PATCH] 2013-04-24 Sergey Rybin * gnat_ugn.texi: Add description of '--help' and '--version' options for ASIS tools: gnatelim, gnatmetric, gnatstub, gnatpp. 2013-04-24 Arnaud Charlet * gnat_rm.texi: Minor syntax fix. 2013-04-24 Hristian Kirtchev * exp_attr.adb (Expand_Loop_Entry_Attribute): Add extra comments on what and why is being analyzed. Remove the decoration of renamings as this simply falls out of the general analysis mechanism. 2013-04-24 Hristian Kirtchev * sem_res.adb (Explain_Redundancy): New routine. (Resolve_Equality_Op): Place the error concerning a redundant comparison to True at the "=". Try to explain the nature of the redundant True. 2013-04-24 Javier Miranda * checks.adb, exp_ch6.adb (Install_Null_Excluding_Check): No check in interface thunks since it is performed at the caller side. (Expand_Simple_Function_Return): No accessibility check needed in thunks since the check is done by the target routine. 2013-04-24 Vincent Celier * xref_lib.adb (Add_Entity): Use the canonical file names so that source file names with capital letters are found on platforms where file names are case insensitive. 2013-04-24 Hristian Kirtchev * par-ch4.adb (P_Name): Continue to parse the name extension when the construct is attribute Loop_Entry. Do not convert the attribute reference into an indexed component when there is at least one expression / range following 'Loop_Entry. 2013-04-24 Hristian Kirtchev * sem_ch6.adb (Contains_Enabled_Pragmas): New routine. (Process_PPCs): Generate procedure _Postconditions only when the context has invariants or predicates or enabled aspects/pragmas. From-SVN: r198236 --- gcc/ada/ChangeLog | 51 ++++++++++++++++++++++++++++++++++ gcc/ada/exp_attr.adb | 27 ++++++++---------- gcc/ada/gnat_rm.texi | 6 ++-- gcc/ada/gnat_ugn.texi | 32 ++++++++++++++++++++++ gcc/ada/par-ch4.adb | 31 +++++++++++++++++---- gcc/ada/sem_ch6.adb | 31 +++++++++++++++++++-- gcc/ada/sem_res.adb | 76 +++++++++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/xref_lib.adb | 25 +++++++++-------- 8 files changed, 239 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4b39d70..1efb8b9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,54 @@ +2013-04-24 Sergey Rybin + + * gnat_ugn.texi: Add description of '--help' and '--version' + options for ASIS tools: gnatelim, gnatmetric, gnatstub, gnatpp. + +2013-04-24 Arnaud Charlet + + * gnat_rm.texi: Minor syntax fix. + +2013-04-24 Hristian Kirtchev + + * exp_attr.adb (Expand_Loop_Entry_Attribute): Add extra comments on + what and why is being analyzed. Remove the decoration of renamings as + this simply falls out of the general analysis mechanism. + +2013-04-24 Hristian Kirtchev + + * sem_res.adb (Explain_Redundancy): New routine. + (Resolve_Equality_Op): Place the error concerning a redundant + comparison to True at the "=". Try to explain the nature of the + redundant True. + +2013-04-24 Javier Miranda + + + * checks.adb, exp_ch6.adb (Install_Null_Excluding_Check): No + check in interface thunks since it is performed at the caller + side. + (Expand_Simple_Function_Return): No accessibility check + needed in thunks since the check is done by the target routine. + +2013-04-24 Vincent Celier + + * xref_lib.adb (Add_Entity): Use the canonical file names + so that source file names with capital letters are found on + platforms where file names are case insensitive. + +2013-04-24 Hristian Kirtchev + + * par-ch4.adb (P_Name): Continue to parse the name extension when the + construct is attribute Loop_Entry. Do not convert the attribute + reference into an indexed component when there is at least one + expression / range following 'Loop_Entry. + +2013-04-24 Hristian Kirtchev + + * sem_ch6.adb (Contains_Enabled_Pragmas): New routine. + (Process_PPCs): Generate procedure _Postconditions + only when the context has invariants or predicates or enabled + aspects/pragmas. + 2013-04-24 Thomas Quinot * g-socket.adb (Host_Entry): Introduce intermediate copy of diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index fc44324..c206218 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -985,37 +985,32 @@ package body Exp_Attr is Rewrite (Attr, New_Reference_To (Temp_Id, Loc)); - -- The analysis of the conditional block takes care of the constant - -- declaration. - Installed := Current_Scope = Loop_Id; + -- Depending on the pracement of attribute 'Loop_Entry relative to the + -- associated loop, ensure the proper visibility for analysis. + if not Installed then Push_Scope (Scope (Loop_Id)); end if; + -- The analysis of the conditional block takes care of the constant + -- declaration. + if Present (Result) then Rewrite (Loop_Stmt, Result); Analyze (Loop_Stmt); + + -- The conditional block was analyzed when a previous 'Loop_Entry was + -- expanded. There is no point in reanalyzing the block, simply analyze + -- the declaration of the constant. + else Analyze (Temp_Decl); end if; Analyze (Attr); - -- Patch up a renaming of a 'Loop_Entry attribute. This case may arise - -- when the attribute is used as the name in an Ada 2012 iterator loop. - - if Nkind (Parent (Attr)) = N_Object_Renaming_Declaration then - declare - Mark : constant Node_Id := Subtype_Mark (Parent (Attr)); - - begin - Rewrite (Mark, New_Reference_To (Etype (Temp_Id), Sloc (Mark))); - Analyze (Mark); - end; - end if; - if not Installed then Pop_Scope; end if; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index edad793..2d162ef 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -5135,9 +5135,9 @@ compiles with the Rational APEX compiler, even when the code includes non- conforming Ada constructs. The profile enables the following three pragmas: @itemize @bullet -pragma Implicit_Packing; -pragma Overriding_Renamings; -pragma Use_VADS_Size; +@item pragma Implicit_Packing +@item pragma Overriding_Renamings +@item pragma Use_VADS_Size @end itemize @noindent diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 31d8fd7..97aebf1 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -10910,6 +10910,14 @@ Ada 2005 mode etc. @table @option @c !sort! +@item --version +@cindex @option{--version} @command{gnatelim} +Display Copyright and version, then exit disregarding all other options. + +@item --help +@cindex @option{--help} @command{gnatelim} +Display usage, then exit disregarding all other options. + @item ^-files^/FILES^=@var{filename} @cindex @option{^-files^/FILES^} (@code{gnatelim}) Take the argument source files from the specified file. This file should be an @@ -14207,6 +14215,14 @@ with @option{^-pipe^/STANDARD_OUTPUT^} option. The additional @command{gnatpp} switches are defined in this subsection. @table @option +@item --version +@cindex @option{--version} @command{gnatpp} +Display Copyright and version, then exit disregarding all other options. + +@item --help +@cindex @option{--help} @command{gnatpp} +Display usage, then exit disregarding all other options. + @item ^-files @var{filename}^/FILES=@var{filename}^ @cindex @option{^-files^/FILES^} (@code{gnatpp}) Take the argument source files from the specified file. This file should be an @@ -15657,6 +15673,14 @@ Report control fan-in coupling Additional @command{gnatmetric} switches are as follows: @table @option +@item --version +@cindex @option{--version} @command{gnatmetric} +Display Copyright and version, then exit disregarding all other options. + +@item --help +@cindex @option{--help} @command{gnatmetric} +Display usage, then exit disregarding all other options. + @item ^-files @var{filename}^/FILES=@var{filename}^ @cindex @option{^-files^/FILES^} (@code{gnatmetric}) Take the argument source files from the specified file. This file should be an @@ -18476,6 +18500,14 @@ is an optional sequence of switches as described in the next section @table @option @c !sort! +@item --version +@cindex @option{--version} @command{gnatstub} +Display Copyright and version, then exit disregarding all other options. + +@item --help +@cindex @option{--help} @command{gnatstub} +Display usage, then exit disregarding all other options. + @item ^-f^/FULL^ @cindex @option{^-f^/FULL^} (@command{gnatstub}) If the destination directory already contains a file with the name of the diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 8066b8c..f0cfa35 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -509,16 +509,25 @@ package body Ch4 is and then not Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name)) then - Set_Expressions (Name_Node, New_List); + -- Attribute Loop_Entry has no effect on the name extension + -- parsing logic, as if the attribute never existed in the + -- source. Continue parsing the subsequent expressions or + -- ranges. + + if Attr_Name = Name_Loop_Entry then + Scan; -- past left paren + goto Scan_Name_Extension_Left_Paren; -- Attribute Update contains an array or record association -- list which provides new values for various components or -- elements. The list is parsed as an aggregate. - if Attr_Name = Name_Update then + elsif Attr_Name = Name_Update then + Set_Expressions (Name_Node, New_List); Append (P_Aggregate, Expressions (Name_Node)); else + Set_Expressions (Name_Node, New_List); Scan; -- past left paren loop @@ -695,10 +704,20 @@ package body Ch4 is elsif not Comma_Present then T_Right_Paren; - Prefix_Node := Name_Node; - Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node)); - Set_Prefix (Name_Node, Prefix_Node); - Set_Expressions (Name_Node, Arg_List); + + -- Do not convert Prefix'Loop_Entry (Expr1, ..., ExprN) into an + -- indexed component now. Let the analysis determine whether the + -- attribute is legal and perform the transformation if needed. + + if Attr_Name = Name_Loop_Entry then + Set_Expressions (Name_Node, Arg_List); + else + Prefix_Node := Name_Node; + Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node)); + Set_Prefix (Name_Node, Prefix_Node); + Set_Expressions (Name_Node, Arg_List); + end if; + goto Scan_Name_Extension; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index ce865bb..1d8ac8f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11196,6 +11196,10 @@ package body Sem_Ch6 is -- under the same visibility conditions as for other invariant checks, -- the type invariant must be applied to the returned value. + function Contains_Enabled_Pragmas (L : List_Id) return Boolean; + -- Determine whether list L has at least one enabled pragma. The routine + -- ignores nother non-pragma elements. + procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id); -- Given pragma Contract_Cases CCs, create the circuitry needed to -- evaluate case guards and trigger consequence expressions. Subp_Id @@ -11263,6 +11267,26 @@ package body Sem_Ch6 is end if; end Check_Access_Invariants; + ------------------------------ + -- Contains_Enabled_Pragmas -- + ------------------------------ + + function Contains_Enabled_Pragmas (L : List_Id) return Boolean is + Prag : Node_Id; + + begin + Prag := First (L); + while Present (Prag) loop + if Nkind (Prag) = N_Pragma and then Is_Ignored (Prag) then + return False; + end if; + + Next (Prag); + end loop; + + return True; + end Contains_Enabled_Pragmas; + --------------------------- -- Expand_Contract_Cases -- --------------------------- @@ -12252,8 +12276,11 @@ package body Sem_Ch6 is -- If we had any postconditions and expansion is enabled, or if the -- subprogram has invariants, then build the _Postconditions procedure. - if (Present (Plist) or else Invariants_Or_Predicates_Present) - and then Expander_Active + if Expander_Active + and then + (Invariants_Or_Predicates_Present + or else + (Present (Plist) and then Contains_Enabled_Pragmas (Plist))) then if No (Plist) then Plist := Empty_List; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 6674d1f..b4a654a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6821,6 +6821,11 @@ package body Sem_Res is -- impose an expected type (as can be the case in an equality operation) -- the expression must be rejected. + procedure Explain_Redundancy (N : Node_Id); + -- Attempt to explain the nature of a redundant comparison with True. If + -- the expression N is too complex, this routine issues a general error + -- message. + function Find_Unique_Access_Type return Entity_Id; -- In the case of allocators and access attributes, the context must -- provide an indication of the specific access type to be used. If @@ -6850,6 +6855,72 @@ package body Sem_Res is end if; end Check_If_Expression; + ------------------------ + -- Explain_Redundancy -- + ------------------------ + + procedure Explain_Redundancy (N : Node_Id) is + Error : Name_Id; + Val : Node_Id; + Val_Id : Entity_Id; + + begin + Val := N; + + -- Strip the operand down to an entity + + loop + if Nkind (Val) = N_Selected_Component then + Val := Selector_Name (Val); + else + exit; + end if; + end loop; + + -- The construct denotes an entity + + if Is_Entity_Name (Val) and then Present (Entity (Val)) then + Val_Id := Entity (Val); + + -- Do not generate an error message when the comparison is done + -- against the enumeration literal Standard.True. + + if Ekind (Val_Id) /= E_Enumeration_Literal then + + -- Build a customized error message + + Name_Len := 0; + Add_Str_To_Name_Buffer ("?r?"); + + if Ekind (Val_Id) = E_Component then + Add_Str_To_Name_Buffer ("component "); + + elsif Ekind (Val_Id) = E_Constant then + Add_Str_To_Name_Buffer ("constant "); + + elsif Ekind (Val_Id) = E_Discriminant then + Add_Str_To_Name_Buffer ("discriminant "); + + elsif Is_Formal (Val_Id) then + Add_Str_To_Name_Buffer ("parameter "); + + elsif Ekind (Val_Id) = E_Variable then + Add_Str_To_Name_Buffer ("variable "); + end if; + + Add_Str_To_Name_Buffer ("& is always True!"); + Error := Name_Find; + + Error_Msg_NE (Get_Name_String (Error), Val, Val_Id); + end if; + + -- The construct is too complex to disect, issue a general message + + else + Error_Msg_N ("?r?expression is always True!", Val); + end if; + end Explain_Redundancy; + ----------------------------- -- Find_Unique_Access_Type -- ----------------------------- @@ -6979,12 +7050,13 @@ package body Sem_Res is if Warn_On_Redundant_Constructs and then Comes_From_Source (N) + and then Comes_From_Source (R) and then Is_Entity_Name (R) and then Entity (R) = Standard_True - and then Comes_From_Source (R) then Error_Msg_N -- CODEFIX - ("?r?comparison with True is redundant!", R); + ("?r?comparison with True is redundant!", N); + Explain_Redundancy (Original_Node (R)); end if; Check_Unset_Reference (L); diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index 56a28ef..db83c94 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -272,18 +272,21 @@ package body Xref_Lib is end if; end if; - File_Ref := - Add_To_Xref_File - (Entity (File_Start .. Line_Start - 1), Visited => True); - Pattern.File_Ref := File_Ref; + declare + File_Name : String := Entity (File_Start .. Line_Start - 1); + begin + Osint.Canonical_Case_File_Name (File_Name); + File_Ref := Add_To_Xref_File (File_Name, Visited => True); + Pattern.File_Ref := File_Ref; - Add_Line (Pattern.File_Ref, Line_Num, Col_Num); + Add_Line (Pattern.File_Ref, Line_Num, Col_Num); - File_Ref := - Add_To_Xref_File - (ALI_File_Name (Entity (File_Start .. Line_Start - 1)), - Visited => False, - Emit_Warning => True); + File_Ref := + Add_To_Xref_File + (ALI_File_Name (File_Name), + Visited => False, + Emit_Warning => True); + end; end Add_Entity; ------------------- -- 2.7.4