1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S T Y L E S W -- 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 26with Hostparm; use Hostparm; 27with Opt; use Opt; 28with Output; use Output; 29 30package body Stylesw is 31 32 -- The following constant defines the default style options for -gnaty 33 34 Default_Style : constant String := 35 "3" & -- indentation level is 3 36 "a" & -- check attribute casing 37 "A" & -- check array attribute indexes 38 "b" & -- check no blanks at end of lines 39 "c" & -- check comment formats 40 "e" & -- check end/exit labels present 41 "f" & -- check no form/feeds vertical tabs in source 42 "h" & -- check no horizontal tabs in source 43 "i" & -- check if-then layout 44 "k" & -- check casing rules for keywords 45 "l" & -- check reference manual layout 46 "m" & -- check line length <= 79 characters 47 "n" & -- check casing of package Standard idents 48 "p" & -- check pragma casing 49 "r" & -- check casing for identifier references 50 "s" & -- check separate subprogram specs present 51 "t"; -- check token separation rules 52 53 -- The following constant defines the GNAT style options, showing them 54 -- as additions to the standard default style check options. 55 56 GNAT_Style : constant String := Default_Style & 57 "d" & -- check no DOS line terminators 58 "I" & -- check mode IN 59 "S" & -- check separate lines after THEN or ELSE 60 "u" & -- check no unnecessary blank lines 61 "x"; -- check extra parentheses around conditionals 62 63 -- Note: we intend GNAT_Style to also include the following, but we do 64 -- not yet have the whole tool suite clean with respect to this. 65 66 -- "B" & -- check boolean operators 67 68 ------------------------------- 69 -- Reset_Style_Check_Options -- 70 ------------------------------- 71 72 procedure Reset_Style_Check_Options is 73 begin 74 Style_Check_Indentation := 0; 75 Style_Check_Array_Attribute_Index := False; 76 Style_Check_Attribute_Casing := False; 77 Style_Check_Blanks_At_End := False; 78 Style_Check_Blank_Lines := False; 79 Style_Check_Boolean_And_Or := False; 80 Style_Check_Comments := False; 81 Style_Check_DOS_Line_Terminator := False; 82 Style_Check_End_Labels := False; 83 Style_Check_Form_Feeds := False; 84 Style_Check_Horizontal_Tabs := False; 85 Style_Check_If_Then_Layout := False; 86 Style_Check_Keyword_Casing := False; 87 Style_Check_Layout := False; 88 Style_Check_Max_Line_Length := False; 89 Style_Check_Max_Nesting_Level := False; 90 Style_Check_Missing_Overriding := False; 91 Style_Check_Mode_In := False; 92 Style_Check_Order_Subprograms := False; 93 Style_Check_Pragma_Casing := False; 94 Style_Check_References := False; 95 Style_Check_Separate_Stmt_Lines := False; 96 Style_Check_Specs := False; 97 Style_Check_Standard := False; 98 Style_Check_Tokens := False; 99 Style_Check_Xtra_Parens := False; 100 end Reset_Style_Check_Options; 101 102 --------------------- 103 -- RM_Column_Check -- 104 --------------------- 105 106 function RM_Column_Check return Boolean is 107 begin 108 return Style_Check and Style_Check_Layout; 109 end RM_Column_Check; 110 111 ------------------------------ 112 -- Save_Style_Check_Options -- 113 ------------------------------ 114 115 procedure Save_Style_Check_Options (Options : out Style_Check_Options) is 116 P : Natural := 0; 117 118 procedure Add (C : Character; S : Boolean); 119 -- Add given character C to string if switch S is true 120 121 procedure Add_Nat (N : Nat); 122 -- Add given natural number to string 123 124 --------- 125 -- Add -- 126 --------- 127 128 procedure Add (C : Character; S : Boolean) is 129 begin 130 if S then 131 P := P + 1; 132 Options (P) := C; 133 end if; 134 end Add; 135 136 ------------- 137 -- Add_Nat -- 138 ------------- 139 140 procedure Add_Nat (N : Nat) is 141 begin 142 if N > 9 then 143 Add_Nat (N / 10); 144 end if; 145 146 P := P + 1; 147 Options (P) := Character'Val (Character'Pos ('0') + N mod 10); 148 end Add_Nat; 149 150 -- Start of processing for Save_Style_Check_Options 151 152 begin 153 for K in Options'Range loop 154 Options (K) := ' '; 155 end loop; 156 157 Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')), 158 Style_Check_Indentation /= 0); 159 160 Add ('a', Style_Check_Attribute_Casing); 161 Add ('A', Style_Check_Array_Attribute_Index); 162 Add ('b', Style_Check_Blanks_At_End); 163 Add ('B', Style_Check_Boolean_And_Or); 164 165 if Style_Check_Comments then 166 if Style_Check_Comments_Spacing = 2 then 167 Add ('c', Style_Check_Comments); 168 elsif Style_Check_Comments_Spacing = 1 then 169 Add ('C', Style_Check_Comments); 170 end if; 171 end if; 172 173 Add ('d', Style_Check_DOS_Line_Terminator); 174 Add ('e', Style_Check_End_Labels); 175 Add ('f', Style_Check_Form_Feeds); 176 Add ('h', Style_Check_Horizontal_Tabs); 177 Add ('i', Style_Check_If_Then_Layout); 178 Add ('I', Style_Check_Mode_In); 179 Add ('k', Style_Check_Keyword_Casing); 180 Add ('l', Style_Check_Layout); 181 Add ('n', Style_Check_Standard); 182 Add ('o', Style_Check_Order_Subprograms); 183 Add ('O', Style_Check_Missing_Overriding); 184 Add ('p', Style_Check_Pragma_Casing); 185 Add ('r', Style_Check_References); 186 Add ('s', Style_Check_Specs); 187 Add ('S', Style_Check_Separate_Stmt_Lines); 188 Add ('t', Style_Check_Tokens); 189 Add ('u', Style_Check_Blank_Lines); 190 Add ('x', Style_Check_Xtra_Parens); 191 192 if Style_Check_Max_Line_Length then 193 P := P + 1; 194 Options (P) := 'M'; 195 Add_Nat (Style_Max_Line_Length); 196 end if; 197 198 if Style_Check_Max_Nesting_Level then 199 P := P + 1; 200 Options (P) := 'L'; 201 Add_Nat (Style_Max_Nesting_Level); 202 end if; 203 204 pragma Assert (P <= Options'Last); 205 206 while P < Options'Last loop 207 P := P + 1; 208 Options (P) := ' '; 209 end loop; 210 end Save_Style_Check_Options; 211 212 ------------------------------------- 213 -- Set_Default_Style_Check_Options -- 214 ------------------------------------- 215 216 procedure Set_Default_Style_Check_Options is 217 begin 218 Reset_Style_Check_Options; 219 Set_Style_Check_Options (Default_Style); 220 end Set_Default_Style_Check_Options; 221 222 ---------------------------------- 223 -- Set_GNAT_Style_Check_Options -- 224 ---------------------------------- 225 226 procedure Set_GNAT_Style_Check_Options is 227 begin 228 Reset_Style_Check_Options; 229 Set_Style_Check_Options (GNAT_Style); 230 end Set_GNAT_Style_Check_Options; 231 232 ----------------------------- 233 -- Set_Style_Check_Options -- 234 ----------------------------- 235 236 -- Version used when no error checking is required 237 238 procedure Set_Style_Check_Options (Options : String) is 239 OK : Boolean; 240 EC : Natural; 241 pragma Warnings (Off, EC); 242 begin 243 Set_Style_Check_Options (Options, OK, EC); 244 pragma Assert (OK); 245 end Set_Style_Check_Options; 246 247 -- Normal version with error checking 248 249 procedure Set_Style_Check_Options 250 (Options : String; 251 OK : out Boolean; 252 Err_Col : out Natural) 253 is 254 C : Character; 255 256 On : Boolean := True; 257 -- Set to False if minus encountered 258 -- Set to True if plus encountered 259 260 Last_Option : Character := ' '; 261 -- Set to last character encountered 262 263 procedure Add_Img (N : Natural); 264 -- Concatenates image of N at end of Style_Msg_Buf 265 266 procedure Bad_Style_Switch (Msg : String); 267 -- Called if bad style switch found. Msg is set in Style_Msg_Buf and 268 -- Style_Msg_Len. OK is set False. 269 270 ------------- 271 -- Add_Img -- 272 ------------- 273 274 procedure Add_Img (N : Natural) is 275 begin 276 if N >= 10 then 277 Add_Img (N / 10); 278 end if; 279 280 Style_Msg_Len := Style_Msg_Len + 1; 281 Style_Msg_Buf (Style_Msg_Len) := 282 Character'Val (N mod 10 + Character'Pos ('0')); 283 end Add_Img; 284 285 ---------------------- 286 -- Bad_Style_Switch -- 287 ---------------------- 288 289 procedure Bad_Style_Switch (Msg : String) is 290 begin 291 OK := False; 292 Style_Msg_Len := Msg'Length; 293 Style_Msg_Buf (1 .. Style_Msg_Len) := Msg; 294 end Bad_Style_Switch; 295 296 -- Start of processing for Set_Style_Check_Options 297 298 begin 299 Err_Col := Options'First; 300 while Err_Col <= Options'Last loop 301 C := Options (Err_Col); 302 Last_Option := C; 303 Err_Col := Err_Col + 1; 304 305 -- Turning switches on 306 307 if On then 308 case C is 309 310 when '+' => 311 null; 312 313 when '-' => 314 On := False; 315 316 when '0' .. '9' => 317 Style_Check_Indentation := 318 Character'Pos (C) - Character'Pos ('0'); 319 320 when 'a' => 321 Style_Check_Attribute_Casing := True; 322 323 when 'A' => 324 Style_Check_Array_Attribute_Index := True; 325 326 when 'b' => 327 Style_Check_Blanks_At_End := True; 328 329 when 'B' => 330 Style_Check_Boolean_And_Or := True; 331 332 when 'c' => 333 Style_Check_Comments := True; 334 Style_Check_Comments_Spacing := 2; 335 336 when 'C' => 337 Style_Check_Comments := True; 338 Style_Check_Comments_Spacing := 1; 339 340 when 'd' => 341 Style_Check_DOS_Line_Terminator := True; 342 343 when 'e' => 344 Style_Check_End_Labels := True; 345 346 when 'f' => 347 Style_Check_Form_Feeds := True; 348 349 when 'g' => 350 Set_GNAT_Style_Check_Options; 351 352 when 'h' => 353 Style_Check_Horizontal_Tabs := True; 354 355 when 'i' => 356 Style_Check_If_Then_Layout := True; 357 358 when 'I' => 359 Style_Check_Mode_In := True; 360 361 when 'k' => 362 Style_Check_Keyword_Casing := True; 363 364 when 'l' => 365 Style_Check_Layout := True; 366 367 when 'L' => 368 Style_Max_Nesting_Level := 0; 369 370 if Err_Col > Options'Last 371 or else Options (Err_Col) not in '0' .. '9' 372 then 373 Bad_Style_Switch ("invalid nesting level"); 374 return; 375 end if; 376 377 loop 378 Style_Max_Nesting_Level := 379 Style_Max_Nesting_Level * 10 + 380 Character'Pos (Options (Err_Col)) - Character'Pos ('0'); 381 382 if Style_Max_Nesting_Level > 999 then 383 Bad_Style_Switch 384 ("max nesting level (999) exceeded in style check"); 385 return; 386 end if; 387 388 Err_Col := Err_Col + 1; 389 exit when Err_Col > Options'Last 390 or else Options (Err_Col) not in '0' .. '9'; 391 end loop; 392 393 Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0; 394 395 when 'm' => 396 Style_Check_Max_Line_Length := True; 397 Style_Max_Line_Length := 79; 398 399 when 'M' => 400 Style_Max_Line_Length := 0; 401 402 if Err_Col > Options'Last 403 or else Options (Err_Col) not in '0' .. '9' 404 then 405 Bad_Style_Switch 406 ("invalid line length in style check"); 407 return; 408 end if; 409 410 loop 411 Style_Max_Line_Length := 412 Style_Max_Line_Length * 10 + 413 Character'Pos (Options (Err_Col)) - Character'Pos ('0'); 414 415 if Style_Max_Line_Length > Int (Max_Line_Length) then 416 OK := False; 417 Style_Msg_Buf (1 .. 27) := "max line length allowed is "; 418 Style_Msg_Len := 27; 419 Add_Img (Natural (Max_Line_Length)); 420 return; 421 end if; 422 423 Err_Col := Err_Col + 1; 424 exit when Err_Col > Options'Last 425 or else Options (Err_Col) not in '0' .. '9'; 426 end loop; 427 428 Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0; 429 430 when 'n' => 431 Style_Check_Standard := True; 432 433 when 'N' => 434 Reset_Style_Check_Options; 435 436 when 'o' => 437 Style_Check_Order_Subprograms := True; 438 439 when 'O' => 440 Style_Check_Missing_Overriding := True; 441 442 when 'p' => 443 Style_Check_Pragma_Casing := True; 444 445 when 'r' => 446 Style_Check_References := True; 447 448 when 's' => 449 Style_Check_Specs := True; 450 451 when 'S' => 452 Style_Check_Separate_Stmt_Lines := True; 453 454 when 't' => 455 Style_Check_Tokens := True; 456 457 when 'u' => 458 Style_Check_Blank_Lines := True; 459 460 when 'x' => 461 Style_Check_Xtra_Parens := True; 462 463 when 'y' => 464 Set_Default_Style_Check_Options; 465 466 when ' ' => 467 null; 468 469 when others => 470 if Ignore_Unrecognized_VWY_Switches then 471 Write_Line ("unrecognized switch -gnaty" & C & " ignored"); 472 else 473 Err_Col := Err_Col - 1; 474 Bad_Style_Switch ("invalid style switch: " & C); 475 return; 476 end if; 477 end case; 478 479 -- Turning switches off 480 481 else 482 case C is 483 484 when '+' => 485 On := True; 486 487 when '-' => 488 null; 489 490 when '0' .. '9' => 491 Style_Check_Indentation := 0; 492 493 when 'a' => 494 Style_Check_Attribute_Casing := False; 495 496 when 'A' => 497 Style_Check_Array_Attribute_Index := False; 498 499 when 'b' => 500 Style_Check_Blanks_At_End := False; 501 502 when 'B' => 503 Style_Check_Boolean_And_Or := False; 504 505 when 'c' | 'C' => 506 Style_Check_Comments := False; 507 508 when 'd' => 509 Style_Check_DOS_Line_Terminator := False; 510 511 when 'e' => 512 Style_Check_End_Labels := False; 513 514 when 'f' => 515 Style_Check_Form_Feeds := False; 516 517 when 'g' => 518 Reset_Style_Check_Options; 519 520 when 'h' => 521 Style_Check_Horizontal_Tabs := False; 522 523 when 'i' => 524 Style_Check_If_Then_Layout := False; 525 526 when 'I' => 527 Style_Check_Mode_In := False; 528 529 when 'k' => 530 Style_Check_Keyword_Casing := False; 531 532 when 'l' => 533 Style_Check_Layout := False; 534 535 when 'L' => 536 Style_Max_Nesting_Level := 0; 537 538 when 'm' => 539 Style_Check_Max_Line_Length := False; 540 541 when 'M' => 542 Style_Max_Line_Length := 0; 543 Style_Check_Max_Line_Length := False; 544 545 when 'n' => 546 Style_Check_Standard := False; 547 548 when 'o' => 549 Style_Check_Order_Subprograms := False; 550 551 when 'O' => 552 Style_Check_Missing_Overriding := False; 553 554 when 'p' => 555 Style_Check_Pragma_Casing := False; 556 557 when 'r' => 558 Style_Check_References := False; 559 560 when 's' => 561 Style_Check_Specs := False; 562 563 when 'S' => 564 Style_Check_Separate_Stmt_Lines := False; 565 566 when 't' => 567 Style_Check_Tokens := False; 568 569 when 'u' => 570 Style_Check_Blank_Lines := False; 571 572 when 'x' => 573 Style_Check_Xtra_Parens := False; 574 575 when ' ' => 576 null; 577 578 when others => 579 if Ignore_Unrecognized_VWY_Switches then 580 Write_Line ("unrecognized switch -gnaty-" & C & " ignored"); 581 else 582 Err_Col := Err_Col - 1; 583 Bad_Style_Switch ("invalid style switch: " & C); 584 return; 585 end if; 586 end case; 587 end if; 588 end loop; 589 590 -- Turn on style checking if other than N at end of string 591 592 Style_Check := (Last_Option /= 'N'); 593 OK := True; 594 end Set_Style_Check_Options; 595end Stylesw; 596