diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 24 | ||||
| -rw-r--r-- | gcc/ada/errout.ads | 27 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 5 | ||||
| -rw-r--r-- | gcc/ada/lib-load.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/par-ch12.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/par-ch3.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/par-ch5.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/par-ch6.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/par-ch9.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/par-endh.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/par-load.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/par-tchk.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/par-util.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/prj-dect.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 33 | ||||
| -rw-r--r-- | gcc/ada/sinput-l.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sinput.adb | 218 | ||||
| -rw-r--r-- | gcc/ada/sinput.ads | 8 |
23 files changed, 414 insertions, 78 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0a77a748d08..05c34ab5684 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,29 @@ 2009-05-06 Sergey Rybin <rybin@adacore.com> + * gnat_ugn.texi: For Misnamed_Identifiers rule all description of the + new form of the rule parameter that allows to specify the suffix for + access-to-access type names. + +2009-05-06 Robert Dewar <dewar@adacore.com> + + * sem_warn.adb (Warn_On_Useless_Assignment): Avoid false negative for + out parameter assigned when exception handlers are present. + + * sem_ch5.adb (Analyze_Exit_Statement): Kill current value last + assignments on exit. + + * par-ch9.adb, sem_aggr.adb, par-endh.adb, sem_res.adb, par-ch6.adb, + sinput-l.adb, par-load.adb, errout.ads, sem_ch4.adb, lib-load.adb, + prj-dect.adb, par-ch12.adb, sem_ch8.adb, par-util.adb, par-ch3.adb, + par-tchk.adb, par-ch5.adb: This patch adds stylized comments to error + messages that are included in the codefix circuitry of IDE's such as + GPS. + + * sinput.ads, sinput.adb (Expr_First_Char): New function + (Expr_Last_Char): New function + +2009-05-06 Sergey Rybin <rybin@adacore.com> + * gnat_ugn.texi: Add subsection for Exits_From_Conditional_Loops rule Add formal definition for extra exit point metric diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 41daf243bab..e4d8a62e6dc 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -581,6 +581,33 @@ package Errout is -- Triggering switch. If non-zero, then ignore errors mode is activated. -- This is a counter to allow convenient nesting of enable/disable. + ----------------------- + -- CODEFIX Facility -- + ----------------------- + + -- The GPS and GNATBench IDE's have a codefix facility that allows for + -- automatic correction of a subset of the errors and warnings issued + -- by the compiler. This is done by recognizing the text of specific + -- messages using appropriate matching patterns. + + -- The text of such messages should not be altered without coordinating + -- with the codefix code. All such messages are marked by a specific + -- style of comments, as shown by the following example: + + -- Error_Msg_N -- CODEFIX + -- (parameters ....) + + -- Any message marked with this -- CODEFIX comment should not be modified + -- without appropriate coordination. If new messages are added which may + -- be susceptible to automatic codefix action, they are marked using: + + -- Error_Msg -- CODEFIX??? + -- (parameters) + + -- And subsequently either the appropriate code is added to codefix and the + -- ??? are removed, or it is determined that this is not an appropriate + -- case for codefix action, and the comment is removed. + ------------------------------ -- Error Output Subprograms -- ------------------------------ diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 4a59e16d514..4e5e2141fda 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21556,6 +21556,11 @@ Specifies the suffix for a type name. Specifies the suffix for an access type name. If this parameter is set, it overrides for access types the suffix set by the @code{Type_Suffix} parameter. +For access types, @emph{string} may have the following format: +@emph{suffix1(suffix2)}. That means that an access type name +should have the @emph{suffix1} suffix except for the case when +the designated type is also an access type, in this case the +type name should have the @emph{suffix1 & suffix2} suffix. @item Constant_Suffix=@emph{string} Specifies the suffix for a constant name. diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 1d0c2d4e79d..ee956dc3f77 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -724,7 +724,7 @@ package body Lib.Load is Check_Restricted_Unit (Load_Name, Error_Node); Error_Msg_Unit_1 := Uname_Actual; - Error_Msg + Error_Msg -- CODEFIX ("$$ is not a predefined library unit", Load_Msg_Sloc); else diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 951d3087540..046ac43e775 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -100,7 +100,8 @@ package body Ch12 is Scan; -- past GENERIC if Token = Tok_Private then - Error_Msg_SC ("PRIVATE goes before GENERIC, not after"); + Error_Msg_SC -- CODEFIX + ("PRIVATE goes before GENERIC, not after"); Scan; -- past junk PRIVATE token end if; @@ -179,7 +180,7 @@ package body Ch12 is Append (P_Formal_Subprogram_Declaration, Decls); else - Error_Msg_BC + Error_Msg_BC -- CODEFIX ("FUNCTION, PROCEDURE or PACKAGE expected here"); Resync_Past_Semicolon; end if; @@ -657,7 +658,8 @@ package body Ch12 is else if Token = Tok_Abstract then - Error_Msg_SC ("ABSTRACT must come before LIMITED"); + Error_Msg_SC -- CODEFIX + ("ABSTRACT must come before LIMITED"); Scan; -- past improper ABSTRACT if Token = Tok_New then @@ -805,15 +807,18 @@ package body Ch12 is if Token = Tok_Abstract then if Prev_Token = Tok_Tagged then - Error_Msg_SC ("ABSTRACT must come before TAGGED"); + Error_Msg_SC -- CODEFIX + ("ABSTRACT must come before TAGGED"); elsif Prev_Token = Tok_Limited then - Error_Msg_SC ("ABSTRACT must come before LIMITED"); + Error_Msg_SC -- CODEFIX + ("ABSTRACT must come before LIMITED"); end if; Resync_Past_Semicolon; elsif Token = Tok_Tagged then - Error_Msg_SC ("TAGGED must come before LIMITED"); + Error_Msg_SC -- CODEFIX + ("TAGGED must come before LIMITED"); Resync_Past_Semicolon; end if; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index b90e0840652..973f64360df 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -541,7 +541,8 @@ package body Ch3 is end if; if Token = Tok_Abstract then - Error_Msg_SC ("ABSTRACT must come before TAGGED"); + Error_Msg_SC -- CODEFIX + ("ABSTRACT must come before TAGGED"); Abstract_Present := True; Abstract_Loc := Token_Ptr; Scan; -- past ABSTRACT @@ -606,11 +607,13 @@ package body Ch3 is loop if Token = Tok_Tagged then - Error_Msg_SC ("TAGGED must come before LIMITED"); + Error_Msg_SC -- CODEFIX + ("TAGGED must come before LIMITED"); Scan; -- past TAGGED elsif Token = Tok_Abstract then - Error_Msg_SC ("ABSTRACT must come before LIMITED"); + Error_Msg_SC -- CODEFIX + ("ABSTRACT must come before LIMITED"); Scan; -- past ABSTRACT else @@ -1526,7 +1529,8 @@ package body Ch3 is end if; if Token = Tok_Aliased then - Error_Msg_SC ("ALIASED should be before CONSTANT"); + Error_Msg_SC -- CODEFIX + ("ALIASED should be before CONSTANT"); Scan; -- past ALIASED Set_Aliased_Present (Decl_Node, True); end if; @@ -1888,7 +1892,8 @@ package body Ch3 is end if; if Token = Tok_Abstract then - Error_Msg_SC ("ABSTRACT must come before NEW, not after"); + Error_Msg_SC -- CODEFIX + ("ABSTRACT must come before NEW, not after"); Scan; end if; @@ -2306,7 +2311,8 @@ package body Ch3 is -- Handle decimal fixed-point defn with DIGITS/DELTA in wrong order if Token = Tok_Delta then - Error_Msg_SC ("|DELTA must come before DIGITS"); + Error_Msg_SC -- CODEFIX + ("|DELTA must come before DIGITS"); Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Digits_Loc); Scan; -- past DELTA Set_Delta_Expression (Def_Node, P_Expression_No_Right_Paren); @@ -3791,7 +3797,8 @@ package body Ch3 is Scan; -- past PROTECTED if Token /= Tok_Procedure and then Token /= Tok_Function then - Error_Msg_SC ("FUNCTION or PROCEDURE expected"); + Error_Msg_SC -- CODEFIX + ("FUNCTION or PROCEDURE expected"); end if; end if; diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index e0a7e0af6f8..f782f51e024 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -178,7 +178,8 @@ package body Ch5 is procedure Junk_Declaration is begin if (not Declaration_Found) or All_Errors_Mode then - Error_Msg_SC ("declarations must come before BEGIN"); + Error_Msg_SC -- CODEFIX + ("declarations must come before BEGIN"); Declaration_Found := True; end if; @@ -450,7 +451,8 @@ package body Ch5 is and then Block_Label = Name_Go and then Token_Name = Name_To then - Error_Msg_SP ("goto is one word"); + Error_Msg_SP -- CODEFIX + ("goto is one word"); Append_To (Statement_List, P_Goto_Statement); Statement_Required := False; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index d91b2d9f15d..0cf71a79e15 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -227,7 +227,8 @@ package body Ch6 is Error_Msg_SC ("overriding indicator not allowed here!"); elsif Token /= Tok_Function and then Token /= Tok_Procedure then - Error_Msg_SC ("FUNCTION or PROCEDURE expected!"); + Error_Msg_SC -- CODEFIX + ("FUNCTION or PROCEDURE expected!"); end if; end if; @@ -1430,7 +1431,8 @@ package body Ch6 is Set_Constant_Present (Decl_Node); if Token = Tok_Aliased then - Error_Msg_SC ("ALIASED should be before CONSTANT"); + Error_Msg_SC -- CODEFIX + ("ALIASED should be before CONSTANT"); Scan; -- past ALIASED Set_Aliased_Present (Decl_Node); end if; diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb index d5c3549f23d..1271d478a73 100644 --- a/gcc/ada/par-ch9.adb +++ b/gcc/ada/par-ch9.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -651,7 +651,8 @@ package body Ch9 is Set_Must_Not_Override (Specification (Decl), Not_Overriding); else - Error_Msg_SC ("ENTRY, FUNCTION or PROCEDURE expected!"); + Error_Msg_SC -- CODEFIX + ("ENTRY, FUNCTION or PROCEDURE expected!"); end if; end if; diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index e04b154e506..94e753976aa 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -717,7 +717,8 @@ package body Endh is if Error_Msg_Name_1 > Error_Name then if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then Error_Msg_Name_1 := Chars (Nam); - Error_Msg_N ("misspelling of %", End_Labl); + Error_Msg_N -- CODEFIX + ("misspelling of %", End_Labl); Syntax_OK := True; return; end if; @@ -839,29 +840,32 @@ package body Endh is end if; if End_Type = E_Case then - Error_Msg_SC ("`END CASE;` expected@ for CASE#!"); + Error_Msg_SC -- CODEFIX + ("`END CASE;` expected@ for CASE#!"); elsif End_Type = E_If then - Error_Msg_SC ("`END IF;` expected@ for IF#!"); + Error_Msg_SC -- CODEFIX + ("`END IF;` expected@ for IF#!"); elsif End_Type = E_Loop then if Error_Msg_Node_1 = Empty then - Error_Msg_SC + Error_Msg_SC -- CODEFIX ("`END LOOP;` expected@ for LOOP#!"); else - Error_Msg_SC ("`END LOOP &;` expected@!"); + Error_Msg_SC -- CODEFIX + ("`END LOOP &;` expected@!"); end if; elsif End_Type = E_Record then - Error_Msg_SC + Error_Msg_SC -- CODEFIX ("`END RECORD;` expected@ for RECORD#!"); elsif End_Type = E_Return then - Error_Msg_SC + Error_Msg_SC -- CODEFIX ("`END RETURN;` expected@ for RETURN#!"); elsif End_Type = E_Select then - Error_Msg_SC + Error_Msg_SC -- CODEFIX ("`END SELECT;` expected@ for SELECT#!"); -- All remaining cases are cases with a name (we do not treat @@ -870,9 +874,11 @@ package body Endh is elsif End_Type = E_Name or else (not Ins) then if Error_Msg_Node_1 = Empty then - Error_Msg_SC ("`END;` expected@ for BEGIN#!"); + Error_Msg_SC -- CODEFIX + ("`END;` expected@ for BEGIN#!"); else - Error_Msg_SC ("`END &;` expected@!"); + Error_Msg_SC -- CODEFIX + ("`END &;` expected@!"); end if; -- The other possibility is a missing END for a subprogram with a diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index 544998b623e..e21fb0434c6 100644 --- a/gcc/ada/par-load.adb +++ b/gcc/ada/par-load.adb @@ -205,7 +205,8 @@ begin begin Error_Msg_Unit_1 := Expect_Name; - Error_Msg ("$$ is not a predefined library unit!", Loc); + Error_Msg -- CODEFIX + ("$$ is not a predefined library unit!", Loc); -- In the predefined file case, we know the user did not -- construct their own package, but we got the wrong one. @@ -229,7 +230,8 @@ begin (Name_Id (Expect_Name), Name_Id (Actual_Name)) then Error_Msg_Unit_1 := Actual_Name; - Error_Msg ("possible misspelling of $$!", Loc); + Error_Msg -- CODEFIX + ("possible misspelling of $$!", Loc); end if; end; diff --git a/gcc/ada/par-tchk.adb b/gcc/ada/par-tchk.adb index a4c3b2d4999..9329b41cd14 100644 --- a/gcc/ada/par-tchk.adb +++ b/gcc/ada/par-tchk.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -443,7 +443,8 @@ package body Tchk is -- the possibility of a "C" confusion. elsif Token = Tok_Vertical_Bar then - Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?"); + Error_Msg_SC -- CODEFIX + ("unexpected occurrence of ""'|"", did you mean OR'?"); Resync_Past_Semicolon; return; diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index bf5680e2515..82ffdd00f1c 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -86,7 +86,8 @@ package body Util is M2 (P2 + J - 1) := Fold_Upper (S (J)); end loop; - Error_Msg_SC (M2 (1 .. P2 - 1 + S'Last)); + Error_Msg_SC -- CODEFIX??? + (M2 (1 .. P2 - 1 + S'Last)); Token := T; return True; end if; @@ -119,7 +120,8 @@ package body Util is M1 (P1 + J - 1) := Fold_Upper (S (J)); end loop; - Error_Msg_SC (M1 (1 .. P1 - 1 + S'Last)); + Error_Msg_SC -- CODFIX + (M1 (1 .. P1 - 1 + S'Last)); Token := T; return True; @@ -678,7 +680,8 @@ package body Util is Error_Msg_Name_1 := First_Attribute_Name; while Error_Msg_Name_1 <= Last_Attribute_Name loop if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then - Error_Msg_N ("\possible misspelling of %", Token_Node); + Error_Msg_N -- CODEFIX + ("\possible misspelling of %", Token_Node); exit; end if; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 49bd50e0e4c..001b2596d48 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2009, 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- -- @@ -1052,9 +1052,9 @@ package body Prj.Dect is end if; if Index /= 0 then - Error_Msg ("\?possible misspelling of """ & - List (Index).all & """", - Token_Ptr); + Error_Msg -- CODEFIX + ("\?possible misspelling of """ & + List (Index).all & """", Token_Ptr); end if; end; end if; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 2a855b2c9e5..66653f643e9 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -756,12 +756,12 @@ package body Sem_Aggr is -- Report at most two suggestions if Nr_Of_Suggestions = 1 then - Error_Msg_NE + Error_Msg_NE -- CODEFIX ("\possible misspelling of&", Component, Suggestion_1); elsif Nr_Of_Suggestions = 2 then Error_Msg_Node_2 := Suggestion_2; - Error_Msg_NE + Error_Msg_NE -- CODEFIX ("\possible misspelling of& or&", Component, Suggestion_1); end if; end Check_Misspelled_Component; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 5ea961b1ae1..b8e8b42d211 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -446,7 +446,7 @@ package body Sem_Ch4 is if Nkind (Constraint (E)) = N_Index_Or_Discriminant_Constraint then - Error_Msg_N + Error_Msg_N -- CODEFIX ("\if qualified expression was meant, " & "use apostrophe", Constraint (E)); end if; @@ -483,7 +483,7 @@ package body Sem_Ch4 is and then Nkind (Constraint (E)) = N_Index_Or_Discriminant_Constraint then - Error_Msg_N + Error_Msg_N -- CODEFIX ("if qualified expression was meant, " & "use apostrophe!", Constraint (E)); end if; @@ -2466,7 +2466,7 @@ package body Sem_Ch4 is Formal := First_Formal (Nam); while Present (Formal) loop if Chars (Left_Opnd (Actual)) = Chars (Formal) then - Error_Msg_N + Error_Msg_N -- CODEFIX ("possible misspelling of `='>`!", Actual); exit; end if; @@ -4245,12 +4245,12 @@ package body Sem_Ch4 is -- Report at most two suggestions if Nr_Of_Suggestions = 1 then - Error_Msg_NE + Error_Msg_NE -- CODEFIX ("\possible misspelling of&", Sel, Suggestion_1); elsif Nr_Of_Suggestions = 2 then Error_Msg_Node_2 := Suggestion_2; - Error_Msg_NE + Error_Msg_NE -- CODEFIX ("\possible misspelling of& or&", Sel, Suggestion_1); end if; end Check_Misspelled_Selector; @@ -4359,8 +4359,8 @@ package body Sem_Ch4 is if Nkind (Parent (N)) = N_Selected_Component and then N = Prefix (Parent (N)) then - Error_Msg_N ( - "\period should probably be semicolon", Parent (N)); + Error_Msg_N -- CODEFIX + ("\period should probably be semicolon", Parent (N)); end if; elsif Nkind (N) = N_Procedure_Call_Statement @@ -5238,7 +5238,8 @@ package body Sem_Ch4 is and then Valid_Boolean_Arg (Etype (R)) then Error_Msg_N ("invalid operands for concatenation", N); - Error_Msg_N ("\maybe AND was meant", N); + Error_Msg_N -- CODEFIX + ("\maybe AND was meant", N); return; -- A special case for comparison of access parameter with null @@ -6073,7 +6074,8 @@ package body Sem_Ch4 is if Nkind (Parent (Op)) = N_Full_Type_Declaration then Error_Msg_N ("\possible interpretation (inherited)#", N); else - Error_Msg_N ("\possible interpretation#", N); + Error_Msg_N -- CODEFIX + ("\possible interpretation#", N); end if; end if; end Report_Ambiguity; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 37975bc73a7..4c047b49c53 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1208,6 +1208,13 @@ package body Sem_Ch5 is Analyze_And_Resolve (Cond, Any_Boolean); Check_Unset_Reference (Cond); end if; + + -- Since the exit may take us out of a loop, any previous assignment + -- statement is not useless, so clear last assignment indications. It + -- is OK to keep other current values, since if the exit statement + -- does not exit, then the current values are still valid. + + Kill_Current_Values (Last_Assignment_Only => True); end Analyze_Exit_Statement; ---------------------------- diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 713f2e35aaa..d8cfb4b00c3 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3747,7 +3747,8 @@ package body Sem_Ch8 is end if; Error_Msg_Sloc := Sloc (Ent); - Error_Msg_N ("hidden declaration#!", N); + Error_Msg_N -- CODEFIX + ("hidden declaration#!", N); end if; Ent := Homonym (Ent); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c6f79de4915..7914e4a06e3 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2007,7 +2007,8 @@ package body Sem_Res is Error_Msg_N ("\\possible interpretation (inherited)#!", N); else - Error_Msg_N ("\\possible interpretation#!", N); + Error_Msg_N -- CODEFIX + ("\\possible interpretation#!", N); end if; end if; @@ -2089,7 +2090,8 @@ package body Sem_Res is Error_Msg_N ("\\possible interpretation (inherited)#!", N); else - Error_Msg_N ("\\possible interpretation#!", N); + Error_Msg_N -- CODEFIX + ("\\possible interpretation#!", N); end if; end if; @@ -6936,7 +6938,8 @@ package body Sem_Res is or else Base_Type (It.Typ) = Base_Type (Component_Type (Typ)) then - Error_Msg_N ("\\possible interpretation#", Arg); + Error_Msg_N -- CODEFIX + ("\\possible interpretation#", Arg); end if; Get_Next_Interp (I, It); @@ -9314,10 +9317,12 @@ package body Sem_Res is Error_Msg_N ("ambiguous operand in conversion", Operand); Error_Msg_Sloc := Sloc (It.Nam); - Error_Msg_N ("\\possible interpretation#!", Operand); + Error_Msg_N -- CODEFIX + ("\\possible interpretation#!", Operand); Error_Msg_Sloc := Sloc (N1); - Error_Msg_N ("\\possible interpretation#!", Operand); + Error_Msg_N -- CODEFIX + ("\\possible interpretation#!", Operand); return False; end if; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index eca31f0356c..515e727bdb8 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3903,8 +3903,8 @@ package body Sem_Warn is X : Node_Id; function Check_Ref (N : Node_Id) return Traverse_Result; - -- Used to instantiate Traverse_Func. Returns Abandon if - -- a reference to the entity in question is found. + -- Used to instantiate Traverse_Func. Returns Abandon if a reference to + -- the entity in question is found. function Test_No_Refs is new Traverse_Func (Check_Ref); @@ -3935,7 +3935,7 @@ package body Sem_Warn is -- variable with the last assignment field set, with warnings enabled, -- and which is not imported or exported. We also check that it is OK -- to capture the value. We are not going to capture any value, but - -- the warning messages depends on the same kind of conditions. + -- the warning message depends on the same kind of conditions. if Is_Assignable (Ent) and then not Is_Return_Object (Ent) @@ -4027,18 +4027,27 @@ package body Sem_Warn is -- Otherwise we are at the outer level. An exception -- handler is significant only if it references the - -- variable in question. + -- variable in question, or if the entity in question + -- is an OUT or IN OUT parameter, which which case + -- the caller can reference it after the exception + -- hanlder completes else - X := First (Exception_Handlers (P)); - while Present (X) loop - if Test_No_Refs (X) = Abandon then - Set_Last_Assignment (Ent, Empty); - return; - end if; + if Is_Formal (Ent) then + Set_Last_Assignment (Ent, Empty); + return; - X := Next (X); - end loop; + else + X := First (Exception_Handlers (P)); + while Present (X) loop + if Test_No_Refs (X) = Abandon then + Set_Last_Assignment (Ent, Empty); + return; + end if; + + X := Next (X); + end loop; + end if; end if; end if; end if; diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 32f8bdedd6b..fe38b751dd2 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -453,7 +453,8 @@ package body Sinput.L is -- Preprocess the source if it needs to be preprocessed if Preprocessing_Needed then - -- Set temporarily the Source_File_Index_Table entries for the + + -- Temporarily set the Source_File_Index_Table entries for the -- source, to avoid crash when reporting an error. Set_Source_File_Index_Table (X); diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index d780804b70f..949fcc3afa2 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -32,10 +32,12 @@ pragma Style_Checks (All_Checks); -- Subprograms not all in alpha order +with Atree; use Atree; with Debug; use Debug; with Opt; use Opt; with Output; use Output; with Tree_IO; use Tree_IO; +with Sinfo; use Sinfo; with System; use System; with Widechar; use Widechar; @@ -238,6 +240,222 @@ package body Sinput is return; end Build_Location_String; + --------------------- + -- Expr_First_Char -- + --------------------- + + function Expr_First_Char (Expr : Node_Id) return Source_Ptr is + + function First_Char (Expr : Node_Id; PC : Nat) return Source_Ptr; + -- Internal recursive function used to traverse the expression tree. + -- Returns the source pointer corresponding to the first location of + -- the subexpression N, followed by backing up the given (PC) number of + -- preceding left parentheses. + + ---------------- + -- First_Char -- + ---------------- + + function First_Char (Expr : Node_Id; PC : Nat) return Source_Ptr is + N : constant Node_Id := Original_Node (Expr); + Count : constant Nat := PC + Paren_Count (N); + Kind : constant N_Subexpr := Nkind (N); + Loc : Source_Ptr; + + begin + case Kind is + when N_And_Then | + N_In | + N_Not_In | + N_Or_Else | + N_Binary_Op => + return First_Char (Left_Opnd (N), Count); + + when N_Attribute_Reference | + N_Expanded_Name | + N_Explicit_Dereference | + N_Indexed_Component | + N_Reference | + N_Selected_Component | + N_Slice => + return First_Char (Prefix (N), Count); + + when N_Function_Call => + return First_Char (Sinfo.Name (N), Count); + + when N_Qualified_Expression | + N_Type_Conversion => + return First_Char (Subtype_Mark (N), Count); + + when N_Range => + return First_Char (Low_Bound (N), Count); + + -- Nodes that should not appear in original expression trees + + when N_Procedure_Call_Statement | + N_Raise_xxx_Error | + N_Subprogram_Info | + N_Unchecked_Expression | + N_Unchecked_Type_Conversion | + N_Conditional_Expression => + raise Program_Error; + + -- Cases where the Sloc points to the start of the tokem, but we + -- still need to handle the sequence of left parentheses. + + when N_Identifier | + N_Operator_Symbol | + N_Character_Literal | + N_Integer_Literal | + N_Null | + N_Unary_Op | + N_Aggregate | + N_Allocator | + N_Extension_Aggregate | + N_Real_Literal | + N_String_Literal => + + Loc := Sloc (N); + + if Count > 0 then + declare + SFI : constant Source_File_Index := + Get_Source_File_Index (Loc); + Src : constant Source_Buffer_Ptr := Source_Text (SFI); + Fst : constant Source_Ptr := Source_First (SFI); + + begin + for J in 1 .. Count loop + loop + exit when Loc = Fst; + Loc := Loc - 1; + exit when Src (Loc) >= ' '; + end loop; + + exit when Src (Loc) /= '('; + end loop; + end; + end if; + + return Loc; + end case; + end First_Char; + + -- Start of processing for Expr_First_Char + + begin + pragma Assert (Nkind (Expr) in N_Subexpr); + return First_Char (Expr, 0); + end Expr_First_Char; + + -------------------- + -- Expr_Last_Char -- + -------------------- + + function Expr_Last_Char (Expr : Node_Id) return Source_Ptr is + + function Last_Char (Expr : Node_Id; PC : Nat) return Source_Ptr; + -- Internal recursive function used to traverse the expression tree. + -- Returns the source pointer corresponding to the last location of + -- the subexpression N, followed by ztepping to the last of the given + -- number of right parentheses. + + --------------- + -- Last_Char -- + --------------- + + function Last_Char (Expr : Node_Id; PC : Nat) return Source_Ptr is + N : constant Node_Id := Original_Node (Expr); + Count : constant Nat := PC + Paren_Count (N); + Kind : constant N_Subexpr := Nkind (N); + Loc : Source_Ptr; + + begin + case Kind is + when N_And_Then | + N_In | + N_Not_In | + N_Or_Else | + N_Binary_Op => + return Last_Char (Right_Opnd (N), Count); + + when N_Attribute_Reference | + N_Expanded_Name | + N_Explicit_Dereference | + N_Indexed_Component | + N_Reference | + N_Selected_Component | + N_Slice => + return Last_Char (Prefix (N), Count); + + when N_Function_Call => + return Last_Char (Sinfo.Name (N), Count); + + when N_Qualified_Expression | + N_Type_Conversion => + return Last_Char (Subtype_Mark (N), Count); + + when N_Range => + return Last_Char (Low_Bound (N), Count); + + -- Nodes that should not appear in original expression trees + + when N_Procedure_Call_Statement | + N_Raise_xxx_Error | + N_Subprogram_Info | + N_Unchecked_Expression | + N_Unchecked_Type_Conversion | + N_Conditional_Expression => + raise Program_Error; + + -- Cases where the Sloc points to the start of the tokem, but we + -- still need to handle the sequence of left parentheses. + + when N_Identifier | + N_Operator_Symbol | + N_Character_Literal | + N_Integer_Literal | + N_Null | + N_Unary_Op | + N_Aggregate | + N_Allocator | + N_Extension_Aggregate | + N_Real_Literal | + N_String_Literal => + + Loc := Sloc (N); + + if Count > 0 then + declare + SFI : constant Source_File_Index := + Get_Source_File_Index (Loc); + Src : constant Source_Buffer_Ptr := Source_Text (SFI); + Fst : constant Source_Ptr := Source_Last (SFI); + + begin + for J in 1 .. Count loop + loop + exit when Loc = Fst; + Loc := Loc - 1; + exit when Src (Loc) >= ' '; + end loop; + + exit when Src (Loc) /= '('; + end loop; + end; + end if; + + return Loc; + end case; + end Last_Char; + + -- Start of processing for Expr_Last_Char + + begin + pragma Assert (Nkind (Expr) in N_Subexpr); + return Last_Char (Expr, 0); + end Expr_Last_Char; + ----------------------- -- Get_Column_Number -- ----------------------- diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index ca97716145e..c679e24d84b 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -471,6 +471,14 @@ package Sinput is -- ASCII.NUL, with Name_Length indicating the length not including the -- terminating Nul. + function Expr_First_Char (Expr : Node_Id) return Source_Ptr; + -- Given a node for a subexpression, returns the source location of the + -- first character of the expression. + + function Expr_Last_Char (Expr : Node_Id) return Source_Ptr; + -- Given a node for a subexpression, returns the source location of the + -- last character of the expression. + function Get_Column_Number (P : Source_Ptr) return Column_Number; -- The ones-origin column number of the specified Source_Ptr value is -- determined and returned. Tab characters if present are assumed to |