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' | 's' | '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
 105    All_Warnings : constant Warnings_State := --  Warnings set by -gnatw.e
 106      (X.Elab_Info_Messages |
 107       X.Warning_Doc_Switch |
 108       X.Warn_On_Ada_2022_Compatibility |
 109       X.Warn_On_Elab_Access |
 110       X.No_Warn_On_Non_Local_Exception => False,
 111       others => True);
 112    --  Warning_Doc_Switch is not really a warning to be enabled, but controls
 113    --  the form of warnings printed. No_Warn_On_Non_Local_Exception is handled
 114    --  specially (see Warn_On_Non_Local_Exception). The others are not part of
 115    --  -gnatw.e for historical reasons.
 116
 117    WA_Warnings : constant Warnings_State := --  Warnings set by -gnatwa
 118      (X.Check_Unreferenced                  | -- -gnatwf/-gnatwu
 119       X.Check_Unreferenced_Formals          | -- -gnatwf/-gnatwu
 120       X.Check_Withs                         | -- -gnatwu
 121       X.Constant_Condition_Warnings         | -- -gnatwc
 122       X.Implementation_Unit_Warnings        | -- -gnatwi
 123       X.Ineffective_Inline_Warnings         | -- -gnatwp
 124       X.Warn_On_Ada_2005_Compatibility      | -- -gnatwy
 125       X.Warn_On_Ada_2012_Compatibility      | -- -gnatwy
 126       X.Warn_On_Anonymous_Allocators        | -- -gnatw_a
 127       X.Warn_On_Assertion_Failure           | -- -gnatw.a
 128       X.Warn_On_Assumed_Low_Bound           | -- -gnatww
 129       X.Warn_On_Bad_Fixed_Value             | -- -gnatwb
 130       X.Warn_On_Biased_Representation       | -- -gnatw.b
 131       X.Warn_On_Constant                    | -- -gnatwk
 132       X.Warn_On_Export_Import               | -- -gnatwx
 133       X.Warn_On_Late_Primitives             | -- -gnatw.j
 134       X.Warn_On_Modified_Unread             | -- -gnatwm
 135       X.Warn_On_No_Value_Assigned           | -- -gnatwv
 136       X.Warn_On_Non_Local_Exception         | -- -gnatw.x
 137       X.Warn_On_Object_Renames_Function     | -- -gnatw.r
 138       X.Warn_On_Obsolescent_Feature         | -- -gnatwj
 139       X.Warn_On_Overlap                     | -- -gnatw.i
 140       X.Warn_On_Parameter_Order             | -- -gnatw.p
 141       X.Warn_On_Questionable_Missing_Parens | -- -gnatwq
 142       X.Warn_On_Redundant_Constructs        | -- -gnatwr
 143       X.Warn_On_Reverse_Bit_Order           | -- -gnatw.v
 144       X.Warn_On_Size_Alignment              | -- -gnatw.z
 145       X.Warn_On_Suspicious_Contract         | -- -gnatw.t
 146       X.Warn_On_Suspicious_Modulus_Value    | -- -gnatw.m
 147       X.Warn_On_Unchecked_Conversion        | -- -gnatwz
 148       X.Warn_On_Unrecognized_Pragma         | -- -gnatwg
 149       X.Warn_On_Unrepped_Components         => -- -gnatw.c
 150         True,
 151
 152       others => False);
 153
 154    ----------------------
 155    -- Restore_Warnings --
 156    ----------------------
 157
 158    procedure Restore_Warnings (W : Warnings_State) is
 159    begin
 160       Warning_Flags := W;
 161    end Restore_Warnings;
 162
 163    -------------------
 164    -- Save_Warnings --
 165    -------------------
 166
 167    function Save_Warnings return Warnings_State is
 168    begin
 169       return Warning_Flags;
 170    end Save_Warnings;
 171
 172    ----------------------------
 173    -- Set_GNAT_Mode_Warnings --
 174    ----------------------------
 175
 176    procedure Set_GNAT_Mode_Warnings is
 177    begin
 178       --  Set -gnatwa warnings and no others
 179
 180       Warning_Flags := (Warning_Flags and not All_Warnings) or WA_Warnings;
 181
 182       --  These warnings are added to the -gnatwa set
 183
 184       Address_Clause_Overlay_Warnings     := True;
 185       Warn_On_Questionable_Layout         := True;
 186       Warn_On_Overridden_Size             := True;
 187
 188       --  These warnings are removed from the -gnatwa set
 189
 190       Implementation_Unit_Warnings        := False;
 191       Warn_On_Non_Local_Exception         := False;
 192       No_Warn_On_Non_Local_Exception      := True;
 193       Warn_On_Reverse_Bit_Order           := False;
 194       Warn_On_Size_Alignment              := False;
 195       Warn_On_Unrepped_Components         := False;
 196    end Set_GNAT_Mode_Warnings;
 197
 198    ------------------------
 199    -- Set_Warning_Switch --
 200    ------------------------
 201
 202    function Set_Warning_Switch
 203      (Family : Warning_Family; C : Character) return Boolean
 204    is
 205       L : constant Character := To_Lower (C);
 206    begin
 207       --  Error case
 208
 209       if L not in Lowercase
 210         or else Switch_To_Flag_Mapping (Family, L) = No_Such_Warning
 211       then
 212          if Ignore_Unrecognized_VWY_Switches then
 213             declare
 214                Family_Switch : constant String :=
 215                  (case Family is
 216                    when Plain => "", when '.' => ".", when '_' => "_");
 217             begin
 218                Write_Line
 219                  ("unrecognized switch -gnatw" & Family_Switch & C &
 220                   " ignored");
 221             end;
 222             return True;
 223          else
 224             return False;
 225          end if;
 226       end if;
 227
 228       --  Special cases that don't fall into the normal pattern below
 229
 230       if Switch_To_Flag_Mapping (Family, L) = Special_Case then
 231          case Family is
 232             when Plain =>
 233                case C is
 234                   when 'a' =>
 235                      --  "or" in the -gnatwa flags, possibly leaving others set
 236                      Warning_Flags := Warning_Flags or WA_Warnings;
 237
 238                   when 'A' =>
 239                      --  Turn off the All_Warnings flags, except that
 240                      --  No_Warn_On_Non_Local_Exception is a special case.
 241                      Warning_Flags := Warning_Flags and not All_Warnings;
 242                      No_Warn_On_Non_Local_Exception := True;
 243
 244                   when 'e' =>
 245                      Warning_Mode := Treat_As_Error;
 246
 247                   when 'E' =>
 248                      Warning_Mode := Treat_Run_Time_Warnings_As_Errors;
 249
 250                   when 'n' =>
 251                      Warning_Mode := Normal;
 252
 253                   when 's' =>
 254                      Warning_Mode := Suppress;
 255
 256                   when 'u' =>
 257                      Check_Unreferenced := True;
 258                      Check_Withs := True;
 259                      Check_Unreferenced_Formals := True;
 260
 261                   when 'U' =>
 262                      Check_Unreferenced := False;
 263                      Check_Withs := False;
 264                      Check_Unreferenced_Formals := False;
 265
 266                   when 'y' =>
 267                      Warn_On_Ada_2005_Compatibility := True;
 268                      Warn_On_Ada_2012_Compatibility := True;
 269
 270                   when 'Y' =>
 271                      Warn_On_Ada_2005_Compatibility := False;
 272                      Warn_On_Ada_2012_Compatibility := False;
 273
 274                   when others => raise Program_Error;
 275                end case;
 276
 277             when '.' =>
 278                case C is
 279                   when 'e' =>
 280                      --  "or" in the All_Warnings flags
 281                      Warning_Flags := Warning_Flags or All_Warnings;
 282                   when 'g' =>
 283                      Set_GNAT_Mode_Warnings;
 284
 285                   when 'x' =>
 286                      Warn_On_Non_Local_Exception := True;
 287
 288                   when 'X' =>
 289                      Warn_On_Non_Local_Exception := False;
 290                      No_Warn_On_Non_Local_Exception := True;
 291
 292                   when others => raise Program_Error;
 293                end case;
 294
 295             when '_' =>
 296                raise Program_Error;
 297          end case;
 298
 299          return True;
 300       end if;
 301
 302       --  Normal pattern (lower case enables the warning, upper case disables
 303       --  the warning).
 304
 305       if C in Lowercase then
 306          Warning_Flags (Switch_To_Flag_Mapping (Family, C)) := True;
 307       elsif L in Lowercase then
 308          Warning_Flags (Switch_To_Flag_Mapping (Family, L)) := False;
 309       else
 310          raise Program_Error;
 311       end if;
 312
 313       return True;
 314    end Set_Warning_Switch;
 315
 316 end Warnsw;