Commit 12c5f1ef by Arnaud Charlet

[multiple changes]

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): a)
	An attribute_reference to Loop_Entry denotes an iterator
	specification: its prefix is an object, as is the case for 'Old.
	b) If the domain of iteration is an expression whose type has
	the Iterable aspect defined, this is an iterator specification.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* gnatcmd.adb: Minor reformatting.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* atree.ads (Info_Messages): New counter.
	* err_vars.ads: Minor comment update.
	* errout.adb (Delete_Warning_And_Continuations): Deal
	with new Info_Messages counter.
	(Error_Msg_Internal): ditto.
	(Delete_Warning): ditto.
	(Initialize): ditto.
	(Write_Error_Summary): ditto.
	(Output_Messages): ditto.
	(To_Be_Removed): ditto.
	* erroutc.adb (Delete_Msg): Deal with Info_Messages counter.
	(Compilation_Errors): ditto.
	* errutil.adb (Error_Msg): Deal with Info_Messages counter.
	(Finalize): ditto.
	(Initialize): ditto.
	* sem_prag.adb (Analyze_Pragma): Minor comment addition.
	* gnat_ugn.texi: Document that -gnatwe does not affect info
	messages.

From-SVN: r213457
parent 511c5197
2014-08-01 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Loop_Parameter_Specification): a)
An attribute_reference to Loop_Entry denotes an iterator
specification: its prefix is an object, as is the case for 'Old.
b) If the domain of iteration is an expression whose type has
the Iterable aspect defined, this is an iterator specification.
2014-08-01 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb: Minor reformatting.
2014-08-01 Robert Dewar <dewar@adacore.com>
* atree.ads (Info_Messages): New counter.
* err_vars.ads: Minor comment update.
* errout.adb (Delete_Warning_And_Continuations): Deal
with new Info_Messages counter.
(Error_Msg_Internal): ditto.
(Delete_Warning): ditto.
(Initialize): ditto.
(Write_Error_Summary): ditto.
(Output_Messages): ditto.
(To_Be_Removed): ditto.
* erroutc.adb (Delete_Msg): Deal with Info_Messages counter.
(Compilation_Errors): ditto.
* errutil.adb (Error_Msg): Deal with Info_Messages counter.
(Finalize): ditto.
(Initialize): ditto.
* sem_prag.adb (Analyze_Pragma): Minor comment addition.
* gnat_ugn.texi: Document that -gnatwe does not affect info
messages.
2014-08-01 Robert Dewar <dewar@adacore.com> 2014-08-01 Robert Dewar <dewar@adacore.com>
* debug.adb: Document debug switch -gnatd.Z. * debug.adb: Document debug switch -gnatd.Z.
......
...@@ -313,7 +313,12 @@ package Atree is ...@@ -313,7 +313,12 @@ package Atree is
Warnings_Detected : Nat := 0; Warnings_Detected : Nat := 0;
-- Number of warnings detected. Initialized to zero at the start of -- Number of warnings detected. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above. -- compilation. Initialized for -gnatVa use, see comment above. This
-- count includes the count of style and info messages.
Info_Messages : Nat := 0;
-- Number of info messages generated. Info messages are neved treated as
-- errors (whether from use of the pragma, or the compiler switch -gnatwe).
Warnings_Treated_As_Errors : Nat := 0; Warnings_Treated_As_Errors : Nat := 0;
-- Number of warnings changed into errors as a result of matching a pattern -- Number of warnings changed into errors as a result of matching a pattern
......
...@@ -39,10 +39,10 @@ package Err_Vars is ...@@ -39,10 +39,10 @@ package Err_Vars is
-- from invalid values in such cases. -- from invalid values in such cases.
-- Note on error counts (Serious_Errors_Detected, Total_Errors_Detected, -- Note on error counts (Serious_Errors_Detected, Total_Errors_Detected,
-- Warnings_Detected). These counts might more logically appear in this -- Warnings_Detected, Info_Messages). These counts might more logically
-- unit, but we place them in atree.ads, because of licensing issues. We -- appear in this unit, but we place them instead in atree.ads, because of
-- need to be able to access these counts from units that have the more -- licensing issues. We need to be able to access these counts from units
-- general licensing conditions. -- that have the more general licensing conditions.
---------------------------------- ----------------------------------
-- Error Message Mode Variables -- -- Error Message Mode Variables --
......
...@@ -261,8 +261,12 @@ package body Errout is ...@@ -261,8 +261,12 @@ package body Errout is
M.Deleted := True; M.Deleted := True;
Warnings_Detected := Warnings_Detected - 1; Warnings_Detected := Warnings_Detected - 1;
if M.Info then
Info_Messages := Info_Messages - 1;
end if;
if M.Warn_Err then if M.Warn_Err then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1; Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
end if; end if;
end if; end if;
...@@ -1132,6 +1136,10 @@ package body Errout is ...@@ -1132,6 +1136,10 @@ package body Errout is
if Errors.Table (Cur_Msg).Warn or else Errors.Table (Cur_Msg).Style then if Errors.Table (Cur_Msg).Warn or else Errors.Table (Cur_Msg).Style then
Warnings_Detected := Warnings_Detected + 1; Warnings_Detected := Warnings_Detected + 1;
if Errors.Table (Cur_Msg).Info then
Info_Messages := Info_Messages + 1;
end if;
else else
Total_Errors_Detected := Total_Errors_Detected + 1; Total_Errors_Detected := Total_Errors_Detected + 1;
...@@ -1340,8 +1348,12 @@ package body Errout is ...@@ -1340,8 +1348,12 @@ package body Errout is
Errors.Table (E).Deleted := True; Errors.Table (E).Deleted := True;
Warnings_Detected := Warnings_Detected - 1; Warnings_Detected := Warnings_Detected - 1;
if Errors.Table (E).Info then
Info_Messages := Info_Messages - 1;
end if;
if Errors.Table (E).Warn_Err then if Errors.Table (E).Warn_Err then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1; Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
end if; end if;
end if; end if;
end Delete_Warning; end Delete_Warning;
...@@ -1566,6 +1578,7 @@ package body Errout is ...@@ -1566,6 +1578,7 @@ package body Errout is
Total_Errors_Detected := 0; Total_Errors_Detected := 0;
Warnings_Treated_As_Errors := 0; Warnings_Treated_As_Errors := 0;
Warnings_Detected := 0; Warnings_Detected := 0;
Info_Messages := 0;
Warnings_As_Errors_Count := 0; Warnings_As_Errors_Count := 0;
Cur_Msg := No_Error_Msg; Cur_Msg := No_Error_Msg;
List_Pragmas.Init; List_Pragmas.Init;
...@@ -1656,8 +1669,7 @@ package body Errout is ...@@ -1656,8 +1669,7 @@ package body Errout is
begin begin
-- Extra blank line if error messages or source listing were output -- Extra blank line if error messages or source listing were output
if Total_Errors_Detected + Warnings_Detected > 0 if Total_Errors_Detected + Warnings_Detected > 0 or else Full_List
or else Full_List
then then
Write_Eol; Write_Eol;
end if; end if;
...@@ -1666,8 +1678,8 @@ package body Errout is ...@@ -1666,8 +1678,8 @@ package body Errout is
-- This normally goes to Standard_Output. The exception is when brief -- This normally goes to Standard_Output. The exception is when brief
-- mode is not set, verbose mode (or full list mode) is set, and -- mode is not set, verbose mode (or full list mode) is set, and
-- there are errors. In this case we send the message to standard -- there are errors. In this case we send the message to standard
-- error to make sure that *something* appears on standard error in -- error to make sure that *something* appears on standard error
-- an error situation. -- in an error situation.
if Total_Errors_Detected + Warnings_Detected /= 0 if Total_Errors_Detected + Warnings_Detected /= 0
and then not Brief_Output and then not Brief_Output
...@@ -1702,12 +1714,12 @@ package body Errout is ...@@ -1702,12 +1714,12 @@ package body Errout is
Write_Str (" errors"); Write_Str (" errors");
end if; end if;
if Warnings_Detected /= 0 then if Warnings_Detected - Info_Messages /= 0 then
Write_Str (", "); Write_Str (", ");
Write_Int (Warnings_Detected); Write_Int (Warnings_Detected);
Write_Str (" warning"); Write_Str (" warning");
if Warnings_Detected /= 1 then if Warnings_Detected - Info_Messages /= 1 then
Write_Char ('s'); Write_Char ('s');
end if; end if;
...@@ -1727,6 +1739,16 @@ package body Errout is ...@@ -1727,6 +1739,16 @@ package body Errout is
end if; end if;
end if; end if;
if Info_Messages /= 0 then
Write_Str (", ");
Write_Int (Info_Messages);
Write_Str (" info message");
if Info_Messages > 1 then
Write_Char ('s');
end if;
end if;
Write_Eol; Write_Eol;
Set_Standard_Output; Set_Standard_Output;
end Write_Error_Summary; end Write_Error_Summary;
...@@ -2027,8 +2049,9 @@ package body Errout is ...@@ -2027,8 +2049,9 @@ package body Errout is
Write_Max_Errors; Write_Max_Errors;
if Warning_Mode = Treat_As_Error then if Warning_Mode = Treat_As_Error then
Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected; Total_Errors_Detected :=
Warnings_Detected := 0; Total_Errors_Detected + Warnings_Detected - Info_Messages;
Warnings_Detected := Info_Messages;
end if; end if;
end Output_Messages; end Output_Messages;
...@@ -2200,6 +2223,11 @@ package body Errout is ...@@ -2200,6 +2223,11 @@ package body Errout is
and then not Errors.Table (E).Uncond and then not Errors.Table (E).Uncond
then then
Warnings_Detected := Warnings_Detected - 1; Warnings_Detected := Warnings_Detected - 1;
if Errors.Table (E).Info then
Info_Messages := Info_Messages - 1;
end if;
return True; return True;
-- No removal required -- No removal required
......
...@@ -143,7 +143,7 @@ package body Erroutc is ...@@ -143,7 +143,7 @@ package body Erroutc is
if Errors.Table (D).Warn_Err then if Errors.Table (D).Warn_Err then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors :=
Warnings_Treated_As_Errors + 1; Warnings_Treated_As_Errors - 1;
end if; end if;
else else
...@@ -233,7 +233,7 @@ package body Erroutc is ...@@ -233,7 +233,7 @@ package body Erroutc is
function Compilation_Errors return Boolean is function Compilation_Errors return Boolean is
begin begin
return Total_Errors_Detected /= 0 return Total_Errors_Detected /= 0
or else (Warnings_Detected /= 0 or else (Warnings_Detected - Info_Messages /= 0
and then Warning_Mode = Treat_As_Error) and then Warning_Mode = Treat_As_Error)
or else Warnings_Treated_As_Errors /= 0; or else Warnings_Treated_As_Errors /= 0;
end Compilation_Errors; end Compilation_Errors;
......
...@@ -309,6 +309,10 @@ package body Errutil is ...@@ -309,6 +309,10 @@ package body Errutil is
then then
Warnings_Detected := Warnings_Detected + 1; Warnings_Detected := Warnings_Detected + 1;
if Errors.Table (Cur_Msg).Info then
Info_Messages := Info_Messages + 1;
end if;
else else
Total_Errors_Detected := Total_Errors_Detected + 1; Total_Errors_Detected := Total_Errors_Detected + 1;
...@@ -536,19 +540,19 @@ package body Errutil is ...@@ -536,19 +540,19 @@ package body Errutil is
Write_Str (" errors"); Write_Str (" errors");
end if; end if;
if Warnings_Detected /= 0 then if Warnings_Detected - Info_Messages /= 0 then
Write_Str (", "); Write_Str (", ");
Write_Int (Warnings_Detected); Write_Int (Warnings_Detected - Info_Messages);
Write_Str (" warning"); Write_Str (" warning");
if Warnings_Detected /= 1 then if Warnings_Detected - Info_Messages /= 1 then
Write_Char ('s'); Write_Char ('s');
end if; end if;
if Warning_Mode = Treat_As_Error then if Warning_Mode = Treat_As_Error then
Write_Str (" (treated as error"); Write_Str (" (treated as error");
if Warnings_Detected /= 1 then if Warnings_Detected - Info_Messages /= 1 then
Write_Char ('s'); Write_Char ('s');
end if; end if;
...@@ -575,8 +579,9 @@ package body Errutil is ...@@ -575,8 +579,9 @@ package body Errutil is
end if; end if;
if Warning_Mode = Treat_As_Error then if Warning_Mode = Treat_As_Error then
Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected; Total_Errors_Detected :=
Warnings_Detected := 0; Total_Errors_Detected + Warnings_Detected - Info_Messages;
Warnings_Detected := Info_Messages;
end if; end if;
-- Prevent displaying the same messages again in the future -- Prevent displaying the same messages again in the future
...@@ -596,6 +601,7 @@ package body Errutil is ...@@ -596,6 +601,7 @@ package body Errutil is
Serious_Errors_Detected := 0; Serious_Errors_Detected := 0;
Total_Errors_Detected := 0; Total_Errors_Detected := 0;
Warnings_Detected := 0; Warnings_Detected := 0;
Info_Messages := 0;
Cur_Msg := No_Error_Msg; Cur_Msg := No_Error_Msg;
-- Initialize warnings table, if all warnings are suppressed, supply -- Initialize warnings table, if all warnings are suppressed, supply
......
...@@ -4995,6 +4995,8 @@ treated as errors. ...@@ -4995,6 +4995,8 @@ treated as errors.
The warning string still appears, but the warning messages are counted The warning string still appears, but the warning messages are counted
as errors, and prevent the generation of an object file. Note that this as errors, and prevent the generation of an object file. Note that this
is the only -gnatw switch that affects the handling of style check messages. is the only -gnatw switch that affects the handling of style check messages.
Note also that this switch has no effect on info (information) messages, which
are not treated as errors if this switch is present.
@item -gnatw.e @item -gnatw.e
@emph{Activate every optional warning} @emph{Activate every optional warning}
......
...@@ -47,7 +47,6 @@ with Snames; use Snames; ...@@ -47,7 +47,6 @@ with Snames; use Snames;
with Stringt; with Stringt;
with Switch; use Switch; with Switch; use Switch;
with Table; with Table;
with Targparm; use Targparm;
with Tempdir; with Tempdir;
with Types; use Types; with Types; use Types;
...@@ -58,6 +57,9 @@ with Ada.Text_IO; use Ada.Text_IO; ...@@ -58,6 +57,9 @@ with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure GNATCmd is procedure GNATCmd is
AAMP_On_Target : Boolean := False;
Normal_Exit : exception; Normal_Exit : exception;
-- Raise this exception for normal program termination -- Raise this exception for normal program termination
...@@ -1183,7 +1185,7 @@ procedure GNATCmd is ...@@ -1183,7 +1185,7 @@ procedure GNATCmd is
-- No usage for Sync -- No usage for Sync
if C /= Sync then if C /= Sync then
if Targparm.AAMP_On_Target then if AAMP_On_Target then
Put ("gnaampcmd "); Put ("gnaampcmd ");
else else
Put ("gnat "); Put ("gnat ");
...@@ -1584,12 +1586,11 @@ begin ...@@ -1584,12 +1586,11 @@ begin
Rules_Switches.Init; Rules_Switches.Init;
Rules_Switches.Set_Last (0); Rules_Switches.Set_Last (0);
-- Set AAMP_On_Target from the command name, for testing in -- Set AAMP_On_Target from command name, for testing in Osint.Program_Name
-- Osint.Program_Name to handle the mapping of GNAAMP tool names. We don't -- to handle the mapping of GNAAMP tool names. We don't extract it from
-- extract it from system.ads, has there may be no default runtime. -- system.ads, as there may be no default runtime.
Find_Program_Name; AAMP_On_Target := To_Lower (Command_Name) = "gnaampcmd";
AAMP_On_Target := Name_Buffer (1 .. Name_Len) = "gnaampcmd";
-- Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE, -- Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
-- so that the spawned tool may know the way the GNAT driver was invoked. -- so that the spawned tool may know the way the GNAT driver was invoked.
......
...@@ -2523,8 +2523,10 @@ package body Sem_Ch5 is ...@@ -2523,8 +2523,10 @@ package body Sem_Ch5 is
or else (Is_Entity_Name (DS_Copy) or else (Is_Entity_Name (DS_Copy)
and then not Is_Type (Entity (DS_Copy))) and then not Is_Type (Entity (DS_Copy)))
or else (Nkind (DS_Copy) = N_Attribute_Reference or else (Nkind (DS_Copy) = N_Attribute_Reference
and then Attribute_Name (DS_Copy) = Name_Old) and then Nam_In (Attribute_Name (DS_Copy),
Name_Old, Name_Loop_Entry))
or else Nkind (DS_Copy) = N_Unchecked_Type_Conversion or else Nkind (DS_Copy) = N_Unchecked_Type_Conversion
or else Has_Aspect (Etype (DS_Copy), Aspect_Iterable)
then then
-- This is an iterator specification. Rewrite it as such and -- This is an iterator specification. Rewrite it as such and
-- analyze it to capture function calls that may require -- analyze it to capture function calls that may require
......
...@@ -20715,6 +20715,8 @@ package body Sem_Prag is ...@@ -20715,6 +20715,8 @@ package body Sem_Prag is
-- Warning_As_Error -- -- Warning_As_Error --
---------------------- ----------------------
-- pragma Warning_As_Error (static_string_EXPRESSION);
when Pragma_Warning_As_Error => when Pragma_Warning_As_Error =>
GNAT_Pragma; GNAT_Pragma;
Check_Arg_Count (1); Check_Arg_Count (1);
......
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