]>
Commit | Line | Data |
---|---|---|
415dddc8 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- V A L I D S W -- | |
6 | -- -- | |
7 | -- B o d y -- | |
415dddc8 | 8 | -- -- |
4b490c1e | 9 | -- Copyright (C) 2001-2020, Free Software Foundation, Inc. -- |
415dddc8 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
415dddc8 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
415dddc8 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
415dddc8 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
d48cd424 RD |
26 | with Opt; use Opt; |
27 | with Output; use Output; | |
415dddc8 RK |
28 | |
29 | package body Validsw is | |
30 | ||
31 | ---------------------------------- | |
32 | -- Reset_Validity_Check_Options -- | |
33 | ---------------------------------- | |
34 | ||
35 | procedure Reset_Validity_Check_Options is | |
36 | begin | |
e8dde875 AC |
37 | Validity_Check_Components := False; |
38 | Validity_Check_Copies := False; | |
7cbe60de | 39 | Validity_Check_Default := False; |
e8dde875 AC |
40 | Validity_Check_Floating_Point := False; |
41 | Validity_Check_In_Out_Params := False; | |
42 | Validity_Check_In_Params := False; | |
43 | Validity_Check_Operands := False; | |
7cbe60de | 44 | Validity_Check_Parameters := False; |
e8dde875 AC |
45 | Validity_Check_Returns := False; |
46 | Validity_Check_Subscripts := False; | |
47 | Validity_Check_Tests := False; | |
415dddc8 RK |
48 | end Reset_Validity_Check_Options; |
49 | ||
50 | --------------------------------- | |
51 | -- Save_Validity_Check_Options -- | |
52 | --------------------------------- | |
53 | ||
54 | procedure Save_Validity_Check_Options | |
55 | (Options : out Validity_Check_Options) | |
56 | is | |
57 | P : Natural := 0; | |
58 | ||
59 | procedure Add (C : Character; S : Boolean); | |
60 | -- Add given character C to string if switch S is true | |
61 | ||
62 | procedure Add (C : Character; S : Boolean) is | |
63 | begin | |
64 | if S then | |
65 | P := P + 1; | |
66 | Options (P) := C; | |
67 | end if; | |
68 | end Add; | |
69 | ||
70 | -- Start of processing for Save_Validity_Check_Options | |
71 | ||
72 | begin | |
73 | for K in Options'Range loop | |
74 | Options (K) := ' '; | |
75 | end loop; | |
76 | ||
ba1cbfb9 | 77 | Add ('e', Validity_Check_Components); |
7cbe60de EB |
78 | Add ('c', Validity_Check_Copies); |
79 | Add ('d', Validity_Check_Default); | |
415dddc8 RK |
80 | Add ('f', Validity_Check_Floating_Point); |
81 | Add ('i', Validity_Check_In_Params); | |
82 | Add ('m', Validity_Check_In_Out_Params); | |
83 | Add ('o', Validity_Check_Operands); | |
7cbe60de | 84 | Add ('p', Validity_Check_Parameters); |
415dddc8 RK |
85 | Add ('r', Validity_Check_Returns); |
86 | Add ('s', Validity_Check_Subscripts); | |
87 | Add ('t', Validity_Check_Tests); | |
88 | end Save_Validity_Check_Options; | |
89 | ||
90 | ---------------------------------------- | |
91 | -- Set_Default_Validity_Check_Options -- | |
92 | ---------------------------------------- | |
93 | ||
94 | procedure Set_Default_Validity_Check_Options is | |
95 | begin | |
96 | Reset_Validity_Check_Options; | |
97 | Set_Validity_Check_Options ("d"); | |
98 | end Set_Default_Validity_Check_Options; | |
99 | ||
100 | -------------------------------- | |
101 | -- Set_Validity_Check_Options -- | |
102 | -------------------------------- | |
103 | ||
104 | -- Version used when no error checking is required | |
105 | ||
106 | procedure Set_Validity_Check_Options (Options : String) is | |
107 | OK : Boolean; | |
108 | EC : Natural; | |
67ce0d7e RD |
109 | pragma Warnings (Off, OK); |
110 | pragma Warnings (Off, EC); | |
415dddc8 RK |
111 | begin |
112 | Set_Validity_Check_Options (Options, OK, EC); | |
113 | end Set_Validity_Check_Options; | |
114 | ||
115 | -- Normal version with error checking | |
116 | ||
117 | procedure Set_Validity_Check_Options | |
118 | (Options : String; | |
119 | OK : out Boolean; | |
120 | Err_Col : out Natural) | |
121 | is | |
122 | J : Natural; | |
123 | C : Character; | |
124 | ||
125 | begin | |
415dddc8 RK |
126 | J := Options'First; |
127 | while J <= Options'Last loop | |
128 | C := Options (J); | |
129 | J := J + 1; | |
130 | ||
07fc65c4 GB |
131 | -- Turn on validity checking (gets turned off by Vn) |
132 | ||
133 | Validity_Checks_On := True; | |
134 | ||
415dddc8 RK |
135 | case C is |
136 | when 'c' => | |
e8dde875 | 137 | Validity_Check_Copies := True; |
415dddc8 RK |
138 | |
139 | when 'd' => | |
e8dde875 | 140 | Validity_Check_Default := True; |
415dddc8 | 141 | |
ba1cbfb9 | 142 | when 'e' => |
e8dde875 | 143 | Validity_Check_Components := True; |
ba1cbfb9 | 144 | |
415dddc8 | 145 | when 'f' => |
e8dde875 | 146 | Validity_Check_Floating_Point := True; |
415dddc8 RK |
147 | |
148 | when 'i' => | |
e8dde875 | 149 | Validity_Check_In_Params := True; |
415dddc8 RK |
150 | |
151 | when 'm' => | |
e8dde875 | 152 | Validity_Check_In_Out_Params := True; |
415dddc8 RK |
153 | |
154 | when 'o' => | |
e8dde875 | 155 | Validity_Check_Operands := True; |
415dddc8 | 156 | |
fbf5a39b | 157 | when 'p' => |
e8dde875 | 158 | Validity_Check_Parameters := True; |
fbf5a39b | 159 | |
415dddc8 | 160 | when 'r' => |
e8dde875 | 161 | Validity_Check_Returns := True; |
415dddc8 RK |
162 | |
163 | when 's' => | |
e8dde875 | 164 | Validity_Check_Subscripts := True; |
415dddc8 RK |
165 | |
166 | when 't' => | |
e8dde875 | 167 | Validity_Check_Tests := True; |
415dddc8 RK |
168 | |
169 | when 'C' => | |
e8dde875 | 170 | Validity_Check_Copies := False; |
415dddc8 RK |
171 | |
172 | when 'D' => | |
e8dde875 | 173 | Validity_Check_Default := False; |
415dddc8 | 174 | |
ba1cbfb9 | 175 | when 'E' => |
e8dde875 | 176 | Validity_Check_Components := False; |
0ea55619 AC |
177 | |
178 | when 'F' => | |
e8dde875 | 179 | Validity_Check_Floating_Point := False; |
ba1cbfb9 | 180 | |
415dddc8 | 181 | when 'I' => |
e8dde875 | 182 | Validity_Check_In_Params := False; |
415dddc8 RK |
183 | |
184 | when 'M' => | |
e8dde875 | 185 | Validity_Check_In_Out_Params := False; |
415dddc8 RK |
186 | |
187 | when 'O' => | |
e8dde875 | 188 | Validity_Check_Operands := False; |
415dddc8 | 189 | |
fbf5a39b | 190 | when 'P' => |
e8dde875 | 191 | Validity_Check_Parameters := False; |
fbf5a39b | 192 | |
415dddc8 | 193 | when 'R' => |
e8dde875 | 194 | Validity_Check_Returns := False; |
415dddc8 RK |
195 | |
196 | when 'S' => | |
e8dde875 | 197 | Validity_Check_Subscripts := False; |
415dddc8 RK |
198 | |
199 | when 'T' => | |
e8dde875 | 200 | Validity_Check_Tests := False; |
c92e8586 | 201 | |
415dddc8 | 202 | when 'a' => |
e8dde875 AC |
203 | Validity_Check_Components := True; |
204 | Validity_Check_Copies := True; | |
205 | Validity_Check_Default := True; | |
206 | Validity_Check_Floating_Point := True; | |
207 | Validity_Check_In_Out_Params := True; | |
208 | Validity_Check_In_Params := True; | |
209 | Validity_Check_Operands := True; | |
210 | Validity_Check_Parameters := True; | |
211 | Validity_Check_Returns := True; | |
212 | Validity_Check_Subscripts := True; | |
213 | Validity_Check_Tests := True; | |
415dddc8 RK |
214 | |
215 | when 'n' => | |
e8dde875 AC |
216 | Validity_Check_Components := False; |
217 | Validity_Check_Copies := False; | |
218 | Validity_Check_Default := False; | |
219 | Validity_Check_Floating_Point := False; | |
220 | Validity_Check_In_Out_Params := False; | |
221 | Validity_Check_In_Params := False; | |
222 | Validity_Check_Operands := False; | |
223 | Validity_Check_Parameters := False; | |
224 | Validity_Check_Returns := False; | |
225 | Validity_Check_Subscripts := False; | |
226 | Validity_Check_Tests := False; | |
227 | Validity_Checks_On := False; | |
415dddc8 RK |
228 | |
229 | when ' ' => | |
230 | null; | |
231 | ||
232 | when others => | |
d48cd424 RD |
233 | if Ignore_Unrecognized_VWY_Switches then |
234 | Write_Line ("unrecognized switch -gnatV" & C & " ignored"); | |
235 | else | |
236 | OK := False; | |
237 | Err_Col := J - 1; | |
238 | return; | |
239 | end if; | |
415dddc8 RK |
240 | end case; |
241 | end loop; | |
242 | ||
415dddc8 RK |
243 | OK := True; |
244 | Err_Col := Options'Last + 1; | |
245 | end Set_Validity_Check_Options; | |
246 | ||
247 | end Validsw; |