diff options
Diffstat (limited to 'gcc/ada/errout.adb')
| -rw-r--r-- | gcc/ada/errout.adb | 172 |
1 files changed, 128 insertions, 44 deletions
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index a08c6df..1063d7d 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2020, 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- -- @@ -311,6 +311,18 @@ package body Errout is end Error_Msg; procedure Error_Msg + (Msg : String; + Flag_Location : Source_Ptr; + Is_Compile_Time_Pragma : Boolean) + is + Save_Is_Compile_Time_Msg : constant Boolean := Is_Compile_Time_Msg; + begin + Is_Compile_Time_Msg := Is_Compile_Time_Pragma; + Error_Msg (Msg, Flag_Location, Current_Node); + Is_Compile_Time_Msg := Save_Is_Compile_Time_Msg; + end Error_Msg; + + procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr; N : Node_Id) @@ -618,6 +630,24 @@ package body Errout is end if; end Error_Msg_Ada_2012_Feature; + -------------------------------- + -- Error_Msg_Ada_2020_Feature -- + -------------------------------- + + procedure Error_Msg_Ada_2020_Feature (Feature : String; Loc : Source_Ptr) is + begin + if Ada_Version < Ada_2020 then + Error_Msg (Feature & " is an Ada 2020 feature", Loc); + + if No (Ada_Version_Pragma) then + Error_Msg ("\unit must be compiled with -gnat2020 switch", Loc); + else + Error_Msg_Sloc := Sloc (Ada_Version_Pragma); + Error_Msg ("\incompatible with Ada version set#", Loc); + end if; + end if; + end Error_Msg_Ada_2020_Feature; + ------------------ -- Error_Msg_AP -- ------------------ @@ -1084,25 +1114,26 @@ package body Errout is -- Here we build a new error object Errors.Append - ((Text => new String'(Msg_Buffer (1 .. Msglen)), - Next => No_Error_Msg, - Prev => No_Error_Msg, - Sptr => Sptr, - Optr => Optr, - Sfile => Get_Source_File_Index (Sptr), - Line => Get_Physical_Line_Number (Sptr), - Col => Get_Column_Number (Sptr), - Warn => Is_Warning_Msg, - Info => Is_Info_Msg, - Check => Is_Check_Msg, - Warn_Err => False, -- reset below - Warn_Chr => Warning_Msg_Char, - Style => Is_Style_Msg, - Serious => Is_Serious_Error, - Uncond => Is_Unconditional_Msg, - Msg_Cont => Continuation, - Deleted => False, - Node => Node)); + ((Text => new String'(Msg_Buffer (1 .. Msglen)), + Next => No_Error_Msg, + Prev => No_Error_Msg, + Sptr => Sptr, + Optr => Optr, + Sfile => Get_Source_File_Index (Sptr), + Line => Get_Physical_Line_Number (Sptr), + Col => Get_Column_Number (Sptr), + Compile_Time_Pragma => Is_Compile_Time_Msg, + Warn => Is_Warning_Msg, + Info => Is_Info_Msg, + Check => Is_Check_Msg, + Warn_Err => False, -- reset below + Warn_Chr => Warning_Msg_Char, + Style => Is_Style_Msg, + Serious => Is_Serious_Error, + Uncond => Is_Unconditional_Msg, + Msg_Cont => Continuation, + Deleted => False, + Node => Node)); Cur_Msg := Errors.Last; -- Test if warning to be treated as error @@ -1857,30 +1888,77 @@ package body Errout is Write_Str (" errors"); end if; - if Warnings_Detected - Warning_Info_Messages /= 0 then - Write_Str (", "); - Write_Int (Warnings_Detected); - Write_Str (" warning"); + -- We now need to output warnings. When using -gnatwe, all warnings + -- should be treated as errors, except for warnings originating from + -- the use of the Compile_Time_Warning pragma. Another situation + -- where a warning might be treated as an error is when the source + -- code contains a Warning_As_Error pragma. + -- When warnings are treated as errors, we still log them as + -- warnings, but we add a message denoting how many of these warnings + -- are also errors. - if Warnings_Detected - Warning_Info_Messages /= 1 then - Write_Char ('s'); - end if; + declare + Warnings_Count : constant Int := + Warnings_Detected - Warning_Info_Messages; + + Compile_Time_Warnings : Int; + -- Number of warnings that come from a Compile_Time_Warning + -- pragma. - if Warning_Mode = Treat_As_Error then - Write_Str (" (treated as error"); + Non_Compile_Time_Warnings : Int; + -- Number of warnings that do not come from a Compile_Time_Warning + -- pragmas. - if Warnings_Detected /= 1 then + begin + if Warnings_Count > 0 then + Write_Str (", "); + Write_Int (Warnings_Count); + Write_Str (" warning"); + + if Warnings_Count > 1 then Write_Char ('s'); end if; - Write_Char (')'); + Compile_Time_Warnings := Count_Compile_Time_Pragma_Warnings; + Non_Compile_Time_Warnings := + Warnings_Count - Compile_Time_Warnings; + + if Warning_Mode = Treat_As_Error + and then Non_Compile_Time_Warnings > 0 + then + Write_Str (" ("); + + if Compile_Time_Warnings > 0 then + Write_Int (Non_Compile_Time_Warnings); + Write_Str (" "); + end if; + + Write_Str ("treated as error"); + + if Non_Compile_Time_Warnings > 1 then + Write_Char ('s'); + end if; + + Write_Char (')'); + + elsif Warnings_Treated_As_Errors > 0 then + Write_Str (" ("); - elsif Warnings_Treated_As_Errors /= 0 then - Write_Str (" ("); - Write_Int (Warnings_Treated_As_Errors); - Write_Str (" treated as errors)"); + if Warnings_Treated_As_Errors /= Warnings_Count then + Write_Int (Warnings_Treated_As_Errors); + Write_Str (" "); + end if; + + Write_Str ("treated as error"); + + if Warnings_Treated_As_Errors > 1 then + Write_Str ("s"); + end if; + + Write_Str (")"); + end if; end if; - end if; + end; if Warning_Info_Messages + Report_Info_Messages /= 0 then Write_Str (", "); @@ -2195,9 +2273,15 @@ package body Errout is -- must not be treated as errors when -gnatwe is in effect. if Warning_Mode = Treat_As_Error then - Total_Errors_Detected := - Total_Errors_Detected + Warnings_Detected - Warning_Info_Messages; - Warnings_Detected := Warning_Info_Messages; + declare + Compile_Time_Pragma_Warnings : constant Int := + Count_Compile_Time_Pragma_Warnings; + begin + Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected + - Warning_Info_Messages - Compile_Time_Pragma_Warnings; + Warnings_Detected := + Warning_Info_Messages + Compile_Time_Pragma_Warnings; + end; end if; end Output_Messages; @@ -3227,11 +3311,11 @@ package body Errout is exit when Nkind (P) not in N_Subexpr; end loop; - if Nkind_In (P, N_Pragma_Argument_Association, - N_Component_Association, - N_Discriminant_Association, - N_Generic_Association, - N_Parameter_Association) + if Nkind (P) in N_Pragma_Argument_Association + | N_Component_Association + | N_Discriminant_Association + | N_Generic_Association + | N_Parameter_Association then Set_Error_Posted (Parent (P)); end if; |