Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/erroutc.adb @ 145:1830386684a0
gcc-9.2.0
author | anatofuz |
---|---|
date | Thu, 13 Feb 2020 11:34:05 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line diff
--- a/gcc/ada/erroutc.adb Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/ada/erroutc.adb Thu Feb 13 11:34:05 2020 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- @@ -53,9 +53,15 @@ function Matches (S : String; P : String) return Boolean; -- Returns true if the String S patches the pattern P, which can contain - -- wild card chars (*). The entire pattern must match the entire string. + -- wildcard chars (*). The entire pattern must match the entire string. -- Case is ignored in the comparison (so X matches x). + function Sloc_In_Range (Loc, Start, Stop : Source_Ptr) return Boolean; + -- Return whether Loc is in the range Start .. Stop, taking instantiation + -- locations of Loc into account. This is useful for suppressing warnings + -- from generic instantiations by using pragma Warnings around generic + -- instances, as needed in GNATprove. + --------------- -- Add_Class -- --------------- @@ -618,155 +624,145 @@ Length : Nat; -- Maximum total length of lines - Text : constant String_Ptr := Errors.Table (E).Text; + E_Msg : Error_Msg_Object renames Errors.Table (E); + Text : constant String_Ptr := E_Msg.Text; Ptr : Natural; Split : Natural; Start : Natural; + Tag : constant String := Get_Warning_Tag (E); + Txt : String_Ptr; + Len : Natural; begin - declare - Tag : constant String := Get_Warning_Tag (E); - Txt : String_Ptr; - Len : Natural; - - begin - -- Postfix warning tag to message if needed + -- Postfix warning tag to message if needed - if Tag /= "" and then Warning_Doc_Switch then - if Include_Subprogram_In_Messages then - Txt := - new String' - (Subprogram_Name_Ptr (Errors.Table (E).Node) & - ": " & Text.all & ' ' & Tag); - else - Txt := new String'(Text.all & ' ' & Tag); - end if; - - elsif Include_Subprogram_In_Messages - and then (Errors.Table (E).Warn or else Errors.Table (E).Style) - then + if Tag /= "" and then Warning_Doc_Switch then + if Include_Subprogram_In_Messages then Txt := new String' - (Subprogram_Name_Ptr (Errors.Table (E).Node) & - ": " & Text.all); + (Subprogram_Name_Ptr (E_Msg.Node) & + ": " & Text.all & ' ' & Tag); else - Txt := Text; + Txt := new String'(Text.all & ' ' & Tag); end if; - -- Deal with warning case + elsif Include_Subprogram_In_Messages + and then (E_Msg.Warn or else E_Msg.Style) + then + Txt := + new String'(Subprogram_Name_Ptr (E_Msg.Node) & ": " & Text.all); + else + Txt := Text; + end if; - if Errors.Table (E).Warn or else Errors.Table (E).Info then + -- For info messages, prefix message with "info: " - -- For info messages, prefix message with "info: " + if E_Msg.Info then + Txt := new String'("info: " & Txt.all); + + -- Warning treated as error + + elsif E_Msg.Warn_Err then - if Errors.Table (E).Info then - Txt := new String'("info: " & Txt.all); + -- We prefix with "error:" rather than warning: and postfix + -- [warning-as-error] at the end. + + Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1; + Txt := new String'("error: " & Txt.all & " [warning-as-error]"); + + -- Normal warning, prefix with "warning: " - -- Warning treated as error + elsif E_Msg.Warn then + Txt := new String'("warning: " & Txt.all); + + -- No prefix needed for style message, "(style)" is there already - elsif Errors.Table (E).Warn_Err then + elsif E_Msg.Style then + null; + + -- No prefix needed for check message, severity is there already + + elsif E_Msg.Check then + null; - -- We prefix with "error:" rather than warning: and postfix - -- [warning-as-error] at the end. + -- All other cases, add "error: " if unique error tag set + + elsif Opt.Unique_Error_Tag then + Txt := new String'("error: " & Txt.all); + end if; - Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1; - Txt := new String'("error: " & Txt.all & " [warning-as-error]"); + -- Set error message line length and length of message + + if Error_Msg_Line_Length = 0 then + Length := Nat'Last; + else + Length := Error_Msg_Line_Length; + end if; - -- Normal case, prefix with "warning: " + Max := Integer (Length - Column + 1); + Len := Txt'Length; + + -- Here we have to split the message up into multiple lines + + Ptr := 1; + loop + -- Make sure we do not have ludicrously small line + + Max := Integer'Max (Max, 20); + + -- If remaining text fits, output it respecting LF and we are done - else - Txt := new String'("warning: " & Txt.all); - end if; + if Len - Ptr < Max then + for J in Ptr .. Len loop + if Txt (J) = ASCII.LF then + Write_Eol; + Write_Spaces (Offs); + else + Write_Char (Txt (J)); + end if; + end loop; - -- No prefix needed for style message, "(style)" is there already + return; + + -- Line does not fit - elsif Errors.Table (E).Style then - null; + else + Start := Ptr; + + -- First scan forward looking for a hard end of line - -- No prefix needed for check message, severity is there already + for Scan in Ptr .. Ptr + Max - 1 loop + if Txt (Scan) = ASCII.LF then + Split := Scan - 1; + Ptr := Scan + 1; + goto Continue; + end if; + end loop; - elsif Errors.Table (E).Check then - null; + -- Otherwise scan backwards looking for a space - -- All other cases, add "error: " if unique error tag set + for Scan in reverse Ptr .. Ptr + Max - 1 loop + if Txt (Scan) = ' ' then + Split := Scan - 1; + Ptr := Scan + 1; + goto Continue; + end if; + end loop; - elsif Opt.Unique_Error_Tag then - Txt := new String'("error: " & Txt.all); + -- If we fall through, no space, so split line arbitrarily + + Split := Ptr + Max - 1; + Ptr := Split + 1; end if; - -- Set error message line length and length of message - - if Error_Msg_Line_Length = 0 then - Length := Nat'Last; - else - Length := Error_Msg_Line_Length; + <<Continue>> + if Start <= Split then + Write_Line (Txt (Start .. Split)); + Write_Spaces (Offs); end if; Max := Integer (Length - Column + 1); - Len := Txt'Length; - - -- Here we have to split the message up into multiple lines - - Ptr := 1; - loop - -- Make sure we do not have ludicrously small line - - Max := Integer'Max (Max, 20); - - -- If remaining text fits, output it respecting LF and we are done - - if Len - Ptr < Max then - for J in Ptr .. Len loop - if Txt (J) = ASCII.LF then - Write_Eol; - Write_Spaces (Offs); - else - Write_Char (Txt (J)); - end if; - end loop; - - return; - - -- Line does not fit - - else - Start := Ptr; - - -- First scan forward looking for a hard end of line - - for Scan in Ptr .. Ptr + Max - 1 loop - if Txt (Scan) = ASCII.LF then - Split := Scan - 1; - Ptr := Scan + 1; - goto Continue; - end if; - end loop; - - -- Otherwise scan backwards looking for a space - - for Scan in reverse Ptr .. Ptr + Max - 1 loop - if Txt (Scan) = ' ' then - Split := Scan - 1; - Ptr := Scan + 1; - goto Continue; - end if; - end loop; - - -- If we fall through, no space, so split line arbitrarily - - Split := Ptr + Max - 1; - Ptr := Split + 1; - end if; - - <<Continue>> - if Start <= Split then - Write_Line (Txt (Start .. Split)); - Write_Spaces (Offs); - end if; - - Max := Integer (Length - Column + 1); - end loop; - end; + end loop; end Output_Msg_Text; --------------------- @@ -1588,6 +1584,25 @@ end if; end Set_Warnings_Mode_On; + ------------------- + -- Sloc_In_Range -- + ------------------- + + function Sloc_In_Range (Loc, Start, Stop : Source_Ptr) return Boolean is + Cur_Loc : Source_Ptr := Loc; + + begin + while Cur_Loc /= No_Location loop + if Start <= Cur_Loc and then Cur_Loc <= Stop then + return True; + end if; + + Cur_Loc := Instantiation_Location (Cur_Loc); + end loop; + + return False; + end Sloc_In_Range; + -------------------------------- -- Validate_Specific_Warnings -- -------------------------------- @@ -1652,7 +1667,7 @@ -- location is in range of a specific non-configuration pragma. if SWE.Config - or else (SWE.Start <= Loc and then Loc <= SWE.Stop) + or else Sloc_In_Range (Loc, SWE.Start, SWE.Stop) then if Matches (Msg.all, SWE.Msg.all) or else Matches (Tag, SWE.Msg.all) @@ -1691,8 +1706,8 @@ -- Loop through table of ON/OFF warnings for J in Warnings.First .. Warnings.Last loop - if Warnings.Table (J).Start <= Loc - and then Loc <= Warnings.Table (J).Stop + if Sloc_In_Range (Loc, Warnings.Table (J).Start, + Warnings.Table (J).Stop) then return Warnings.Table (J).Reason; end if;