| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- W A R N S W -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1999-2022, 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- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Opt; use Opt; |
| with Output; use Output; |
| |
| with System.Case_Util; use System.Case_Util; |
| |
| package body Warnsw is |
| |
| subtype Lowercase is Character range 'a' .. 'z'; |
| -- Warning-enable switches are lowercase letters |
| |
| Switch_To_Flag_Mapping : constant array (Warning_Family, Lowercase) of |
| -- Mapping from the letter after "-gnatw", "-gnatw." or "-gnatw_" to |
| -- the corresponding flag for the warning it enables. Special_Case means |
| -- Set_Warning_Switch must do something special, as opposed to simply |
| -- setting the corresponding flag. No_Such_Warning means the letter |
| -- is not a defined warning switch, which is an error. |
| X.Opt_Warnings_Enum := |
| (Plain => |
| ('a' | 'e' | 'n' | 's' | 'u' | 'y' => Special_Case, |
| |
| 'b' => X.Warn_On_Bad_Fixed_Value, |
| 'c' => X.Constant_Condition_Warnings, |
| 'd' => X.Warn_On_Dereference, |
| 'f' => X.Check_Unreferenced_Formals, |
| 'g' => X.Warn_On_Unrecognized_Pragma, |
| 'h' => X.Warn_On_Hiding, |
| 'i' => X.Implementation_Unit_Warnings, |
| 'j' => X.Warn_On_Obsolescent_Feature, |
| 'k' => X.Warn_On_Constant, |
| 'l' => X.Elab_Warnings, |
| 'm' => X.Warn_On_Modified_Unread, |
| 'o' => X.Address_Clause_Overlay_Warnings, |
| 'p' => X.Ineffective_Inline_Warnings, |
| 'q' => X.Warn_On_Questionable_Missing_Parens, |
| 'r' => X.Warn_On_Redundant_Constructs, |
| 't' => X.Warn_On_Deleted_Code, |
| 'v' => X.Warn_On_No_Value_Assigned, |
| 'w' => X.Warn_On_Assumed_Low_Bound, |
| 'x' => X.Warn_On_Export_Import, |
| 'z' => X.Warn_On_Unchecked_Conversion), |
| |
| '.' => |
| ('e' | 'g' | 'x' => Special_Case, |
| |
| 'a' => X.Warn_On_Assertion_Failure, |
| 'b' => X.Warn_On_Biased_Representation, |
| 'c' => X.Warn_On_Unrepped_Components, |
| 'd' => X.Warning_Doc_Switch, |
| 'f' => X.Warn_On_Elab_Access, |
| 'h' => X.Warn_On_Record_Holes, |
| 'i' => X.Warn_On_Overlap, |
| 'j' => X.Warn_On_Late_Primitives, |
| 'k' => X.Warn_On_Standard_Redefinition, |
| 'l' => X.List_Inherited_Aspects, |
| 'm' => X.Warn_On_Suspicious_Modulus_Value, |
| 'n' => X.Warn_On_Atomic_Synchronization, |
| 'o' => X.Warn_On_All_Unread_Out_Parameters, |
| 'p' => X.Warn_On_Parameter_Order, |
| 'q' => X.Warn_On_Questionable_Layout, |
| 'r' => X.Warn_On_Object_Renames_Function, |
| 's' => X.Warn_On_Overridden_Size, |
| 't' => X.Warn_On_Suspicious_Contract, |
| 'u' => X.Warn_On_Unordered_Enumeration_Type, |
| 'v' => X.Warn_On_Reverse_Bit_Order, |
| 'w' => X.Warn_On_Warnings_Off, |
| 'y' => X.List_Body_Required_Info, |
| 'z' => X.Warn_On_Size_Alignment), |
| |
| '_' => |
| ('b' | 'd' | 'e' | 'f' | 'g' | 'h' | 'i' | 'j' | 'k' | 'l' | 'm' | |
| 'n' | 'o' | 's' | 't' | 'u' | 'v' | 'w' | 'x' | 'y' | 'z' => |
| No_Such_Warning, |
| |
| 'a' => X.Warn_On_Anonymous_Allocators, |
| 'c' => X.Warn_On_Unknown_Compile_Time_Warning, |
| 'p' => X.Warn_On_Pedantic_Checks, |
| 'q' => X.Warn_On_Ignored_Equality, |
| 'r' => X.Warn_On_Component_Order)); |
| |
| All_Warnings : constant Warnings_State := -- Warnings set by -gnatw.e |
| (X.Elab_Info_Messages | |
| X.Warning_Doc_Switch | |
| X.Warn_On_Ada_2022_Compatibility | |
| X.Warn_On_Elab_Access | |
| X.No_Warn_On_Non_Local_Exception => False, |
| others => True); |
| -- Warning_Doc_Switch is not really a warning to be enabled, but controls |
| -- the form of warnings printed. No_Warn_On_Non_Local_Exception is handled |
| -- specially (see Warn_On_Non_Local_Exception). The others are not part of |
| -- -gnatw.e for historical reasons. |
| |
| WA_Warnings : constant Warnings_State := -- Warnings set by -gnatwa |
| (X.Check_Unreferenced | -- -gnatwf/-gnatwu |
| X.Check_Unreferenced_Formals | -- -gnatwf/-gnatwu |
| X.Check_Withs | -- -gnatwu |
| X.Constant_Condition_Warnings | -- -gnatwc |
| X.Implementation_Unit_Warnings | -- -gnatwi |
| X.Ineffective_Inline_Warnings | -- -gnatwp |
| X.Warn_On_Ada_2005_Compatibility | -- -gnatwy |
| X.Warn_On_Ada_2012_Compatibility | -- -gnatwy |
| X.Warn_On_Anonymous_Allocators | -- -gnatw_a |
| X.Warn_On_Assertion_Failure | -- -gnatw.a |
| X.Warn_On_Assumed_Low_Bound | -- -gnatww |
| X.Warn_On_Bad_Fixed_Value | -- -gnatwb |
| X.Warn_On_Biased_Representation | -- -gnatw.b |
| X.Warn_On_Constant | -- -gnatwk |
| X.Warn_On_Export_Import | -- -gnatwx |
| X.Warn_On_Late_Primitives | -- -gnatw.j |
| X.Warn_On_Modified_Unread | -- -gnatwm |
| X.Warn_On_No_Value_Assigned | -- -gnatwv |
| X.Warn_On_Non_Local_Exception | -- -gnatw.x |
| X.Warn_On_Object_Renames_Function | -- -gnatw.r |
| X.Warn_On_Obsolescent_Feature | -- -gnatwj |
| X.Warn_On_Overlap | -- -gnatw.i |
| X.Warn_On_Parameter_Order | -- -gnatw.p |
| X.Warn_On_Questionable_Missing_Parens | -- -gnatwq |
| X.Warn_On_Redundant_Constructs | -- -gnatwr |
| X.Warn_On_Reverse_Bit_Order | -- -gnatw.v |
| X.Warn_On_Size_Alignment | -- -gnatw.z |
| X.Warn_On_Suspicious_Contract | -- -gnatw.t |
| X.Warn_On_Suspicious_Modulus_Value | -- -gnatw.m |
| X.Warn_On_Unchecked_Conversion | -- -gnatwz |
| X.Warn_On_Unrecognized_Pragma | -- -gnatwg |
| X.Warn_On_Unrepped_Components => -- -gnatw.c |
| True, |
| |
| others => False); |
| |
| ---------------------- |
| -- Restore_Warnings -- |
| ---------------------- |
| |
| procedure Restore_Warnings (W : Warnings_State) is |
| begin |
| Warning_Flags := W; |
| end Restore_Warnings; |
| |
| ------------------- |
| -- Save_Warnings -- |
| ------------------- |
| |
| function Save_Warnings return Warnings_State is |
| begin |
| return Warning_Flags; |
| end Save_Warnings; |
| |
| ---------------------------- |
| -- Set_GNAT_Mode_Warnings -- |
| ---------------------------- |
| |
| procedure Set_GNAT_Mode_Warnings is |
| begin |
| -- Set -gnatwa warnings and no others |
| |
| Warning_Flags := (Warning_Flags and not All_Warnings) or WA_Warnings; |
| |
| -- These warnings are added to the -gnatwa set |
| |
| Address_Clause_Overlay_Warnings := True; |
| Warn_On_Questionable_Layout := True; |
| Warn_On_Overridden_Size := True; |
| |
| -- These warnings are removed from the -gnatwa set |
| |
| Implementation_Unit_Warnings := False; |
| Warn_On_Non_Local_Exception := False; |
| No_Warn_On_Non_Local_Exception := True; |
| Warn_On_Reverse_Bit_Order := False; |
| Warn_On_Size_Alignment := False; |
| Warn_On_Unrepped_Components := False; |
| end Set_GNAT_Mode_Warnings; |
| |
| ------------------------ |
| -- Set_Warning_Switch -- |
| ------------------------ |
| |
| function Set_Warning_Switch |
| (Family : Warning_Family; C : Character) return Boolean |
| is |
| L : constant Character := To_Lower (C); |
| begin |
| -- Error case |
| |
| if L not in Lowercase |
| or else Switch_To_Flag_Mapping (Family, L) = No_Such_Warning |
| then |
| if Ignore_Unrecognized_VWY_Switches then |
| declare |
| Family_Switch : constant String := |
| (case Family is |
| when Plain => "", when '.' => ".", when '_' => "_"); |
| begin |
| Write_Line |
| ("unrecognized switch -gnatw" & Family_Switch & C & |
| " ignored"); |
| end; |
| return True; |
| else |
| return False; |
| end if; |
| end if; |
| |
| -- Special cases that don't fall into the normal pattern below |
| |
| if Switch_To_Flag_Mapping (Family, L) = Special_Case then |
| case Family is |
| when Plain => |
| case C is |
| when 'a' => |
| -- "or" in the -gnatwa flags, possibly leaving others set |
| Warning_Flags := Warning_Flags or WA_Warnings; |
| |
| when 'A' => |
| -- Turn off the All_Warnings flags, except that |
| -- No_Warn_On_Non_Local_Exception is a special case. |
| Warning_Flags := Warning_Flags and not All_Warnings; |
| No_Warn_On_Non_Local_Exception := True; |
| |
| when 'e' => |
| Warning_Mode := Treat_As_Error; |
| |
| when 'E' => |
| Warning_Mode := Treat_Run_Time_Warnings_As_Errors; |
| |
| when 'n' => |
| Warning_Mode := Normal; |
| |
| when 's' => |
| Warning_Mode := Suppress; |
| |
| when 'u' => |
| Check_Unreferenced := True; |
| Check_Withs := True; |
| Check_Unreferenced_Formals := True; |
| |
| when 'U' => |
| Check_Unreferenced := False; |
| Check_Withs := False; |
| Check_Unreferenced_Formals := False; |
| |
| when 'y' => |
| Warn_On_Ada_2005_Compatibility := True; |
| Warn_On_Ada_2012_Compatibility := True; |
| |
| when 'Y' => |
| Warn_On_Ada_2005_Compatibility := False; |
| Warn_On_Ada_2012_Compatibility := False; |
| |
| when others => raise Program_Error; |
| end case; |
| |
| when '.' => |
| case C is |
| when 'e' => |
| -- "or" in the All_Warnings flags |
| Warning_Flags := Warning_Flags or All_Warnings; |
| when 'g' => |
| Set_GNAT_Mode_Warnings; |
| |
| when 'x' => |
| Warn_On_Non_Local_Exception := True; |
| |
| when 'X' => |
| Warn_On_Non_Local_Exception := False; |
| No_Warn_On_Non_Local_Exception := True; |
| |
| when others => raise Program_Error; |
| end case; |
| |
| when '_' => |
| raise Program_Error; |
| end case; |
| |
| return True; |
| end if; |
| |
| -- Normal pattern (lower case enables the warning, upper case disables |
| -- the warning). |
| |
| if C in Lowercase then |
| Warning_Flags (Switch_To_Flag_Mapping (Family, C)) := True; |
| elsif L in Lowercase then |
| Warning_Flags (Switch_To_Flag_Mapping (Family, L)) := False; |
| else |
| raise Program_Error; |
| end if; |
| |
| return True; |
| end Set_Warning_Switch; |
| |
| end Warnsw; |
