1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Hostparm
; use Hostparm
;
29 package body Stylesw
is
31 -- The following constant defines the default style options for -gnaty
33 Default_Style
: constant String :=
34 "3" & -- indentation level is 3
35 "a" & -- check attribute casing
36 "A" & -- check array attribute indexes
37 "b" & -- check no blanks at end of lines
38 "c" & -- check comment formats
39 "e" & -- check end/exit labels present
40 "f" & -- check no form/feeds vertical tabs in source
41 "h" & -- check no horizontal tabs in source
42 "i" & -- check if-then layout
43 "k" & -- check casing rules for keywords
44 "l" & -- check reference manual layout
45 "m" & -- check line length <= 79 characters
46 "n" & -- check casing of package Standard idents
47 "p" & -- check pragma casing
48 "r" & -- check casing for identifier references
49 "s" & -- check separate subprogram specs present
50 "t"; -- check token separation rules
52 -- The following constant defines the GNAT style options, showing them
53 -- as additions to the standard default style check options.
55 GNAT_Style
: constant String := Default_Style
&
56 "d" & -- check no DOS line terminators
57 "I" & -- check mode IN
58 "S" & -- check separate lines after THEN or ELSE
59 "u" & -- check no unnecessary blank lines
60 "x"; -- check extra parentheses around conditionals
62 -- Note: we intend GNAT_Style to also include the following, but we do
63 -- not yet have the whole tool suite clean with respect to this.
65 -- "B" & -- check boolean operators
67 -------------------------------
68 -- Reset_Style_Check_Options --
69 -------------------------------
71 procedure Reset_Style_Check_Options
is
73 Style_Check_Indentation
:= 0;
74 Style_Check_Array_Attribute_Index
:= False;
75 Style_Check_Attribute_Casing
:= False;
76 Style_Check_Blanks_At_End
:= False;
77 Style_Check_Blank_Lines
:= False;
78 Style_Check_Boolean_And_Or
:= False;
79 Style_Check_Comments
:= False;
80 Style_Check_DOS_Line_Terminator
:= False;
81 Style_Check_End_Labels
:= False;
82 Style_Check_Form_Feeds
:= False;
83 Style_Check_Horizontal_Tabs
:= False;
84 Style_Check_If_Then_Layout
:= False;
85 Style_Check_Keyword_Casing
:= False;
86 Style_Check_Layout
:= False;
87 Style_Check_Max_Line_Length
:= False;
88 Style_Check_Max_Nesting_Level
:= False;
89 Style_Check_Missing_Overriding
:= False;
90 Style_Check_Mode_In
:= False;
91 Style_Check_Order_Subprograms
:= False;
92 Style_Check_Pragma_Casing
:= False;
93 Style_Check_References
:= False;
94 Style_Check_Separate_Stmt_Lines
:= False;
95 Style_Check_Specs
:= False;
96 Style_Check_Standard
:= False;
97 Style_Check_Tokens
:= False;
98 Style_Check_Xtra_Parens
:= False;
99 end Reset_Style_Check_Options
;
101 ---------------------
102 -- RM_Column_Check --
103 ---------------------
105 function RM_Column_Check
return Boolean is
107 return Style_Check
and Style_Check_Layout
;
110 ------------------------------
111 -- Save_Style_Check_Options --
112 ------------------------------
114 procedure Save_Style_Check_Options
(Options
: out Style_Check_Options
) is
117 procedure Add
(C
: Character; S
: Boolean);
118 -- Add given character C to string if switch S is true
120 procedure Add_Nat
(N
: Nat
);
121 -- Add given natural number to string
127 procedure Add
(C
: Character; S
: Boolean) is
139 procedure Add_Nat
(N
: Nat
) is
146 Options
(P
) := Character'Val (Character'Pos ('0') + N
mod 10);
149 -- Start of processing for Save_Style_Check_Options
152 for K
in Options
'Range loop
156 Add
(Character'Val (Style_Check_Indentation
+ Character'Pos ('0')),
157 Style_Check_Indentation
/= 0);
159 Add
('a', Style_Check_Attribute_Casing
);
160 Add
('A', Style_Check_Array_Attribute_Index
);
161 Add
('b', Style_Check_Blanks_At_End
);
162 Add
('B', Style_Check_Boolean_And_Or
);
164 if Style_Check_Comments
then
165 if Style_Check_Comments_Spacing
= 2 then
166 Add
('c', Style_Check_Comments
);
167 elsif Style_Check_Comments_Spacing
= 1 then
168 Add
('C', Style_Check_Comments
);
172 Add
('d', Style_Check_DOS_Line_Terminator
);
173 Add
('e', Style_Check_End_Labels
);
174 Add
('f', Style_Check_Form_Feeds
);
175 Add
('h', Style_Check_Horizontal_Tabs
);
176 Add
('i', Style_Check_If_Then_Layout
);
177 Add
('I', Style_Check_Mode_In
);
178 Add
('k', Style_Check_Keyword_Casing
);
179 Add
('l', Style_Check_Layout
);
180 Add
('n', Style_Check_Standard
);
181 Add
('o', Style_Check_Order_Subprograms
);
182 Add
('O', Style_Check_Missing_Overriding
);
183 Add
('p', Style_Check_Pragma_Casing
);
184 Add
('r', Style_Check_References
);
185 Add
('s', Style_Check_Specs
);
186 Add
('S', Style_Check_Separate_Stmt_Lines
);
187 Add
('t', Style_Check_Tokens
);
188 Add
('u', Style_Check_Blank_Lines
);
189 Add
('x', Style_Check_Xtra_Parens
);
191 if Style_Check_Max_Line_Length
then
194 Add_Nat
(Style_Max_Line_Length
);
197 if Style_Check_Max_Nesting_Level
then
200 Add_Nat
(Style_Max_Nesting_Level
);
203 pragma Assert
(P
<= Options
'Last);
205 while P
< Options
'Last loop
209 end Save_Style_Check_Options
;
211 -------------------------------------
212 -- Set_Default_Style_Check_Options --
213 -------------------------------------
215 procedure Set_Default_Style_Check_Options
is
217 Reset_Style_Check_Options
;
218 Set_Style_Check_Options
(Default_Style
);
219 end Set_Default_Style_Check_Options
;
221 ----------------------------------
222 -- Set_GNAT_Style_Check_Options --
223 ----------------------------------
225 procedure Set_GNAT_Style_Check_Options
is
227 Reset_Style_Check_Options
;
228 Set_Style_Check_Options
(GNAT_Style
);
229 end Set_GNAT_Style_Check_Options
;
231 -----------------------------
232 -- Set_Style_Check_Options --
233 -----------------------------
235 -- Version used when no error checking is required
237 procedure Set_Style_Check_Options
(Options
: String) is
240 pragma Warnings
(Off
, EC
);
242 Set_Style_Check_Options
(Options
, OK
, EC
);
244 end Set_Style_Check_Options
;
246 -- Normal version with error checking
248 procedure Set_Style_Check_Options
251 Err_Col
: out Natural)
255 On
: Boolean := True;
256 -- Set to False if minus encountered
257 -- Set to True if plus encountered
259 Last_Option
: Character := ' ';
260 -- Set to last character encountered
262 procedure Add_Img
(N
: Natural);
263 -- Concatenates image of N at end of Style_Msg_Buf
265 procedure Bad_Style_Switch
(Msg
: String);
266 -- Called if bad style switch found. Msg is set in Style_Msg_Buf and
267 -- Style_Msg_Len. OK is set False.
273 procedure Add_Img
(N
: Natural) is
279 Style_Msg_Len
:= Style_Msg_Len
+ 1;
280 Style_Msg_Buf
(Style_Msg_Len
) :=
281 Character'Val (N
mod 10 + Character'Pos ('0'));
284 ----------------------
285 -- Bad_Style_Switch --
286 ----------------------
288 procedure Bad_Style_Switch
(Msg
: String) is
291 Style_Msg_Len
:= Msg
'Length;
292 Style_Msg_Buf
(1 .. Style_Msg_Len
) := Msg
;
293 end Bad_Style_Switch
;
295 -- Start of processing for Set_Style_Check_Options
298 Err_Col
:= Options
'First;
299 while Err_Col
<= Options
'Last loop
300 C
:= Options
(Err_Col
);
302 Err_Col
:= Err_Col
+ 1;
304 -- Turning switches on
316 Style_Check_Indentation
:=
317 Character'Pos (C
) - Character'Pos ('0');
320 Style_Check_Attribute_Casing
:= True;
323 Style_Check_Array_Attribute_Index
:= True;
326 Style_Check_Blanks_At_End
:= True;
329 Style_Check_Boolean_And_Or
:= True;
332 Style_Check_Comments
:= True;
333 Style_Check_Comments_Spacing
:= 2;
336 Style_Check_Comments
:= True;
337 Style_Check_Comments_Spacing
:= 1;
340 Style_Check_DOS_Line_Terminator
:= True;
343 Style_Check_End_Labels
:= True;
346 Style_Check_Form_Feeds
:= True;
349 Set_GNAT_Style_Check_Options
;
352 Style_Check_Horizontal_Tabs
:= True;
355 Style_Check_If_Then_Layout
:= True;
358 Style_Check_Mode_In
:= True;
361 Style_Check_Keyword_Casing
:= True;
364 Style_Check_Layout
:= True;
367 Style_Max_Nesting_Level
:= 0;
369 if Err_Col
> Options
'Last
370 or else Options
(Err_Col
) not in '0' .. '9'
372 Bad_Style_Switch
("invalid nesting level");
377 Style_Max_Nesting_Level
:=
378 Style_Max_Nesting_Level
* 10 +
379 Character'Pos (Options
(Err_Col
)) - Character'Pos ('0');
381 if Style_Max_Nesting_Level
> 999 then
383 ("max nesting level (999) exceeded in style check");
387 Err_Col
:= Err_Col
+ 1;
388 exit when Err_Col
> Options
'Last
389 or else Options
(Err_Col
) not in '0' .. '9';
392 Style_Check_Max_Nesting_Level
:= Style_Max_Nesting_Level
/= 0;
395 Style_Check_Max_Line_Length
:= True;
396 Style_Max_Line_Length
:= 79;
399 Style_Max_Line_Length
:= 0;
401 if Err_Col
> Options
'Last
402 or else Options
(Err_Col
) not in '0' .. '9'
405 ("invalid line length in style check");
410 Style_Max_Line_Length
:=
411 Style_Max_Line_Length
* 10 +
412 Character'Pos (Options
(Err_Col
)) - Character'Pos ('0');
414 if Style_Max_Line_Length
> Int
(Max_Line_Length
) then
416 Style_Msg_Buf
(1 .. 27) := "max line length allowed is ";
418 Add_Img
(Natural (Max_Line_Length
));
422 Err_Col
:= Err_Col
+ 1;
423 exit when Err_Col
> Options
'Last
424 or else Options
(Err_Col
) not in '0' .. '9';
427 Style_Check_Max_Line_Length
:= Style_Max_Line_Length
/= 0;
430 Style_Check_Standard
:= True;
433 Reset_Style_Check_Options
;
436 Style_Check_Order_Subprograms
:= True;
439 Style_Check_Missing_Overriding
:= True;
442 Style_Check_Pragma_Casing
:= True;
445 Style_Check_References
:= True;
448 Style_Check_Specs
:= True;
451 Style_Check_Separate_Stmt_Lines
:= True;
454 Style_Check_Tokens
:= True;
457 Style_Check_Blank_Lines
:= True;
460 Style_Check_Xtra_Parens
:= True;
463 Set_Default_Style_Check_Options
;
469 Err_Col
:= Err_Col
- 1;
470 Bad_Style_Switch
("invalid style switch: " & C
);
474 -- Turning switches off
486 Style_Check_Indentation
:= 0;
489 Style_Check_Attribute_Casing
:= False;
492 Style_Check_Array_Attribute_Index
:= False;
495 Style_Check_Blanks_At_End
:= False;
498 Style_Check_Boolean_And_Or
:= False;
501 Style_Check_Comments
:= False;
504 Style_Check_DOS_Line_Terminator
:= False;
507 Style_Check_End_Labels
:= False;
510 Style_Check_Form_Feeds
:= False;
513 Reset_Style_Check_Options
;
516 Style_Check_Horizontal_Tabs
:= False;
519 Style_Check_If_Then_Layout
:= False;
522 Style_Check_Mode_In
:= False;
525 Style_Check_Keyword_Casing
:= False;
528 Style_Check_Layout
:= False;
531 Style_Max_Nesting_Level
:= 0;
534 Style_Check_Max_Line_Length
:= False;
537 Style_Max_Line_Length
:= 0;
538 Style_Check_Max_Line_Length
:= False;
541 Style_Check_Standard
:= False;
544 Style_Check_Order_Subprograms
:= False;
547 Style_Check_Missing_Overriding
:= False;
550 Style_Check_Pragma_Casing
:= False;
553 Style_Check_References
:= False;
556 Style_Check_Specs
:= False;
559 Style_Check_Separate_Stmt_Lines
:= False;
562 Style_Check_Tokens
:= False;
565 Style_Check_Blank_Lines
:= False;
568 Style_Check_Xtra_Parens
:= False;
574 Err_Col
:= Err_Col
- 1;
575 Bad_Style_Switch
("invalid style switch: " & C
);
581 -- Turn on style checking if other than N at end of string
583 Style_Check
:= (Last_Option
/= 'N');
585 end Set_Style_Check_Options
;