Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/stylesw.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT COMPILER COMPONENTS -- | |
4 -- -- | |
5 -- S T Y L E S W -- | |
6 -- -- | |
7 -- B o d y -- | |
8 -- -- | |
9 -- Copyright (C) 1992-2016, 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 Hostparm; use Hostparm; | |
27 with Opt; use Opt; | |
28 with Output; use Output; | |
29 | |
30 package body Stylesw is | |
31 | |
32 -- The following constant defines the default style options for -gnaty | |
33 | |
34 Default_Style : constant String := | |
35 "3" & -- indentation level is 3 | |
36 "a" & -- check attribute casing | |
37 "A" & -- check array attribute indexes | |
38 "b" & -- check no blanks at end of lines | |
39 "c" & -- check comment formats | |
40 "e" & -- check end/exit labels present | |
41 "f" & -- check no form/feeds vertical tabs in source | |
42 "h" & -- check no horizontal tabs in source | |
43 "i" & -- check if-then layout | |
44 "k" & -- check casing rules for keywords | |
45 "l" & -- check reference manual layout | |
46 "m" & -- check line length <= 79 characters | |
47 "n" & -- check casing of package Standard idents | |
48 "p" & -- check pragma casing | |
49 "r" & -- check casing for identifier references | |
50 "s" & -- check separate subprogram specs present | |
51 "t"; -- check token separation rules | |
52 | |
53 -- The following constant defines the GNAT style options, showing them | |
54 -- as additions to the standard default style check options. | |
55 | |
56 GNAT_Style : constant String := Default_Style & | |
57 "d" & -- check no DOS line terminators | |
58 "I" & -- check mode IN | |
59 "S" & -- check separate lines after THEN or ELSE | |
60 "u" & -- check no unnecessary blank lines | |
61 "x"; -- check extra parentheses around conditionals | |
62 | |
63 -- Note: we intend GNAT_Style to also include the following, but we do | |
64 -- not yet have the whole tool suite clean with respect to this. | |
65 | |
66 -- "B" & -- check boolean operators | |
67 | |
68 ------------------------------- | |
69 -- Reset_Style_Check_Options -- | |
70 ------------------------------- | |
71 | |
72 procedure Reset_Style_Check_Options is | |
73 begin | |
74 Style_Check_Indentation := 0; | |
75 Style_Check_Array_Attribute_Index := False; | |
76 Style_Check_Attribute_Casing := False; | |
77 Style_Check_Blanks_At_End := False; | |
78 Style_Check_Blank_Lines := False; | |
79 Style_Check_Boolean_And_Or := False; | |
80 Style_Check_Comments := False; | |
81 Style_Check_DOS_Line_Terminator := False; | |
82 Style_Check_End_Labels := False; | |
83 Style_Check_Form_Feeds := False; | |
84 Style_Check_Horizontal_Tabs := False; | |
85 Style_Check_If_Then_Layout := False; | |
86 Style_Check_Keyword_Casing := False; | |
87 Style_Check_Layout := False; | |
88 Style_Check_Max_Line_Length := False; | |
89 Style_Check_Max_Nesting_Level := False; | |
90 Style_Check_Missing_Overriding := False; | |
91 Style_Check_Mode_In := False; | |
92 Style_Check_Order_Subprograms := False; | |
93 Style_Check_Pragma_Casing := False; | |
94 Style_Check_References := False; | |
95 Style_Check_Separate_Stmt_Lines := False; | |
96 Style_Check_Specs := False; | |
97 Style_Check_Standard := False; | |
98 Style_Check_Tokens := False; | |
99 Style_Check_Xtra_Parens := False; | |
100 end Reset_Style_Check_Options; | |
101 | |
102 --------------------- | |
103 -- RM_Column_Check -- | |
104 --------------------- | |
105 | |
106 function RM_Column_Check return Boolean is | |
107 begin | |
108 return Style_Check and Style_Check_Layout; | |
109 end RM_Column_Check; | |
110 | |
111 ------------------------------ | |
112 -- Save_Style_Check_Options -- | |
113 ------------------------------ | |
114 | |
115 procedure Save_Style_Check_Options (Options : out Style_Check_Options) is | |
116 P : Natural := 0; | |
117 | |
118 procedure Add (C : Character; S : Boolean); | |
119 -- Add given character C to string if switch S is true | |
120 | |
121 procedure Add_Nat (N : Nat); | |
122 -- Add given natural number to string | |
123 | |
124 --------- | |
125 -- Add -- | |
126 --------- | |
127 | |
128 procedure Add (C : Character; S : Boolean) is | |
129 begin | |
130 if S then | |
131 P := P + 1; | |
132 Options (P) := C; | |
133 end if; | |
134 end Add; | |
135 | |
136 ------------- | |
137 -- Add_Nat -- | |
138 ------------- | |
139 | |
140 procedure Add_Nat (N : Nat) is | |
141 begin | |
142 if N > 9 then | |
143 Add_Nat (N / 10); | |
144 end if; | |
145 | |
146 P := P + 1; | |
147 Options (P) := Character'Val (Character'Pos ('0') + N mod 10); | |
148 end Add_Nat; | |
149 | |
150 -- Start of processing for Save_Style_Check_Options | |
151 | |
152 begin | |
153 for K in Options'Range loop | |
154 Options (K) := ' '; | |
155 end loop; | |
156 | |
157 Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')), | |
158 Style_Check_Indentation /= 0); | |
159 | |
160 Add ('a', Style_Check_Attribute_Casing); | |
161 Add ('A', Style_Check_Array_Attribute_Index); | |
162 Add ('b', Style_Check_Blanks_At_End); | |
163 Add ('B', Style_Check_Boolean_And_Or); | |
164 | |
165 if Style_Check_Comments then | |
166 if Style_Check_Comments_Spacing = 2 then | |
167 Add ('c', Style_Check_Comments); | |
168 elsif Style_Check_Comments_Spacing = 1 then | |
169 Add ('C', Style_Check_Comments); | |
170 end if; | |
171 end if; | |
172 | |
173 Add ('d', Style_Check_DOS_Line_Terminator); | |
174 Add ('e', Style_Check_End_Labels); | |
175 Add ('f', Style_Check_Form_Feeds); | |
176 Add ('h', Style_Check_Horizontal_Tabs); | |
177 Add ('i', Style_Check_If_Then_Layout); | |
178 Add ('I', Style_Check_Mode_In); | |
179 Add ('k', Style_Check_Keyword_Casing); | |
180 Add ('l', Style_Check_Layout); | |
181 Add ('n', Style_Check_Standard); | |
182 Add ('o', Style_Check_Order_Subprograms); | |
183 Add ('O', Style_Check_Missing_Overriding); | |
184 Add ('p', Style_Check_Pragma_Casing); | |
185 Add ('r', Style_Check_References); | |
186 Add ('s', Style_Check_Specs); | |
187 Add ('S', Style_Check_Separate_Stmt_Lines); | |
188 Add ('t', Style_Check_Tokens); | |
189 Add ('u', Style_Check_Blank_Lines); | |
190 Add ('x', Style_Check_Xtra_Parens); | |
191 | |
192 if Style_Check_Max_Line_Length then | |
193 P := P + 1; | |
194 Options (P) := 'M'; | |
195 Add_Nat (Style_Max_Line_Length); | |
196 end if; | |
197 | |
198 if Style_Check_Max_Nesting_Level then | |
199 P := P + 1; | |
200 Options (P) := 'L'; | |
201 Add_Nat (Style_Max_Nesting_Level); | |
202 end if; | |
203 | |
204 pragma Assert (P <= Options'Last); | |
205 | |
206 while P < Options'Last loop | |
207 P := P + 1; | |
208 Options (P) := ' '; | |
209 end loop; | |
210 end Save_Style_Check_Options; | |
211 | |
212 ------------------------------------- | |
213 -- Set_Default_Style_Check_Options -- | |
214 ------------------------------------- | |
215 | |
216 procedure Set_Default_Style_Check_Options is | |
217 begin | |
218 Reset_Style_Check_Options; | |
219 Set_Style_Check_Options (Default_Style); | |
220 end Set_Default_Style_Check_Options; | |
221 | |
222 ---------------------------------- | |
223 -- Set_GNAT_Style_Check_Options -- | |
224 ---------------------------------- | |
225 | |
226 procedure Set_GNAT_Style_Check_Options is | |
227 begin | |
228 Reset_Style_Check_Options; | |
229 Set_Style_Check_Options (GNAT_Style); | |
230 end Set_GNAT_Style_Check_Options; | |
231 | |
232 ----------------------------- | |
233 -- Set_Style_Check_Options -- | |
234 ----------------------------- | |
235 | |
236 -- Version used when no error checking is required | |
237 | |
238 procedure Set_Style_Check_Options (Options : String) is | |
239 OK : Boolean; | |
240 EC : Natural; | |
241 pragma Warnings (Off, EC); | |
242 begin | |
243 Set_Style_Check_Options (Options, OK, EC); | |
244 pragma Assert (OK); | |
245 end Set_Style_Check_Options; | |
246 | |
247 -- Normal version with error checking | |
248 | |
249 procedure Set_Style_Check_Options | |
250 (Options : String; | |
251 OK : out Boolean; | |
252 Err_Col : out Natural) | |
253 is | |
254 C : Character; | |
255 | |
256 On : Boolean := True; | |
257 -- Set to False if minus encountered | |
258 -- Set to True if plus encountered | |
259 | |
260 Last_Option : Character := ' '; | |
261 -- Set to last character encountered | |
262 | |
263 procedure Add_Img (N : Natural); | |
264 -- Concatenates image of N at end of Style_Msg_Buf | |
265 | |
266 procedure Bad_Style_Switch (Msg : String); | |
267 -- Called if bad style switch found. Msg is set in Style_Msg_Buf and | |
268 -- Style_Msg_Len. OK is set False. | |
269 | |
270 ------------- | |
271 -- Add_Img -- | |
272 ------------- | |
273 | |
274 procedure Add_Img (N : Natural) is | |
275 begin | |
276 if N >= 10 then | |
277 Add_Img (N / 10); | |
278 end if; | |
279 | |
280 Style_Msg_Len := Style_Msg_Len + 1; | |
281 Style_Msg_Buf (Style_Msg_Len) := | |
282 Character'Val (N mod 10 + Character'Pos ('0')); | |
283 end Add_Img; | |
284 | |
285 ---------------------- | |
286 -- Bad_Style_Switch -- | |
287 ---------------------- | |
288 | |
289 procedure Bad_Style_Switch (Msg : String) is | |
290 begin | |
291 OK := False; | |
292 Style_Msg_Len := Msg'Length; | |
293 Style_Msg_Buf (1 .. Style_Msg_Len) := Msg; | |
294 end Bad_Style_Switch; | |
295 | |
296 -- Start of processing for Set_Style_Check_Options | |
297 | |
298 begin | |
299 Err_Col := Options'First; | |
300 while Err_Col <= Options'Last loop | |
301 C := Options (Err_Col); | |
302 Last_Option := C; | |
303 Err_Col := Err_Col + 1; | |
304 | |
305 -- Turning switches on | |
306 | |
307 if On then | |
308 case C is | |
309 when '+' => | |
310 null; | |
311 | |
312 when '-' => | |
313 On := False; | |
314 | |
315 when '0' .. '9' => | |
316 Style_Check_Indentation := | |
317 Character'Pos (C) - Character'Pos ('0'); | |
318 | |
319 when 'a' => | |
320 Style_Check_Attribute_Casing := True; | |
321 | |
322 when 'A' => | |
323 Style_Check_Array_Attribute_Index := True; | |
324 | |
325 when 'b' => | |
326 Style_Check_Blanks_At_End := True; | |
327 | |
328 when 'B' => | |
329 Style_Check_Boolean_And_Or := True; | |
330 | |
331 when 'c' => | |
332 Style_Check_Comments := True; | |
333 Style_Check_Comments_Spacing := 2; | |
334 | |
335 when 'C' => | |
336 Style_Check_Comments := True; | |
337 Style_Check_Comments_Spacing := 1; | |
338 | |
339 when 'd' => | |
340 Style_Check_DOS_Line_Terminator := True; | |
341 | |
342 when 'e' => | |
343 Style_Check_End_Labels := True; | |
344 | |
345 when 'f' => | |
346 Style_Check_Form_Feeds := True; | |
347 | |
348 when 'g' => | |
349 Set_GNAT_Style_Check_Options; | |
350 | |
351 when 'h' => | |
352 Style_Check_Horizontal_Tabs := True; | |
353 | |
354 when 'i' => | |
355 Style_Check_If_Then_Layout := True; | |
356 | |
357 when 'I' => | |
358 Style_Check_Mode_In := True; | |
359 | |
360 when 'k' => | |
361 Style_Check_Keyword_Casing := True; | |
362 | |
363 when 'l' => | |
364 Style_Check_Layout := True; | |
365 | |
366 when 'L' => | |
367 Style_Max_Nesting_Level := 0; | |
368 | |
369 if Err_Col > Options'Last | |
370 or else Options (Err_Col) not in '0' .. '9' | |
371 then | |
372 Bad_Style_Switch ("invalid nesting level"); | |
373 return; | |
374 end if; | |
375 | |
376 loop | |
377 Style_Max_Nesting_Level := | |
378 Style_Max_Nesting_Level * 10 + | |
379 Character'Pos (Options (Err_Col)) - Character'Pos ('0'); | |
380 | |
381 if Style_Max_Nesting_Level > 999 then | |
382 Bad_Style_Switch | |
383 ("max nesting level (999) exceeded in style check"); | |
384 return; | |
385 end if; | |
386 | |
387 Err_Col := Err_Col + 1; | |
388 exit when Err_Col > Options'Last | |
389 or else Options (Err_Col) not in '0' .. '9'; | |
390 end loop; | |
391 | |
392 Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0; | |
393 | |
394 when 'm' => | |
395 Style_Check_Max_Line_Length := True; | |
396 Style_Max_Line_Length := 79; | |
397 | |
398 when 'M' => | |
399 Style_Max_Line_Length := 0; | |
400 | |
401 if Err_Col > Options'Last | |
402 or else Options (Err_Col) not in '0' .. '9' | |
403 then | |
404 Bad_Style_Switch | |
405 ("invalid line length in style check"); | |
406 return; | |
407 end if; | |
408 | |
409 loop | |
410 Style_Max_Line_Length := | |
411 Style_Max_Line_Length * 10 + | |
412 Character'Pos (Options (Err_Col)) - Character'Pos ('0'); | |
413 | |
414 if Style_Max_Line_Length > Int (Max_Line_Length) then | |
415 OK := False; | |
416 Style_Msg_Buf (1 .. 27) := "max line length allowed is "; | |
417 Style_Msg_Len := 27; | |
418 Add_Img (Natural (Max_Line_Length)); | |
419 return; | |
420 end if; | |
421 | |
422 Err_Col := Err_Col + 1; | |
423 exit when Err_Col > Options'Last | |
424 or else Options (Err_Col) not in '0' .. '9'; | |
425 end loop; | |
426 | |
427 Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0; | |
428 | |
429 when 'n' => | |
430 Style_Check_Standard := True; | |
431 | |
432 when 'N' => | |
433 Reset_Style_Check_Options; | |
434 | |
435 when 'o' => | |
436 Style_Check_Order_Subprograms := True; | |
437 | |
438 when 'O' => | |
439 Style_Check_Missing_Overriding := True; | |
440 | |
441 when 'p' => | |
442 Style_Check_Pragma_Casing := True; | |
443 | |
444 when 'r' => | |
445 Style_Check_References := True; | |
446 | |
447 when 's' => | |
448 Style_Check_Specs := True; | |
449 | |
450 when 'S' => | |
451 Style_Check_Separate_Stmt_Lines := True; | |
452 | |
453 when 't' => | |
454 Style_Check_Tokens := True; | |
455 | |
456 when 'u' => | |
457 Style_Check_Blank_Lines := True; | |
458 | |
459 when 'x' => | |
460 Style_Check_Xtra_Parens := True; | |
461 | |
462 when 'y' => | |
463 Set_Default_Style_Check_Options; | |
464 | |
465 when ' ' => | |
466 null; | |
467 | |
468 when others => | |
469 if Ignore_Unrecognized_VWY_Switches then | |
470 Write_Line ("unrecognized switch -gnaty" & C & " ignored"); | |
471 else | |
472 Err_Col := Err_Col - 1; | |
473 Bad_Style_Switch ("invalid style switch"); | |
474 return; | |
475 end if; | |
476 end case; | |
477 | |
478 -- Turning switches off | |
479 | |
480 else | |
481 case C is | |
482 when '+' => | |
483 On := True; | |
484 | |
485 when '-' => | |
486 null; | |
487 | |
488 when '0' .. '9' => | |
489 Style_Check_Indentation := 0; | |
490 | |
491 when 'a' => | |
492 Style_Check_Attribute_Casing := False; | |
493 | |
494 when 'A' => | |
495 Style_Check_Array_Attribute_Index := False; | |
496 | |
497 when 'b' => | |
498 Style_Check_Blanks_At_End := False; | |
499 | |
500 when 'B' => | |
501 Style_Check_Boolean_And_Or := False; | |
502 | |
503 when 'c' | 'C' => | |
504 Style_Check_Comments := False; | |
505 | |
506 when 'd' => | |
507 Style_Check_DOS_Line_Terminator := False; | |
508 | |
509 when 'e' => | |
510 Style_Check_End_Labels := False; | |
511 | |
512 when 'f' => | |
513 Style_Check_Form_Feeds := False; | |
514 | |
515 when 'g' => | |
516 Reset_Style_Check_Options; | |
517 | |
518 when 'h' => | |
519 Style_Check_Horizontal_Tabs := False; | |
520 | |
521 when 'i' => | |
522 Style_Check_If_Then_Layout := False; | |
523 | |
524 when 'I' => | |
525 Style_Check_Mode_In := False; | |
526 | |
527 when 'k' => | |
528 Style_Check_Keyword_Casing := False; | |
529 | |
530 when 'l' => | |
531 Style_Check_Layout := False; | |
532 | |
533 when 'L' => | |
534 Style_Max_Nesting_Level := 0; | |
535 | |
536 when 'm' => | |
537 Style_Check_Max_Line_Length := False; | |
538 | |
539 when 'M' => | |
540 Style_Max_Line_Length := 0; | |
541 Style_Check_Max_Line_Length := False; | |
542 | |
543 when 'n' => | |
544 Style_Check_Standard := False; | |
545 | |
546 when 'o' => | |
547 Style_Check_Order_Subprograms := False; | |
548 | |
549 when 'O' => | |
550 Style_Check_Missing_Overriding := False; | |
551 | |
552 when 'p' => | |
553 Style_Check_Pragma_Casing := False; | |
554 | |
555 when 'r' => | |
556 Style_Check_References := False; | |
557 | |
558 when 's' => | |
559 Style_Check_Specs := False; | |
560 | |
561 when 'S' => | |
562 Style_Check_Separate_Stmt_Lines := False; | |
563 | |
564 when 't' => | |
565 Style_Check_Tokens := False; | |
566 | |
567 when 'u' => | |
568 Style_Check_Blank_Lines := False; | |
569 | |
570 when 'x' => | |
571 Style_Check_Xtra_Parens := False; | |
572 | |
573 when ' ' => | |
574 null; | |
575 | |
576 when others => | |
577 if Ignore_Unrecognized_VWY_Switches then | |
578 Write_Line ("unrecognized switch -gnaty-" & C & " ignored"); | |
579 else | |
580 Err_Col := Err_Col - 1; | |
581 Bad_Style_Switch ("invalid style switch"); | |
582 return; | |
583 end if; | |
584 end case; | |
585 end if; | |
586 end loop; | |
587 | |
588 -- Turn on style checking if other than N at end of string | |
589 | |
590 Style_Check := (Last_Option /= 'N'); | |
591 OK := True; | |
592 end Set_Style_Check_Options; | |
593 end Stylesw; |