1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T N A M E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-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 Ada.Command_Line; use Ada.Command_Line; 27with Ada.Text_IO; use Ada.Text_IO; 28 29with GNAT.Dynamic_Tables; 30with GNAT.OS_Lib; use GNAT.OS_Lib; 31 32with Hostparm; 33with Opt; 34with Osint; use Osint; 35with Output; use Output; 36with Prj; use Prj; 37with Prj.Makr; 38with Switch; use Switch; 39with Table; 40 41with System.Regexp; use System.Regexp; 42 43procedure Gnatname is 44 45 Subdirs_Switch : constant String := "--subdirs="; 46 47 Usage_Output : Boolean := False; 48 -- Set to True when usage is output, to avoid multiple output 49 50 Usage_Needed : Boolean := False; 51 -- Set to True by -h switch 52 53 Version_Output : Boolean := False; 54 -- Set to True when version is output, to avoid multiple output 55 56 Very_Verbose : Boolean := False; 57 -- Set to True with -v -v 58 59 Create_Project : Boolean := False; 60 -- Set to True with a -P switch 61 62 File_Path : String_Access := new String'("gnat.adc"); 63 -- Path name of the file specified by -c or -P switch 64 65 File_Set : Boolean := False; 66 -- Set to True by -c or -P switch. 67 -- Used to detect multiple -c/-P switches. 68 69 package Patterns is new GNAT.Dynamic_Tables 70 (Table_Component_Type => String_Access, 71 Table_Index_Type => Natural, 72 Table_Low_Bound => 0, 73 Table_Initial => 10, 74 Table_Increment => 100); 75 -- Table to accumulate the patterns 76 77 type Argument_Data is record 78 Directories : Patterns.Instance; 79 Name_Patterns : Patterns.Instance; 80 Excluded_Patterns : Patterns.Instance; 81 Foreign_Patterns : Patterns.Instance; 82 end record; 83 84 package Arguments is new Table.Table 85 (Table_Component_Type => Argument_Data, 86 Table_Index_Type => Natural, 87 Table_Low_Bound => 0, 88 Table_Initial => 10, 89 Table_Increment => 100, 90 Table_Name => "Gnatname.Arguments"); 91 -- Table to accumulate directories and patterns 92 93 package Preprocessor_Switches is new Table.Table 94 (Table_Component_Type => String_Access, 95 Table_Index_Type => Natural, 96 Table_Low_Bound => 0, 97 Table_Initial => 10, 98 Table_Increment => 100, 99 Table_Name => "Gnatname.Preprocessor_Switches"); 100 -- Table to store the preprocessor switches to be used in the call 101 -- to the compiler. 102 103 procedure Output_Version; 104 -- Print name and version 105 106 procedure Usage; 107 -- Print usage 108 109 procedure Scan_Args; 110 -- Scan the command line arguments 111 112 procedure Add_Source_Directory (S : String); 113 -- Add S in the Source_Directories table 114 115 procedure Get_Directories (From_File : String); 116 -- Read a source directory text file 117 118 -------------------------- 119 -- Add_Source_Directory -- 120 -------------------------- 121 122 procedure Add_Source_Directory (S : String) is 123 begin 124 Patterns.Append 125 (Arguments.Table (Arguments.Last).Directories, new String'(S)); 126 end Add_Source_Directory; 127 128 --------------------- 129 -- Get_Directories -- 130 --------------------- 131 132 procedure Get_Directories (From_File : String) is 133 File : Ada.Text_IO.File_Type; 134 Line : String (1 .. 2_000); 135 Last : Natural; 136 137 begin 138 Open (File, In_File, From_File); 139 140 while not End_Of_File (File) loop 141 Get_Line (File, Line, Last); 142 143 if Last /= 0 then 144 Add_Source_Directory (Line (1 .. Last)); 145 end if; 146 end loop; 147 148 Close (File); 149 150 exception 151 when Name_Error => 152 Fail ("cannot open source directory file """ & From_File & '"'); 153 end Get_Directories; 154 155 -------------------- 156 -- Output_Version -- 157 -------------------- 158 159 procedure Output_Version is 160 begin 161 if not Version_Output then 162 Version_Output := True; 163 Output.Write_Eol; 164 Display_Version ("GNATNAME", "2001"); 165 end if; 166 end Output_Version; 167 168 --------------- 169 -- Scan_Args -- 170 --------------- 171 172 procedure Scan_Args is 173 174 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); 175 176 Project_File_Name_Expected : Boolean; 177 178 Pragmas_File_Expected : Boolean; 179 180 Directory_Expected : Boolean; 181 182 Dir_File_Name_Expected : Boolean; 183 184 Foreign_Pattern_Expected : Boolean; 185 186 Excluded_Pattern_Expected : Boolean; 187 188 procedure Check_Regular_Expression (S : String); 189 -- Compile string S into a Regexp, fail if any error 190 191 ----------------------------- 192 -- Check_Regular_Expression-- 193 ----------------------------- 194 195 procedure Check_Regular_Expression (S : String) is 196 Dummy : Regexp; 197 pragma Warnings (Off, Dummy); 198 begin 199 Dummy := Compile (S, Glob => True); 200 exception 201 when Error_In_Regexp => 202 Fail ("invalid regular expression """ & S & """"); 203 end Check_Regular_Expression; 204 205 -- Start of processing for Scan_Args 206 207 begin 208 -- First check for --version or --help 209 210 Check_Version_And_Help ("GNATNAME", "2001"); 211 212 -- Now scan the other switches 213 214 Project_File_Name_Expected := False; 215 Pragmas_File_Expected := False; 216 Directory_Expected := False; 217 Dir_File_Name_Expected := False; 218 Foreign_Pattern_Expected := False; 219 Excluded_Pattern_Expected := False; 220 221 for Next_Arg in 1 .. Argument_Count loop 222 declare 223 Next_Argv : constant String := Argument (Next_Arg); 224 Arg : String (1 .. Next_Argv'Length) := Next_Argv; 225 226 begin 227 if Arg'Length > 0 then 228 229 -- -P xxx 230 231 if Project_File_Name_Expected then 232 if Arg (1) = '-' then 233 Fail ("project file name missing"); 234 235 else 236 File_Set := True; 237 File_Path := new String'(Arg); 238 Project_File_Name_Expected := False; 239 end if; 240 241 -- -c file 242 243 elsif Pragmas_File_Expected then 244 File_Set := True; 245 File_Path := new String'(Arg); 246 Create_Project := False; 247 Pragmas_File_Expected := False; 248 249 -- -d xxx 250 251 elsif Directory_Expected then 252 Add_Source_Directory (Arg); 253 Directory_Expected := False; 254 255 -- -D xxx 256 257 elsif Dir_File_Name_Expected then 258 Get_Directories (Arg); 259 Dir_File_Name_Expected := False; 260 261 -- -f xxx 262 263 elsif Foreign_Pattern_Expected then 264 Patterns.Append 265 (Arguments.Table (Arguments.Last).Foreign_Patterns, 266 new String'(Arg)); 267 Check_Regular_Expression (Arg); 268 Foreign_Pattern_Expected := False; 269 270 -- -x xxx 271 272 elsif Excluded_Pattern_Expected then 273 Patterns.Append 274 (Arguments.Table (Arguments.Last).Excluded_Patterns, 275 new String'(Arg)); 276 Check_Regular_Expression (Arg); 277 Excluded_Pattern_Expected := False; 278 279 -- There must be at least one Ada pattern or one foreign 280 -- pattern for the previous section. 281 282 -- --and 283 284 elsif Arg = "--and" then 285 286 if Patterns.Last 287 (Arguments.Table (Arguments.Last).Name_Patterns) = 0 288 and then 289 Patterns.Last 290 (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0 291 then 292 Usage; 293 return; 294 end if; 295 296 -- If no directory were specified for the previous section, 297 -- then the directory is the project directory. 298 299 if Patterns.Last 300 (Arguments.Table (Arguments.Last).Directories) = 0 301 then 302 Patterns.Append 303 (Arguments.Table (Arguments.Last).Directories, 304 new String'(".")); 305 end if; 306 307 -- Add and initialize another component to Arguments table 308 309 declare 310 New_Arguments : Argument_Data; 311 pragma Warnings (Off, New_Arguments); 312 -- Declaring this defaulted initialized object ensures 313 -- that the new allocated component of table Arguments 314 -- is correctly initialized. 315 316 -- This is VERY ugly, Table should never be used with 317 -- data requiring default initialization. We should 318 -- find a way to avoid violating this rule ??? 319 320 begin 321 Arguments.Append (New_Arguments); 322 end; 323 324 Patterns.Init 325 (Arguments.Table (Arguments.Last).Directories); 326 Patterns.Set_Last 327 (Arguments.Table (Arguments.Last).Directories, 0); 328 Patterns.Init 329 (Arguments.Table (Arguments.Last).Name_Patterns); 330 Patterns.Set_Last 331 (Arguments.Table (Arguments.Last).Name_Patterns, 0); 332 Patterns.Init 333 (Arguments.Table (Arguments.Last).Excluded_Patterns); 334 Patterns.Set_Last 335 (Arguments.Table (Arguments.Last).Excluded_Patterns, 0); 336 Patterns.Init 337 (Arguments.Table (Arguments.Last).Foreign_Patterns); 338 Patterns.Set_Last 339 (Arguments.Table (Arguments.Last).Foreign_Patterns, 0); 340 341 -- Subdirectory switch 342 343 elsif Arg'Length > Subdirs_Switch'Length 344 and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch 345 then 346 Subdirs := 347 new String'(Arg (Subdirs_Switch'Length + 1 .. Arg'Last)); 348 349 -- --no-backup 350 351 elsif Arg = "--no-backup" then 352 Opt.No_Backup := True; 353 354 -- -c 355 356 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then 357 if File_Set then 358 Fail ("only one -P or -c switch may be specified"); 359 end if; 360 361 if Arg'Length = 2 then 362 Pragmas_File_Expected := True; 363 364 if Next_Arg = Argument_Count then 365 Fail ("configuration pragmas file name missing"); 366 end if; 367 368 else 369 File_Set := True; 370 File_Path := new String'(Arg (3 .. Arg'Last)); 371 Create_Project := False; 372 end if; 373 374 -- -d 375 376 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then 377 if Arg'Length = 2 then 378 Directory_Expected := True; 379 380 if Next_Arg = Argument_Count then 381 Fail ("directory name missing"); 382 end if; 383 384 else 385 Add_Source_Directory (Arg (3 .. Arg'Last)); 386 end if; 387 388 -- -D 389 390 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then 391 if Arg'Length = 2 then 392 Dir_File_Name_Expected := True; 393 394 if Next_Arg = Argument_Count then 395 Fail ("directory list file name missing"); 396 end if; 397 398 else 399 Get_Directories (Arg (3 .. Arg'Last)); 400 end if; 401 402 -- -eL 403 404 elsif Arg = "-eL" then 405 Opt.Follow_Links_For_Files := True; 406 Opt.Follow_Links_For_Dirs := True; 407 408 -- -f 409 410 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then 411 if Arg'Length = 2 then 412 Foreign_Pattern_Expected := True; 413 414 if Next_Arg = Argument_Count then 415 Fail ("foreign pattern missing"); 416 end if; 417 418 else 419 Patterns.Append 420 (Arguments.Table (Arguments.Last).Foreign_Patterns, 421 new String'(Arg (3 .. Arg'Last))); 422 Check_Regular_Expression (Arg (3 .. Arg'Last)); 423 end if; 424 425 -- -gnatep or -gnateD 426 427 elsif Arg'Length > 7 and then 428 (Arg (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD") 429 then 430 Preprocessor_Switches.Append (new String'(Arg)); 431 432 -- -h 433 434 elsif Arg = "-h" then 435 Usage_Needed := True; 436 437 -- -p 438 439 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then 440 if File_Set then 441 Fail ("only one -c or -P switch may be specified"); 442 end if; 443 444 if Arg'Length = 2 then 445 if Next_Arg = Argument_Count then 446 Fail ("project file name missing"); 447 448 else 449 Project_File_Name_Expected := True; 450 end if; 451 452 else 453 File_Set := True; 454 File_Path := new String'(Arg (3 .. Arg'Last)); 455 end if; 456 457 Create_Project := True; 458 459 -- -v 460 461 elsif Arg = "-v" then 462 if Opt.Verbose_Mode then 463 Very_Verbose := True; 464 else 465 Opt.Verbose_Mode := True; 466 end if; 467 468 -- -x 469 470 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then 471 if Arg'Length = 2 then 472 Excluded_Pattern_Expected := True; 473 474 if Next_Arg = Argument_Count then 475 Fail ("excluded pattern missing"); 476 end if; 477 478 else 479 Patterns.Append 480 (Arguments.Table (Arguments.Last).Excluded_Patterns, 481 new String'(Arg (3 .. Arg'Last))); 482 Check_Regular_Expression (Arg (3 .. Arg'Last)); 483 end if; 484 485 -- Junk switch starting with minus 486 487 elsif Arg (1) = '-' then 488 Fail ("wrong switch: " & Arg); 489 490 -- Not a recognized switch, assume file name 491 492 else 493 Canonical_Case_File_Name (Arg); 494 Patterns.Append 495 (Arguments.Table (Arguments.Last).Name_Patterns, 496 new String'(Arg)); 497 Check_Regular_Expression (Arg); 498 end if; 499 end if; 500 end; 501 end loop; 502 end Scan_Args; 503 504 ----------- 505 -- Usage -- 506 ----------- 507 508 procedure Usage is 509 begin 510 if not Usage_Output then 511 Usage_Needed := False; 512 Usage_Output := True; 513 Write_Str ("Usage: "); 514 Osint.Write_Program_Name; 515 Write_Line (" [switches] naming-pattern [naming-patterns]"); 516 Write_Line (" {--and [switches] naming-pattern [naming-patterns]}"); 517 Write_Eol; 518 Write_Line ("switches:"); 519 520 Display_Usage_Version_And_Help; 521 522 Write_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs"); 523 Write_Line (" --no-backup do not create backup of project file"); 524 Write_Eol; 525 526 Write_Line (" --and use different patterns"); 527 Write_Eol; 528 529 Write_Line (" -cfile create configuration pragmas file"); 530 Write_Line (" -ddir use dir as one of the source " & 531 "directories"); 532 Write_Line (" -Dfile get source directories from file"); 533 Write_Line (" -eL follow symbolic links when processing " & 534 "project files"); 535 Write_Line (" -fpat foreign pattern"); 536 Write_Line (" -gnateDsym=v preprocess with symbol definition"); 537 Write_Line (" -gnatep=data preprocess files with data file"); 538 Write_Line (" -h output this help message"); 539 Write_Line (" -Pproj update or create project file proj"); 540 Write_Line (" -v verbose output"); 541 Write_Line (" -v -v very verbose output"); 542 Write_Line (" -xpat exclude pattern pat"); 543 end if; 544 end Usage; 545 546-- Start of processing for Gnatname 547 548begin 549 -- Add the directory where gnatname is invoked in front of the 550 -- path, if gnatname is invoked with directory information. 551 -- Only do this if the platform is not VMS, where the notion of path 552 -- does not really exist. 553 554 if not Hostparm.OpenVMS then 555 declare 556 Command : constant String := Command_Name; 557 558 begin 559 for Index in reverse Command'Range loop 560 if Command (Index) = Directory_Separator then 561 declare 562 Absolute_Dir : constant String := 563 Normalize_Pathname 564 (Command (Command'First .. Index)); 565 566 PATH : constant String := 567 Absolute_Dir & 568 Path_Separator & 569 Getenv ("PATH").all; 570 571 begin 572 Setenv ("PATH", PATH); 573 end; 574 575 exit; 576 end if; 577 end loop; 578 end; 579 end if; 580 581 -- Initialize tables 582 583 Arguments.Set_Last (0); 584 declare 585 New_Arguments : Argument_Data; 586 pragma Warnings (Off, New_Arguments); 587 -- Declaring this defaulted initialized object ensures 588 -- that the new allocated component of table Arguments 589 -- is correctly initialized. 590 begin 591 Arguments.Append (New_Arguments); 592 end; 593 Patterns.Init (Arguments.Table (1).Directories); 594 Patterns.Set_Last (Arguments.Table (1).Directories, 0); 595 Patterns.Init (Arguments.Table (1).Name_Patterns); 596 Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0); 597 Patterns.Init (Arguments.Table (1).Excluded_Patterns); 598 Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0); 599 Patterns.Init (Arguments.Table (1).Foreign_Patterns); 600 Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0); 601 602 Preprocessor_Switches.Set_Last (0); 603 604 -- Get the arguments 605 606 Scan_Args; 607 608 if Opt.Verbose_Mode then 609 Output_Version; 610 end if; 611 612 if Usage_Needed then 613 Usage; 614 end if; 615 616 -- If no Ada or foreign pattern was specified, print the usage and return 617 618 if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0 619 and then 620 Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0 621 then 622 Usage; 623 return; 624 end if; 625 626 -- If no source directory was specified, use the current directory as the 627 -- unique directory. Note that if a file was specified with directory 628 -- information, the current directory is the directory of the specified 629 -- file. 630 631 if Patterns.Last 632 (Arguments.Table (Arguments.Last).Directories) = 0 633 then 634 Patterns.Append 635 (Arguments.Table (Arguments.Last).Directories, new String'(".")); 636 end if; 637 638 -- Initialize 639 640 declare 641 Prep_Switches : Argument_List 642 (1 .. Integer (Preprocessor_Switches.Last)); 643 644 begin 645 for Index in Prep_Switches'Range loop 646 Prep_Switches (Index) := Preprocessor_Switches.Table (Index); 647 end loop; 648 649 Prj.Makr.Initialize 650 (File_Path => File_Path.all, 651 Project_File => Create_Project, 652 Preproc_Switches => Prep_Switches, 653 Very_Verbose => Very_Verbose, 654 Flags => Gnatmake_Flags); 655 end; 656 657 -- Process each section successively 658 659 for J in 1 .. Arguments.Last loop 660 declare 661 Directories : Argument_List 662 (1 .. Integer 663 (Patterns.Last (Arguments.Table (J).Directories))); 664 Name_Patterns : Prj.Makr.Regexp_List 665 (1 .. Integer 666 (Patterns.Last (Arguments.Table (J).Name_Patterns))); 667 Excl_Patterns : Prj.Makr.Regexp_List 668 (1 .. Integer 669 (Patterns.Last (Arguments.Table (J).Excluded_Patterns))); 670 Frgn_Patterns : Prj.Makr.Regexp_List 671 (1 .. Integer 672 (Patterns.Last (Arguments.Table (J).Foreign_Patterns))); 673 674 begin 675 -- Build the Directories and Patterns arguments 676 677 for Index in Directories'Range loop 678 Directories (Index) := 679 Arguments.Table (J).Directories.Table (Index); 680 end loop; 681 682 for Index in Name_Patterns'Range loop 683 Name_Patterns (Index) := 684 Compile 685 (Arguments.Table (J).Name_Patterns.Table (Index).all, 686 Glob => True); 687 end loop; 688 689 for Index in Excl_Patterns'Range loop 690 Excl_Patterns (Index) := 691 Compile 692 (Arguments.Table (J).Excluded_Patterns.Table (Index).all, 693 Glob => True); 694 end loop; 695 696 for Index in Frgn_Patterns'Range loop 697 Frgn_Patterns (Index) := 698 Compile 699 (Arguments.Table (J).Foreign_Patterns.Table (Index).all, 700 Glob => True); 701 end loop; 702 703 -- Call Prj.Makr.Process where the real work is done 704 705 Prj.Makr.Process 706 (Directories => Directories, 707 Name_Patterns => Name_Patterns, 708 Excluded_Patterns => Excl_Patterns, 709 Foreign_Patterns => Frgn_Patterns); 710 end; 711 end loop; 712 713 -- Finalize 714 715 Prj.Makr.Finalize; 716 717 if Opt.Verbose_Mode then 718 Write_Eol; 719 end if; 720end Gnatname; 721