i386: Allow all register_operand SUBREGs in x86_ternlog_idx.
[official-gcc.git] / gcc / ada / warnsw.adb
blob4c6934df9508bb257d1f0edd4d472c211ecc43e7
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- W A R N S W --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2024, Free Software Foundation, Inc. --
10 -- --
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- --
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- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 with Opt; use Opt;
27 with Output; use Output;
29 with System.Case_Util; use System.Case_Util;
31 package body Warnsw is
33 subtype Lowercase is Character range 'a' .. 'z';
34 -- Warning-enable switches are lowercase letters
36 Switch_To_Flag_Mapping : constant array (Warning_Family, Lowercase) of
37 -- Mapping from the letter after "-gnatw", "-gnatw." or "-gnatw_" to
38 -- the corresponding flag for the warning it enables. Special_Case means
39 -- Set_Warning_Switch must do something special, as opposed to simply
40 -- setting the corresponding flag. No_Such_Warning means the letter
41 -- is not a defined warning switch, which is an error.
42 X.Opt_Warnings_Enum :=
43 (Plain =>
44 ('a' | 'e' | 'n' | 's' | 'u' | 'y' => Special_Case,
46 'b' => X.Warn_On_Bad_Fixed_Value,
47 'c' => X.Constant_Condition_Warnings,
48 'd' => X.Warn_On_Dereference,
49 'f' => X.Check_Unreferenced_Formals,
50 'g' => X.Warn_On_Unrecognized_Pragma,
51 'h' => X.Warn_On_Hiding,
52 'i' => X.Implementation_Unit_Warnings,
53 'j' => X.Warn_On_Obsolescent_Feature,
54 'k' => X.Warn_On_Constant,
55 'l' => X.Elab_Warnings,
56 'm' => X.Warn_On_Modified_Unread,
57 'o' => X.Address_Clause_Overlay_Warnings,
58 'p' => X.Ineffective_Inline_Warnings,
59 'q' => X.Warn_On_Questionable_Missing_Parens,
60 'r' => X.Warn_On_Redundant_Constructs,
61 't' => X.Warn_On_Deleted_Code,
62 'v' => X.Warn_On_No_Value_Assigned,
63 'w' => X.Warn_On_Assumed_Low_Bound,
64 'x' => X.Warn_On_Export_Import,
65 'z' => X.Warn_On_Unchecked_Conversion),
67 '.' =>
68 ('e' | 'g' | 'x' => Special_Case,
70 'a' => X.Warn_On_Assertion_Failure,
71 'b' => X.Warn_On_Biased_Representation,
72 'c' => X.Warn_On_Unrepped_Components,
73 'd' => X.Warning_Doc_Switch,
74 'f' => X.Warn_On_Elab_Access,
75 'h' => X.Warn_On_Record_Holes,
76 'i' => X.Warn_On_Overlap,
77 'j' => X.Warn_On_Late_Primitives,
78 'k' => X.Warn_On_Standard_Redefinition,
79 'l' => X.List_Inherited_Aspects,
80 'm' => X.Warn_On_Suspicious_Modulus_Value,
81 'n' => X.Warn_On_Atomic_Synchronization,
82 'o' => X.Warn_On_All_Unread_Out_Parameters,
83 'p' => X.Warn_On_Parameter_Order,
84 'q' => X.Warn_On_Questionable_Layout,
85 'r' => X.Warn_On_Object_Renames_Function,
86 's' => X.Warn_On_Overridden_Size,
87 't' => X.Warn_On_Suspicious_Contract,
88 'u' => X.Warn_On_Unordered_Enumeration_Type,
89 'v' => X.Warn_On_Reverse_Bit_Order,
90 'w' => X.Warn_On_Warnings_Off,
91 'y' => X.List_Body_Required_Info,
92 'z' => X.Warn_On_Size_Alignment),
94 '_' =>
95 ('b' | 'd' | 'e' | 'f' | 'g' | 'h' | 'i' | 'j' | 'k' | 'l' | 'm' |
96 'n' | 'o' | 't' | 'u' | 'v' | 'w' | 'x' | 'y' | 'z' =>
97 No_Such_Warning,
99 'a' => X.Warn_On_Anonymous_Allocators,
100 'c' => X.Warn_On_Unknown_Compile_Time_Warning,
101 'p' => X.Warn_On_Pedantic_Checks,
102 'q' => X.Warn_On_Ignored_Equality,
103 'r' => X.Warn_On_Component_Order,
104 's' => X.Warn_On_Ineffective_Predicate_Test));
106 All_Warnings : constant Warnings_State := -- Warnings set by -gnatw.e
107 (X.Elab_Info_Messages |
108 X.Warning_Doc_Switch |
109 X.Warn_On_Ada_2022_Compatibility |
110 X.Warn_On_Elab_Access |
111 X.No_Warn_On_Non_Local_Exception => False,
112 others => True);
113 -- Warning_Doc_Switch is not really a warning to be enabled, but controls
114 -- the form of warnings printed. No_Warn_On_Non_Local_Exception is handled
115 -- specially (see Warn_On_Non_Local_Exception). The others are not part of
116 -- -gnatw.e for historical reasons.
118 WA_Warnings : constant Warnings_State := -- Warnings set by -gnatwa
119 (X.Check_Unreferenced | -- -gnatwf/-gnatwu
120 X.Check_Unreferenced_Formals | -- -gnatwf/-gnatwu
121 X.Check_Withs | -- -gnatwu
122 X.Constant_Condition_Warnings | -- -gnatwc
123 X.Implementation_Unit_Warnings | -- -gnatwi
124 X.Ineffective_Inline_Warnings | -- -gnatwp
125 X.Warn_On_Ada_2005_Compatibility | -- -gnatwy
126 X.Warn_On_Ada_2012_Compatibility | -- -gnatwy
127 X.Warn_On_Anonymous_Allocators | -- -gnatw_a
128 X.Warn_On_Assertion_Failure | -- -gnatw.a
129 X.Warn_On_Assumed_Low_Bound | -- -gnatww
130 X.Warn_On_Bad_Fixed_Value | -- -gnatwb
131 X.Warn_On_Biased_Representation | -- -gnatw.b
132 X.Warn_On_Constant | -- -gnatwk
133 X.Warn_On_Export_Import | -- -gnatwx
134 X.Warn_On_Ineffective_Predicate_Test | -- -gnatw_s
135 X.Warn_On_Late_Primitives | -- -gnatw.j
136 X.Warn_On_Modified_Unread | -- -gnatwm
137 X.Warn_On_No_Value_Assigned | -- -gnatwv
138 X.Warn_On_Non_Local_Exception | -- -gnatw.x
139 X.Warn_On_Object_Renames_Function | -- -gnatw.r
140 X.Warn_On_Obsolescent_Feature | -- -gnatwj
141 X.Warn_On_Overlap | -- -gnatw.i
142 X.Warn_On_Parameter_Order | -- -gnatw.p
143 X.Warn_On_Questionable_Missing_Parens | -- -gnatwq
144 X.Warn_On_Redundant_Constructs | -- -gnatwr
145 X.Warn_On_Reverse_Bit_Order | -- -gnatw.v
146 X.Warn_On_Size_Alignment | -- -gnatw.z
147 X.Warn_On_Suspicious_Contract | -- -gnatw.t
148 X.Warn_On_Suspicious_Modulus_Value | -- -gnatw.m
149 X.Warn_On_Unchecked_Conversion | -- -gnatwz
150 X.Warn_On_Unrecognized_Pragma | -- -gnatwg
151 X.Warn_On_Unrepped_Components => -- -gnatw.c
152 True,
154 others => False);
156 ----------------------
157 -- Restore_Warnings --
158 ----------------------
160 procedure Restore_Warnings (W : Warnings_State) is
161 begin
162 Warning_Flags := W;
163 end Restore_Warnings;
165 -------------------
166 -- Save_Warnings --
167 -------------------
169 function Save_Warnings return Warnings_State is
170 begin
171 return Warning_Flags;
172 end Save_Warnings;
174 ----------------------------
175 -- Set_GNAT_Mode_Warnings --
176 ----------------------------
178 procedure Set_GNAT_Mode_Warnings is
179 begin
180 -- Set -gnatwa warnings and no others
182 Warning_Flags := (Warning_Flags and not All_Warnings) or WA_Warnings;
184 -- These warnings are added to the -gnatwa set
186 Address_Clause_Overlay_Warnings := True;
187 Warn_On_Questionable_Layout := True;
188 Warn_On_Overridden_Size := True;
190 -- These warnings are removed from the -gnatwa set
192 Implementation_Unit_Warnings := False;
193 Warn_On_Non_Local_Exception := False;
194 No_Warn_On_Non_Local_Exception := True;
195 Warn_On_Reverse_Bit_Order := False;
196 Warn_On_Size_Alignment := False;
197 Warn_On_Unrepped_Components := False;
198 end Set_GNAT_Mode_Warnings;
200 ------------------------
201 -- Set_Warning_Switch --
202 ------------------------
204 function Set_Warning_Switch
205 (Family : Warning_Family; C : Character) return Boolean
207 L : constant Character := To_Lower (C);
208 begin
209 -- Error case
211 if L not in Lowercase
212 or else Switch_To_Flag_Mapping (Family, L) = No_Such_Warning
213 then
214 if Ignore_Unrecognized_VWY_Switches then
215 declare
216 Family_Switch : constant String :=
217 (case Family is
218 when Plain => "", when '.' => ".", when '_' => "_");
219 begin
220 Write_Line
221 ("unrecognized switch -gnatw" & Family_Switch & C &
222 " ignored");
223 end;
224 return True;
225 else
226 return False;
227 end if;
228 end if;
230 -- Special cases that don't fall into the normal pattern below
232 if Switch_To_Flag_Mapping (Family, L) = Special_Case then
233 case Family is
234 when Plain =>
235 case C is
236 when 'a' =>
237 -- "or" in the -gnatwa flags, possibly leaving others set
238 Warning_Flags := Warning_Flags or WA_Warnings;
240 when 'A' =>
241 -- Turn off the All_Warnings flags, except that
242 -- No_Warn_On_Non_Local_Exception is a special case.
243 Warning_Flags := Warning_Flags and not All_Warnings;
244 No_Warn_On_Non_Local_Exception := True;
246 when 'e' =>
247 Warning_Mode := Treat_As_Error;
249 when 'E' =>
250 Warning_Mode := Treat_Run_Time_Warnings_As_Errors;
252 when 'n' =>
253 Warning_Mode := Normal;
255 when 's' =>
256 Warning_Mode := Suppress;
258 when 'u' =>
259 Check_Unreferenced := True;
260 Check_Withs := True;
261 Check_Unreferenced_Formals := True;
263 when 'U' =>
264 Check_Unreferenced := False;
265 Check_Withs := False;
266 Check_Unreferenced_Formals := False;
268 when 'y' =>
269 Warn_On_Ada_2005_Compatibility := True;
270 Warn_On_Ada_2012_Compatibility := True;
272 when 'Y' =>
273 Warn_On_Ada_2005_Compatibility := False;
274 Warn_On_Ada_2012_Compatibility := False;
276 when others => raise Program_Error;
277 end case;
279 when '.' =>
280 case C is
281 when 'e' =>
282 -- "or" in the All_Warnings flags
283 Warning_Flags := Warning_Flags or All_Warnings;
284 when 'g' =>
285 Set_GNAT_Mode_Warnings;
287 when 'x' =>
288 Warn_On_Non_Local_Exception := True;
290 when 'X' =>
291 Warn_On_Non_Local_Exception := False;
292 No_Warn_On_Non_Local_Exception := True;
294 when others => raise Program_Error;
295 end case;
297 when '_' =>
298 raise Program_Error;
299 end case;
301 return True;
302 end if;
304 -- Normal pattern (lower case enables the warning, upper case disables
305 -- the warning).
307 if C in Lowercase then
308 Warning_Flags (Switch_To_Flag_Mapping (Family, C)) := True;
309 elsif L in Lowercase then
310 Warning_Flags (Switch_To_Flag_Mapping (Family, L)) := False;
311 else
312 raise Program_Error;
313 end if;
315 return True;
316 end Set_Warning_Switch;
318 end Warnsw;