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-2012, 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 the foreign 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 -- -c 350 351 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then 352 if File_Set then 353 Fail ("only one -P or -c switch may be specified"); 354 end if; 355 356 if Arg'Length = 2 then 357 Pragmas_File_Expected := True; 358 359 if Next_Arg = Argument_Count then 360 Fail ("configuration pragmas file name missing"); 361 end if; 362 363 else 364 File_Set := True; 365 File_Path := new String'(Arg (3 .. Arg'Last)); 366 Create_Project := False; 367 end if; 368 369 -- -d 370 371 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then 372 if Arg'Length = 2 then 373 Directory_Expected := True; 374 375 if Next_Arg = Argument_Count then 376 Fail ("directory name missing"); 377 end if; 378 379 else 380 Add_Source_Directory (Arg (3 .. Arg'Last)); 381 end if; 382 383 -- -D 384 385 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then 386 if Arg'Length = 2 then 387 Dir_File_Name_Expected := True; 388 389 if Next_Arg = Argument_Count then 390 Fail ("directory list file name missing"); 391 end if; 392 393 else 394 Get_Directories (Arg (3 .. Arg'Last)); 395 end if; 396 397 -- -eL 398 399 elsif Arg = "-eL" then 400 Opt.Follow_Links_For_Files := True; 401 Opt.Follow_Links_For_Dirs := True; 402 403 -- -f 404 405 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then 406 if Arg'Length = 2 then 407 Foreign_Pattern_Expected := True; 408 409 if Next_Arg = Argument_Count then 410 Fail ("foreign pattern missing"); 411 end if; 412 413 else 414 Patterns.Append 415 (Arguments.Table (Arguments.Last).Foreign_Patterns, 416 new String'(Arg (3 .. Arg'Last))); 417 Check_Regular_Expression (Arg (3 .. Arg'Last)); 418 end if; 419 420 -- -gnatep or -gnateD 421 422 elsif Arg'Length > 7 and then 423 (Arg (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD") 424 then 425 Preprocessor_Switches.Append (new String'(Arg)); 426 427 -- -h 428 429 elsif Arg = "-h" then 430 Usage_Needed := True; 431 432 -- -p 433 434 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then 435 if File_Set then 436 Fail ("only one -c or -P switch may be specified"); 437 end if; 438 439 if Arg'Length = 2 then 440 if Next_Arg = Argument_Count then 441 Fail ("project file name missing"); 442 443 else 444 Project_File_Name_Expected := True; 445 end if; 446 447 else 448 File_Set := True; 449 File_Path := new String'(Arg (3 .. Arg'Last)); 450 end if; 451 452 Create_Project := True; 453 454 -- -v 455 456 elsif Arg = "-v" then 457 if Opt.Verbose_Mode then 458 Very_Verbose := True; 459 else 460 Opt.Verbose_Mode := True; 461 end if; 462 463 -- -x 464 465 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then 466 if Arg'Length = 2 then 467 Excluded_Pattern_Expected := True; 468 469 if Next_Arg = Argument_Count then 470 Fail ("excluded pattern missing"); 471 end if; 472 473 else 474 Patterns.Append 475 (Arguments.Table (Arguments.Last).Excluded_Patterns, 476 new String'(Arg (3 .. Arg'Last))); 477 Check_Regular_Expression (Arg (3 .. Arg'Last)); 478 end if; 479 480 -- Junk switch starting with minus 481 482 elsif Arg (1) = '-' then 483 Fail ("wrong switch: " & Arg); 484 485 -- Not a recognized switch, assume file name 486 487 else 488 Canonical_Case_File_Name (Arg); 489 Patterns.Append 490 (Arguments.Table (Arguments.Last).Name_Patterns, 491 new String'(Arg)); 492 Check_Regular_Expression (Arg); 493 end if; 494 end if; 495 end; 496 end loop; 497 end Scan_Args; 498 499 ----------- 500 -- Usage -- 501 ----------- 502 503 procedure Usage is 504 begin 505 if not Usage_Output then 506 Usage_Needed := False; 507 Usage_Output := True; 508 Write_Str ("Usage: "); 509 Osint.Write_Program_Name; 510 Write_Line (" [switches] naming-pattern [naming-patterns]"); 511 Write_Line (" {--and [switches] naming-pattern [naming-patterns]}"); 512 Write_Eol; 513 Write_Line ("switches:"); 514 515 Display_Usage_Version_And_Help; 516 517 Write_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs"); 518 Write_Eol; 519 520 Write_Line (" --and use different patterns"); 521 Write_Eol; 522 523 Write_Line (" -cfile create configuration pragmas file"); 524 Write_Line (" -ddir use dir as one of the source " & 525 "directories"); 526 Write_Line (" -Dfile get source directories from file"); 527 Write_Line (" -eL follow symbolic links when processing " & 528 "project files"); 529 Write_Line (" -fpat foreign pattern"); 530 Write_Line (" -gnateDsym=v preprocess with symbol definition"); 531 Write_Line (" -gnatep=data preprocess files with data file"); 532 Write_Line (" -h output this help message"); 533 Write_Line (" -Pproj update or create project file proj"); 534 Write_Line (" -v verbose output"); 535 Write_Line (" -v -v very verbose output"); 536 Write_Line (" -xpat exclude pattern pat"); 537 end if; 538 end Usage; 539 540-- Start of processing for Gnatname 541 542begin 543 -- Add the directory where gnatname is invoked in front of the 544 -- path, if gnatname is invoked with directory information. 545 -- Only do this if the platform is not VMS, where the notion of path 546 -- does not really exist. 547 548 if not Hostparm.OpenVMS then 549 declare 550 Command : constant String := Command_Name; 551 552 begin 553 for Index in reverse Command'Range loop 554 if Command (Index) = Directory_Separator then 555 declare 556 Absolute_Dir : constant String := 557 Normalize_Pathname 558 (Command (Command'First .. Index)); 559 560 PATH : constant String := 561 Absolute_Dir & 562 Path_Separator & 563 Getenv ("PATH").all; 564 565 begin 566 Setenv ("PATH", PATH); 567 end; 568 569 exit; 570 end if; 571 end loop; 572 end; 573 end if; 574 575 -- Initialize tables 576 577 Arguments.Set_Last (0); 578 declare 579 New_Arguments : Argument_Data; 580 pragma Warnings (Off, New_Arguments); 581 -- Declaring this defaulted initialized object ensures 582 -- that the new allocated component of table Arguments 583 -- is correctly initialized. 584 begin 585 Arguments.Append (New_Arguments); 586 end; 587 Patterns.Init (Arguments.Table (1).Directories); 588 Patterns.Set_Last (Arguments.Table (1).Directories, 0); 589 Patterns.Init (Arguments.Table (1).Name_Patterns); 590 Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0); 591 Patterns.Init (Arguments.Table (1).Excluded_Patterns); 592 Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0); 593 Patterns.Init (Arguments.Table (1).Foreign_Patterns); 594 Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0); 595 596 Preprocessor_Switches.Set_Last (0); 597 598 -- Get the arguments 599 600 Scan_Args; 601 602 if Opt.Verbose_Mode then 603 Output_Version; 604 end if; 605 606 if Usage_Needed then 607 Usage; 608 end if; 609 610 -- If no Ada or foreign pattern was specified, print the usage and return 611 612 if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0 613 and then 614 Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0 615 then 616 Usage; 617 return; 618 end if; 619 620 -- If no source directory was specified, use the current directory as the 621 -- unique directory. Note that if a file was specified with directory 622 -- information, the current directory is the directory of the specified 623 -- file. 624 625 if Patterns.Last 626 (Arguments.Table (Arguments.Last).Directories) = 0 627 then 628 Patterns.Append 629 (Arguments.Table (Arguments.Last).Directories, new String'(".")); 630 end if; 631 632 -- Initialize 633 634 declare 635 Prep_Switches : Argument_List 636 (1 .. Integer (Preprocessor_Switches.Last)); 637 638 begin 639 for Index in Prep_Switches'Range loop 640 Prep_Switches (Index) := Preprocessor_Switches.Table (Index); 641 end loop; 642 643 Prj.Makr.Initialize 644 (File_Path => File_Path.all, 645 Project_File => Create_Project, 646 Preproc_Switches => Prep_Switches, 647 Very_Verbose => Very_Verbose, 648 Flags => Gnatmake_Flags); 649 end; 650 651 -- Process each section successively 652 653 for J in 1 .. Arguments.Last loop 654 declare 655 Directories : Argument_List 656 (1 .. Integer 657 (Patterns.Last (Arguments.Table (J).Directories))); 658 Name_Patterns : Prj.Makr.Regexp_List 659 (1 .. Integer 660 (Patterns.Last (Arguments.Table (J).Name_Patterns))); 661 Excl_Patterns : Prj.Makr.Regexp_List 662 (1 .. Integer 663 (Patterns.Last (Arguments.Table (J).Excluded_Patterns))); 664 Frgn_Patterns : Prj.Makr.Regexp_List 665 (1 .. Integer 666 (Patterns.Last (Arguments.Table (J).Foreign_Patterns))); 667 668 begin 669 -- Build the Directories and Patterns arguments 670 671 for Index in Directories'Range loop 672 Directories (Index) := 673 Arguments.Table (J).Directories.Table (Index); 674 end loop; 675 676 for Index in Name_Patterns'Range loop 677 Name_Patterns (Index) := 678 Compile 679 (Arguments.Table (J).Name_Patterns.Table (Index).all, 680 Glob => True); 681 end loop; 682 683 for Index in Excl_Patterns'Range loop 684 Excl_Patterns (Index) := 685 Compile 686 (Arguments.Table (J).Excluded_Patterns.Table (Index).all, 687 Glob => True); 688 end loop; 689 690 for Index in Frgn_Patterns'Range loop 691 Frgn_Patterns (Index) := 692 Compile 693 (Arguments.Table (J).Foreign_Patterns.Table (Index).all, 694 Glob => True); 695 end loop; 696 697 -- Call Prj.Makr.Process where the real work is done 698 699 Prj.Makr.Process 700 (Directories => Directories, 701 Name_Patterns => Name_Patterns, 702 Excluded_Patterns => Excl_Patterns, 703 Foreign_Patterns => Frgn_Patterns); 704 end; 705 end loop; 706 707 -- Finalize 708 709 Prj.Makr.Finalize; 710 711 if Opt.Verbose_Mode then 712 Write_Eol; 713 end if; 714end Gnatname; 715