gcc/ada/warnsw.adb

   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-2023, 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 ------------------------------------------------------------------------------
  25
  26 with Opt;      use Opt;
  27 with Output;   use Output;
  28
  29 with System.Case_Util; use System.Case_Util;
  30
  31 package body Warnsw is
  32
  33    subtype Lowercase is Character range 'a' .. 'z';
  34    --  Warning-enable switches are lowercase letters
  35
  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,
  45
  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),
  66
  67         '.' =>
  68          ('e' | 'g' | 'x' => Special_Case,
  69
  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),
  93
  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,
  98
  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));
 105
 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.
 117
 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,
 153
 154       others => False);
 155
 156    ----------------------
 157    -- Restore_Warnings --
 158    ----------------------
 159
 160    procedure Restore_Warnings (W : Warnings_State) is
 161    begin
 162       Warning_Flags := W;
 163    end Restore_Warnings;
 164
 165    -------------------
 166    -- Save_Warnings --
 167    -------------------
 168
 169    function Save_Warnings return Warnings_State is
 170    begin
 171       return Warning_Flags;
 172    end Save_Warnings;
 173
 174    ----------------------------
 175    -- Set_GNAT_Mode_Warnings --
 176    ----------------------------
 177
 178    procedure Set_GNAT_Mode_Warnings is
 179    begin
 180       --  Set -gnatwa warnings and no others
 181
 182       Warning_Flags := (Warning_Flags and not All_Warnings) or WA_Warnings;
 183
 184       --  These warnings are added to the -gnatwa set
 185
 186       Address_Clause_Overlay_Warnings     := True;
 187       Warn_On_Questionable_Layout         := True;
 188       Warn_On_Overridden_Size             := True;
 189
 190       --  These warnings are removed from the -gnatwa set
 191
 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;
 199
 200    ------------------------
 201    -- Set_Warning_Switch --
 202    ------------------------
 203
 204    function Set_Warning_Switch
 205      (Family : Warning_Family; C : Character) return Boolean
 206    is
 207       L : constant Character := To_Lower (C);
 208    begin
 209       --  Error case
 210
 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;
 229
 230       --  Special cases that don't fall into the normal pattern below
 231
 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;
 239
 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;
 245
 246                   when 'e' =>
 247                      Warning_Mode := Treat_As_Error;
 248
 249                   when 'E' =>
 250                      Warning_Mode := Treat_Run_Time_Warnings_As_Errors;
 251
 252                   when 'n' =>
 253                      Warning_Mode := Normal;
 254
 255                   when 's' =>
 256                      Warning_Mode := Suppress;
 257
 258                   when 'u' =>
 259                      Check_Unreferenced := True;
 260                      Check_Withs := True;
 261                      Check_Unreferenced_Formals := True;
 262
 263                   when 'U' =>
 264                      Check_Unreferenced := False;
 265                      Check_Withs := False;
 266                      Check_Unreferenced_Formals := False;
 267
 268                   when 'y' =>
 269                      Warn_On_Ada_2005_Compatibility := True;
 270                      Warn_On_Ada_2012_Compatibility := True;
 271
 272                   when 'Y' =>
 273                      Warn_On_Ada_2005_Compatibility := False;
 274                      Warn_On_Ada_2012_Compatibility := False;
 275
 276                   when others => raise Program_Error;
 277                end case;
 278
 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;
 286
 287                   when 'x' =>
 288                      Warn_On_Non_Local_Exception := True;
 289
 290                   when 'X' =>
 291                      Warn_On_Non_Local_Exception := False;
 292                      No_Warn_On_Non_Local_Exception := True;
 293
 294                   when others => raise Program_Error;
 295                end case;
 296
 297             when '_' =>
 298                raise Program_Error;
 299          end case;
 300
 301          return True;
 302       end if;
 303
 304       --  Normal pattern (lower case enables the warning, upper case disables
 305       --  the warning).
 306
 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;
 314
 315       return True;
 316    end Set_Warning_Switch;
 317
 318 end Warnsw;