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-2021, 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
26with Opt;    use Opt;
27with Output; use Output;
28
29package 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
197end Validsw;
198