[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

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>
* s-exctab.adb: avoid race conditions in exception registration.

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -3128,7 +3128,7 @@ package body Checks is
else
Apply_Compile_Time_Constraint_Error
(Ck_Node,
"static value out of range of}?",
"static value out of range of}??",
CE_Range_Check_Failed,
Ent => Target_Typ,
Typ => Target_Typ);
@ -3913,7 +3913,7 @@ package body Checks is
Apply_Compile_Time_Constraint_Error
(N => Expr,
Msg => "(Ada 2005) null not allowed "
& "in null-excluding objects?",
& "in null-excluding objects??",
Reason => CE_Null_Not_Allowed);
when N_Parameter_Specification =>

View File

@ -107,7 +107,7 @@ package body Debug is
-- d.n Print source file names
-- d.o Generate .NET listing of CIL code
-- 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.s Disable expansion of slice move, use memmove
-- 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
-- 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
-- base types that have no discriminants.

View File

@ -756,6 +756,15 @@ package body Erroutc is
end;
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)
elsif Msg (J) = '!' then

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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 Has_Signed_Zeros (RT) and then UR_Is_Negative (X) then
Error_Msg_N
("floating-point value underflows to -0.0?", Enode);
("floating-point value underflows to -0.0??", Enode);
return Ureal_M_0;
else
Error_Msg_N
("floating-point value underflows to 0.0?", Enode);
("floating-point value underflows to 0.0??", Enode);
return Ureal_0;
end if;
@ -545,7 +545,7 @@ package body Eval_Fat is
begin
if X_Frac_Denorm /= X_Frac then
Error_Msg_N
("gradual underflow causes loss of precision?",
("gradual underflow causes loss of precision??",
Enode);
X_Frac := X_Frac_Denorm;
end if;

View File

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

View File

@ -4301,7 +4301,7 @@ package body Freeze is
Error_Msg_N
("??convention C enumeration object has size less than ^",
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;

File diff suppressed because it is too large Load Diff

View File

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

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -412,7 +412,7 @@ package body Endh is
Error_Msg_SC
("misplaced aspects for package declaration");
Error_Msg
("info: aspect specifications belong here", Is_Loc);
("info: aspect specifications belong here??", Is_Loc);
P_Aspect_Specifications (Empty);
-- Other cases where aspect specifications are not allowed

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
("(Ada 2005) null not allowed in null-excluding component??", Expr);
Error_Msg_N
("\Constraint_Error will be raised at run time?", Expr);
("\Constraint_Error will be raised at run time??", Expr);
Rewrite (Expr,
Make_Raise_Constraint_Error

View File

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

View File

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

View File

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

View File

@ -10227,7 +10227,7 @@ package body Sem_Ch3 is
if GNAT_Mode then
Error_Msg_N
("?cannot initialize entities of limited type!", Exp);
("??cannot initialize entities of limited type!", Exp);
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 Comes_From_Source (S) then
Error_Msg_N
("constraint on class-wide type ignored?",
("constraint on class-wide type ignored??",
Constraint (S));
end if;

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -1003,9 +1003,9 @@ package body Styleg is
-- Check_Then --
----------------
-- In check if then layout mode (-gnatyi), we expect a THEN keyword
-- to appear either on the same line as the IF, or on a separate line
-- if the IF statement extends for more than one line.
-- In check if then layout mode (-gnatyi), we expect a THEN keyword to
-- appear either on the same line as the IF, or on a separate line if
-- the IF statement extends for more than one line.
procedure Check_Then (If_Loc : Source_Ptr) is
begin
@ -1061,7 +1061,7 @@ package body Styleg is
begin
if Style_Check_Xtra_Parens then
Error_Msg -- CODEFIX
("redundant parentheses?", Loc);
("(style) redundant parentheses", Loc);
end if;
end Check_Xtra_Parens;