Skip to content

R
riscv-gcc-1
Commit dbfeb4fa by Robert Dewar Committed by Arnaud Charlet
Options

errout.adb (Set_Msg_Insertion_Warning): Correct typo causing tests to fail if… 

errout.adb (Set_Msg_Insertion_Warning): Correct typo causing tests to fail if insertion sequence is at end of message...

2013-01-02  Robert Dewar  <dewar@adacore.com>

	* errout.adb (Set_Msg_Insertion_Warning): Correct typo causing
	tests to fail if insertion sequence is at end of message string.
	* opt.ads: Minor comment fixes and additions.
	* sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_ch10.adb, sem_ch11.adb,
	sem_ch12.adb, sem_ch13.adb: Add tags to warning messages.
	* sem_ch6.ads, sem_ch6.adb (Cannot_Inline): Deal with warning message
	tags. Add tags to warning messages.

From-SVN: r194785
parent a3633438
Showing with 140 additions and 125 deletions
gcc/ada/ChangeLog
2013-01-02 Robert Dewar <dewar@adacore.com>
* errout.adb (Set_Msg_Insertion_Warning): Correct typo causing
tests to fail if insertion sequence is at end of message string.
* opt.ads: Minor comment fixes and additions.
* sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_ch10.adb, sem_ch11.adb,
sem_ch12.adb, sem_ch13.adb: Add tags to warning messages.
* sem_ch6.ads, sem_ch6.adb (Cannot_Inline): Deal with warning message
tags. Add tags to warning messages.
2013-01-02 Robert Dewar <dewar@adacore.com>
* err_vars.ads (Warning_Doc_Switch): New flag.
* errout.adb (Error_Msg_Internal): Implement new warning flag
doc tag stuff (Set_Msg_Insertion_Warning): New procedure.
......
gcc/ada/errout.adb
......@@ -2677,14 +2677,14 @@ package body Errout is
begin
Warning_Msg_Char := ' ';
if P + 1 <= Text'Last and then Text (P) = '?' then
if P <= Text'Last and then Text (P) = '?' then
if Warning_Doc_Switch then
Warning_Msg_Char := '?';
end if;
P := P + 1;
elsif P + 2 <= Text'Last
elsif P + 1 <= Text'Last
and then (Text (P) in 'a' .. 'z'
or else
Text (P) in 'A' .. 'Z')
......
gcc/ada/opt.ads
......@@ -1506,8 +1506,8 @@ package Opt is
Warn_On_Biased_Representation : Boolean := True;
-- GNAT
-- Set to True to generate warnings for size clauses, component clauses
-- and component_size clauses that force biased representation. Set False
-- by -gnatw.B.
-- and component_size clauses that force biased representation. Modified
-- by use of -gnatw.b/.B.
Warn_On_Constant : Boolean := False;
-- GNAT
......@@ -1567,12 +1567,14 @@ package Opt is
Warn_On_Object_Renames_Function : Boolean := False;
-- GNAT
-- Set to True to generate warnings when a function result is renamed as
-- an object. The default is that this warning is disabled.
-- an object. The default is that this warning is disabled. Modified by
-- use of -gnatw.r/.R.
Warn_On_Obsolescent_Feature : Boolean := False;
-- GNAT
-- Set to True to generate warnings on use of any feature in Annex or if a
-- subprogram is called for which a pragma Obsolescent applies.
-- subprogram is called for which a pragma Obsolescent applies. Modified
-- by use of -gnatwj/J.
Warn_On_Overlap : Boolean := False;
-- GNAT
......@@ -1600,7 +1602,7 @@ package Opt is
-- GNAT
-- Set to True to generate warning (informational) messages for component
-- clauses that are affected by non-standard bit-order. The default is
-- that this warning is enabled.
-- that this warning is enabled. Modified by -gnatw.v/.V.
Warn_On_Suspicious_Contract : Boolean := False;
-- GNAT
......@@ -1616,8 +1618,8 @@ package Opt is
Warn_On_Unchecked_Conversion : Boolean := True;
-- GNAT
-- Set to True to generate warnings for unchecked conversions that may have
-- non-portable semantics (e.g. because sizes of types differ). The default
-- is that this warning is enabled.
-- non-portable semantics (e.g. because sizes of types differ). Modified
-- by use of -gnatw.z/.Z.
Warn_On_Unordered_Enumeration_Type : Boolean := False;
-- GNAT
......@@ -1635,7 +1637,7 @@ package Opt is
-- GNAT
-- Set to True to generate warnings for the case of components of record
-- which have a record representation clause but this component does not
-- have a component clause. The default is that this warning is disabled.
-- have a component clause. Modified by use of -gnatw.c/.C.
Warn_On_Warnings_Off : Boolean := False;
-- GNAT
......
gcc/ada/sem_ch10.adb
......@@ -556,7 +556,7 @@ package body Sem_Ch10 is
Used_In_Spec)
then
Error_Msg_N -- CODEFIX
("?redundant with clause in body", Clause);
("redundant with clause in body??", Clause);
end if;
Used_In_Body := False;
......@@ -585,7 +585,7 @@ package body Sem_Ch10 is
if Withed then
Error_Msg_N -- CODEFIX
("?redundant with clause", Clause);
("redundant with clause??", Clause);
end if;
end;
end if;
......@@ -1793,7 +1793,7 @@ package body Sem_Ch10 is
Error_Msg_File_1 :=
Get_File_Name (Subunit_Name, Subunit => True);
Error_Msg_N
("subunit$$ in file{ not found?!!", N);
("subunit$$ in file{ not found??!!", N);
Subunits_Missing := True;
end if;
......@@ -2513,30 +2513,30 @@ package body Sem_Ch10 is
begin
if U_Kind = Implementation_Unit then
Error_Msg_F ("& is an internal 'G'N'A'T unit?", Name (N));
Error_Msg_F ("& is an internal 'G'N'A'T unit?i?", Name (N));
-- Add alternative name if available, otherwise issue a
-- general warning message.
if Error_Msg_Strlen /= 0 then
Error_Msg_F ("\use ""~"" instead", Name (N));
Error_Msg_F ("\use ""~"" instead?i?", Name (N));
else
Error_Msg_F
("\use of this unit is non-portable " &
"and version-dependent?", Name (N));
"and version-dependent?i?", Name (N));
end if;
elsif U_Kind = Ada_2005_Unit
and then Ada_Version < Ada_2005
and then Warn_On_Ada_2005_Compatibility
then
Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
Error_Msg_N ("& is an Ada 2005 unit?i?", Name (N));
elsif U_Kind = Ada_2012_Unit
and then Ada_Version < Ada_2012
and then Warn_On_Ada_2012_Compatibility
then
Error_Msg_N ("& is an Ada 2012 unit?", Name (N));
Error_Msg_N ("& is an Ada 2012 unit?i?", Name (N));
end if;
end;
end if;
......@@ -3342,7 +3342,7 @@ package body Sem_Ch10 is
procedure License_Error is
begin
Error_Msg_N
("?license of withed unit & may be inconsistent",
("license of withed unit & may be inconsistent??",
Name (Item));
end License_Error;
......@@ -4129,7 +4129,7 @@ package body Sem_Ch10 is
then
Error_Msg_NE
("child unit& hides compilation unit " &
"with the same name?",
"with the same name??",
Name (Item), Id);
exit;
end if;
......
gcc/ada/sem_ch11.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -266,7 +266,7 @@ package body Sem_Ch11 is
and then Scope (Entity (Id)) = Current_Scope
then
Error_Msg_NE
("?exception & is never raised", Entity (Id), Id);
("exception & is never raised?r?", Entity (Id), Id);
end if;
if Present (Renamed_Entity (Entity (Id))) then
......@@ -276,9 +276,9 @@ package body Sem_Ch11 is
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("Numeric_Error is an " &
"obsolescent feature (RM J.6(1))?", Id);
"obsolescent feature (RM J.6(1))?j?", Id);
Error_Msg_N
("\use Constraint_Error instead?", Id);
("\use Constraint_Error instead?j?", Id);
end if;
end if;
end if;
......@@ -345,7 +345,7 @@ package body Sem_Ch11 is
N_Others_Choice)
then
Error_Msg_N
("useless handler contains only a reraise statement?",
("useless handler contains only a reraise statement?r?",
Handler);
end if;
......@@ -445,8 +445,7 @@ package body Sem_Ch11 is
end if;
-- Check for useless assignment to OUT or IN OUT scalar preceding the
-- raise. Right now we only look at assignment statements, we could do
-- more.
-- raise. Right now only look at assignment statements, could do more???
if Is_List_Member (N) then
declare
......@@ -496,11 +495,11 @@ package body Sem_Ch11 is
if No (Exception_Handlers (Par)) then
Error_Msg_N
("?assignment to pass-by-copy formal " &
"may have no effect", P);
("assignment to pass-by-copy formal " &
"may have no effect??", P);
Error_Msg_N
("\?RAISE statement may result in abnormal return" &
" (RM 6.4.1(17))", P);
("\RAISE statement may result in abnormal return" &
" (RM 6.4.1(17))??", P);
end if;
end if;
end if;
......
gcc/ada/sem_ch12.adb
......@@ -10491,8 +10491,7 @@ package body Sem_Ch12 is
-- This is a binding interpretation that applies to previous versions
-- of the language, but for now we retain the milder check in order
-- to preserve ACATS tests.
-- These will be protested eventually ???
-- to preserve ACATS tests. These will be protested eventually ???
if Ada_Version < Ada_2012 then
Check_Mode_Conformant
......@@ -12155,8 +12154,8 @@ package body Sem_Ch12 is
E1 := First_Entity (Form);
E2 := First_Entity (Act);
while Present (E1) and then E1 /= First_Private_Entity (Form) loop
-- Could this test be a single condition???
-- Seems like it could, and isn't FPE (Form) a constant anyway???
-- Could this test be a single condition??? Seems like it could, and
-- isn't FPE (Form) a constant anyway???
if not Is_Internal (E1)
and then Present (Parent (E1))
......@@ -12422,7 +12421,7 @@ package body Sem_Ch12 is
-- provide additional warning which might explain the error.
Set_Is_Immediately_Visible (Cur, Vis);
Error_Msg_NE ("& hides outer unit with the same name?",
Error_Msg_NE ("& hides outer unit with the same name??",
N, Defining_Unit_Name (N));
end if;
......
gcc/ada/sem_ch6.ads
......@@ -58,26 +58,30 @@ package Sem_Ch6 is
Is_Serious : Boolean := False);
-- This procedure is called if the node N, an instance of a call to
-- subprogram Subp, cannot be inlined. Msg is the message to be issued,
-- and has a ? as the last character. Temporarily the behavior of this
-- routine depends on the value of -gnatd.k:
-- which ends with ? (but not ?p?, this routine takes care of the need
-- to change ? to ?p?). Temporarily the behavior of this routine depends
-- on the value of -gnatd.k:
--
-- * If -gnatd.k is not set (ie. old inlining model) then if Subp has
-- a pragma Always_Inlined, then an error message is issued (by
-- removing the last character of Msg). If Subp is not Always_Inlined,
-- then a warning is issued if the flag Ineffective_Inline_Warnings
-- is set, and if not, the call has no effect.
--
-- * If -gnatd.k is set (ie. new inlining model) then:
-- - If Is_Serious is true, then an error is reported (by removing the
-- last character of Msg);
-- - otherwise:
--
-- * Compiling without optimizations if Subp has a pragma
-- Always_Inlined, then an error message is issued; if Subp is
-- not Always_Inlined, then a warning is issued if the flag
-- Ineffective_Inline_Warnings is set, and if not, the call
-- has no effect.
-- * Compiling with optimizations then a warning is issued if
-- the flag Ineffective_Inline_Warnings is set; otherwise the
-- call has no effect since inlining may be performed by the
-- backend.
--
-- * Compiling with optimizations then a warning is issued if the
-- flag Ineffective_Inline_Warnings is set; otherwise the call has
-- no effect since inlining may be performed by the backend.
procedure Check_Conventions (Typ : Entity_Id);
-- Ada 2005 (AI-430): Check that the conventions of all inherited and
......
gcc/ada/sem_ch7.adb
......@@ -261,7 +261,7 @@ package body Sem_Ch7 is
then
if Ada_Version = Ada_83 then
Error_Msg_N
("optional package body (not allowed in Ada 95)?", N);
("optional package body (not allowed in Ada 95)??", N);
else
Error_Msg_N ("spec of this package does not allow a body", N);
end if;
......
gcc/ada/sem_ch8.adb
......@@ -1017,13 +1017,13 @@ package body Sem_Ch8 is
and then Comes_From_Source (Nam)
then
Error_Msg_N
("?renaming function result object is suspicious", Nam);
("renaming function result object is suspicious?R?", Nam);
Error_Msg_NE
("\?function & will be called only once", Nam,
("\function & will be called only once?R?", Nam,
Entity (Name (Nam)));
Error_Msg_N -- CODEFIX
("\?suggest using an initialized constant object instead",
Nam);
("\suggest using an initialized constant "
& "object instead?R?", Nam);
end if;
end case;
......@@ -2289,10 +2289,10 @@ package body Sem_Ch8 is
and then Hidden /= Old_S
then
Error_Msg_Sloc := Sloc (Hidden);
Error_Msg_N ("?default subprogram is resolved " &
Error_Msg_N ("default subprogram is resolved " &
"in the generic declaration " &
"(RM 12.6(17))", N);
Error_Msg_NE ("\?and will not use & #", N, Hidden);
"(RM 12.6(17))??", N);
Error_Msg_NE ("\and will not use & #??", N, Hidden);
end if;
end;
end if;
......@@ -2942,7 +2942,7 @@ package body Sem_Ch8 is
and then Chars (Old_S) /= Chars (New_S)
then
Error_Msg_NE
("?& is being renamed as a different operator", N, Old_S);
("& is being renamed as a different operator??", N, Old_S);
end if;
-- Check for renaming of obsolescent subprogram
......@@ -2965,7 +2965,7 @@ package body Sem_Ch8 is
and then Chars (Current_Scope) /= Chars (Old_S)
then
Error_Msg_N
("?redundant renaming, entity is directly visible", Name (N));
("redundant renaming, entity is directly visible?r?", Name (N));
end if;
-- Implementation-defined aspect specifications can appear in a renaming
......@@ -3219,7 +3219,7 @@ package body Sem_Ch8 is
and then Pack = Current_Scope
then
Error_Msg_NE -- CODEFIX
("& is already use-visible within itself?", Pack_Name, Pack);
("& is already use-visible within itself?r?", Pack_Name, Pack);
end if;
return False;
......@@ -6015,7 +6015,8 @@ package body Sem_Ch8 is
then
-- Selected component of record. Type checking will validate
-- name of selector.
-- ??? could we rewrite an implicit dereference into an explicit
-- ??? Could we rewrite an implicit dereference into an explicit
-- one here?
Analyze_Selected_Component (N);
......@@ -6275,18 +6276,18 @@ package body Sem_Ch8 is
Set_Entity (N, Any_Type);
return;
-- ??? This test is temporarily disabled (always False)
-- because it causes an unwanted warning on GNAT sources
-- (built with -gnatg, which includes Warn_On_Obsolescent_
-- Feature). Once this issue is cleared in the sources, it
-- can be enabled.
-- ??? This test is temporarily disabled (always
-- False) because it causes an unwanted warning on
-- GNAT sources (built with -gnatg, which includes
-- Warn_On_Obsolescent_ Feature). Once this issue
-- is cleared in the sources, it can be enabled.
elsif Warn_On_Obsolescent_Feature
and then False
then
Error_Msg_N
("applying 'Class to an untagged incomplete type"
& " is an obsolescent feature (RM J.11)", N);
& " is an obsolescent feature (RM J.11)?r?", N);
end if;
end if;
......@@ -6379,7 +6380,7 @@ package body Sem_Ch8 is
and then Base_Type (Typ) = Typ
then
Error_Msg_NE -- CODEFIX
("?redundant attribute, & is its own base type", N, Typ);
("redundant attribute, & is its own base type?r?", N, Typ);
end if;
T := Base_Type (Typ);
......@@ -7248,7 +7249,7 @@ package body Sem_Ch8 is
if Present (Redundant) then
Error_Msg_Sloc := Sloc (Prev_Use);
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous use clause #?",
("& is already use-visible through previous use clause #??",
Redundant, Pack_Name);
end if;
end Note_Redundant_Use;
......@@ -8362,14 +8363,14 @@ package body Sem_Ch8 is
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Clause1, T);
& "use_type_clause #??", Clause1, T);
return;
elsif Nkind (Unit1) = N_Subunit then
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Clause1, T);
& "use_type_clause #??", Clause1, T);
return;
elsif Nkind_In (Unit2, N_Package_Body, N_Subprogram_Body)
......@@ -8379,7 +8380,7 @@ package body Sem_Ch8 is
Error_Msg_Sloc := Sloc (Clause1);
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Current_Use_Clause (T), T);
& "use_type_clause #??", Current_Use_Clause (T), T);
return;
end if;
......@@ -8431,7 +8432,7 @@ package body Sem_Ch8 is
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Err_No, Id);
& "use_type_clause #??", Err_No, Id);
-- Case where current use type clause and the use type
-- clause for the type are not both at the compilation unit
......@@ -8440,7 +8441,7 @@ package body Sem_Ch8 is
else
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use type clause?", Id, T);
& "use type clause??", Id, T);
end if;
end Use_Clause_Known;
......@@ -8450,7 +8451,7 @@ package body Sem_Ch8 is
else
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use type clause?", Id, T);
& "use type clause??", Id, T);
end if;
-- The package where T is declared is already used
......@@ -8458,7 +8459,7 @@ package body Sem_Ch8 is
elsif In_Use (Scope (T)) then
Error_Msg_Sloc := Sloc (Current_Use_Clause (Scope (T)));
Error_Msg_NE -- CODEFIX
("& is already use-visible through package use clause #?",
("& is already use-visible through package use clause #??",
Id, T);
-- The current scope is the package where T is declared
......@@ -8466,7 +8467,7 @@ package body Sem_Ch8 is
else
Error_Msg_Node_2 := Scope (T);
Error_Msg_NE -- CODEFIX
("& is already use-visible inside package &?", Id, T);
("& is already use-visible inside package &??", Id, T);
end if;
end if;
end Use_One_Type;
......
gcc/ada/sem_ch9.adb
......@@ -1062,9 +1062,9 @@ package body Sem_Ch9 is
and then Nkind (First (Else_Statements (N))) in N_Delay_Statement
then
Error_Msg_N
("suspicious form of conditional entry call?!", N);
("suspicious form of conditional entry call??!", N);
Error_Msg_N
("\`SELECT OR` may be intended rather than `SELECT ELSE`!", N);
("\`SELECT OR` may be intended rather than `SELECT ELSE`??!", N);
end if;
-- Postpone the analysis of the statements till expansion. Analyze only
......@@ -1987,11 +1987,11 @@ package body Sem_Ch9 is
if Error_Msg_Sloc = No_Location then
Error_Msg_N
("objects of this type will violate " &
"`No_Local_Protected_Objects`?", N);
"`No_Local_Protected_Objects`??", N);
else
Error_Msg_N
("objects of this type will violate " &
"`No_Local_Protected_Objects`?#", N);
"`No_Local_Protected_Objects`#??", N);
end if;
end if;
......@@ -2052,15 +2052,15 @@ package body Sem_Ch9 is
or else From_Aspect_Specification (Prio_Item)
then
Error_Msg_Name_1 := Chars (Identifier (Prio_Item));
Error_Msg_NE ("?aspect% for & has no effect when Lock_Free" &
" given", Prio_Item, Id);
Error_Msg_NE ("aspect% for & has no effect when Lock_Free" &
" given??", Prio_Item, Id);
-- Pragma case
else
Error_Msg_Name_1 := Pragma_Name (Prio_Item);
Error_Msg_NE ("?pragma% for & has no effect when Lock_Free" &
" given", Prio_Item, Id);
Error_Msg_NE ("pragma% for & has no effect when Lock_Free" &
" given??", Prio_Item, Id);
end if;
end if;
end;
......@@ -2089,16 +2089,16 @@ package body Sem_Ch9 is
or else From_Aspect_Specification (Prio_Item))
and then Chars (Identifier (Prio_Item)) = Name_Priority
then
Error_Msg_N ("?aspect Interrupt_Priority is preferred "
& "in presence of handlers", Prio_Item);
Error_Msg_N ("aspect Interrupt_Priority is preferred "
& "in presence of handlers??", Prio_Item);
-- Pragma case
elsif Nkind (Prio_Item) = N_Pragma
and then Pragma_Name (Prio_Item) = Name_Priority
then
Error_Msg_N ("?pragma Interrupt_Priority is preferred "
& "in presence of handlers", Prio_Item);
Error_Msg_N ("pragma Interrupt_Priority is preferred "
& "in presence of handlers??", Prio_Item);
end if;
end if;
end;
......@@ -2516,7 +2516,7 @@ package body Sem_Ch9 is
if Entity (EDN1) = Ent then
Error_Msg_Sloc := Sloc (Stm1);
Error_Msg_N
("?accept duplicates one on line#", Stm);
("accept duplicates one on line#??", Stm);
exit;
end if;
end if;
......@@ -2799,7 +2799,7 @@ package body Sem_Ch9 is
and then not Entry_Accepted (Ent)
and then Comes_From_Source (Ent)
then
Error_Msg_NE ("no accept for entry &?", N, Ent);
Error_Msg_NE ("no accept for entry &??", N, Ent);
end if;
Next_Entity (Ent);
......@@ -2923,10 +2923,10 @@ package body Sem_Ch9 is
if Error_Msg_Sloc = No_Location then
Error_Msg_N
("objects of this type will violate `No_Task_Hierarchy`?", N);
("objects of this type will violate `No_Task_Hierarchy`??", N);
else
Error_Msg_N
("objects of this type will violate `No_Task_Hierarchy`?#", N);
("objects of this type will violate `No_Task_Hierarchy`#??", N);
end if;
end if;
......
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