git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2014-06-11  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Add debug flag -gnatd.q.
	* erroutc.adb (Prescan_Message): Bomb if untagged warning with
	-gnatd.q set.
	* styleg.adb (Check_Xtra_Parens): Message should be a style
	message.
	* sem_aggr.adb, sem_ch3.adb, exp_ch9.adb, checks.adb, sem_prag.adb,
	par-endh.adb, eval_fat.adb, freeze.adb, sem_util.adb, sem_attr.adb,
	sem_elab.adb, sem_ch6.adb, sem_warn.adb, sem_cat.adb,
	sem_ch13.adb, lib-xref.adb: Add remaining warning tags.

2014-06-11  Ben Brosgol  <brosgol@adacore.com>

	* gnat_rm.texi: Revised chapter on Implementation Defined
	Characteristics.

From-SVN: r211448
This commit is contained in:
Arnaud Charlet 2014-06-11 12:55:15 +02:00
parent 2e57f88b77
commit b785e0b875
21 changed files with 395 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/ada/ChangeLog
View File

@ -1,3 +1,20 @@
2014-06-11 Robert Dewar <dewar@adacore.com>
* debug.adb: Add debug flag -gnatd.q.
* erroutc.adb (Prescan_Message): Bomb if untagged warning with
-gnatd.q set.
* styleg.adb (Check_Xtra_Parens): Message should be a style
message.
* sem_aggr.adb, sem_ch3.adb, exp_ch9.adb, checks.adb, sem_prag.adb,
par-endh.adb, eval_fat.adb, freeze.adb, sem_util.adb, sem_attr.adb,
sem_elab.adb, sem_ch6.adb, sem_warn.adb, sem_cat.adb,
sem_ch13.adb, lib-xref.adb: Add remaining warning tags.
2014-06-11 Ben Brosgol <brosgol@adacore.com>
* gnat_rm.texi: Revised chapter on Implementation Defined
Characteristics.
2014-06-11 Geert Bosch <bosch@adacore.com> 2014-06-11 Geert Bosch <bosch@adacore.com>
* s-exctab.adb: avoid race conditions in exception registration. * s-exctab.adb: avoid race conditions in exception registration.

6
gcc/ada/checks.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, 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- --
@ -3128,7 +3128,7 @@ package body Checks is
else else
Apply_Compile_Time_Constraint_Error Apply_Compile_Time_Constraint_Error
(Ck_Node, (Ck_Node,
"static value out of range of}?", "static value out of range of}??",
CE_Range_Check_Failed, CE_Range_Check_Failed,
Ent => Target_Typ, Ent => Target_Typ,
Typ => Target_Typ); Typ => Target_Typ);
@ -3913,7 +3913,7 @@ package body Checks is
Apply_Compile_Time_Constraint_Error Apply_Compile_Time_Constraint_Error
(N => Expr, (N => Expr,
Msg => "(Ada 2005) null not allowed " Msg => "(Ada 2005) null not allowed "
& "in null-excluding objects?", & "in null-excluding objects??",
Reason => CE_Null_Not_Allowed); Reason => CE_Null_Not_Allowed);
when N_Parameter_Specification => when N_Parameter_Specification =>

8
gcc/ada/debug.adb
View File

@ -107,7 +107,7 @@ package body Debug is
-- d.n Print source file names -- d.n Print source file names
-- d.o Generate .NET listing of CIL code -- d.o Generate .NET listing of CIL code
-- d.p Enable the .NET CIL verifier -- d.p Enable the .NET CIL verifier
-- d.q -- d.q Quit on badly tagged warning message
-- d.r Enable OK_To_Reorder_Components in non-variant records -- d.r Enable OK_To_Reorder_Components in non-variant records
-- d.s Disable expansion of slice move, use memmove -- d.s Disable expansion of slice move, use memmove
-- d.t Disable static allocation of library level dispatch tables -- d.t Disable static allocation of library level dispatch tables
@ -561,6 +561,12 @@ package body Debug is
-- disabled by default and this flag is used to enable it. In the -- disabled by default and this flag is used to enable it. In the
-- future we will reverse this functionality. -- future we will reverse this functionality.
-- d.q All warning and info messages are supposed to be tagged with one
-- of the extended warning sequences such as ?? or <x<. The use of a
-- single ? or < is allowed for transitional purposes, but these are
-- intended to disappear. This debug switch makes it fatal to have a
-- warning presented which is not tagged (Program Error is raised).
-- d.r Forces the flag OK_To_Reorder_Components to be set in all record -- d.r Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have no discriminants. -- base types that have no discriminants.

9
gcc/ada/erroutc.adb
View File

@ -756,6 +756,15 @@ package body Erroutc is
end; end;
end if; end if;
-- Bomb if untagged warning message and -gnatd.q set
if Debug_Flag_Dot_Q
and then Is_Warning_Msg
and then Warning_Msg_Char = ' '
then
raise Program_Error;
end if;
-- Unconditional message (! insertion) -- Unconditional message (! insertion)
elsif Msg (J) = '!' then elsif Msg (J) = '!' then

8
gcc/ada/eval_fat.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, 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- --
@ -508,12 +508,12 @@ package body Eval_Fat is
if X_Exp < Emin_Den or not Has_Denormals (RT) then if X_Exp < Emin_Den or not Has_Denormals (RT) then
if Has_Signed_Zeros (RT) and then UR_Is_Negative (X) then if Has_Signed_Zeros (RT) and then UR_Is_Negative (X) then
Error_Msg_N Error_Msg_N
("floating-point value underflows to -0.0?", Enode); ("floating-point value underflows to -0.0??", Enode);
return Ureal_M_0; return Ureal_M_0;
else else
Error_Msg_N Error_Msg_N
("floating-point value underflows to 0.0?", Enode); ("floating-point value underflows to 0.0??", Enode);
return Ureal_0; return Ureal_0;
end if; end if;
@ -545,7 +545,7 @@ package body Eval_Fat is
begin begin
if X_Frac_Denorm /= X_Frac then if X_Frac_Denorm /= X_Frac then
Error_Msg_N Error_Msg_N
("gradual underflow causes loss of precision?", ("gradual underflow causes loss of precision??",
Enode); Enode);
X_Frac := X_Frac_Denorm; X_Frac := X_Frac_Denorm;
end if; end if;

4
gcc/ada/exp_ch9.adb
View File

@ -6233,8 +6233,8 @@ package body Exp_Ch9 is
null; null;
else else
Error_Msg_N ("potentially unsynchronized barrier?", N); Error_Msg_N ("potentially unsynchronized barrier??", N);
Error_Msg_N ("\& should be private component of type?", N); Error_Msg_N ("\& should be private component of type??", N);
end if; end if;
end if; end if;
end if; end if;

2
gcc/ada/freeze.adb
View File

@ -4301,7 +4301,7 @@ package body Freeze is
Error_Msg_N Error_Msg_N
("??convention C enumeration object has size less than ^", ("??convention C enumeration object has size less than ^",
E); E);
Error_Msg_N ("\?use explicit size clause to set size", E); Error_Msg_N ("\??use explicit size clause to set size", E);
end if; end if;
end if; end if;

446
gcc/ada/gnat_rm.texi
View File

File diff suppressed because it is too large Load Diff

2
gcc/ada/lib-xref.adb
View File

@ -868,7 +868,7 @@ package body Lib.Xref is
else else
Error_Msg_NE -- CODEFIX Error_Msg_NE -- CODEFIX
("?pragma Unreferenced given for&!", N, E); ("??pragma Unreferenced given for&!", N, E);
end if; end if;
end if; end if;

4
gcc/ada/par-endh.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, 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- --
@ -412,7 +412,7 @@ package body Endh is
Error_Msg_SC Error_Msg_SC
("misplaced aspects for package declaration"); ("misplaced aspects for package declaration");
Error_Msg Error_Msg
("info: aspect specifications belong here", Is_Loc); ("info: aspect specifications belong here??", Is_Loc);
P_Aspect_Specifications (Empty); P_Aspect_Specifications (Empty);
-- Other cases where aspect specifications are not allowed -- Other cases where aspect specifications are not allowed

4
gcc/ada/sem_aggr.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, 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- --
@ -4749,7 +4749,7 @@ package body Sem_Aggr is
Error_Msg_N Error_Msg_N
("(Ada 2005) null not allowed in null-excluding component??", Expr); ("(Ada 2005) null not allowed in null-excluding component??", Expr);
Error_Msg_N Error_Msg_N
("\Constraint_Error will be raised at run time?", Expr); ("\Constraint_Error will be raised at run time??", Expr);
Rewrite (Expr, Rewrite (Expr,
Make_Raise_Constraint_Error Make_Raise_Constraint_Error

2
gcc/ada/sem_attr.adb
View File

@ -4492,7 +4492,7 @@ package body Sem_Attr is
if Is_Potentially_Unevaluated (P) then if Is_Potentially_Unevaluated (P) then
Error_Msg_Name_1 := Aname; Error_Msg_Name_1 := Aname;
Error_Msg_N Error_Msg_N
("?prefix of attribute % is always evaluated when " ("??prefix of attribute % is always evaluated when "
& "related consequence is selected", P); & "related consequence is selected", P);
end if; end if;

12
gcc/ada/sem_cat.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, 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- --
@ -277,7 +277,7 @@ package body Sem_Cat is
and then Is_Preelaborated (Depended_Entity) and then Is_Preelaborated (Depended_Entity)
then then
Error_Msg_NE Error_Msg_NE
("<must use private with clause for preelaborated unit& ", ("<<must use private with clause for preelaborated unit& ",
N, Depended_Entity); N, Depended_Entity);
-- Subunit case -- Subunit case
@ -291,7 +291,7 @@ package body Sem_Cat is
else else
Error_Msg_NE Error_Msg_NE
("<cannot depend on& " & ("<<cannot depend on& " &
"(wrong categorization)", N, Depended_Entity); "(wrong categorization)", N, Depended_Entity);
end if; end if;
@ -299,7 +299,7 @@ package body Sem_Cat is
if Unit_Category = Pure then if Unit_Category = Pure then
Error_Msg_NE Error_Msg_NE
("\<pure unit cannot depend on non-pure unit", ("\<<pure unit cannot depend on non-pure unit",
N, Depended_Entity); N, Depended_Entity);
elsif Is_Preelaborated (Unit_Entity) elsif Is_Preelaborated (Unit_Entity)
@ -307,7 +307,7 @@ package body Sem_Cat is
and then not Is_Pure (Depended_Entity) and then not Is_Pure (Depended_Entity)
then then
Error_Msg_NE Error_Msg_NE
("\<preelaborated unit cannot depend on " ("\<<preelaborated unit cannot depend on "
& "non-preelaborated unit", & "non-preelaborated unit",
N, Depended_Entity); N, Depended_Entity);
end if; end if;
@ -1102,7 +1102,7 @@ package body Sem_Cat is
Error_Msg_Warn := GNAT_Mode; Error_Msg_Warn := GNAT_Mode;
Error_Msg_N Error_Msg_N
("<statements not allowed in preelaborated unit", Item); ("<<statements not allowed in preelaborated unit", Item);
exit; exit;
end if; end if;

4
gcc/ada/sem_ch13.adb
View File

@ -11285,7 +11285,7 @@ package body Sem_Ch13 is
and then X_Size > Y_Size and then X_Size > Y_Size
then then
Error_Msg_NE Error_Msg_NE
("?& overlays smaller object", ACCR.N, ACCR.X); ("??& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_N Error_Msg_N
("\??program execution may be erroneous", ACCR.N); ("\??program execution may be erroneous", ACCR.N);
Error_Msg_Uint_1 := X_Size; Error_Msg_Uint_1 := X_Size;
@ -11926,7 +11926,7 @@ package body Sem_Ch13 is
elsif Is_Unsigned_Type (Source) then elsif Is_Unsigned_Type (Source) then
Error_Msg Error_Msg
("\?z?source will be extended with ^ high order " ("\?z?source will be extended with ^ high order "
& "zero bits?!", Eloc); & "zero bits!", Eloc);
else else
Error_Msg Error_Msg

4
gcc/ada/sem_ch3.adb
View File

@ -10227,7 +10227,7 @@ package body Sem_Ch3 is
if GNAT_Mode then if GNAT_Mode then
Error_Msg_N Error_Msg_N
("?cannot initialize entities of limited type!", Exp); ("??cannot initialize entities of limited type!", Exp);
elsif Ada_Version < Ada_2005 then elsif Ada_Version < Ada_2005 then
@ -19458,7 +19458,7 @@ package body Sem_Ch3 is
if Is_Class_Wide_Type (Designated_Type (Subtype_Mark_Id)) then if Is_Class_Wide_Type (Designated_Type (Subtype_Mark_Id)) then
if Comes_From_Source (S) then if Comes_From_Source (S) then
Error_Msg_N Error_Msg_N
("constraint on class-wide type ignored?", ("constraint on class-wide type ignored??",
Constraint (S)); Constraint (S));
end if; end if;

10
gcc/ada/sem_ch6.adb
View File

@ -933,8 +933,8 @@ package body Sem_Ch6 is
-- Can it really happen (extended return???) -- Can it really happen (extended return???)
Error_Msg_N Error_Msg_N
("aliased only allowed for limited" ("aliased only allowed for limited return objects "
& " return objects in Ada 2012?", N); & "in Ada 2012??", N);
elsif not Is_Limited_View (R_Type) then elsif not Is_Limited_View (R_Type) then
Error_Msg_N ("aliased only allowed for limited" Error_Msg_N ("aliased only allowed for limited"
@ -2817,7 +2817,7 @@ package body Sem_Ch6 is
elsif Ekind (Scope (Spec_Id)) = E_Protected_Type then elsif Ekind (Scope (Spec_Id)) = E_Protected_Type then
Error_Msg_Warn := Error_To_Warning; Error_Msg_Warn := Error_To_Warning;
Error_Msg_N Error_Msg_N
("<overriding indicator not allowed for protected " ("<<overriding indicator not allowed for protected "
& "subprogram body", Body_Spec); & "subprogram body", Body_Spec);
end if; end if;
@ -2842,7 +2842,7 @@ package body Sem_Ch6 is
Error_Msg_Warn := Error_To_Warning; Error_Msg_Warn := Error_To_Warning;
Error_Msg_N Error_Msg_N
("<overriding indicator not allowed " & ("<<overriding indicator not allowed " &
"for protected subprogram body", "for protected subprogram body",
Body_Spec); Body_Spec);
@ -11609,7 +11609,7 @@ package body Sem_Ch6 is
if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then
Error_Msg_N Error_Msg_N
("cannot pass aliased parameter & by copy?", Formal); ("cannot pass aliased parameter & by copy??", Formal);
end if; end if;
-- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy -- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy

2
gcc/ada/sem_elab.adb
View File

@ -1317,7 +1317,7 @@ package body Sem_Elab is
Error_Msg_Warn := GNAT_Mode; Error_Msg_Warn := GNAT_Mode;
Error_Msg_N Error_Msg_N
("<non-static call not allowed in preelaborated unit", N); ("<<non-static call not allowed in preelaborated unit", N);
return; return;
end if; end if;

12
gcc/ada/sem_prag.adb
View File

@ -6482,10 +6482,10 @@ package body Sem_Prag is
if Force then if Force then
if Cont = False then if Cont = False then
Error_Msg_N ("<~!!", Arg1); Error_Msg_N ("<<~!!", Arg1);
Cont := True; Cont := True;
else else
Error_Msg_N ("\<~!!", Arg1); Error_Msg_N ("\<<~!!", Arg1);
end if; end if;
-- Error, rather than warning, or in a body, so we do not -- Error, rather than warning, or in a body, so we do not
@ -6496,10 +6496,10 @@ package body Sem_Prag is
else else
if Cont = False then if Cont = False then
Error_Msg_N ("<~", Arg1); Error_Msg_N ("<<~", Arg1);
Cont := True; Cont := True;
else else
Error_Msg_N ("\<~", Arg1); Error_Msg_N ("\<<~", Arg1);
end if; end if;
end if; end if;
@ -9068,7 +9068,7 @@ package body Sem_Prag is
if Nkind (Expr) /= N_Identifier if Nkind (Expr) /= N_Identifier
or else not Is_Attribute_Name (Chars (Expr)) or else not Is_Attribute_Name (Chars (Expr))
then then
Error_Msg_N ("unknown attribute name?", Expr); Error_Msg_N ("unknown attribute name??", Expr);
else else
Set_Restriction_No_Use_Of_Attribute (Expr, Warn); Set_Restriction_No_Use_Of_Attribute (Expr, Warn);
@ -9078,7 +9078,7 @@ package body Sem_Prag is
if Nkind (Expr) /= N_Identifier if Nkind (Expr) /= N_Identifier
or else not Is_Pragma_Name (Chars (Expr)) or else not Is_Pragma_Name (Chars (Expr))
then then
Error_Msg_N ("unknown pragma name?", Expr); Error_Msg_N ("unknown pragma name??", Expr);
else else
Set_Restriction_No_Use_Of_Pragma (Expr, Warn); Set_Restriction_No_Use_Of_Pragma (Expr, Warn);

8
gcc/ada/sem_util.adb
View File

@ -638,7 +638,7 @@ package body Sem_Util is
is is
begin begin
Error_Msg_Warn := Warn; Error_Msg_Warn := Warn;
Error_Msg_N ("unrecognized attribute&<", N); Error_Msg_N ("unrecognized attribute&<<", N);
-- Check for possible misspelling -- Check for possible misspelling
@ -646,7 +646,7 @@ package body Sem_Util is
while Error_Msg_Name_1 <= Last_Attribute_Name loop while Error_Msg_Name_1 <= Last_Attribute_Name loop
if Is_Bad_Spelling_Of (Nam, Error_Msg_Name_1) then if Is_Bad_Spelling_Of (Nam, Error_Msg_Name_1) then
Error_Msg_N -- CODEFIX Error_Msg_N -- CODEFIX
("\possible misspelling of %<", N); ("\possible misspelling of %<<", N);
exit; exit;
end if; end if;
@ -1555,7 +1555,7 @@ package body Sem_Util is
else else
Error_Msg_NE Error_Msg_NE
("?static expression fails static predicate check on &", ("??static expression fails static predicate check on &",
Expr, Typ); Expr, Typ);
end if; end if;
end if; end if;
@ -2087,7 +2087,7 @@ package body Sem_Util is
Error_Msg_N Error_Msg_N
("writable function parameter may affect " ("writable function parameter may affect "
& "value in other component because order " & "value in other component because order "
& "of evaluation is unspecified?", & "of evaluation is unspecified??",
Node (First_Elmt (Writable_Actuals_List))); Node (First_Elmt (Writable_Actuals_List)));
end if; end if;
end if; end if;

22
gcc/ada/sem_warn.adb
View File

@ -1425,20 +1425,20 @@ package body Sem_Warn is
if not Is_Trivial_Subprogram (Scope (E1)) then if not Is_Trivial_Subprogram (Scope (E1)) then
if not Warnings_Off_E1 then if not Warnings_Off_E1 then
if Is_Access_Type (Etype (Parent (UR))) then if Is_Access_Type (Etype (Parent (UR))) then
Error_Msg_N ("?`&.&` may be null!", UR); Error_Msg_N ("??`&.&` may be null!", UR);
else else
Error_Msg_N Error_Msg_N
("?`&.&` may be referenced before " ("??`&.&` may be referenced before "
& "it has a value!", UR); & "it has a value!", UR);
end if; end if;
end if; end if;
end if; end if;
-- All other cases of unset reference active
-- All other cases of unset reference active
elsif not Warnings_Off_E1 then elsif not Warnings_Off_E1 then
Error_Msg_N Error_Msg_N
("?& may be referenced before it has a value!", ("??& may be referenced before it has a value!", UR);
UR);
end if; end if;
end if; end if;
@ -3194,15 +3194,15 @@ package body Sem_Warn is
Error_Msg_Sloc := Sloc (CV); Error_Msg_Sloc := Sloc (CV);
if Nkind (CV) not in N_Subexpr then if Nkind (CV) not in N_Subexpr then
Error_Msg_N ("\\?(see test #)", Loc); Error_Msg_N ("\\??(see test #)", Loc);
elsif Nkind (Parent (CV)) = elsif Nkind (Parent (CV)) =
N_Case_Statement_Alternative N_Case_Statement_Alternative
then then
Error_Msg_N ("\\?(see case alternative #)", Loc); Error_Msg_N ("\\??(see case alternative #)", Loc);
else else
Error_Msg_N ("\\?(see assignment #)", Loc); Error_Msg_N ("\\??(see assignment #)", Loc);
end if; end if;
end if; end if;
end; end;
@ -3520,7 +3520,7 @@ package body Sem_Warn is
then then
if Act1 = First_Actual (N) then if Act1 = First_Actual (N) then
Error_Msg_FE Error_Msg_FE
("<`IN OUT` prefix overlaps with " ("<<`IN OUT` prefix overlaps with "
& "actual for&", Act1, Form); & "actual for&", Act1, Form);
else else
@ -3528,7 +3528,7 @@ package body Sem_Warn is
Error_Msg_Node_2 := Form; Error_Msg_Node_2 := Form;
Error_Msg_FE Error_Msg_FE
("<writable actual for & overlaps with " ("<<writable actual for & overlaps with "
& "actual for&", Act1, Form); & "actual for&", Act1, Form);
end if; end if;
@ -3540,7 +3540,7 @@ package body Sem_Warn is
-- This is one of the messages -- This is one of the messages
Error_Msg_FE Error_Msg_FE
("<writable actual for & overlaps with " ("<<writable actual for & overlaps with "
& "actual for&", Act1, Form1); & "actual for&", Act1, Form1);
end if; end if;
end; end;

10
gcc/ada/styleg.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, 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- --
@ -1003,9 +1003,9 @@ package body Styleg is
-- Check_Then -- -- Check_Then --
---------------- ----------------
-- In check if then layout mode (-gnatyi), we expect a THEN keyword -- In check if then layout mode (-gnatyi), we expect a THEN keyword to
-- to appear either on the same line as the IF, or on a separate line -- appear either on the same line as the IF, or on a separate line if
-- if the IF statement extends for more than one line. -- the IF statement extends for more than one line.
procedure Check_Then (If_Loc : Source_Ptr) is procedure Check_Then (If_Loc : Source_Ptr) is
begin begin
@ -1061,7 +1061,7 @@ package body Styleg is
begin begin
if Style_Check_Xtra_Parens then if Style_Check_Xtra_Parens then
Error_Msg -- CODEFIX Error_Msg -- CODEFIX
("redundant parentheses?", Loc); ("(style) redundant parentheses", Loc);
end if; end if;
end Check_Xtra_Parens; end Check_Xtra_Parens;