comparison gcc/ada/errout.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- E R R O U T -- 5 -- E R R O U T --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
859 else 859 else
860 Set_Fatal_Error (U, Error_Detected); 860 Set_Fatal_Error (U, Error_Detected);
861 end if; 861 end if;
862 end; 862 end;
863 end if; 863 end if;
864
865 -- Disable warnings on unused use clauses and the like. Otherwise, an
866 -- error might hide a reference to an entity in a used package, so
867 -- after fixing the error, the use clause no longer looks like it was
868 -- unused.
869
870 Check_Unreferenced := False;
871 Check_Unreferenced_Formals := False;
864 end Handle_Serious_Error; 872 end Handle_Serious_Error;
865 873
866 -- Start of processing for Error_Msg_Internal 874 -- Start of processing for Error_Msg_Internal
867 875
868 begin 876 begin
1098 Cur_Msg := Errors.Last; 1106 Cur_Msg := Errors.Last;
1099 1107
1100 -- Test if warning to be treated as error 1108 -- Test if warning to be treated as error
1101 1109
1102 Warn_Err := 1110 Warn_Err :=
1103 Is_Warning_Msg 1111 (Is_Warning_Msg or Is_Style_Msg)
1104 and then (Warning_Treated_As_Error (Msg_Buffer (1 .. Msglen)) 1112 and then (Warning_Treated_As_Error (Msg_Buffer (1 .. Msglen))
1105 or else 1113 or else
1106 Warning_Treated_As_Error (Get_Warning_Tag (Cur_Msg))); 1114 Warning_Treated_As_Error (Get_Warning_Tag (Cur_Msg)));
1107 1115
1108 -- Propagate Warn_Err to this message and preceding continuations 1116 -- Propagate Warn_Err to this message and preceding continuations
1707 -- Initialize warnings tables 1715 -- Initialize warnings tables
1708 1716
1709 Warnings.Init; 1717 Warnings.Init;
1710 Specific_Warnings.Init; 1718 Specific_Warnings.Init;
1711 end Initialize; 1719 end Initialize;
1720
1721 -------------------------------
1722 -- Is_Size_Too_Small_Message --
1723 -------------------------------
1724
1725 function Is_Size_Too_Small_Message (S : String) return Boolean is
1726 Size_For : constant String := "size for";
1727 pragma Assert (Size_Too_Small_Message (1 .. Size_For'Last) = Size_For);
1728 -- Assert that Size_Too_Small_Message starts with Size_For
1729 begin
1730 return S'Length >= Size_For'Length
1731 and then S (S'First .. S'First + Size_For'Length - 1) = Size_For;
1732 -- True if S starts with Size_For
1733 end Is_Size_Too_Small_Message;
1712 1734
1713 ----------------- 1735 -----------------
1714 -- No_Warnings -- 1736 -- No_Warnings --
1715 ----------------- 1737 -----------------
1716 1738
3257 if Debug_Flag_OO then 3279 if Debug_Flag_OO then
3258 return False; 3280 return False;
3259 3281
3260 -- Processing for "Size too small" messages 3282 -- Processing for "Size too small" messages
3261 3283
3262 elsif Msg = "size for& too small, minimum allowed is ^" then 3284 elsif Is_Size_Too_Small_Message (Msg) then
3263 3285
3264 -- Suppress "size too small" errors in CodePeer mode, since code may 3286 -- Suppress "size too small" errors in CodePeer mode, since code may
3265 -- be analyzed in a different configuration than the one used for 3287 -- be analyzed in a different configuration than the one used for
3266 -- compilation. Even when the configurations match, this message 3288 -- compilation. Even when the configurations match, this message
3267 -- may be issued on correct code, because pragma Pack is ignored 3289 -- may be issued on correct code, because pragma Pack is ignored