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