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