|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S T Y L E G --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
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 -- This version of the Style package implements the standard GNAT style
|
|
|
27 -- checking rules. For documentation of these rules, see comments on the
|
|
|
28 -- individual procedures.
|
|
|
29
|
|
|
30 with Atree; use Atree;
|
|
|
31 with Casing; use Casing;
|
|
|
32 with Csets; use Csets;
|
|
|
33 with Einfo; use Einfo;
|
|
|
34 with Err_Vars; use Err_Vars;
|
|
|
35 with Opt; use Opt;
|
|
|
36 with Scans; use Scans;
|
|
|
37 with Sinfo; use Sinfo;
|
|
|
38 with Sinput; use Sinput;
|
|
|
39 with Stylesw; use Stylesw;
|
|
|
40
|
|
|
41 package body Styleg is
|
|
|
42
|
|
|
43 use ASCII;
|
|
|
44
|
|
|
45 Blank_Lines : Nat := 0;
|
|
|
46 -- Counts number of empty lines seen. Reset to zero if a non-empty line
|
|
|
47 -- is encountered. Used to check for trailing blank lines in Check_EOF,
|
|
|
48 -- and for multiple blank lines.
|
|
|
49
|
|
|
50 Blank_Line_Location : Source_Ptr;
|
|
|
51 -- Remembers location of first blank line in a series. Used to issue an
|
|
|
52 -- appropriate diagnostic if subsequent blank lines or the end of file
|
|
|
53 -- is encountered.
|
|
|
54
|
|
|
55 -----------------------
|
|
|
56 -- Local Subprograms --
|
|
|
57 -----------------------
|
|
|
58
|
|
|
59 procedure Check_No_Space_After;
|
|
|
60 -- Checks that there is a non-white space character after the current
|
|
|
61 -- token, or white space followed by a comment, or the end of line.
|
|
|
62 -- Issue error message if not.
|
|
|
63
|
|
|
64 procedure Check_No_Space_Before;
|
|
|
65 -- Check that token is first token on line, or else is not preceded
|
|
|
66 -- by white space. Signal error of space not allowed if not.
|
|
|
67
|
|
|
68 procedure Check_Separate_Stmt_Lines_Cont;
|
|
|
69 -- Non-inlined continuation of Check_Separate_Stmt_Lines
|
|
|
70
|
|
|
71 function Determine_Token_Casing return Casing_Type;
|
|
|
72 -- Determine casing of current token
|
|
|
73
|
|
|
74 procedure Error_Space_Not_Allowed (S : Source_Ptr);
|
|
|
75 -- Posts an error message indicating that a space is not allowed
|
|
|
76 -- at the given source location.
|
|
|
77
|
|
|
78 procedure Error_Space_Required (S : Source_Ptr);
|
|
|
79 -- Posts an error message indicating that a space is required at
|
|
|
80 -- the given source location.
|
|
|
81
|
|
|
82 function Is_White_Space (C : Character) return Boolean;
|
|
|
83 pragma Inline (Is_White_Space);
|
|
|
84 -- Returns True for space or HT, False otherwise
|
|
|
85 -- What about VT and FF, should they return True ???
|
|
|
86
|
|
|
87 procedure Require_Following_Space;
|
|
|
88 pragma Inline (Require_Following_Space);
|
|
|
89 -- Require token to be followed by white space. Used only if in GNAT
|
|
|
90 -- style checking mode.
|
|
|
91
|
|
|
92 procedure Require_Preceding_Space;
|
|
|
93 pragma Inline (Require_Preceding_Space);
|
|
|
94 -- Require token to be preceded by white space. Used only if in GNAT
|
|
|
95 -- style checking mode.
|
|
|
96
|
|
|
97 ----------------------
|
|
|
98 -- Check_Abs_Or_Not --
|
|
|
99 ----------------------
|
|
|
100
|
|
|
101 -- In check token mode (-gnatyt), ABS/NOT must be followed by a space
|
|
|
102
|
|
|
103 procedure Check_Abs_Not is
|
|
|
104 begin
|
|
|
105 if Style_Check_Tokens then
|
|
|
106 if Source (Scan_Ptr) > ' ' then -- ???
|
|
|
107 Error_Space_Required (Scan_Ptr);
|
|
|
108 end if;
|
|
|
109 end if;
|
|
|
110 end Check_Abs_Not;
|
|
|
111
|
|
|
112 ----------------------
|
|
|
113 -- Check_Apostrophe --
|
|
|
114 ----------------------
|
|
|
115
|
|
|
116 -- Do not allow space before or after apostrophe -- OR AFTER???
|
|
|
117
|
|
|
118 procedure Check_Apostrophe is
|
|
|
119 begin
|
|
|
120 if Style_Check_Tokens then
|
|
|
121 Check_No_Space_After;
|
|
|
122 end if;
|
|
|
123 end Check_Apostrophe;
|
|
|
124
|
|
|
125 -----------------
|
|
|
126 -- Check_Arrow --
|
|
|
127 -----------------
|
|
|
128
|
|
|
129 -- In check tokens mode (-gnatys), arrow must be surrounded by spaces,
|
|
|
130 -- except that within the argument of a Depends or Refined_Depends aspect
|
|
|
131 -- or pragma the required format is "=>+ " rather than "=> +").
|
|
|
132
|
|
|
133 procedure Check_Arrow (Inside_Depends : Boolean := False) is
|
|
|
134 begin
|
|
|
135 if Style_Check_Tokens then
|
|
|
136 Require_Preceding_Space;
|
|
|
137
|
|
|
138 -- Special handling for Depends and Refined_Depends
|
|
|
139
|
|
|
140 if Inside_Depends then
|
|
|
141 if Source (Scan_Ptr) = ' '
|
|
|
142 and then Source (Scan_Ptr + 1) = '+'
|
|
|
143 then
|
|
|
144 Error_Space_Not_Allowed (Scan_Ptr);
|
|
|
145
|
|
|
146 elsif Source (Scan_Ptr) /= ' '
|
|
|
147 and then Source (Scan_Ptr) /= '+'
|
|
|
148 then
|
|
|
149 Require_Following_Space;
|
|
|
150 end if;
|
|
|
151
|
|
|
152 -- Normal case
|
|
|
153
|
|
|
154 else
|
|
|
155 Require_Following_Space;
|
|
|
156 end if;
|
|
|
157 end if;
|
|
|
158 end Check_Arrow;
|
|
|
159
|
|
|
160 --------------------------
|
|
|
161 -- Check_Attribute_Name --
|
|
|
162 --------------------------
|
|
|
163
|
|
|
164 -- In check attribute casing mode (-gnatya), attribute names must be
|
|
|
165 -- mixed case, i.e. start with an upper case letter, and otherwise
|
|
|
166 -- lower case, except after an underline character.
|
|
|
167
|
|
|
168 procedure Check_Attribute_Name (Reserved : Boolean) is
|
|
|
169 pragma Warnings (Off, Reserved);
|
|
|
170 begin
|
|
|
171 if Style_Check_Attribute_Casing then
|
|
|
172 if Determine_Token_Casing /= Mixed_Case then
|
|
|
173 Error_Msg_SC -- CODEFIX
|
|
|
174 ("(style) bad capitalization, mixed case required");
|
|
|
175 end if;
|
|
|
176 end if;
|
|
|
177 end Check_Attribute_Name;
|
|
|
178
|
|
|
179 ---------------------------
|
|
|
180 -- Check_Binary_Operator --
|
|
|
181 ---------------------------
|
|
|
182
|
|
|
183 -- In check token mode (-gnatyt), binary operators other than the special
|
|
|
184 -- case of exponentiation require surrounding space characters.
|
|
|
185
|
|
|
186 procedure Check_Binary_Operator is
|
|
|
187 begin
|
|
|
188 if Style_Check_Tokens then
|
|
|
189 Require_Preceding_Space;
|
|
|
190 Require_Following_Space;
|
|
|
191 end if;
|
|
|
192 end Check_Binary_Operator;
|
|
|
193
|
|
|
194 ----------------------------
|
|
|
195 -- Check_Boolean_Operator --
|
|
|
196 ----------------------------
|
|
|
197
|
|
|
198 procedure Check_Boolean_Operator (Node : Node_Id) is
|
|
|
199
|
|
|
200 function OK_Boolean_Operand (N : Node_Id) return Boolean;
|
|
|
201 -- Returns True for simple variable, or "not X1" or "X1 and X2" or
|
|
|
202 -- "X1 or X2" where X1, X2 are recursively OK_Boolean_Operand's.
|
|
|
203
|
|
|
204 ------------------------
|
|
|
205 -- OK_Boolean_Operand --
|
|
|
206 ------------------------
|
|
|
207
|
|
|
208 function OK_Boolean_Operand (N : Node_Id) return Boolean is
|
|
|
209 begin
|
|
|
210 if Nkind_In (N, N_Identifier, N_Expanded_Name) then
|
|
|
211 return True;
|
|
|
212
|
|
|
213 elsif Nkind (N) = N_Op_Not then
|
|
|
214 return OK_Boolean_Operand (Original_Node (Right_Opnd (N)));
|
|
|
215
|
|
|
216 elsif Nkind_In (N, N_Op_And, N_Op_Or) then
|
|
|
217 return OK_Boolean_Operand (Original_Node (Left_Opnd (N)))
|
|
|
218 and then
|
|
|
219 OK_Boolean_Operand (Original_Node (Right_Opnd (N)));
|
|
|
220
|
|
|
221 else
|
|
|
222 return False;
|
|
|
223 end if;
|
|
|
224 end OK_Boolean_Operand;
|
|
|
225
|
|
|
226 -- Start of processing for Check_Boolean_Operator
|
|
|
227
|
|
|
228 begin
|
|
|
229 if Style_Check_Boolean_And_Or
|
|
|
230 and then Comes_From_Source (Node)
|
|
|
231 then
|
|
|
232 declare
|
|
|
233 Orig : constant Node_Id := Original_Node (Node);
|
|
|
234
|
|
|
235 begin
|
|
|
236 if Nkind_In (Orig, N_Op_And, N_Op_Or) then
|
|
|
237 declare
|
|
|
238 L : constant Node_Id := Original_Node (Left_Opnd (Orig));
|
|
|
239 R : constant Node_Id := Original_Node (Right_Opnd (Orig));
|
|
|
240
|
|
|
241 begin
|
|
|
242 -- First OK case, simple boolean constants/identifiers
|
|
|
243
|
|
|
244 if OK_Boolean_Operand (L)
|
|
|
245 and then
|
|
|
246 OK_Boolean_Operand (R)
|
|
|
247 then
|
|
|
248 return;
|
|
|
249
|
|
|
250 -- Second OK case, modular types
|
|
|
251
|
|
|
252 elsif Is_Modular_Integer_Type (Etype (Node)) then
|
|
|
253 return;
|
|
|
254
|
|
|
255 -- Third OK case, array types
|
|
|
256
|
|
|
257 elsif Is_Array_Type (Etype (Node)) then
|
|
|
258 return;
|
|
|
259
|
|
|
260 -- Otherwise we have an error
|
|
|
261
|
|
|
262 elsif Nkind (Orig) = N_Op_And then
|
|
|
263 Error_Msg -- CODEFIX
|
|
|
264 ("(style) `AND THEN` required", Sloc (Orig));
|
|
|
265 else
|
|
|
266 Error_Msg -- CODEFIX
|
|
|
267 ("(style) `OR ELSE` required", Sloc (Orig));
|
|
|
268 end if;
|
|
|
269 end;
|
|
|
270 end if;
|
|
|
271 end;
|
|
|
272 end if;
|
|
|
273 end Check_Boolean_Operator;
|
|
|
274
|
|
|
275 ---------------
|
|
|
276 -- Check_Box --
|
|
|
277 ---------------
|
|
|
278
|
|
|
279 -- In check token mode (-gnatyt), box must be preceded by a space or by
|
|
|
280 -- a left parenthesis. Spacing checking on the surrounding tokens takes
|
|
|
281 -- care of the remaining checks.
|
|
|
282
|
|
|
283 procedure Check_Box is
|
|
|
284 begin
|
|
|
285 if Style_Check_Tokens then
|
|
|
286 if Prev_Token /= Tok_Left_Paren then
|
|
|
287 Require_Preceding_Space;
|
|
|
288 end if;
|
|
|
289 end if;
|
|
|
290 end Check_Box;
|
|
|
291
|
|
|
292 -----------------
|
|
|
293 -- Check_Colon --
|
|
|
294 -----------------
|
|
|
295
|
|
|
296 -- In check token mode (-gnatyt), colon must be surrounded by spaces
|
|
|
297
|
|
|
298 procedure Check_Colon is
|
|
|
299 begin
|
|
|
300 if Style_Check_Tokens then
|
|
|
301 Require_Preceding_Space;
|
|
|
302 Require_Following_Space;
|
|
|
303 end if;
|
|
|
304 end Check_Colon;
|
|
|
305
|
|
|
306 -----------------------
|
|
|
307 -- Check_Colon_Equal --
|
|
|
308 -----------------------
|
|
|
309
|
|
|
310 -- In check token mode (-gnatyt), := must be surrounded by spaces
|
|
|
311
|
|
|
312 procedure Check_Colon_Equal is
|
|
|
313 begin
|
|
|
314 if Style_Check_Tokens then
|
|
|
315 Require_Preceding_Space;
|
|
|
316 Require_Following_Space;
|
|
|
317 end if;
|
|
|
318 end Check_Colon_Equal;
|
|
|
319
|
|
|
320 -----------------
|
|
|
321 -- Check_Comma --
|
|
|
322 -----------------
|
|
|
323
|
|
|
324 -- In check token mode (-gnatyt), comma must be either the first
|
|
|
325 -- token on a line, or be preceded by a non-blank character.
|
|
|
326 -- It must also always be followed by a blank.
|
|
|
327
|
|
|
328 procedure Check_Comma is
|
|
|
329 begin
|
|
|
330 if Style_Check_Tokens then
|
|
|
331 Check_No_Space_Before;
|
|
|
332
|
|
|
333 if Source (Scan_Ptr) > ' ' then
|
|
|
334 Error_Space_Required (Scan_Ptr);
|
|
|
335 end if;
|
|
|
336 end if;
|
|
|
337 end Check_Comma;
|
|
|
338
|
|
|
339 -------------------
|
|
|
340 -- Check_Comment --
|
|
|
341 -------------------
|
|
|
342
|
|
|
343 -- In check comment mode (-gnatyc) there are several requirements on the
|
|
|
344 -- format of comments. The following are permissible comment formats:
|
|
|
345
|
|
|
346 -- 1. Any comment that is not at the start of a line, i.e. where the
|
|
|
347 -- initial minuses are not the first non-blank characters on the
|
|
|
348 -- line must have at least one blank after the second minus or a
|
|
|
349 -- special character as defined in rule 5.
|
|
|
350
|
|
|
351 -- 2. A row of all minuses of any length is permitted (see procedure
|
|
|
352 -- box above in the source of this routine).
|
|
|
353
|
|
|
354 -- 3. A comment line starting with two minuses and a space, and ending
|
|
|
355 -- with a space and two minuses. Again see the procedure title box
|
|
|
356 -- immediately above in the source.
|
|
|
357
|
|
|
358 -- 4. A full line comment where two spaces follow the two minus signs.
|
|
|
359 -- This is the normal comment format in GNAT style, as typified by
|
|
|
360 -- the comments you are reading now.
|
|
|
361
|
|
|
362 -- 5. A full line comment where the first character after the second
|
|
|
363 -- minus is a special character, i.e. a character in the ASCII
|
|
|
364 -- range 16#21#..16#2F# or 16#3A#..16#3F#. This allows special
|
|
|
365 -- comments, such as those generated by gnatprep, or those that
|
|
|
366 -- appear in the SPARK annotation language to be accepted.
|
|
|
367
|
|
|
368 -- Note: for GNAT internal files (-gnatg switch set on for the
|
|
|
369 -- compilation), the only special sequence recognized and allowed
|
|
|
370 -- is --! as generated by gnatprep.
|
|
|
371
|
|
|
372 -- 6. In addition, the comment must be properly indented if comment
|
|
|
373 -- indentation checking is active (Style_Check_Indentation non-zero).
|
|
|
374 -- Either the start column must be a multiple of this indentation,
|
|
|
375 -- or the indentation must match that of the next non-blank line,
|
|
|
376 -- or must match the indentation of the immediately preciding line
|
|
|
377 -- if it is non-blank.
|
|
|
378
|
|
|
379 procedure Check_Comment is
|
|
|
380 S : Source_Ptr;
|
|
|
381 C : Character;
|
|
|
382
|
|
|
383 function Is_Box_Comment return Boolean;
|
|
|
384 -- Returns True if the last two characters on the line are -- which
|
|
|
385 -- characterizes a box comment (as for example follows this spec).
|
|
|
386
|
|
|
387 function Is_Special_Character (C : Character) return Boolean;
|
|
|
388 -- Determines if C is a special character (see rule 5 above)
|
|
|
389
|
|
|
390 function Same_Column_As_Next_Non_Blank_Line return Boolean;
|
|
|
391 -- Called for a full line comment. If the indentation of this comment
|
|
|
392 -- matches that of the next non-blank line in the source, then True is
|
|
|
393 -- returned, otherwise False.
|
|
|
394
|
|
|
395 function Same_Column_As_Previous_Line return Boolean;
|
|
|
396 -- Called for a full line comment. If the previous line is blank, then
|
|
|
397 -- returns False. Otherwise, if the indentation of this comment matches
|
|
|
398 -- that of the previous line in the source, then True is returned,
|
|
|
399 -- otherwise False.
|
|
|
400
|
|
|
401 --------------------
|
|
|
402 -- Is_Box_Comment --
|
|
|
403 --------------------
|
|
|
404
|
|
|
405 function Is_Box_Comment return Boolean is
|
|
|
406 S : Source_Ptr;
|
|
|
407
|
|
|
408 begin
|
|
|
409 -- Do we need to worry about UTF_32 line terminators here ???
|
|
|
410
|
|
|
411 S := Scan_Ptr + 3;
|
|
|
412 while Source (S) not in Line_Terminator loop
|
|
|
413 S := S + 1;
|
|
|
414 end loop;
|
|
|
415
|
|
|
416 return Source (S - 1) = '-' and then Source (S - 2) = '-';
|
|
|
417 end Is_Box_Comment;
|
|
|
418
|
|
|
419 --------------------------
|
|
|
420 -- Is_Special_Character --
|
|
|
421 --------------------------
|
|
|
422
|
|
|
423 function Is_Special_Character (C : Character) return Boolean is
|
|
|
424 begin
|
|
|
425 if GNAT_Mode then
|
|
|
426 return C = '!';
|
|
|
427 else
|
|
|
428 return
|
|
|
429 Character'Pos (C) in 16#21# .. 16#2F#
|
|
|
430 or else
|
|
|
431 Character'Pos (C) in 16#3A# .. 16#3F#;
|
|
|
432 end if;
|
|
|
433 end Is_Special_Character;
|
|
|
434
|
|
|
435 ----------------------------------------
|
|
|
436 -- Same_Column_As_Next_Non_Blank_Line --
|
|
|
437 ----------------------------------------
|
|
|
438
|
|
|
439 function Same_Column_As_Next_Non_Blank_Line return Boolean is
|
|
|
440 P : Source_Ptr;
|
|
|
441
|
|
|
442 begin
|
|
|
443 -- Step to end of line
|
|
|
444
|
|
|
445 P := Scan_Ptr + 2;
|
|
|
446 while Source (P) not in Line_Terminator loop
|
|
|
447 P := P + 1;
|
|
|
448 end loop;
|
|
|
449
|
|
|
450 -- Step past blanks, and line terminators (UTF_32 case???)
|
|
|
451
|
|
|
452 while Source (P) <= ' ' and then Source (P) /= EOF loop
|
|
|
453 P := P + 1;
|
|
|
454 end loop;
|
|
|
455
|
|
|
456 -- Compare columns
|
|
|
457
|
|
|
458 return Get_Column_Number (Scan_Ptr) = Get_Column_Number (P);
|
|
|
459 end Same_Column_As_Next_Non_Blank_Line;
|
|
|
460
|
|
|
461 ----------------------------------
|
|
|
462 -- Same_Column_As_Previous_Line --
|
|
|
463 ----------------------------------
|
|
|
464
|
|
|
465 function Same_Column_As_Previous_Line return Boolean is
|
|
|
466 S, P : Source_Ptr;
|
|
|
467
|
|
|
468 begin
|
|
|
469 -- Point S to start of this line, and P to start of previous line
|
|
|
470
|
|
|
471 S := Line_Start (Scan_Ptr);
|
|
|
472 P := S;
|
|
|
473 Backup_Line (P);
|
|
|
474
|
|
|
475 -- Step P to first non-blank character on line
|
|
|
476
|
|
|
477 loop
|
|
|
478 -- If we get back to start of current line, then the previous line
|
|
|
479 -- was blank, and we always return False in that situation.
|
|
|
480
|
|
|
481 if P = S then
|
|
|
482 return False;
|
|
|
483 end if;
|
|
|
484
|
|
|
485 exit when Source (P) /= ' ' and then Source (P) /= ASCII.HT;
|
|
|
486 P := P + 1;
|
|
|
487 end loop;
|
|
|
488
|
|
|
489 -- Compare columns
|
|
|
490
|
|
|
491 return Get_Column_Number (Scan_Ptr) = Get_Column_Number (P);
|
|
|
492 end Same_Column_As_Previous_Line;
|
|
|
493
|
|
|
494 -- Start of processing for Check_Comment
|
|
|
495
|
|
|
496 begin
|
|
|
497 -- Can never have a non-blank character preceding the first minus.
|
|
|
498 -- The "+ 3" is to leave room for a possible byte order mark (BOM);
|
|
|
499 -- we want to avoid a warning for a comment at the start of the
|
|
|
500 -- file just after the BOM.
|
|
|
501
|
|
|
502 if Style_Check_Comments then
|
|
|
503 if Scan_Ptr > Source_First (Current_Source_File) + 3
|
|
|
504 and then Source (Scan_Ptr - 1) > ' '
|
|
|
505 then
|
|
|
506 Error_Msg_S -- CODEFIX
|
|
|
507 ("(style) space required");
|
|
|
508 end if;
|
|
|
509 end if;
|
|
|
510
|
|
|
511 -- For a comment that is not at the start of the line, the only
|
|
|
512 -- requirement is that we cannot have a non-blank character after
|
|
|
513 -- the second minus sign or a special character.
|
|
|
514
|
|
|
515 if Scan_Ptr /= First_Non_Blank_Location then
|
|
|
516 if Style_Check_Comments then
|
|
|
517 if Source (Scan_Ptr + 2) > ' '
|
|
|
518 and then not Is_Special_Character (Source (Scan_Ptr + 2))
|
|
|
519 then
|
|
|
520 Error_Msg -- CODEFIX
|
|
|
521 ("(style) space required", Scan_Ptr + 2);
|
|
|
522 end if;
|
|
|
523 end if;
|
|
|
524
|
|
|
525 return;
|
|
|
526
|
|
|
527 -- Case of a comment that is at the start of a line
|
|
|
528
|
|
|
529 else
|
|
|
530 -- First check, must be in appropriately indented column
|
|
|
531
|
|
|
532 if Style_Check_Indentation /= 0 then
|
|
|
533 if Start_Column rem Style_Check_Indentation /= 0 then
|
|
|
534 if not Same_Column_As_Next_Non_Blank_Line
|
|
|
535 and then not Same_Column_As_Previous_Line
|
|
|
536 then
|
|
|
537 Error_Msg_S -- CODEFIX
|
|
|
538 ("(style) bad column");
|
|
|
539 end if;
|
|
|
540
|
|
|
541 return;
|
|
|
542 end if;
|
|
|
543 end if;
|
|
|
544
|
|
|
545 -- If we are not checking comments, nothing more to do
|
|
|
546
|
|
|
547 if not Style_Check_Comments then
|
|
|
548 return;
|
|
|
549 end if;
|
|
|
550
|
|
|
551 -- Case of not followed by a blank. Usually wrong, but there are
|
|
|
552 -- some exceptions that we permit.
|
|
|
553
|
|
|
554 if Source (Scan_Ptr + 2) /= ' ' then
|
|
|
555 C := Source (Scan_Ptr + 2);
|
|
|
556
|
|
|
557 -- Case of -- all on its own on a line is OK
|
|
|
558
|
|
|
559 if C < ' ' then
|
|
|
560 return;
|
|
|
561 end if;
|
|
|
562
|
|
|
563 -- Case of --x, x special character is OK (gnatprep/SPARK/etc.)
|
|
|
564 -- This is not permitted in internal GNAT implementation units
|
|
|
565 -- except for the case of --! as used by gnatprep output.
|
|
|
566
|
|
|
567 if Is_Special_Character (C) then
|
|
|
568 return;
|
|
|
569 end if;
|
|
|
570
|
|
|
571 -- The only other case in which we allow a character after
|
|
|
572 -- the -- other than a space is when we have a row of minus
|
|
|
573 -- signs (case of header lines for a box comment for example).
|
|
|
574
|
|
|
575 S := Scan_Ptr + 2;
|
|
|
576 while Source (S) >= ' ' loop
|
|
|
577 if Source (S) /= '-' then
|
|
|
578 if Is_Box_Comment
|
|
|
579 or else Style_Check_Comments_Spacing = 1
|
|
|
580 then
|
|
|
581 Error_Space_Required (Scan_Ptr + 2);
|
|
|
582 else
|
|
|
583 Error_Msg -- CODEFIX
|
|
|
584 ("(style) two spaces required", Scan_Ptr + 2);
|
|
|
585 end if;
|
|
|
586
|
|
|
587 return;
|
|
|
588 end if;
|
|
|
589
|
|
|
590 S := S + 1;
|
|
|
591 end loop;
|
|
|
592
|
|
|
593 -- If we are followed by a blank, then the comment is OK if the
|
|
|
594 -- character following this blank is another blank or a format
|
|
|
595 -- effector, or if the required comment spacing is 1.
|
|
|
596
|
|
|
597 elsif Source (Scan_Ptr + 3) <= ' '
|
|
|
598 or else Style_Check_Comments_Spacing = 1
|
|
|
599 then
|
|
|
600 return;
|
|
|
601
|
|
|
602 -- Here is the case where we only have one blank after the two minus
|
|
|
603 -- signs, with Style_Check_Comments_Spacing set to 2, which is an
|
|
|
604 -- error unless the line ends with two minus signs, the case of a
|
|
|
605 -- box comment.
|
|
|
606
|
|
|
607 elsif not Is_Box_Comment then
|
|
|
608 Error_Space_Required (Scan_Ptr + 3);
|
|
|
609 end if;
|
|
|
610 end if;
|
|
|
611 end Check_Comment;
|
|
|
612
|
|
|
613 -------------------
|
|
|
614 -- Check_Dot_Dot --
|
|
|
615 -------------------
|
|
|
616
|
|
|
617 -- In check token mode (-gnatyt), ".." must be surrounded by spaces
|
|
|
618
|
|
|
619 procedure Check_Dot_Dot is
|
|
|
620 begin
|
|
|
621 if Style_Check_Tokens then
|
|
|
622 Require_Preceding_Space;
|
|
|
623 Require_Following_Space;
|
|
|
624 end if;
|
|
|
625 end Check_Dot_Dot;
|
|
|
626
|
|
|
627 ---------------
|
|
|
628 -- Check_EOF --
|
|
|
629 ---------------
|
|
|
630
|
|
|
631 -- In check blanks at end mode, check no blank lines precede the EOF
|
|
|
632
|
|
|
633 procedure Check_EOF is
|
|
|
634 begin
|
|
|
635 if Style_Check_Blank_Lines then
|
|
|
636
|
|
|
637 -- We expect one blank line, from the EOF, but no more than one
|
|
|
638
|
|
|
639 if Blank_Lines = 2 then
|
|
|
640 Error_Msg -- CODEFIX
|
|
|
641 ("(style) blank line not allowed at end of file",
|
|
|
642 Blank_Line_Location);
|
|
|
643
|
|
|
644 elsif Blank_Lines >= 3 then
|
|
|
645 Error_Msg -- CODEFIX
|
|
|
646 ("(style) blank lines not allowed at end of file",
|
|
|
647 Blank_Line_Location);
|
|
|
648 end if;
|
|
|
649 end if;
|
|
|
650 end Check_EOF;
|
|
|
651
|
|
|
652 -----------------------------------
|
|
|
653 -- Check_Exponentiation_Operator --
|
|
|
654 -----------------------------------
|
|
|
655
|
|
|
656 -- No spaces are required for the ** operator in GNAT style check mode
|
|
|
657
|
|
|
658 procedure Check_Exponentiation_Operator is
|
|
|
659 begin
|
|
|
660 null;
|
|
|
661 end Check_Exponentiation_Operator;
|
|
|
662
|
|
|
663 --------------
|
|
|
664 -- Check_HT --
|
|
|
665 --------------
|
|
|
666
|
|
|
667 -- In check horizontal tab mode (-gnatyh), tab characters are not allowed
|
|
|
668
|
|
|
669 procedure Check_HT is
|
|
|
670 begin
|
|
|
671 if Style_Check_Horizontal_Tabs then
|
|
|
672 Error_Msg_S -- CODEFIX
|
|
|
673 ("(style) horizontal tab not allowed");
|
|
|
674 end if;
|
|
|
675 end Check_HT;
|
|
|
676
|
|
|
677 -----------------------
|
|
|
678 -- Check_Indentation --
|
|
|
679 -----------------------
|
|
|
680
|
|
|
681 -- In check indentation mode (-gnaty? for ? a digit), a new statement or
|
|
|
682 -- declaration is required to start in a column that is a multiple of the
|
|
|
683 -- indentation amount.
|
|
|
684
|
|
|
685 procedure Check_Indentation is
|
|
|
686 begin
|
|
|
687 if Style_Check_Indentation /= 0 then
|
|
|
688 if Token_Ptr = First_Non_Blank_Location
|
|
|
689 and then Start_Column rem Style_Check_Indentation /= 0
|
|
|
690 then
|
|
|
691 Error_Msg_SC -- CODEFIX
|
|
|
692 ("(style) bad indentation");
|
|
|
693 end if;
|
|
|
694 end if;
|
|
|
695 end Check_Indentation;
|
|
|
696
|
|
|
697 ----------------------
|
|
|
698 -- Check_Left_Paren --
|
|
|
699 ----------------------
|
|
|
700
|
|
|
701 -- In check token mode (-gnatyt), left paren must not be preceded by an
|
|
|
702 -- identifier character or digit (a separating space is required) and may
|
|
|
703 -- never be followed by a space.
|
|
|
704
|
|
|
705 procedure Check_Left_Paren is
|
|
|
706 begin
|
|
|
707 if Style_Check_Tokens then
|
|
|
708 if Token_Ptr > Source_First (Current_Source_File)
|
|
|
709 and then Identifier_Char (Source (Token_Ptr - 1))
|
|
|
710 then
|
|
|
711 Error_Space_Required (Token_Ptr);
|
|
|
712 end if;
|
|
|
713
|
|
|
714 Check_No_Space_After;
|
|
|
715 end if;
|
|
|
716 end Check_Left_Paren;
|
|
|
717
|
|
|
718 ---------------------------
|
|
|
719 -- Check_Line_Max_Length --
|
|
|
720 ---------------------------
|
|
|
721
|
|
|
722 -- In check max line length mode (-gnatym), the line length must
|
|
|
723 -- not exceed the permitted maximum value.
|
|
|
724
|
|
|
725 procedure Check_Line_Max_Length (Len : Nat) is
|
|
|
726 begin
|
|
|
727 if Style_Check_Max_Line_Length then
|
|
|
728 if Len > Style_Max_Line_Length then
|
|
|
729 Error_Msg
|
|
|
730 ("(style) this line is too long",
|
|
|
731 Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
|
|
|
732 end if;
|
|
|
733 end if;
|
|
|
734 end Check_Line_Max_Length;
|
|
|
735
|
|
|
736 ---------------------------
|
|
|
737 -- Check_Line_Terminator --
|
|
|
738 ---------------------------
|
|
|
739
|
|
|
740 -- In check blanks at end mode (-gnatyb), lines may not end with a
|
|
|
741 -- trailing space.
|
|
|
742
|
|
|
743 -- In check form feeds mode (-gnatyf), the line terminator may not
|
|
|
744 -- be either of the characters FF or VT.
|
|
|
745
|
|
|
746 -- In check DOS line terminators node (-gnatyd), the line terminator
|
|
|
747 -- must be a single LF, without a following CR.
|
|
|
748
|
|
|
749 procedure Check_Line_Terminator (Len : Nat) is
|
|
|
750 S : Source_Ptr;
|
|
|
751
|
|
|
752 L : Nat := Len;
|
|
|
753 -- Length of line (adjusted down for blanks at end of line)
|
|
|
754
|
|
|
755 begin
|
|
|
756 -- Reset count of blank lines if first line
|
|
|
757
|
|
|
758 if Get_Logical_Line_Number (Scan_Ptr) = 1 then
|
|
|
759 Blank_Lines := 0;
|
|
|
760 end if;
|
|
|
761
|
|
|
762 -- Check FF/VT terminators
|
|
|
763
|
|
|
764 if Style_Check_Form_Feeds then
|
|
|
765 if Source (Scan_Ptr) = ASCII.FF then
|
|
|
766 Error_Msg_S -- CODEFIX
|
|
|
767 ("(style) form feed not allowed");
|
|
|
768 elsif Source (Scan_Ptr) = ASCII.VT then
|
|
|
769 Error_Msg_S -- CODEFIX
|
|
|
770 ("(style) vertical tab not allowed");
|
|
|
771 end if;
|
|
|
772 end if;
|
|
|
773
|
|
|
774 -- Check DOS line terminator
|
|
|
775
|
|
|
776 if Style_Check_DOS_Line_Terminator then
|
|
|
777
|
|
|
778 -- Ignore EOF, since we only get called with an EOF if it is the last
|
|
|
779 -- character in the buffer (and was therefore not in the source
|
|
|
780 -- file), since the terminating EOF is added to stop the scan.
|
|
|
781
|
|
|
782 if Source (Scan_Ptr) = EOF then
|
|
|
783 null;
|
|
|
784
|
|
|
785 -- Bad terminator if we don't have an LF
|
|
|
786
|
|
|
787 elsif Source (Scan_Ptr) /= LF then
|
|
|
788 Error_Msg_S ("(style) incorrect line terminator");
|
|
|
789 end if;
|
|
|
790 end if;
|
|
|
791
|
|
|
792 -- Remove trailing spaces
|
|
|
793
|
|
|
794 S := Scan_Ptr;
|
|
|
795 while L > 0 and then Is_White_Space (Source (S - 1)) loop
|
|
|
796 S := S - 1;
|
|
|
797 L := L - 1;
|
|
|
798 end loop;
|
|
|
799
|
|
|
800 -- Issue message for blanks at end of line if option enabled
|
|
|
801
|
|
|
802 if Style_Check_Blanks_At_End and then L < Len then
|
|
|
803 Error_Msg -- CODEFIX
|
|
|
804 ("(style) trailing spaces not permitted", S);
|
|
|
805 end if;
|
|
|
806
|
|
|
807 -- Deal with empty (blank) line
|
|
|
808
|
|
|
809 if L = 0 then
|
|
|
810
|
|
|
811 -- Increment blank line count
|
|
|
812
|
|
|
813 Blank_Lines := Blank_Lines + 1;
|
|
|
814
|
|
|
815 -- If first blank line, record location for later error message
|
|
|
816
|
|
|
817 if Blank_Lines = 1 then
|
|
|
818 Blank_Line_Location := Scan_Ptr;
|
|
|
819 end if;
|
|
|
820
|
|
|
821 -- Non-blank line, check for previous multiple blank lines
|
|
|
822
|
|
|
823 else
|
|
|
824 if Style_Check_Blank_Lines and then Blank_Lines > 1 then
|
|
|
825 Error_Msg -- CODEFIX
|
|
|
826 ("(style) multiple blank lines", Blank_Line_Location);
|
|
|
827 end if;
|
|
|
828
|
|
|
829 -- And reset blank line count
|
|
|
830
|
|
|
831 Blank_Lines := 0;
|
|
|
832 end if;
|
|
|
833 end Check_Line_Terminator;
|
|
|
834
|
|
|
835 ------------------
|
|
|
836 -- Check_Not_In --
|
|
|
837 ------------------
|
|
|
838
|
|
|
839 -- In check tokens mode, only one space between NOT and IN
|
|
|
840
|
|
|
841 procedure Check_Not_In is
|
|
|
842 begin
|
|
|
843 if Style_Check_Tokens then
|
|
|
844 if Source (Token_Ptr - 1) /= ' '
|
|
|
845 or else Token_Ptr - Prev_Token_Ptr /= 4
|
|
|
846 then -- CODEFIX?
|
|
|
847 Error_Msg
|
|
|
848 ("(style) single space must separate NOT and IN", Token_Ptr - 1);
|
|
|
849 end if;
|
|
|
850 end if;
|
|
|
851 end Check_Not_In;
|
|
|
852
|
|
|
853 --------------------------
|
|
|
854 -- Check_No_Space_After --
|
|
|
855 --------------------------
|
|
|
856
|
|
|
857 procedure Check_No_Space_After is
|
|
|
858 S : Source_Ptr;
|
|
|
859
|
|
|
860 begin
|
|
|
861 if Is_White_Space (Source (Scan_Ptr)) then
|
|
|
862
|
|
|
863 -- Allow one or more spaces if followed by comment
|
|
|
864
|
|
|
865 S := Scan_Ptr + 1;
|
|
|
866 loop
|
|
|
867 if Source (S) = '-' and then Source (S + 1) = '-' then
|
|
|
868 return;
|
|
|
869
|
|
|
870 elsif Is_White_Space (Source (S)) then
|
|
|
871 S := S + 1;
|
|
|
872
|
|
|
873 else
|
|
|
874 exit;
|
|
|
875 end if;
|
|
|
876 end loop;
|
|
|
877
|
|
|
878 Error_Space_Not_Allowed (Scan_Ptr);
|
|
|
879 end if;
|
|
|
880 end Check_No_Space_After;
|
|
|
881
|
|
|
882 ---------------------------
|
|
|
883 -- Check_No_Space_Before --
|
|
|
884 ---------------------------
|
|
|
885
|
|
|
886 procedure Check_No_Space_Before is
|
|
|
887 begin
|
|
|
888 if Token_Ptr > First_Non_Blank_Location
|
|
|
889 and then Source (Token_Ptr - 1) <= ' '
|
|
|
890 then
|
|
|
891 Error_Space_Not_Allowed (Token_Ptr - 1);
|
|
|
892 end if;
|
|
|
893 end Check_No_Space_Before;
|
|
|
894
|
|
|
895 -----------------------
|
|
|
896 -- Check_Pragma_Name --
|
|
|
897 -----------------------
|
|
|
898
|
|
|
899 -- In check pragma casing mode (-gnatyp), pragma names must be mixed
|
|
|
900 -- case, i.e. start with an upper case letter, and otherwise lower case,
|
|
|
901 -- except after an underline character.
|
|
|
902
|
|
|
903 procedure Check_Pragma_Name is
|
|
|
904 begin
|
|
|
905 if Style_Check_Pragma_Casing then
|
|
|
906 if Determine_Token_Casing /= Mixed_Case then
|
|
|
907 Error_Msg_SC -- CODEFIX
|
|
|
908 ("(style) bad capitalization, mixed case required");
|
|
|
909 end if;
|
|
|
910 end if;
|
|
|
911 end Check_Pragma_Name;
|
|
|
912
|
|
|
913 -----------------------
|
|
|
914 -- Check_Right_Paren --
|
|
|
915 -----------------------
|
|
|
916
|
|
|
917 -- In check token mode (-gnatyt), right paren must not be immediately
|
|
|
918 -- followed by an identifier character, and must never be preceded by
|
|
|
919 -- a space unless it is the initial non-blank character on the line.
|
|
|
920
|
|
|
921 procedure Check_Right_Paren is
|
|
|
922 begin
|
|
|
923 if Style_Check_Tokens then
|
|
|
924 if Identifier_Char (Source (Token_Ptr + 1)) then
|
|
|
925 Error_Space_Required (Token_Ptr + 1);
|
|
|
926 end if;
|
|
|
927
|
|
|
928 Check_No_Space_Before;
|
|
|
929 end if;
|
|
|
930 end Check_Right_Paren;
|
|
|
931
|
|
|
932 ---------------------
|
|
|
933 -- Check_Semicolon --
|
|
|
934 ---------------------
|
|
|
935
|
|
|
936 -- In check token mode (-gnatyt), semicolon does not permit a preceding
|
|
|
937 -- space and a following space is required.
|
|
|
938
|
|
|
939 procedure Check_Semicolon is
|
|
|
940 begin
|
|
|
941 if Style_Check_Tokens then
|
|
|
942 Check_No_Space_Before;
|
|
|
943
|
|
|
944 if Source (Scan_Ptr) > ' ' then
|
|
|
945 Error_Space_Required (Scan_Ptr);
|
|
|
946 end if;
|
|
|
947 end if;
|
|
|
948 end Check_Semicolon;
|
|
|
949
|
|
|
950 -------------------------------
|
|
|
951 -- Check_Separate_Stmt_Lines --
|
|
|
952 -------------------------------
|
|
|
953
|
|
|
954 procedure Check_Separate_Stmt_Lines is
|
|
|
955 begin
|
|
|
956 if Style_Check_Separate_Stmt_Lines then
|
|
|
957 Check_Separate_Stmt_Lines_Cont;
|
|
|
958 end if;
|
|
|
959 end Check_Separate_Stmt_Lines;
|
|
|
960
|
|
|
961 ------------------------------------
|
|
|
962 -- Check_Separate_Stmt_Lines_Cont --
|
|
|
963 ------------------------------------
|
|
|
964
|
|
|
965 procedure Check_Separate_Stmt_Lines_Cont is
|
|
|
966 S : Source_Ptr;
|
|
|
967
|
|
|
968 begin
|
|
|
969 -- Skip past white space
|
|
|
970
|
|
|
971 S := Scan_Ptr;
|
|
|
972 while Is_White_Space (Source (S)) loop
|
|
|
973 S := S + 1;
|
|
|
974 end loop;
|
|
|
975
|
|
|
976 -- Line terminator is OK
|
|
|
977
|
|
|
978 if Source (S) in Line_Terminator then
|
|
|
979 return;
|
|
|
980
|
|
|
981 -- Comment is OK
|
|
|
982
|
|
|
983 elsif Source (S) = '-' and then Source (S + 1) = '-' then
|
|
|
984 return;
|
|
|
985
|
|
|
986 -- ABORT keyword is OK after THEN (THEN ABORT case)
|
|
|
987
|
|
|
988 elsif Token = Tok_Then
|
|
|
989 and then (Source (S + 0) = 'a' or else Source (S + 0) = 'A')
|
|
|
990 and then (Source (S + 1) = 'b' or else Source (S + 1) = 'B')
|
|
|
991 and then (Source (S + 2) = 'o' or else Source (S + 2) = 'O')
|
|
|
992 and then (Source (S + 3) = 'r' or else Source (S + 3) = 'R')
|
|
|
993 and then (Source (S + 4) = 't' or else Source (S + 4) = 'T')
|
|
|
994 and then (Source (S + 5) in Line_Terminator
|
|
|
995 or else Is_White_Space (Source (S + 5)))
|
|
|
996 then
|
|
|
997 return;
|
|
|
998
|
|
|
999 -- PRAGMA keyword is OK after ELSE
|
|
|
1000
|
|
|
1001 elsif Token = Tok_Else
|
|
|
1002 and then (Source (S + 0) = 'p' or else Source (S + 0) = 'P')
|
|
|
1003 and then (Source (S + 1) = 'r' or else Source (S + 1) = 'R')
|
|
|
1004 and then (Source (S + 2) = 'a' or else Source (S + 2) = 'A')
|
|
|
1005 and then (Source (S + 3) = 'g' or else Source (S + 3) = 'G')
|
|
|
1006 and then (Source (S + 4) = 'm' or else Source (S + 4) = 'M')
|
|
|
1007 and then (Source (S + 5) = 'a' or else Source (S + 5) = 'A')
|
|
|
1008 and then (Source (S + 6) in Line_Terminator
|
|
|
1009 or else Is_White_Space (Source (S + 6)))
|
|
|
1010 then
|
|
|
1011 return;
|
|
|
1012
|
|
|
1013 -- Otherwise we have the style violation we are looking for
|
|
|
1014
|
|
|
1015 else
|
|
|
1016 if Token = Tok_Then then
|
|
|
1017 Error_Msg -- CODEFIX
|
|
|
1018 ("(style) no statements may follow THEN on same line", S);
|
|
|
1019 else
|
|
|
1020 Error_Msg
|
|
|
1021 ("(style) no statements may follow ELSE on same line", S);
|
|
|
1022 end if;
|
|
|
1023 end if;
|
|
|
1024 end Check_Separate_Stmt_Lines_Cont;
|
|
|
1025
|
|
|
1026 ----------------
|
|
|
1027 -- Check_Then --
|
|
|
1028 ----------------
|
|
|
1029
|
|
|
1030 -- In check if then layout mode (-gnatyi), we expect a THEN keyword to
|
|
|
1031 -- appear either on the same line as the IF, or on a separate line if
|
|
|
1032 -- the IF statement extends for more than one line.
|
|
|
1033
|
|
|
1034 procedure Check_Then (If_Loc : Source_Ptr) is
|
|
|
1035 begin
|
|
|
1036 if Style_Check_If_Then_Layout then
|
|
|
1037 declare
|
|
|
1038 If_Line : constant Physical_Line_Number :=
|
|
|
1039 Get_Physical_Line_Number (If_Loc);
|
|
|
1040 Then_Line : constant Physical_Line_Number :=
|
|
|
1041 Get_Physical_Line_Number (Token_Ptr);
|
|
|
1042 begin
|
|
|
1043 if If_Line = Then_Line then
|
|
|
1044 null;
|
|
|
1045 elsif Token_Ptr /= First_Non_Blank_Location then
|
|
|
1046 Error_Msg_SC ("(style) misplaced THEN");
|
|
|
1047 end if;
|
|
|
1048 end;
|
|
|
1049 end if;
|
|
|
1050 end Check_Then;
|
|
|
1051
|
|
|
1052 -------------------------------
|
|
|
1053 -- Check_Unary_Plus_Or_Minus --
|
|
|
1054 -------------------------------
|
|
|
1055
|
|
|
1056 -- In check token mode (-gnatyt), unary plus or minus must not be
|
|
|
1057 -- followed by a space.
|
|
|
1058
|
|
|
1059 -- Annoying exception: if we have the sequence =>+ within a Depends or
|
|
|
1060 -- Refined_Depends pragma or aspect, then we insist on a space rather
|
|
|
1061 -- than forbidding it.
|
|
|
1062
|
|
|
1063 procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False) is
|
|
|
1064 begin
|
|
|
1065 if Style_Check_Tokens then
|
|
|
1066 if Inside_Depends then
|
|
|
1067 Require_Following_Space;
|
|
|
1068 else
|
|
|
1069 Check_No_Space_After;
|
|
|
1070 end if;
|
|
|
1071 end if;
|
|
|
1072 end Check_Unary_Plus_Or_Minus;
|
|
|
1073
|
|
|
1074 ------------------------
|
|
|
1075 -- Check_Vertical_Bar --
|
|
|
1076 ------------------------
|
|
|
1077
|
|
|
1078 -- In check token mode (-gnatyt), vertical bar must be surrounded by spaces
|
|
|
1079
|
|
|
1080 procedure Check_Vertical_Bar is
|
|
|
1081 begin
|
|
|
1082 if Style_Check_Tokens then
|
|
|
1083 Require_Preceding_Space;
|
|
|
1084 Require_Following_Space;
|
|
|
1085 end if;
|
|
|
1086 end Check_Vertical_Bar;
|
|
|
1087
|
|
|
1088 -----------------------
|
|
|
1089 -- Check_Xtra_Parens --
|
|
|
1090 -----------------------
|
|
|
1091
|
|
|
1092 procedure Check_Xtra_Parens (Loc : Source_Ptr) is
|
|
|
1093 begin
|
|
|
1094 if Style_Check_Xtra_Parens then
|
|
|
1095 Error_Msg -- CODEFIX
|
|
|
1096 ("(style) redundant parentheses", Loc);
|
|
|
1097 end if;
|
|
|
1098 end Check_Xtra_Parens;
|
|
|
1099
|
|
|
1100 ----------------------------
|
|
|
1101 -- Determine_Token_Casing --
|
|
|
1102 ----------------------------
|
|
|
1103
|
|
|
1104 function Determine_Token_Casing return Casing_Type is
|
|
|
1105 begin
|
|
|
1106 return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1));
|
|
|
1107 end Determine_Token_Casing;
|
|
|
1108
|
|
|
1109 -----------------------------
|
|
|
1110 -- Error_Space_Not_Allowed --
|
|
|
1111 -----------------------------
|
|
|
1112
|
|
|
1113 procedure Error_Space_Not_Allowed (S : Source_Ptr) is
|
|
|
1114 begin
|
|
|
1115 Error_Msg -- CODEFIX
|
|
|
1116 ("(style) space not allowed", S);
|
|
|
1117 end Error_Space_Not_Allowed;
|
|
|
1118
|
|
|
1119 --------------------------
|
|
|
1120 -- Error_Space_Required --
|
|
|
1121 --------------------------
|
|
|
1122
|
|
|
1123 procedure Error_Space_Required (S : Source_Ptr) is
|
|
|
1124 begin
|
|
|
1125 Error_Msg -- CODEFIX
|
|
|
1126 ("(style) space required", S);
|
|
|
1127 end Error_Space_Required;
|
|
|
1128
|
|
|
1129 --------------------
|
|
|
1130 -- Is_White_Space --
|
|
|
1131 --------------------
|
|
|
1132
|
|
|
1133 function Is_White_Space (C : Character) return Boolean is
|
|
|
1134 begin
|
|
|
1135 return C = ' ' or else C = HT;
|
|
|
1136 end Is_White_Space;
|
|
|
1137
|
|
|
1138 -------------------
|
|
|
1139 -- Mode_In_Check --
|
|
|
1140 -------------------
|
|
|
1141
|
|
|
1142 function Mode_In_Check return Boolean is
|
|
|
1143 begin
|
|
|
1144 return Style_Check and Style_Check_Mode_In;
|
|
|
1145 end Mode_In_Check;
|
|
|
1146
|
|
|
1147 -----------------
|
|
|
1148 -- No_End_Name --
|
|
|
1149 -----------------
|
|
|
1150
|
|
|
1151 -- In check end/exit labels mode (-gnatye), always require the name of
|
|
|
1152 -- a subprogram or package to be present on the END, so this is an error.
|
|
|
1153
|
|
|
1154 procedure No_End_Name (Name : Node_Id) is
|
|
|
1155 begin
|
|
|
1156 if Style_Check_End_Labels then
|
|
|
1157 Error_Msg_Node_1 := Name;
|
|
|
1158 Error_Msg_SP -- CODEFIX
|
|
|
1159 ("(style) `END &` required");
|
|
|
1160 end if;
|
|
|
1161 end No_End_Name;
|
|
|
1162
|
|
|
1163 ------------------
|
|
|
1164 -- No_Exit_Name --
|
|
|
1165 ------------------
|
|
|
1166
|
|
|
1167 -- In check end/exit labels mode (-gnatye), always require the name of
|
|
|
1168 -- the loop to be present on the EXIT when exiting a named loop.
|
|
|
1169
|
|
|
1170 procedure No_Exit_Name (Name : Node_Id) is
|
|
|
1171 begin
|
|
|
1172 if Style_Check_End_Labels then
|
|
|
1173 Error_Msg_Node_1 := Name;
|
|
|
1174 Error_Msg_SP -- CODEFIX
|
|
|
1175 ("(style) `EXIT &` required");
|
|
|
1176 end if;
|
|
|
1177 end No_Exit_Name;
|
|
|
1178
|
|
|
1179 ----------------------------
|
|
|
1180 -- Non_Lower_Case_Keyword --
|
|
|
1181 ----------------------------
|
|
|
1182
|
|
|
1183 -- In check casing mode (-gnatyk), reserved keywords must be spelled
|
|
|
1184 -- in all lower case (excluding keywords range, access, delta and digits
|
|
|
1185 -- used as attribute designators).
|
|
|
1186
|
|
|
1187 procedure Non_Lower_Case_Keyword is
|
|
|
1188 begin
|
|
|
1189 if Style_Check_Keyword_Casing then
|
|
|
1190 Error_Msg_SC -- CODEFIX
|
|
|
1191 ("(style) reserved words must be all lower case");
|
|
|
1192 end if;
|
|
|
1193 end Non_Lower_Case_Keyword;
|
|
|
1194
|
|
|
1195 -----------------------------
|
|
|
1196 -- Require_Following_Space --
|
|
|
1197 -----------------------------
|
|
|
1198
|
|
|
1199 procedure Require_Following_Space is
|
|
|
1200 begin
|
|
|
1201 if Source (Scan_Ptr) > ' ' then
|
|
|
1202 Error_Space_Required (Scan_Ptr);
|
|
|
1203 end if;
|
|
|
1204 end Require_Following_Space;
|
|
|
1205
|
|
|
1206 -----------------------------
|
|
|
1207 -- Require_Preceding_Space --
|
|
|
1208 -----------------------------
|
|
|
1209
|
|
|
1210 procedure Require_Preceding_Space is
|
|
|
1211 begin
|
|
|
1212 if Token_Ptr > Source_First (Current_Source_File)
|
|
|
1213 and then Source (Token_Ptr - 1) > ' '
|
|
|
1214 then
|
|
|
1215 Error_Space_Required (Token_Ptr);
|
|
|
1216 end if;
|
|
|
1217 end Require_Preceding_Space;
|
|
|
1218
|
|
|
1219 end Styleg;
|
