1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S T Y L E G -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2020, 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-- 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 30with Atree; use Atree; 31with Casing; use Casing; 32with Csets; use Csets; 33with Einfo; use Einfo; 34with Err_Vars; use Err_Vars; 35with Opt; use Opt; 36with Scans; use Scans; 37with Sinfo; use Sinfo; 38with Sinput; use Sinput; 39with Stylesw; use Stylesw; 40 41package 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 (N) in 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 (N) in 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 (Orig) in 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_Defining_Identifier_Casing -- 615 -------------------------------------- 616 617 procedure Check_Defining_Identifier_Casing is 618 begin 619 if Style_Check_Mixed_Case_Decls then 620 case Determine_Token_Casing is 621 when All_Lower_Case 622 | All_Upper_Case 623 => 624 Error_Msg_SC -- CODEFIX 625 ("(style) bad capitalization, mixed case required"); 626 627 -- The Unknown case is something like A_B_C, which is both all 628 -- caps and mixed case. 629 630 when Mixed_Case 631 | Unknown 632 => 633 null; -- OK 634 end case; 635 end if; 636 end Check_Defining_Identifier_Casing; 637 638 ------------------- 639 -- Check_Dot_Dot -- 640 ------------------- 641 642 -- In check token mode (-gnatyt), ".." must be surrounded by spaces 643 644 procedure Check_Dot_Dot is 645 begin 646 if Style_Check_Tokens then 647 Require_Preceding_Space; 648 Require_Following_Space; 649 end if; 650 end Check_Dot_Dot; 651 652 --------------- 653 -- Check_EOF -- 654 --------------- 655 656 -- In check blanks at end mode, check no blank lines precede the EOF 657 658 procedure Check_EOF is 659 begin 660 if Style_Check_Blank_Lines then 661 662 -- We expect one blank line, from the EOF, but no more than one 663 664 if Blank_Lines = 2 then 665 Error_Msg -- CODEFIX 666 ("(style) blank line not allowed at end of file", 667 Blank_Line_Location); 668 669 elsif Blank_Lines >= 3 then 670 Error_Msg -- CODEFIX 671 ("(style) blank lines not allowed at end of file", 672 Blank_Line_Location); 673 end if; 674 end if; 675 end Check_EOF; 676 677 ----------------------------------- 678 -- Check_Exponentiation_Operator -- 679 ----------------------------------- 680 681 -- No spaces are required for the ** operator in GNAT style check mode 682 683 procedure Check_Exponentiation_Operator is 684 begin 685 null; 686 end Check_Exponentiation_Operator; 687 688 -------------- 689 -- Check_HT -- 690 -------------- 691 692 -- In check horizontal tab mode (-gnatyh), tab characters are not allowed 693 694 procedure Check_HT is 695 begin 696 if Style_Check_Horizontal_Tabs then 697 Error_Msg_S -- CODEFIX 698 ("(style) horizontal tab not allowed"); 699 end if; 700 end Check_HT; 701 702 ----------------------- 703 -- Check_Indentation -- 704 ----------------------- 705 706 -- In check indentation mode (-gnaty? for ? a digit), a new statement or 707 -- declaration is required to start in a column that is a multiple of the 708 -- indentation amount. 709 710 procedure Check_Indentation is 711 begin 712 if Style_Check_Indentation /= 0 then 713 if Token_Ptr = First_Non_Blank_Location 714 and then Start_Column rem Style_Check_Indentation /= 0 715 then 716 Error_Msg_SC -- CODEFIX 717 ("(style) bad indentation"); 718 end if; 719 end if; 720 end Check_Indentation; 721 722 ---------------------- 723 -- Check_Left_Paren -- 724 ---------------------- 725 726 -- In check token mode (-gnatyt), left paren must not be preceded by an 727 -- identifier character or digit (a separating space is required) and may 728 -- never be followed by a space. 729 730 procedure Check_Left_Paren is 731 begin 732 if Style_Check_Tokens then 733 if Token_Ptr > Source_First (Current_Source_File) 734 and then Identifier_Char (Source (Token_Ptr - 1)) 735 then 736 Error_Space_Required (Token_Ptr); 737 end if; 738 739 Check_No_Space_After; 740 end if; 741 end Check_Left_Paren; 742 743 --------------------------- 744 -- Check_Line_Max_Length -- 745 --------------------------- 746 747 -- In check max line length mode (-gnatym), the line length must 748 -- not exceed the permitted maximum value. 749 750 procedure Check_Line_Max_Length (Len : Nat) is 751 begin 752 if Style_Check_Max_Line_Length then 753 if Len > Style_Max_Line_Length then 754 Error_Msg 755 ("(style) this line is too long", 756 Current_Line_Start + Source_Ptr (Style_Max_Line_Length)); 757 end if; 758 end if; 759 end Check_Line_Max_Length; 760 761 --------------------------- 762 -- Check_Line_Terminator -- 763 --------------------------- 764 765 -- In check blanks at end mode (-gnatyb), lines may not end with a 766 -- trailing space. 767 768 -- In check form feeds mode (-gnatyf), the line terminator may not 769 -- be either of the characters FF or VT. 770 771 -- In check DOS line terminators node (-gnatyd), the line terminator 772 -- must be a single LF, without a following CR. 773 774 procedure Check_Line_Terminator (Len : Nat) is 775 S : Source_Ptr; 776 777 L : Nat := Len; 778 -- Length of line (adjusted down for blanks at end of line) 779 780 begin 781 -- Reset count of blank lines if first line 782 783 if Get_Logical_Line_Number (Scan_Ptr) = 1 then 784 Blank_Lines := 0; 785 end if; 786 787 -- Check FF/VT terminators 788 789 if Style_Check_Form_Feeds then 790 if Source (Scan_Ptr) = ASCII.FF then 791 Error_Msg_S -- CODEFIX 792 ("(style) form feed not allowed"); 793 elsif Source (Scan_Ptr) = ASCII.VT then 794 Error_Msg_S -- CODEFIX 795 ("(style) vertical tab not allowed"); 796 end if; 797 end if; 798 799 -- Check DOS line terminator 800 801 if Style_Check_DOS_Line_Terminator then 802 803 -- Ignore EOF, since we only get called with an EOF if it is the last 804 -- character in the buffer (and was therefore not in the source 805 -- file), since the terminating EOF is added to stop the scan. 806 807 if Source (Scan_Ptr) = EOF then 808 null; 809 810 -- Bad terminator if we don't have an LF 811 812 elsif Source (Scan_Ptr) /= LF then 813 Error_Msg_S ("(style) incorrect line terminator"); 814 end if; 815 end if; 816 817 -- Remove trailing spaces 818 819 S := Scan_Ptr; 820 while L > 0 and then Is_White_Space (Source (S - 1)) loop 821 S := S - 1; 822 L := L - 1; 823 end loop; 824 825 -- Issue message for blanks at end of line if option enabled 826 827 if Style_Check_Blanks_At_End and then L < Len then 828 Error_Msg -- CODEFIX 829 ("(style) trailing spaces not permitted", S); 830 end if; 831 832 -- Deal with empty (blank) line 833 834 if L = 0 then 835 836 -- Increment blank line count 837 838 Blank_Lines := Blank_Lines + 1; 839 840 -- If first blank line, record location for later error message 841 842 if Blank_Lines = 1 then 843 Blank_Line_Location := Scan_Ptr; 844 end if; 845 846 -- Non-blank line, check for previous multiple blank lines 847 848 else 849 if Style_Check_Blank_Lines and then Blank_Lines > 1 then 850 Error_Msg -- CODEFIX 851 ("(style) multiple blank lines", Blank_Line_Location); 852 end if; 853 854 -- And reset blank line count 855 856 Blank_Lines := 0; 857 end if; 858 end Check_Line_Terminator; 859 860 ------------------ 861 -- Check_Not_In -- 862 ------------------ 863 864 -- In check tokens mode, only one space between NOT and IN 865 866 procedure Check_Not_In is 867 begin 868 if Style_Check_Tokens then 869 if Source (Token_Ptr - 1) /= ' ' 870 or else Token_Ptr - Prev_Token_Ptr /= 4 871 then -- CODEFIX? 872 Error_Msg 873 ("(style) single space must separate NOT and IN", Token_Ptr - 1); 874 end if; 875 end if; 876 end Check_Not_In; 877 878 -------------------------- 879 -- Check_No_Space_After -- 880 -------------------------- 881 882 procedure Check_No_Space_After is 883 S : Source_Ptr; 884 885 begin 886 if Is_White_Space (Source (Scan_Ptr)) then 887 888 -- Allow one or more spaces if followed by comment 889 890 S := Scan_Ptr + 1; 891 loop 892 if Source (S) = '-' and then Source (S + 1) = '-' then 893 return; 894 895 elsif Is_White_Space (Source (S)) then 896 S := S + 1; 897 898 else 899 exit; 900 end if; 901 end loop; 902 903 Error_Space_Not_Allowed (Scan_Ptr); 904 end if; 905 end Check_No_Space_After; 906 907 --------------------------- 908 -- Check_No_Space_Before -- 909 --------------------------- 910 911 procedure Check_No_Space_Before is 912 begin 913 if Token_Ptr > First_Non_Blank_Location 914 and then Source (Token_Ptr - 1) <= ' ' 915 then 916 Error_Space_Not_Allowed (Token_Ptr - 1); 917 end if; 918 end Check_No_Space_Before; 919 920 ----------------------- 921 -- Check_Pragma_Name -- 922 ----------------------- 923 924 -- In check pragma casing mode (-gnatyp), pragma names must be mixed 925 -- case, i.e. start with an upper case letter, and otherwise lower case, 926 -- except after an underline character. 927 928 procedure Check_Pragma_Name is 929 begin 930 if Style_Check_Pragma_Casing then 931 if Determine_Token_Casing /= Mixed_Case then 932 Error_Msg_SC -- CODEFIX 933 ("(style) bad capitalization, mixed case required"); 934 end if; 935 end if; 936 end Check_Pragma_Name; 937 938 ----------------------- 939 -- Check_Right_Paren -- 940 ----------------------- 941 942 -- In check token mode (-gnatyt), right paren must not be immediately 943 -- followed by an identifier character, and must never be preceded by 944 -- a space unless it is the initial non-blank character on the line. 945 946 procedure Check_Right_Paren is 947 begin 948 if Style_Check_Tokens then 949 if Identifier_Char (Source (Token_Ptr + 1)) then 950 Error_Space_Required (Token_Ptr + 1); 951 end if; 952 953 Check_No_Space_Before; 954 end if; 955 end Check_Right_Paren; 956 957 --------------------- 958 -- Check_Semicolon -- 959 --------------------- 960 961 -- In check token mode (-gnatyt), semicolon does not permit a preceding 962 -- space and a following space is required. 963 964 procedure Check_Semicolon is 965 begin 966 if Style_Check_Tokens then 967 Check_No_Space_Before; 968 969 if Source (Scan_Ptr) > ' ' then 970 Error_Space_Required (Scan_Ptr); 971 end if; 972 end if; 973 end Check_Semicolon; 974 975 ------------------------------- 976 -- Check_Separate_Stmt_Lines -- 977 ------------------------------- 978 979 procedure Check_Separate_Stmt_Lines is 980 begin 981 if Style_Check_Separate_Stmt_Lines then 982 Check_Separate_Stmt_Lines_Cont; 983 end if; 984 end Check_Separate_Stmt_Lines; 985 986 ------------------------------------ 987 -- Check_Separate_Stmt_Lines_Cont -- 988 ------------------------------------ 989 990 procedure Check_Separate_Stmt_Lines_Cont is 991 S : Source_Ptr; 992 993 begin 994 -- Skip past white space 995 996 S := Scan_Ptr; 997 while Is_White_Space (Source (S)) loop 998 S := S + 1; 999 end loop; 1000 1001 -- Line terminator is OK 1002 1003 if Source (S) in Line_Terminator then 1004 return; 1005 1006 -- Comment is OK 1007 1008 elsif Source (S) = '-' and then Source (S + 1) = '-' then 1009 return; 1010 1011 -- ABORT keyword is OK after THEN (THEN ABORT case) 1012 1013 elsif Token = Tok_Then 1014 and then (Source (S + 0) = 'a' or else Source (S + 0) = 'A') 1015 and then (Source (S + 1) = 'b' or else Source (S + 1) = 'B') 1016 and then (Source (S + 2) = 'o' or else Source (S + 2) = 'O') 1017 and then (Source (S + 3) = 'r' or else Source (S + 3) = 'R') 1018 and then (Source (S + 4) = 't' or else Source (S + 4) = 'T') 1019 and then (Source (S + 5) in Line_Terminator 1020 or else Is_White_Space (Source (S + 5))) 1021 then 1022 return; 1023 1024 -- PRAGMA keyword is OK after ELSE 1025 1026 elsif Token = Tok_Else 1027 and then (Source (S + 0) = 'p' or else Source (S + 0) = 'P') 1028 and then (Source (S + 1) = 'r' or else Source (S + 1) = 'R') 1029 and then (Source (S + 2) = 'a' or else Source (S + 2) = 'A') 1030 and then (Source (S + 3) = 'g' or else Source (S + 3) = 'G') 1031 and then (Source (S + 4) = 'm' or else Source (S + 4) = 'M') 1032 and then (Source (S + 5) = 'a' or else Source (S + 5) = 'A') 1033 and then (Source (S + 6) in Line_Terminator 1034 or else Is_White_Space (Source (S + 6))) 1035 then 1036 return; 1037 1038 -- Otherwise we have the style violation we are looking for 1039 1040 else 1041 if Token = Tok_Then then 1042 Error_Msg -- CODEFIX 1043 ("(style) no statements may follow THEN on same line", S); 1044 else 1045 Error_Msg 1046 ("(style) no statements may follow ELSE on same line", S); 1047 end if; 1048 end if; 1049 end Check_Separate_Stmt_Lines_Cont; 1050 1051 ---------------- 1052 -- Check_Then -- 1053 ---------------- 1054 1055 -- In check if then layout mode (-gnatyi), we expect a THEN keyword to 1056 -- appear either on the same line as the IF, or on a separate line if 1057 -- the IF statement extends for more than one line. 1058 1059 procedure Check_Then (If_Loc : Source_Ptr) is 1060 begin 1061 if Style_Check_If_Then_Layout then 1062 declare 1063 If_Line : constant Physical_Line_Number := 1064 Get_Physical_Line_Number (If_Loc); 1065 Then_Line : constant Physical_Line_Number := 1066 Get_Physical_Line_Number (Token_Ptr); 1067 begin 1068 if If_Line = Then_Line then 1069 null; 1070 elsif Token_Ptr /= First_Non_Blank_Location then 1071 Error_Msg_SC ("(style) misplaced THEN"); 1072 end if; 1073 end; 1074 end if; 1075 end Check_Then; 1076 1077 ------------------------------- 1078 -- Check_Unary_Plus_Or_Minus -- 1079 ------------------------------- 1080 1081 -- In check token mode (-gnatyt), unary plus or minus must not be 1082 -- followed by a space. 1083 1084 -- Annoying exception: if we have the sequence =>+ within a Depends or 1085 -- Refined_Depends pragma or aspect, then we insist on a space rather 1086 -- than forbidding it. 1087 1088 procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False) is 1089 begin 1090 if Style_Check_Tokens then 1091 if Inside_Depends then 1092 Require_Following_Space; 1093 else 1094 Check_No_Space_After; 1095 end if; 1096 end if; 1097 end Check_Unary_Plus_Or_Minus; 1098 1099 ------------------------ 1100 -- Check_Vertical_Bar -- 1101 ------------------------ 1102 1103 -- In check token mode (-gnatyt), vertical bar must be surrounded by spaces 1104 1105 procedure Check_Vertical_Bar is 1106 begin 1107 if Style_Check_Tokens then 1108 Require_Preceding_Space; 1109 Require_Following_Space; 1110 end if; 1111 end Check_Vertical_Bar; 1112 1113 ----------------------- 1114 -- Check_Xtra_Parens -- 1115 ----------------------- 1116 1117 procedure Check_Xtra_Parens (Loc : Source_Ptr) is 1118 begin 1119 if Style_Check_Xtra_Parens then 1120 Error_Msg -- CODEFIX 1121 ("(style) redundant parentheses", Loc); 1122 end if; 1123 end Check_Xtra_Parens; 1124 1125 ---------------------------- 1126 -- Determine_Token_Casing -- 1127 ---------------------------- 1128 1129 function Determine_Token_Casing return Casing_Type is 1130 begin 1131 return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1)); 1132 end Determine_Token_Casing; 1133 1134 ----------------------------- 1135 -- Error_Space_Not_Allowed -- 1136 ----------------------------- 1137 1138 procedure Error_Space_Not_Allowed (S : Source_Ptr) is 1139 begin 1140 Error_Msg -- CODEFIX 1141 ("(style) space not allowed", S); 1142 end Error_Space_Not_Allowed; 1143 1144 -------------------------- 1145 -- Error_Space_Required -- 1146 -------------------------- 1147 1148 procedure Error_Space_Required (S : Source_Ptr) is 1149 begin 1150 Error_Msg -- CODEFIX 1151 ("(style) space required", S); 1152 end Error_Space_Required; 1153 1154 -------------------- 1155 -- Is_White_Space -- 1156 -------------------- 1157 1158 function Is_White_Space (C : Character) return Boolean is 1159 begin 1160 return C = ' ' or else C = HT; 1161 end Is_White_Space; 1162 1163 ------------------- 1164 -- Mode_In_Check -- 1165 ------------------- 1166 1167 function Mode_In_Check return Boolean is 1168 begin 1169 return Style_Check and Style_Check_Mode_In; 1170 end Mode_In_Check; 1171 1172 ----------------- 1173 -- No_End_Name -- 1174 ----------------- 1175 1176 -- In check end/exit labels mode (-gnatye), always require the name of 1177 -- a subprogram or package to be present on the END, so this is an error. 1178 1179 procedure No_End_Name (Name : Node_Id) is 1180 begin 1181 if Style_Check_End_Labels then 1182 Error_Msg_Node_1 := Name; 1183 Error_Msg_SP -- CODEFIX 1184 ("(style) `END &` required"); 1185 end if; 1186 end No_End_Name; 1187 1188 ------------------ 1189 -- No_Exit_Name -- 1190 ------------------ 1191 1192 -- In check end/exit labels mode (-gnatye), always require the name of 1193 -- the loop to be present on the EXIT when exiting a named loop. 1194 1195 procedure No_Exit_Name (Name : Node_Id) is 1196 begin 1197 if Style_Check_End_Labels then 1198 Error_Msg_Node_1 := Name; 1199 Error_Msg_SP -- CODEFIX 1200 ("(style) `EXIT &` required"); 1201 end if; 1202 end No_Exit_Name; 1203 1204 ---------------------------- 1205 -- Non_Lower_Case_Keyword -- 1206 ---------------------------- 1207 1208 -- In check casing mode (-gnatyk), reserved keywords must be spelled 1209 -- in all lower case (excluding keywords range, access, delta and digits 1210 -- used as attribute designators). 1211 1212 procedure Non_Lower_Case_Keyword is 1213 begin 1214 if Style_Check_Keyword_Casing then 1215 Error_Msg_SC -- CODEFIX 1216 ("(style) reserved words must be all lower case"); 1217 end if; 1218 end Non_Lower_Case_Keyword; 1219 1220 ----------------------------- 1221 -- Require_Following_Space -- 1222 ----------------------------- 1223 1224 procedure Require_Following_Space is 1225 begin 1226 if Source (Scan_Ptr) > ' ' then 1227 Error_Space_Required (Scan_Ptr); 1228 end if; 1229 end Require_Following_Space; 1230 1231 ----------------------------- 1232 -- Require_Preceding_Space -- 1233 ----------------------------- 1234 1235 procedure Require_Preceding_Space is 1236 begin 1237 if Token_Ptr > Source_First (Current_Source_File) 1238 and then Source (Token_Ptr - 1) > ' ' 1239 then 1240 Error_Space_Required (Token_Ptr); 1241 end if; 1242 end Require_Preceding_Space; 1243 1244end Styleg; 1245