1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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
);
163 Add
('c', Style_Check_Comments
);
164 Add
('d', Style_Check_DOS_Line_Terminator
);
165 Add
('e', Style_Check_End_Labels
);
166 Add
('f', Style_Check_Form_Feeds
);
167 Add
('h', Style_Check_Horizontal_Tabs
);
168 Add
('i', Style_Check_If_Then_Layout
);
169 Add
('I', Style_Check_Mode_In
);
170 Add
('k', Style_Check_Keyword_Casing
);
171 Add
('l', Style_Check_Layout
);
172 Add
('n', Style_Check_Standard
);
173 Add
('o', Style_Check_Order_Subprograms
);
174 Add
('O', Style_Check_Missing_Overriding
);
175 Add
('p', Style_Check_Pragma_Casing
);
176 Add
('r', Style_Check_References
);
177 Add
('s', Style_Check_Specs
);
178 Add
('S', Style_Check_Separate_Stmt_Lines
);
179 Add
('t', Style_Check_Tokens
);
180 Add
('u', Style_Check_Blank_Lines
);
181 Add
('x', Style_Check_Xtra_Parens
);
183 if Style_Check_Max_Line_Length
then
186 Add_Nat
(Style_Max_Line_Length
);
189 if Style_Check_Max_Nesting_Level
then
192 Add_Nat
(Style_Max_Nesting_Level
);
195 pragma Assert
(P
<= Options
'Last);
197 while P
< Options
'Last loop
201 end Save_Style_Check_Options
;
203 -------------------------------------
204 -- Set_Default_Style_Check_Options --
205 -------------------------------------
207 procedure Set_Default_Style_Check_Options
is
209 Reset_Style_Check_Options
;
210 Set_Style_Check_Options
(Default_Style
);
211 end Set_Default_Style_Check_Options
;
213 ----------------------------------
214 -- Set_GNAT_Style_Check_Options --
215 ----------------------------------
217 procedure Set_GNAT_Style_Check_Options
is
219 Reset_Style_Check_Options
;
220 Set_Style_Check_Options
(GNAT_Style
);
221 end Set_GNAT_Style_Check_Options
;
223 -----------------------------
224 -- Set_Style_Check_Options --
225 -----------------------------
227 -- Version used when no error checking is required
229 procedure Set_Style_Check_Options
(Options
: String) is
232 pragma Warnings
(Off
, EC
);
234 Set_Style_Check_Options
(Options
, OK
, EC
);
236 end Set_Style_Check_Options
;
238 -- Normal version with error checking
240 procedure Set_Style_Check_Options
243 Err_Col
: out Natural)
247 On
: Boolean := True;
248 -- Set to False if minus encountered
249 -- Set to True if plus encountered
251 Last_Option
: Character := ' ';
252 -- Set to last character encountered
254 procedure Add_Img
(N
: Natural);
255 -- Concatenates image of N at end of Style_Msg_Buf
257 procedure Bad_Style_Switch
(Msg
: String);
258 -- Called if bad style switch found. Msg is set in Style_Msg_Buf and
259 -- Style_Msg_Len. OK is set False.
265 procedure Add_Img
(N
: Natural) is
271 Style_Msg_Len
:= Style_Msg_Len
+ 1;
272 Style_Msg_Buf
(Style_Msg_Len
) :=
273 Character'Val (N
mod 10 + Character'Pos ('0'));
276 ----------------------
277 -- Bad_Style_Switch --
278 ----------------------
280 procedure Bad_Style_Switch
(Msg
: String) is
283 Style_Msg_Len
:= Msg
'Length;
284 Style_Msg_Buf
(1 .. Style_Msg_Len
) := Msg
;
285 end Bad_Style_Switch
;
287 -- Start of processing for Set_Style_Check_Options
290 Err_Col
:= Options
'First;
291 while Err_Col
<= Options
'Last loop
292 C
:= Options
(Err_Col
);
294 Err_Col
:= Err_Col
+ 1;
296 -- Turning switches on
308 Style_Check_Indentation
:=
309 Character'Pos (C
) - Character'Pos ('0');
312 Style_Check_Attribute_Casing
:= True;
315 Style_Check_Array_Attribute_Index
:= True;
318 Style_Check_Blanks_At_End
:= True;
321 Style_Check_Boolean_And_Or
:= True;
324 Style_Check_Comments
:= True;
327 Style_Check_DOS_Line_Terminator
:= True;
330 Style_Check_End_Labels
:= True;
333 Style_Check_Form_Feeds
:= True;
336 Set_GNAT_Style_Check_Options
;
339 Style_Check_Horizontal_Tabs
:= True;
342 Style_Check_If_Then_Layout
:= True;
345 Style_Check_Mode_In
:= True;
348 Style_Check_Keyword_Casing
:= True;
351 Style_Check_Layout
:= True;
354 Style_Max_Nesting_Level
:= 0;
356 if Err_Col
> Options
'Last
357 or else Options
(Err_Col
) not in '0' .. '9'
359 Bad_Style_Switch
("invalid nesting level");
364 Style_Max_Nesting_Level
:=
365 Style_Max_Nesting_Level
* 10 +
366 Character'Pos (Options
(Err_Col
)) - Character'Pos ('0');
368 if Style_Max_Nesting_Level
> 999 then
370 ("max nesting level (999) exceeded in style check");
374 Err_Col
:= Err_Col
+ 1;
375 exit when Err_Col
> Options
'Last
376 or else Options
(Err_Col
) not in '0' .. '9';
379 Style_Check_Max_Nesting_Level
:= Style_Max_Nesting_Level
/= 0;
382 Style_Check_Max_Line_Length
:= True;
383 Style_Max_Line_Length
:= 79;
386 Style_Max_Line_Length
:= 0;
388 if Err_Col
> Options
'Last
389 or else Options
(Err_Col
) not in '0' .. '9'
392 ("invalid line length in style check");
397 Style_Max_Line_Length
:=
398 Style_Max_Line_Length
* 10 +
399 Character'Pos (Options
(Err_Col
)) - Character'Pos ('0');
401 if Style_Max_Line_Length
> Int
(Max_Line_Length
) then
403 Style_Msg_Buf
(1 .. 27) := "max line length allowed is ";
405 Add_Img
(Natural (Max_Line_Length
));
409 Err_Col
:= Err_Col
+ 1;
410 exit when Err_Col
> Options
'Last
411 or else Options
(Err_Col
) not in '0' .. '9';
414 Style_Check_Max_Line_Length
:= Style_Max_Line_Length
/= 0;
417 Style_Check_Standard
:= True;
420 Reset_Style_Check_Options
;
423 Style_Check_Order_Subprograms
:= True;
426 Style_Check_Missing_Overriding
:= True;
429 Style_Check_Pragma_Casing
:= True;
432 Style_Check_References
:= True;
435 Style_Check_Specs
:= True;
438 Style_Check_Separate_Stmt_Lines
:= True;
441 Style_Check_Tokens
:= True;
444 Style_Check_Blank_Lines
:= True;
447 Style_Check_Xtra_Parens
:= True;
450 Set_Default_Style_Check_Options
;
456 Err_Col
:= Err_Col
- 1;
457 Bad_Style_Switch
("invalid style switch: " & C
);
461 -- Turning switches off
473 Style_Check_Indentation
:= 0;
476 Style_Check_Attribute_Casing
:= False;
479 Style_Check_Array_Attribute_Index
:= False;
482 Style_Check_Blanks_At_End
:= False;
485 Style_Check_Boolean_And_Or
:= False;
488 Style_Check_Comments
:= False;
491 Style_Check_DOS_Line_Terminator
:= False;
494 Style_Check_End_Labels
:= False;
497 Style_Check_Form_Feeds
:= False;
500 Reset_Style_Check_Options
;
503 Style_Check_Horizontal_Tabs
:= False;
506 Style_Check_If_Then_Layout
:= False;
509 Style_Check_Mode_In
:= False;
512 Style_Check_Keyword_Casing
:= False;
515 Style_Check_Layout
:= False;
518 Style_Max_Nesting_Level
:= 0;
521 Style_Check_Max_Line_Length
:= False;
524 Style_Max_Line_Length
:= 0;
525 Style_Check_Max_Line_Length
:= False;
528 Style_Check_Standard
:= False;
531 Style_Check_Order_Subprograms
:= False;
534 Style_Check_Pragma_Casing
:= False;
537 Style_Check_References
:= False;
540 Style_Check_Specs
:= False;
543 Style_Check_Separate_Stmt_Lines
:= False;
546 Style_Check_Tokens
:= False;
549 Style_Check_Blank_Lines
:= False;
552 Style_Check_Xtra_Parens
:= False;
558 Err_Col
:= Err_Col
- 1;
559 Bad_Style_Switch
("invalid style switch: " & C
);
565 -- Turn on style checking if other than N at end of string
567 Style_Check
:= (Last_Option
/= 'N');
569 end Set_Style_Check_Options
;