Skip to content

R
riscv-gcc-1
Commit 4e7a4f6e by Arnaud Charlet
Options

[multiple changes] 

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

From-SVN: r147172
parent 35117aa8
Showing with 406 additions and 70 deletions
gcc/ada/ChangeLog
2009-05-06 Sergey Rybin <rybin@adacore.com> 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 * gnat_ugn.texi: Add subsection for Exits_From_Conditional_Loops rule
Add formal definition for extra exit point metric Add formal definition for extra exit point metric
......
gcc/ada/errout.ads
...@@ -581,6 +581,33 @@ package Errout is ...@@ -581,6 +581,33 @@ package Errout is
-- Triggering switch. If non-zero, then ignore errors mode is activated. -- Triggering switch. If non-zero, then ignore errors mode is activated.
-- This is a counter to allow convenient nesting of enable/disable. -- 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 -- -- Error Output Subprograms --
------------------------------ ------------------------------
......
gcc/ada/gnat_ugn.texi
...@@ -21556,6 +21556,11 @@ Specifies the suffix for a type name. ...@@ -21556,6 +21556,11 @@ Specifies the suffix for a type name.
Specifies the suffix for an access type name. If Specifies the suffix for an access type name. If
this parameter is set, it overrides for access this parameter is set, it overrides for access
types the suffix set by the @code{Type_Suffix} parameter. 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} @item Constant_Suffix=@emph{string}
Specifies the suffix for a constant name. Specifies the suffix for a constant name.
gcc/ada/lib-load.adb
...@@ -724,7 +724,7 @@ package body Lib.Load is ...@@ -724,7 +724,7 @@ package body Lib.Load is
Check_Restricted_Unit (Load_Name, Error_Node); Check_Restricted_Unit (Load_Name, Error_Node);
Error_Msg_Unit_1 := Uname_Actual; Error_Msg_Unit_1 := Uname_Actual;
Error_Msg Error_Msg -- CODEFIX
("$$ is not a predefined library unit", Load_Msg_Sloc); ("$$ is not a predefined library unit", Load_Msg_Sloc);
else else
......
gcc/ada/par-ch12.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -100,7 +100,8 @@ package body Ch12 is ...@@ -100,7 +100,8 @@ package body Ch12 is
Scan; -- past GENERIC Scan; -- past GENERIC
if Token = Tok_Private then 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 Scan; -- past junk PRIVATE token
end if; end if;
...@@ -179,7 +180,7 @@ package body Ch12 is ...@@ -179,7 +180,7 @@ package body Ch12 is
Append (P_Formal_Subprogram_Declaration, Decls); Append (P_Formal_Subprogram_Declaration, Decls);
else else
Error_Msg_BC Error_Msg_BC -- CODEFIX
("FUNCTION, PROCEDURE or PACKAGE expected here"); ("FUNCTION, PROCEDURE or PACKAGE expected here");
Resync_Past_Semicolon; Resync_Past_Semicolon;
end if; end if;
...@@ -657,7 +658,8 @@ package body Ch12 is ...@@ -657,7 +658,8 @@ package body Ch12 is
else else
if Token = Tok_Abstract then 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 Scan; -- past improper ABSTRACT
if Token = Tok_New then if Token = Tok_New then
...@@ -805,15 +807,18 @@ package body Ch12 is ...@@ -805,15 +807,18 @@ package body Ch12 is
if Token = Tok_Abstract then if Token = Tok_Abstract then
if Prev_Token = Tok_Tagged 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 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; end if;
Resync_Past_Semicolon; Resync_Past_Semicolon;
elsif Token = Tok_Tagged then 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; Resync_Past_Semicolon;
end if; end if;
......
gcc/ada/par-ch3.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -541,7 +541,8 @@ package body Ch3 is ...@@ -541,7 +541,8 @@ package body Ch3 is
end if; end if;
if Token = Tok_Abstract then 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_Present := True;
Abstract_Loc := Token_Ptr; Abstract_Loc := Token_Ptr;
Scan; -- past ABSTRACT Scan; -- past ABSTRACT
...@@ -606,11 +607,13 @@ package body Ch3 is ...@@ -606,11 +607,13 @@ package body Ch3 is
loop loop
if Token = Tok_Tagged then 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 Scan; -- past TAGGED
elsif Token = Tok_Abstract then 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 Scan; -- past ABSTRACT
else else
...@@ -1526,7 +1529,8 @@ package body Ch3 is ...@@ -1526,7 +1529,8 @@ package body Ch3 is
end if; end if;
if Token = Tok_Aliased then 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 Scan; -- past ALIASED
Set_Aliased_Present (Decl_Node, True); Set_Aliased_Present (Decl_Node, True);
end if; end if;
...@@ -1888,7 +1892,8 @@ package body Ch3 is ...@@ -1888,7 +1892,8 @@ package body Ch3 is
end if; end if;
if Token = Tok_Abstract then 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; Scan;
end if; end if;
...@@ -2306,7 +2311,8 @@ package body Ch3 is ...@@ -2306,7 +2311,8 @@ package body Ch3 is
-- Handle decimal fixed-point defn with DIGITS/DELTA in wrong order -- Handle decimal fixed-point defn with DIGITS/DELTA in wrong order
if Token = Tok_Delta then 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); Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Digits_Loc);
Scan; -- past DELTA Scan; -- past DELTA
Set_Delta_Expression (Def_Node, P_Expression_No_Right_Paren); Set_Delta_Expression (Def_Node, P_Expression_No_Right_Paren);
...@@ -3791,7 +3797,8 @@ package body Ch3 is ...@@ -3791,7 +3797,8 @@ package body Ch3 is
Scan; -- past PROTECTED Scan; -- past PROTECTED
if Token /= Tok_Procedure and then Token /= Tok_Function then 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;
end if; end if;
......
gcc/ada/par-ch5.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -178,7 +178,8 @@ package body Ch5 is ...@@ -178,7 +178,8 @@ package body Ch5 is
procedure Junk_Declaration is procedure Junk_Declaration is
begin begin
if (not Declaration_Found) or All_Errors_Mode then 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; Declaration_Found := True;
end if; end if;
...@@ -450,7 +451,8 @@ package body Ch5 is ...@@ -450,7 +451,8 @@ package body Ch5 is
and then Block_Label = Name_Go and then Block_Label = Name_Go
and then Token_Name = Name_To and then Token_Name = Name_To
then then
Error_Msg_SP ("goto is one word"); Error_Msg_SP -- CODEFIX
("goto is one word");
Append_To (Statement_List, P_Goto_Statement); Append_To (Statement_List, P_Goto_Statement);
Statement_Required := False; Statement_Required := False;
......
gcc/ada/par-ch6.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -227,7 +227,8 @@ package body Ch6 is ...@@ -227,7 +227,8 @@ package body Ch6 is
Error_Msg_SC ("overriding indicator not allowed here!"); Error_Msg_SC ("overriding indicator not allowed here!");
elsif Token /= Tok_Function and then Token /= Tok_Procedure then 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;
end if; end if;
...@@ -1430,7 +1431,8 @@ package body Ch6 is ...@@ -1430,7 +1431,8 @@ package body Ch6 is
Set_Constant_Present (Decl_Node); Set_Constant_Present (Decl_Node);
if Token = Tok_Aliased then 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 Scan; -- past ALIASED
Set_Aliased_Present (Decl_Node); Set_Aliased_Present (Decl_Node);
end if; end if;
......
gcc/ada/par-ch9.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -651,7 +651,8 @@ package body Ch9 is ...@@ -651,7 +651,8 @@ package body Ch9 is
Set_Must_Not_Override (Specification (Decl), Not_Overriding); Set_Must_Not_Override (Specification (Decl), Not_Overriding);
else else
Error_Msg_SC ("ENTRY, FUNCTION or PROCEDURE expected!"); Error_Msg_SC -- CODEFIX
("ENTRY, FUNCTION or PROCEDURE expected!");
end if; end if;
end if; end if;
......
gcc/ada/par-endh.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -717,7 +717,8 @@ package body Endh is ...@@ -717,7 +717,8 @@ package body Endh is
if Error_Msg_Name_1 > Error_Name then if Error_Msg_Name_1 > Error_Name then
if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then
Error_Msg_Name_1 := Chars (Nam); Error_Msg_Name_1 := Chars (Nam);
Error_Msg_N ("misspelling of %", End_Labl); Error_Msg_N -- CODEFIX
("misspelling of %", End_Labl);
Syntax_OK := True; Syntax_OK := True;
return; return;
end if; end if;
...@@ -839,29 +840,32 @@ package body Endh is ...@@ -839,29 +840,32 @@ package body Endh is
end if; end if;
if End_Type = E_Case then 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 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 elsif End_Type = E_Loop then
if Error_Msg_Node_1 = Empty then if Error_Msg_Node_1 = Empty then
Error_Msg_SC Error_Msg_SC -- CODEFIX
("`END LOOP;` expected@ for LOOP#!"); ("`END LOOP;` expected@ for LOOP#!");
else else
Error_Msg_SC ("`END LOOP &;` expected@!"); Error_Msg_SC -- CODEFIX
("`END LOOP &;` expected@!");
end if; end if;
elsif End_Type = E_Record then elsif End_Type = E_Record then
Error_Msg_SC Error_Msg_SC -- CODEFIX
("`END RECORD;` expected@ for RECORD#!"); ("`END RECORD;` expected@ for RECORD#!");
elsif End_Type = E_Return then elsif End_Type = E_Return then
Error_Msg_SC Error_Msg_SC -- CODEFIX
("`END RETURN;` expected@ for RETURN#!"); ("`END RETURN;` expected@ for RETURN#!");
elsif End_Type = E_Select then elsif End_Type = E_Select then
Error_Msg_SC Error_Msg_SC -- CODEFIX
("`END SELECT;` expected@ for SELECT#!"); ("`END SELECT;` expected@ for SELECT#!");
-- All remaining cases are cases with a name (we do not treat -- All remaining cases are cases with a name (we do not treat
...@@ -870,9 +874,11 @@ package body Endh is ...@@ -870,9 +874,11 @@ package body Endh is
elsif End_Type = E_Name or else (not Ins) then elsif End_Type = E_Name or else (not Ins) then
if Error_Msg_Node_1 = Empty then if Error_Msg_Node_1 = Empty then
Error_Msg_SC ("`END;` expected@ for BEGIN#!"); Error_Msg_SC -- CODEFIX
("`END;` expected@ for BEGIN#!");
else else
Error_Msg_SC ("`END &;` expected@!"); Error_Msg_SC -- CODEFIX
("`END &;` expected@!");
end if; end if;
-- The other possibility is a missing END for a subprogram with a -- The other possibility is a missing END for a subprogram with a
......
gcc/ada/par-load.adb
...@@ -205,7 +205,8 @@ begin ...@@ -205,7 +205,8 @@ begin
begin begin
Error_Msg_Unit_1 := Expect_Name; 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 -- In the predefined file case, we know the user did not
-- construct their own package, but we got the wrong one. -- construct their own package, but we got the wrong one.
...@@ -229,7 +230,8 @@ begin ...@@ -229,7 +230,8 @@ begin
(Name_Id (Expect_Name), Name_Id (Actual_Name)) (Name_Id (Expect_Name), Name_Id (Actual_Name))
then then
Error_Msg_Unit_1 := Actual_Name; Error_Msg_Unit_1 := Actual_Name;
Error_Msg ("possible misspelling of $$!", Loc); Error_Msg -- CODEFIX
("possible misspelling of $$!", Loc);
end if; end if;
end; end;
......
gcc/ada/par-tchk.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -443,7 +443,8 @@ package body Tchk is ...@@ -443,7 +443,8 @@ package body Tchk is
-- the possibility of a "C" confusion. -- the possibility of a "C" confusion.
elsif Token = Tok_Vertical_Bar then 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; Resync_Past_Semicolon;
return; return;
......
gcc/ada/par-util.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -86,7 +86,8 @@ package body Util is ...@@ -86,7 +86,8 @@ package body Util is
M2 (P2 + J - 1) := Fold_Upper (S (J)); M2 (P2 + J - 1) := Fold_Upper (S (J));
end loop; end loop;
Error_Msg_SC (M2 (1 .. P2 - 1 + S'Last)); Error_Msg_SC -- CODEFIX???
(M2 (1 .. P2 - 1 + S'Last));
Token := T; Token := T;
return True; return True;
end if; end if;
...@@ -119,7 +120,8 @@ package body Util is ...@@ -119,7 +120,8 @@ package body Util is
M1 (P1 + J - 1) := Fold_Upper (S (J)); M1 (P1 + J - 1) := Fold_Upper (S (J));
end loop; end loop;
Error_Msg_SC (M1 (1 .. P1 - 1 + S'Last)); Error_Msg_SC -- CODFIX
(M1 (1 .. P1 - 1 + S'Last));
Token := T; Token := T;
return True; return True;
...@@ -678,7 +680,8 @@ package body Util is ...@@ -678,7 +680,8 @@ package body Util is
Error_Msg_Name_1 := First_Attribute_Name; Error_Msg_Name_1 := First_Attribute_Name;
while Error_Msg_Name_1 <= Last_Attribute_Name loop while Error_Msg_Name_1 <= Last_Attribute_Name loop
if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then 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; exit;
end if; end if;
......
gcc/ada/prj-dect.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1052,9 +1052,9 @@ package body Prj.Dect is ...@@ -1052,9 +1052,9 @@ package body Prj.Dect is
end if; end if;
if Index /= 0 then if Index /= 0 then
Error_Msg ("\?possible misspelling of """ & Error_Msg -- CODEFIX
List (Index).all & """", ("\?possible misspelling of """ &
Token_Ptr); List (Index).all & """", Token_Ptr);
end if; end if;
end; end;
end if; end if;
......
gcc/ada/sem_aggr.adb
...@@ -756,12 +756,12 @@ package body Sem_Aggr is ...@@ -756,12 +756,12 @@ package body Sem_Aggr is
-- Report at most two suggestions -- Report at most two suggestions
if Nr_Of_Suggestions = 1 then if Nr_Of_Suggestions = 1 then
Error_Msg_NE Error_Msg_NE -- CODEFIX
("\possible misspelling of&", Component, Suggestion_1); ("\possible misspelling of&", Component, Suggestion_1);
elsif Nr_Of_Suggestions = 2 then elsif Nr_Of_Suggestions = 2 then
Error_Msg_Node_2 := Suggestion_2; Error_Msg_Node_2 := Suggestion_2;
Error_Msg_NE Error_Msg_NE -- CODEFIX
("\possible misspelling of& or&", Component, Suggestion_1); ("\possible misspelling of& or&", Component, Suggestion_1);
end if; end if;
end Check_Misspelled_Component; end Check_Misspelled_Component;
......
gcc/ada/sem_ch4.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -446,7 +446,7 @@ package body Sem_Ch4 is ...@@ -446,7 +446,7 @@ package body Sem_Ch4 is
if Nkind (Constraint (E)) = if Nkind (Constraint (E)) =
N_Index_Or_Discriminant_Constraint N_Index_Or_Discriminant_Constraint
then then
Error_Msg_N Error_Msg_N -- CODEFIX
("\if qualified expression was meant, " & ("\if qualified expression was meant, " &
"use apostrophe", Constraint (E)); "use apostrophe", Constraint (E));
end if; end if;
...@@ -483,7 +483,7 @@ package body Sem_Ch4 is ...@@ -483,7 +483,7 @@ package body Sem_Ch4 is
and then Nkind (Constraint (E)) = and then Nkind (Constraint (E)) =
N_Index_Or_Discriminant_Constraint N_Index_Or_Discriminant_Constraint
then then
Error_Msg_N Error_Msg_N -- CODEFIX
("if qualified expression was meant, " & ("if qualified expression was meant, " &
"use apostrophe!", Constraint (E)); "use apostrophe!", Constraint (E));
end if; end if;
...@@ -2466,7 +2466,7 @@ package body Sem_Ch4 is ...@@ -2466,7 +2466,7 @@ package body Sem_Ch4 is
Formal := First_Formal (Nam); Formal := First_Formal (Nam);
while Present (Formal) loop while Present (Formal) loop
if Chars (Left_Opnd (Actual)) = Chars (Formal) then if Chars (Left_Opnd (Actual)) = Chars (Formal) then
Error_Msg_N Error_Msg_N -- CODEFIX
("possible misspelling of `='>`!", Actual); ("possible misspelling of `='>`!", Actual);
exit; exit;
end if; end if;
...@@ -4245,12 +4245,12 @@ package body Sem_Ch4 is ...@@ -4245,12 +4245,12 @@ package body Sem_Ch4 is
-- Report at most two suggestions -- Report at most two suggestions
if Nr_Of_Suggestions = 1 then if Nr_Of_Suggestions = 1 then
Error_Msg_NE Error_Msg_NE -- CODEFIX
("\possible misspelling of&", Sel, Suggestion_1); ("\possible misspelling of&", Sel, Suggestion_1);
elsif Nr_Of_Suggestions = 2 then elsif Nr_Of_Suggestions = 2 then
Error_Msg_Node_2 := Suggestion_2; Error_Msg_Node_2 := Suggestion_2;
Error_Msg_NE Error_Msg_NE -- CODEFIX
("\possible misspelling of& or&", Sel, Suggestion_1); ("\possible misspelling of& or&", Sel, Suggestion_1);
end if; end if;
end Check_Misspelled_Selector; end Check_Misspelled_Selector;
...@@ -4359,8 +4359,8 @@ package body Sem_Ch4 is ...@@ -4359,8 +4359,8 @@ package body Sem_Ch4 is
if Nkind (Parent (N)) = N_Selected_Component if Nkind (Parent (N)) = N_Selected_Component
and then N = Prefix (Parent (N)) and then N = Prefix (Parent (N))
then then
Error_Msg_N ( Error_Msg_N -- CODEFIX
"\period should probably be semicolon", Parent (N)); ("\period should probably be semicolon", Parent (N));
end if; end if;
elsif Nkind (N) = N_Procedure_Call_Statement elsif Nkind (N) = N_Procedure_Call_Statement
...@@ -5238,7 +5238,8 @@ package body Sem_Ch4 is ...@@ -5238,7 +5238,8 @@ package body Sem_Ch4 is
and then Valid_Boolean_Arg (Etype (R)) and then Valid_Boolean_Arg (Etype (R))
then then
Error_Msg_N ("invalid operands for concatenation", N); 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; return;
-- A special case for comparison of access parameter with null -- A special case for comparison of access parameter with null
...@@ -6073,7 +6074,8 @@ package body Sem_Ch4 is ...@@ -6073,7 +6074,8 @@ package body Sem_Ch4 is
if Nkind (Parent (Op)) = N_Full_Type_Declaration then if Nkind (Parent (Op)) = N_Full_Type_Declaration then
Error_Msg_N ("\possible interpretation (inherited)#", N); Error_Msg_N ("\possible interpretation (inherited)#", N);
else else
Error_Msg_N ("\possible interpretation#", N); Error_Msg_N -- CODEFIX
("\possible interpretation#", N);
end if; end if;
end if; end if;
end Report_Ambiguity; end Report_Ambiguity;
......
gcc/ada/sem_ch5.adb
...@@ -1208,6 +1208,13 @@ package body Sem_Ch5 is ...@@ -1208,6 +1208,13 @@ package body Sem_Ch5 is
Analyze_And_Resolve (Cond, Any_Boolean); Analyze_And_Resolve (Cond, Any_Boolean);
Check_Unset_Reference (Cond); Check_Unset_Reference (Cond);
end if; 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; end Analyze_Exit_Statement;
---------------------------- ----------------------------
......
gcc/ada/sem_ch8.adb
...@@ -3747,7 +3747,8 @@ package body Sem_Ch8 is ...@@ -3747,7 +3747,8 @@ package body Sem_Ch8 is
end if; end if;
Error_Msg_Sloc := Sloc (Ent); Error_Msg_Sloc := Sloc (Ent);
Error_Msg_N ("hidden declaration#!", N); Error_Msg_N -- CODEFIX
("hidden declaration#!", N);
end if; end if;
Ent := Homonym (Ent); Ent := Homonym (Ent);
......
gcc/ada/sem_res.adb
...@@ -2007,7 +2007,8 @@ package body Sem_Res is ...@@ -2007,7 +2007,8 @@ package body Sem_Res is
Error_Msg_N Error_Msg_N
("\\possible interpretation (inherited)#!", N); ("\\possible interpretation (inherited)#!", N);
else else
Error_Msg_N ("\\possible interpretation#!", N); Error_Msg_N -- CODEFIX
("\\possible interpretation#!", N);
end if; end if;
end if; end if;
...@@ -2089,7 +2090,8 @@ package body Sem_Res is ...@@ -2089,7 +2090,8 @@ package body Sem_Res is
Error_Msg_N Error_Msg_N
("\\possible interpretation (inherited)#!", N); ("\\possible interpretation (inherited)#!", N);
else else
Error_Msg_N ("\\possible interpretation#!", N); Error_Msg_N -- CODEFIX
("\\possible interpretation#!", N);
end if; end if;
end if; end if;
...@@ -6936,7 +6938,8 @@ package body Sem_Res is ...@@ -6936,7 +6938,8 @@ package body Sem_Res is
or else Base_Type (It.Typ) = or else Base_Type (It.Typ) =
Base_Type (Component_Type (Typ)) Base_Type (Component_Type (Typ))
then then
Error_Msg_N ("\\possible interpretation#", Arg); Error_Msg_N -- CODEFIX
("\\possible interpretation#", Arg);
end if; end if;
Get_Next_Interp (I, It); Get_Next_Interp (I, It);
...@@ -9314,10 +9317,12 @@ package body Sem_Res is ...@@ -9314,10 +9317,12 @@ package body Sem_Res is
Error_Msg_N ("ambiguous operand in conversion", Operand); Error_Msg_N ("ambiguous operand in conversion", Operand);
Error_Msg_Sloc := Sloc (It.Nam); 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_Sloc := Sloc (N1);
Error_Msg_N ("\\possible interpretation#!", Operand); Error_Msg_N -- CODEFIX
("\\possible interpretation#!", Operand);
return False; return False;
end if; end if;
......
gcc/ada/sem_warn.adb
...@@ -3903,8 +3903,8 @@ package body Sem_Warn is ...@@ -3903,8 +3903,8 @@ package body Sem_Warn is
X : Node_Id; X : Node_Id;
function Check_Ref (N : Node_Id) return Traverse_Result; function Check_Ref (N : Node_Id) return Traverse_Result;
-- Used to instantiate Traverse_Func. Returns Abandon if -- Used to instantiate Traverse_Func. Returns Abandon if a reference to
-- a reference to the entity in question is found. -- the entity in question is found.
function Test_No_Refs is new Traverse_Func (Check_Ref); function Test_No_Refs is new Traverse_Func (Check_Ref);
...@@ -3935,7 +3935,7 @@ package body Sem_Warn is ...@@ -3935,7 +3935,7 @@ package body Sem_Warn is
-- variable with the last assignment field set, with warnings enabled, -- variable with the last assignment field set, with warnings enabled,
-- and which is not imported or exported. We also check that it is OK -- 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 -- 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) if Is_Assignable (Ent)
and then not Is_Return_Object (Ent) and then not Is_Return_Object (Ent)
...@@ -4027,7 +4027,15 @@ package body Sem_Warn is ...@@ -4027,7 +4027,15 @@ package body Sem_Warn is
-- Otherwise we are at the outer level. An exception -- Otherwise we are at the outer level. An exception
-- handler is significant only if it references the -- 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
if Is_Formal (Ent) then
Set_Last_Assignment (Ent, Empty);
return;
else else
X := First (Exception_Handlers (P)); X := First (Exception_Handlers (P));
...@@ -4042,6 +4050,7 @@ package body Sem_Warn is ...@@ -4042,6 +4050,7 @@ package body Sem_Warn is
end if; end if;
end if; end if;
end if; end if;
end if;
P := Parent (P); P := Parent (P);
end loop; end loop;
......
gcc/ada/sinput-l.adb
...@@ -453,7 +453,8 @@ package body Sinput.L is ...@@ -453,7 +453,8 @@ package body Sinput.L is
-- Preprocess the source if it needs to be preprocessed -- Preprocess the source if it needs to be preprocessed
if Preprocessing_Needed then 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. -- source, to avoid crash when reporting an error.
Set_Source_File_Index_Table (X); Set_Source_File_Index_Table (X);
......
gcc/ada/sinput.adb
...@@ -32,10 +32,12 @@ ...@@ -32,10 +32,12 @@
pragma Style_Checks (All_Checks); pragma Style_Checks (All_Checks);
-- Subprograms not all in alpha order -- Subprograms not all in alpha order
with Atree; use Atree;
with Debug; use Debug; with Debug; use Debug;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with Tree_IO; use Tree_IO; with Tree_IO; use Tree_IO;
with Sinfo; use Sinfo;
with System; use System; with System; use System;
with Widechar; use Widechar; with Widechar; use Widechar;
...@@ -238,6 +240,222 @@ package body Sinput is ...@@ -238,6 +240,222 @@ package body Sinput is
return; return;
end Build_Location_String; 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 -- -- Get_Column_Number --
----------------------- -----------------------
......
gcc/ada/sinput.ads
...@@ -471,6 +471,14 @@ package Sinput is ...@@ -471,6 +471,14 @@ package Sinput is
-- ASCII.NUL, with Name_Length indicating the length not including the -- ASCII.NUL, with Name_Length indicating the length not including the
-- terminating Nul. -- 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; function Get_Column_Number (P : Source_Ptr) return Column_Number;
-- The ones-origin column number of the specified Source_Ptr value is -- The ones-origin column number of the specified Source_Ptr value is
-- determined and returned. Tab characters if present are assumed to -- determined and returned. Tab characters if present are assumed to
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment