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