gcc/ada/validsw.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              V A L I D S W                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-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 package body Validsw is
  30
  31    ----------------------------------
  32    -- Reset_Validity_Check_Options --
  33    ----------------------------------
  34
  35    procedure Reset_Validity_Check_Options is
  36    begin
  37       Validity_Check_Components     := False;
  38       Validity_Check_Copies         := False;
  39       Validity_Check_Default        := False;
  40       Validity_Check_Floating_Point := False;
  41       Validity_Check_In_Out_Params  := False;
  42       Validity_Check_In_Params      := False;
  43       Validity_Check_Operands       := False;
  44       Validity_Check_Parameters     := False;
  45       Validity_Check_Returns        := False;
  46       Validity_Check_Subscripts     := False;
  47       Validity_Check_Tests          := False;
  48    end Reset_Validity_Check_Options;
  49
  50    --------------------------------
  51    -- Set_Validity_Check_Options --
  52    --------------------------------
  53
  54    --  Version used when no error checking is required
  55
  56    procedure Set_Validity_Check_Options (Options : String) is
  57       OK : Boolean;
  58       EC : Natural;
  59       pragma Warnings (Off, OK);
  60       pragma Warnings (Off, EC);
  61    begin
  62       Set_Validity_Check_Options (Options, OK, EC);
  63    end Set_Validity_Check_Options;
  64
  65    --  Normal version with error checking
  66
  67    procedure Set_Validity_Check_Options
  68      (Options  : String;
  69       OK       : out Boolean;
  70       Err_Col  : out Natural)
  71    is
  72       J : Natural;
  73       C : Character;
  74
  75    begin
  76       J := Options'First;
  77       while J <= Options'Last loop
  78          C := Options (J);
  79          J := J + 1;
  80
  81          --  Turn on validity checking (gets turned off by Vn)
  82
  83          Validity_Checks_On := True;
  84
  85          case C is
  86             when 'c' =>
  87                Validity_Check_Copies         := True;
  88
  89             when 'd' =>
  90                Validity_Check_Default        := True;
  91
  92             when 'e' =>
  93                Validity_Check_Components     := True;
  94
  95             when 'f' =>
  96                Validity_Check_Floating_Point := True;
  97
  98             when 'i' =>
  99                Validity_Check_In_Params      := True;
 100
 101             when 'm' =>
 102                Validity_Check_In_Out_Params  := True;
 103
 104             when 'o' =>
 105                Validity_Check_Operands       := True;
 106
 107             when 'p' =>
 108                Validity_Check_Parameters     := True;
 109
 110             when 'r' =>
 111                Validity_Check_Returns        := True;
 112
 113             when 's' =>
 114                Validity_Check_Subscripts     := True;
 115
 116             when 't' =>
 117                Validity_Check_Tests          := True;
 118
 119             when 'C' =>
 120                Validity_Check_Copies         := False;
 121
 122             when 'D' =>
 123                Validity_Check_Default        := False;
 124
 125             when 'E' =>
 126                Validity_Check_Components     := False;
 127
 128             when 'F' =>
 129                Validity_Check_Floating_Point := False;
 130
 131             when 'I' =>
 132                Validity_Check_In_Params      := False;
 133
 134             when 'M' =>
 135                Validity_Check_In_Out_Params  := False;
 136
 137             when 'O' =>
 138                Validity_Check_Operands       := False;
 139
 140             when 'P' =>
 141                Validity_Check_Parameters     := False;
 142
 143             when 'R' =>
 144                Validity_Check_Returns        := False;
 145
 146             when 'S' =>
 147                Validity_Check_Subscripts     := False;
 148
 149             when 'T' =>
 150                Validity_Check_Tests          := False;
 151
 152             when 'a' =>
 153                Validity_Check_Components     := True;
 154                Validity_Check_Copies         := True;
 155                Validity_Check_Default        := True;
 156                Validity_Check_Floating_Point := True;
 157                Validity_Check_In_Out_Params  := True;
 158                Validity_Check_In_Params      := True;
 159                Validity_Check_Operands       := True;
 160                Validity_Check_Parameters     := True;
 161                Validity_Check_Returns        := True;
 162                Validity_Check_Subscripts     := True;
 163                Validity_Check_Tests          := True;
 164
 165             when 'n' =>
 166                Validity_Check_Components     := False;
 167                Validity_Check_Copies         := False;
 168                Validity_Check_Default        := False;
 169                Validity_Check_Floating_Point := False;
 170                Validity_Check_In_Out_Params  := False;
 171                Validity_Check_In_Params      := False;
 172                Validity_Check_Operands       := False;
 173                Validity_Check_Parameters     := False;
 174                Validity_Check_Returns        := False;
 175                Validity_Check_Subscripts     := False;
 176                Validity_Check_Tests          := False;
 177                Validity_Checks_On            := False;
 178
 179             when ' ' =>
 180                null;
 181
 182             when others =>
 183                if Ignore_Unrecognized_VWY_Switches then
 184                   Write_Line ("unrecognized switch -gnatV" & C & " ignored");
 185                else
 186                   OK      := False;
 187                   Err_Col := J - 1;
 188                   return;
 189                end if;
 190          end case;
 191       end loop;
 192
 193       OK := True;
 194       Err_Col := Options'Last + 1;
 195    end Set_Validity_Check_Options;
 196
 197 end Validsw;