gcc/ada/clean.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                C L E A N                                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2003-2004, 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 2,  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 COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Ada.Command_Line; use Ada.Command_Line;
  28
  29 with ALI;      use ALI;
  30 with Csets;
  31 with Gnatvsn;
  32 with Hostparm;
  33 with Makeutl;  use Makeutl;
  34 with MLib.Tgt; use MLib.Tgt;
  35 with Namet;    use Namet;
  36 with Opt;      use Opt;
  37 with Osint;    use Osint;
  38 with Osint.M;  use Osint.M;
  39 with Prj;      use Prj;
  40 with Prj.Com;
  41 with Prj.Env;
  42 with Prj.Ext;
  43 with Prj.Pars;
  44 with Prj.Util; use Prj.Util;
  45 with Snames;
  46 with System;
  47 with Table;
  48 with Types;    use Types;
  49
  50 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  51 with GNAT.IO;                   use GNAT.IO;
  52 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  53
  54 package body Clean is
  55
  56    Initialized : Boolean := False;
  57    --  Set to True by the first call to Initialize.
  58    --  To avoid reinitialization of some packages.
  59
  60    --  Suffixes of various files
  61
  62    Assembly_Suffix : constant String := ".s";
  63    ALI_Suffix      : constant String := ".ali";
  64    Tree_Suffix     : constant String := ".adt";
  65    Object_Suffix   : constant String := Get_Object_Suffix.all;
  66    Debug_Suffix    : String          := ".dg";
  67    --  Changed to "_dg" for VMS in the body of the package
  68
  69    Repinfo_Suffix  : String          := ".rep";
  70    --  Changed to "_rep" for VMS in the body of the package
  71
  72    B_Start : String := "b~";
  73    --  Prefix of binder generated file.
  74    --  Changed to "b$" for VMS in the body of the package.
  75
  76    Object_Directory_Path : String_Access := null;
  77    --  The path name of the object directory, set with switch -D
  78
  79    Do_Nothing : Boolean := False;
  80    --  Set to True when switch -n is specified.
  81    --  When True, no file is deleted. gnatclean only lists the files that
  82    --  would have been deleted if the switch -n had not been specified.
  83
  84    File_Deleted : Boolean := False;
  85    --  Set to True if at least one file has been deleted
  86
  87    Copyright_Displayed : Boolean := False;
  88    Usage_Displayed     : Boolean := False;
  89
  90    Project_File_Name : String_Access := null;
  91
  92    Main_Project : Prj.Project_Id := Prj.No_Project;
  93
  94    All_Projects : Boolean := False;
  95
  96    --  Packages of project files where unknown attributes are errors.
  97
  98    Naming_String   : aliased String := "naming";
  99    Builder_String  : aliased String := "builder";
 100    Compiler_String : aliased String := "compiler";
 101    Binder_String   : aliased String := "binder";
 102    Linker_String   : aliased String := "linker";
 103
 104    Gnatmake_Packages : aliased String_List :=
 105      (Naming_String   'Access,
 106       Builder_String  'Access,
 107       Compiler_String 'Access,
 108       Binder_String   'Access,
 109       Linker_String   'Access);
 110
 111    Packages_To_Check_By_Gnatmake : constant String_List_Access :=
 112      Gnatmake_Packages'Access;
 113
 114    package Processed_Projects is new Table.Table
 115      (Table_Component_Type => Project_Id,
 116       Table_Index_Type     => Natural,
 117       Table_Low_Bound      => 0,
 118       Table_Initial        => 10,
 119       Table_Increment      => 10,
 120       Table_Name           => "Clean.Processed_Projects");
 121    --  Table to keep track of what project files have been processed, when
 122    --  switch -r is specified.
 123
 124    package Sources is new Table.Table
 125      (Table_Component_Type => File_Name_Type,
 126       Table_Index_Type     => Natural,
 127       Table_Low_Bound      => 0,
 128       Table_Initial        => 10,
 129       Table_Increment      => 10,
 130       Table_Name           => "Clean.Processed_Projects");
 131    --  Table to store all the source files of a library unit: spec, body and
 132    --  subunits, to detect .dg files and delete them.
 133
 134    ----------------------------
 135    -- Queue (Q) manipulation --
 136    ----------------------------
 137
 138    procedure Init_Q;
 139    --  Must be called to initialize the Q
 140
 141    procedure Insert_Q (Lib_File  : File_Name_Type);
 142    --  If Lib_File is not marked, inserts it at the end of Q and mark it
 143
 144    function Empty_Q return Boolean;
 145    --  Returns True if Q is empty.
 146
 147    procedure Extract_From_Q (Lib_File : out File_Name_Type);
 148    --  Extracts the first element from the Q.
 149
 150    Q_Front : Natural;
 151    --  Points to the first valid element in the Q.
 152
 153    package Q is new Table.Table (
 154      Table_Component_Type => File_Name_Type,
 155      Table_Index_Type     => Natural,
 156      Table_Low_Bound      => 0,
 157      Table_Initial        => 4000,
 158      Table_Increment      => 100,
 159      Table_Name           => "Clean.Q");
 160    --  This is the actual queue
 161
 162    -----------------------------
 163    -- Other local subprograms --
 164    -----------------------------
 165
 166    procedure Add_Source_Dir (N : String);
 167    --  Call Add_Src_Search_Dir.
 168    --  Output one line when in verbose mode.
 169
 170    procedure Add_Source_Directories is
 171      new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
 172
 173    procedure Add_Object_Dir (N : String);
 174    --  Call Add_Lib_Search_Dir.
 175    --  Output one line when in verbose mode.
 176
 177    procedure Add_Object_Directories is
 178      new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
 179
 180    function ALI_File_Name (Source : Name_Id) return String;
 181    --  Returns the name of the ALI file corresponding to Source
 182
 183    function Assembly_File_Name (Source : Name_Id) return String;
 184    --  Returns the assembly file name corresponding to Source
 185
 186    procedure Clean_Archive (Project : Project_Id);
 187    --  Delete a global archive or a fake library project archive and the
 188    --  dependency file, if they exist.
 189
 190    procedure Clean_Directory (Dir : Name_Id);
 191    --  Delete all regular files in a library directory or in a library
 192    --  interface dir.
 193
 194    procedure Clean_Executables;
 195    --  Do the cleaning work when no project file is specified
 196
 197    procedure Clean_Project (Project : Project_Id);
 198    --  Do the cleaning work when a project file is specified.
 199    --  This procedure calls itself recursively when there are several
 200    --  project files in the tree rooted at the main project file and switch -r
 201    --  has been specified.
 202
 203    function Debug_File_Name (Source : Name_Id) return String;
 204    --  Name of the expanded source file corresponding to Source
 205
 206    procedure Delete (In_Directory : String; File : String);
 207    --  Delete one file, or list the file name if switch -n is specified
 208
 209    procedure Delete_Binder_Generated_Files (Dir : String; Source : Name_Id);
 210    --  Delete the binder generated file in directory Dir for Source, if they
 211    --  exist: for Unix these are b~<source>.ads, b~<source>.adb,
 212    --  b~<source>.ali and b~<source>.o.
 213
 214    procedure Display_Copyright;
 215    --  Display the Copyright notice.
 216    --  If called several times, display the Copyright notice only the first
 217    --  time.
 218
 219    procedure Initialize;
 220    --  Call the necessary package initializations
 221
 222    function Object_File_Name (Source : Name_Id) return String;
 223    --  Returns the object file name corresponding to Source
 224
 225    procedure Parse_Cmd_Line;
 226    --  Parse the command line
 227
 228    function Repinfo_File_Name (Source : Name_Id) return String;
 229    --  Returns the repinfo file name corresponding to Source
 230
 231    function Tree_File_Name (Source : Name_Id) return String;
 232    --  Returns the tree file name corresponding to Source
 233
 234    function In_Extension_Chain
 235      (Of_Project : Project_Id;
 236       Prj        : Project_Id) return Boolean;
 237    --  Returns True iff Prj is an extension of Of_Project or if Of_Project is
 238    --  an extension of Prj.
 239
 240    procedure Usage;
 241    --  Display the usage.
 242    --  If called several times, the usage is displayed only the first time.
 243
 244    --------------------
 245    -- Add_Object_Dir --
 246    --------------------
 247
 248    procedure Add_Object_Dir (N : String) is
 249    begin
 250       Add_Lib_Search_Dir (N);
 251
 252       if Opt.Verbose_Mode then
 253          Put ("Adding object directory """);
 254          Put (N);
 255          Put (""".");
 256          New_Line;
 257       end if;
 258    end Add_Object_Dir;
 259
 260    --------------------
 261    -- Add_Source_Dir --
 262    --------------------
 263
 264    procedure Add_Source_Dir (N : String) is
 265    begin
 266       Add_Src_Search_Dir (N);
 267
 268       if Opt.Verbose_Mode then
 269          Put ("Adding source directory """);
 270          Put (N);
 271          Put (""".");
 272          New_Line;
 273       end if;
 274    end Add_Source_Dir;
 275
 276    -------------------
 277    -- ALI_File_Name --
 278    -------------------
 279
 280    function ALI_File_Name (Source : Name_Id) return String is
 281       Src : constant String := Get_Name_String (Source);
 282
 283    begin
 284       --  If the source name has an extension, then replace it with
 285       --  the ALI suffix.
 286
 287       for Index in reverse Src'First + 1 .. Src'Last loop
 288          if Src (Index) = '.' then
 289             return Src (Src'First .. Index - 1) & ALI_Suffix;
 290          end if;
 291       end loop;
 292
 293       --  If there is no dot, or if it is the first character, just add the
 294       --  ALI suffix.
 295
 296       return Src & ALI_Suffix;
 297    end ALI_File_Name;
 298
 299    ------------------------
 300    -- Assembly_File_Name --
 301    ------------------------
 302
 303    function Assembly_File_Name (Source : Name_Id) return String is
 304       Src : constant String := Get_Name_String (Source);
 305
 306    begin
 307       --  If the source name has an extension, then replace it with
 308       --  the assembly suffix.
 309
 310       for Index in reverse Src'First + 1 .. Src'Last loop
 311          if Src (Index) = '.' then
 312             return Src (Src'First .. Index - 1) & Assembly_Suffix;
 313          end if;
 314       end loop;
 315
 316       --  If there is no dot, or if it is the first character, just add the
 317       --  assembly suffix.
 318
 319       return Src & Assembly_Suffix;
 320    end Assembly_File_Name;
 321
 322    -------------------
 323    -- Clean_Archive --
 324    -------------------
 325
 326    procedure Clean_Archive (Project : Project_Id) is
 327       Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
 328
 329       Data        : constant Project_Data := Projects.Table (Project);
 330
 331       Archive_Name : constant String :=
 332         "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
 333       --  The name of the archive file for this project
 334
 335       Archive_Dep_Name : constant String :=
 336         "lib" & Get_Name_String (Data.Name) & ".deps";
 337       --  The name of the archive dependency file for this project
 338
 339       Obj_Dir : constant String := Get_Name_String (Data.Object_Directory);
 340
 341    begin
 342       Change_Dir (Obj_Dir);
 343
 344       if Is_Regular_File (Archive_Name) then
 345          Delete (Obj_Dir, Archive_Name);
 346       end if;
 347
 348       if Is_Regular_File (Archive_Dep_Name) then
 349          Delete (Obj_Dir, Archive_Dep_Name);
 350       end if;
 351
 352       Change_Dir (Current_Dir);
 353    end Clean_Archive;
 354
 355    ---------------------
 356    -- Clean_Directory --
 357    ---------------------
 358
 359    procedure Clean_Directory (Dir : Name_Id) is
 360       Directory : constant String := Get_Name_String (Dir);
 361       Current   : constant Dir_Name_Str := Get_Current_Dir;
 362
 363       Direc : Dir_Type;
 364
 365       Name : String (1 .. 200);
 366       Last : Natural;
 367
 368       procedure Set_Writable (Name : System.Address);
 369       pragma Import (C, Set_Writable, "__gnat_set_writable");
 370
 371    begin
 372       Change_Dir (Directory);
 373       Open (Direc, ".");
 374
 375       --  For each regular file in the directory, if switch -n has not been
 376       --  specified, make it writable and delete the file.
 377
 378       loop
 379          Read (Direc, Name, Last);
 380          exit when Last = 0;
 381
 382          if Is_Regular_File (Name (1 .. Last)) then
 383             if not Do_Nothing then
 384                Name (Last + 1) := ASCII.NUL;
 385                Set_Writable (Name (1)'Address);
 386             end if;
 387
 388             Delete (Directory, Name (1 .. Last));
 389          end if;
 390       end loop;
 391
 392       Close (Direc);
 393
 394       --  Restore the initial working directory
 395
 396       Change_Dir (Current);
 397    end Clean_Directory;
 398
 399    -----------------------
 400    -- Clean_Executables --
 401    -----------------------
 402
 403    procedure Clean_Executables is
 404       Main_Source_File : File_Name_Type;
 405       --  Current main source
 406
 407       Main_Lib_File : File_Name_Type;
 408       --  ALI file of the current main
 409
 410       Lib_File : File_Name_Type;
 411       --  Current ALI file
 412
 413       Full_Lib_File : File_Name_Type;
 414       --  Full name of the current ALI file
 415
 416       Text : Text_Buffer_Ptr;
 417       The_ALI : ALI_Id;
 418
 419    begin
 420       Init_Q;
 421
 422       --  It does not really matter if there is or not an object file
 423       --  corresponding to an ALI file: if there is one, it will be deleted.
 424
 425       Opt.Check_Object_Consistency := False;
 426
 427       --  Proceed each executable one by one. Each source is marked as it is
 428       --  processed, so common sources between executables will not be
 429       --  processed several times.
 430
 431       for N_File in 1 .. Osint.Number_Of_Files loop
 432          Main_Source_File := Next_Main_Source;
 433          Main_Lib_File := Osint.Lib_File_Name
 434                              (Main_Source_File, Current_File_Index);
 435          Insert_Q (Main_Lib_File);
 436
 437          while not Empty_Q loop
 438             Sources.Set_Last (0);
 439             Extract_From_Q (Lib_File);
 440             Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
 441
 442             --  If we have an existing ALI file that is not read-only,
 443             --  process it.
 444
 445             if Full_Lib_File /= No_File
 446               and then not Is_Readonly_Library (Full_Lib_File)
 447             then
 448                Text := Read_Library_Info (Lib_File);
 449
 450                if Text /= null then
 451                   The_ALI :=
 452                     Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
 453                   Free (Text);
 454
 455                   --  If no error was produced while loading this ALI file,
 456                   --  insert into the queue all the unmarked withed sources.
 457
 458                   if The_ALI /= No_ALI_Id then
 459                      for J in ALIs.Table (The_ALI).First_Unit ..
 460                        ALIs.Table (The_ALI).Last_Unit
 461                      loop
 462                         Sources.Increment_Last;
 463                         Sources.Table (Sources.Last) :=
 464                           ALI.Units.Table (J).Sfile;
 465
 466                         for K in ALI.Units.Table (J).First_With ..
 467                           ALI.Units.Table (J).Last_With
 468                         loop
 469                            Insert_Q (Withs.Table (K).Afile);
 470                         end loop;
 471                      end loop;
 472
 473                      --  Look for subunits and put them in the Sources table
 474
 475                      for J in ALIs.Table (The_ALI).First_Sdep ..
 476                        ALIs.Table (The_ALI).Last_Sdep
 477                      loop
 478                         if Sdep.Table (J).Subunit_Name /= No_Name then
 479                            Sources.Increment_Last;
 480                            Sources.Table (Sources.Last) :=
 481                              Sdep.Table (J).Sfile;
 482                         end if;
 483                      end loop;
 484                   end if;
 485                end if;
 486
 487                --  Now, delete all the existing files corresponding to this
 488                --  ALI file.
 489
 490                declare
 491                   Obj_Dir : constant String :=
 492                               Dir_Name (Get_Name_String (Full_Lib_File));
 493                   Obj     : constant String := Object_File_Name (Lib_File);
 494                   Adt     : constant String := Tree_File_Name   (Lib_File);
 495                   Asm     : constant String := Assembly_File_Name (Lib_File);
 496
 497                begin
 498                   Delete (Obj_Dir, Get_Name_String (Lib_File));
 499
 500                   if Is_Regular_File (Obj_Dir & Dir_Separator & Obj) then
 501                      Delete (Obj_Dir, Obj);
 502                   end if;
 503
 504                   if Is_Regular_File (Obj_Dir & Dir_Separator & Adt) then
 505                      Delete (Obj_Dir, Adt);
 506                   end if;
 507
 508                   if Is_Regular_File (Obj_Dir & Dir_Separator & Asm) then
 509                      Delete (Obj_Dir, Asm);
 510                   end if;
 511
 512                   --  Delete expanded source files (.dg) and/or repinfo files
 513                   --  (.rep) if any
 514
 515                   for J in 1 .. Sources.Last loop
 516                      declare
 517                         Deb : constant String :=
 518                                          Debug_File_Name (Sources.Table (J));
 519                         Rep : constant String :=
 520                                          Repinfo_File_Name (Sources.Table (J));
 521                      begin
 522                         if Is_Regular_File (Obj_Dir & Dir_Separator & Deb) then
 523                            Delete (Obj_Dir, Deb);
 524                         end if;
 525
 526                         if Is_Regular_File (Obj_Dir & Dir_Separator & Rep) then
 527                            Delete (Obj_Dir, Rep);
 528                         end if;
 529                      end;
 530                   end loop;
 531                end;
 532             end if;
 533          end loop;
 534
 535          --  Delete the executable, if it exists, and the binder generated
 536          --  files, if any.
 537
 538          if not Compile_Only then
 539             declare
 540                Source : constant Name_Id := Strip_Suffix (Main_Lib_File);
 541                Executable : constant String := Get_Name_String
 542                                               (Executable_Name (Source));
 543             begin
 544                if Is_Regular_File (Executable) then
 545                   Delete ("", Executable);
 546                end if;
 547
 548                Delete_Binder_Generated_Files (Get_Current_Dir, Source);
 549             end;
 550          end if;
 551       end loop;
 552    end Clean_Executables;
 553
 554    -------------------
 555    -- Clean_Project --
 556    -------------------
 557
 558    procedure Clean_Project (Project : Project_Id) is
 559       Main_Source_File : File_Name_Type;
 560       --  Name of the executable on the command line, without directory
 561       --  information.
 562
 563       Executable : Name_Id;
 564       --  Name of the executable file
 565
 566       Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
 567       Data        : constant Project_Data := Projects.Table (Project);
 568       U_Data      : Prj.Com.Unit_Data;
 569       File_Name1  : Name_Id;
 570       Index1      : Int;
 571       File_Name2  : Name_Id;
 572       Index2      : Int;
 573       Lib_File    : File_Name_Type;
 574
 575       Source_Id   : Other_Source_Id;
 576       Source      : Other_Source;
 577
 578       Global_Archive : Boolean := False;
 579
 580       use Prj.Com;
 581
 582    begin
 583       --  Check that we don't specify executable on the command line for
 584       --  a main library project.
 585
 586       if Project = Main_Project
 587         and then Osint.Number_Of_Files /= 0
 588         and then Data.Library
 589       then
 590          Osint.Fail
 591            ("Cannot specify executable(s) for a Library Project File");
 592       end if;
 593
 594       if Verbose_Mode then
 595          Put ("Cleaning project """);
 596          Put (Get_Name_String (Data.Name));
 597          Put_Line ("""");
 598       end if;
 599
 600       --  Add project to the list of proceesed projects
 601
 602       Processed_Projects.Increment_Last;
 603       Processed_Projects.Table (Processed_Projects.Last) := Project;
 604
 605       if Data.Object_Directory /= No_Name then
 606          declare
 607             Obj_Dir : constant String :=
 608                         Get_Name_String (Data.Object_Directory);
 609
 610          begin
 611             Change_Dir (Obj_Dir);
 612
 613             --  First, deal with Ada.
 614             --  Look through the units to find those that are either immediate
 615             --  sources or inherited sources of the project.
 616
 617             if Data.Languages (Lang_Ada) then
 618                for Unit in 1 .. Prj.Com.Units.Last loop
 619                   U_Data := Prj.Com.Units.Table (Unit);
 620                   File_Name1 := No_Name;
 621                   File_Name2 := No_Name;
 622
 623                   --  If either the spec or the body is a source of the
 624                   --  project, check for the corresponding ALI file in the
 625                   --  object directory.
 626
 627                   if In_Extension_Chain
 628                     (U_Data.File_Names (Body_Part).Project, Project)
 629                     or else
 630                       In_Extension_Chain
 631                         (U_Data.File_Names (Specification).Project, Project)
 632                   then
 633                      File_Name1 := U_Data.File_Names (Body_Part).Name;
 634                      Index1     := U_Data.File_Names (Body_Part).Index;
 635                      File_Name2 := U_Data.File_Names (Specification).Name;
 636                      Index2     := U_Data.File_Names (Specification).Index;
 637
 638                      --  If there is no body file name, then there may be only
 639                      --  a spec.
 640
 641                      if File_Name1 = No_Name then
 642                         File_Name1 := File_Name2;
 643                         Index1     := Index2;
 644                         File_Name2 := No_Name;
 645                         Index2     := 0;
 646                      end if;
 647                   end if;
 648
 649                   --  If there is either a spec or a body, look for files
 650                   --  in the object directory.
 651
 652                   if File_Name1 /= No_Name then
 653                      Lib_File := Osint.Lib_File_Name (File_Name1, Index1);
 654
 655                      declare
 656                         Asm : constant String := Assembly_File_Name (Lib_File);
 657                         ALI : constant String := ALI_File_Name      (Lib_File);
 658                         Obj : constant String := Object_File_Name   (Lib_File);
 659                         Adt : constant String := Tree_File_Name     (Lib_File);
 660                         Deb : constant String :=
 661                                 Debug_File_Name (File_Name1);
 662                         Rep : constant String :=
 663                                 Repinfo_File_Name (File_Name1);
 664                         Del : Boolean := True;
 665
 666                      begin
 667                         --  If the ALI file exists and is read-only, no file
 668                         --  is deleted.
 669
 670                         if Is_Regular_File (ALI) then
 671                            if Is_Writable_File (ALI) then
 672                               Delete (Obj_Dir, ALI);
 673
 674                            else
 675                               Del := False;
 676
 677                               if Verbose_Mode then
 678                                  Put ('"');
 679                                  Put (Obj_Dir);
 680
 681                                  if Obj_Dir (Obj_Dir'Last) /=
 682                                       Dir_Separator
 683                                  then
 684                                     Put (Dir_Separator);
 685                                  end if;
 686
 687                                  Put (ALI);
 688                                  Put_Line (""" is read-only");
 689                               end if;
 690                            end if;
 691                         end if;
 692
 693                         if Del then
 694
 695                            --  Object file
 696
 697                            if Is_Regular_File (Obj) then
 698                               Delete (Obj_Dir, Obj);
 699                            end if;
 700
 701                            --  Assembly file
 702
 703                            if Is_Regular_File (Asm) then
 704                               Delete (Obj_Dir, Asm);
 705                            end if;
 706
 707                            --  Tree file
 708
 709                            if Is_Regular_File (Adt) then
 710                               Delete (Obj_Dir, Adt);
 711                            end if;
 712
 713                            --  First expanded source file
 714
 715                            if Is_Regular_File (Deb) then
 716                               Delete (Obj_Dir, Deb);
 717                            end if;
 718
 719                            --  Repinfo file
 720
 721                            if Is_Regular_File (Rep) then
 722                               Delete (Obj_Dir, Rep);
 723                            end if;
 724
 725                            --  Second expanded source file
 726
 727                            if File_Name2 /= No_Name then
 728                               declare
 729                                  Deb : constant String :=
 730                                          Debug_File_Name   (File_Name2);
 731                                  Rep : constant String :=
 732                                          Repinfo_File_Name (File_Name2);
 733                               begin
 734                                  if Is_Regular_File (Deb) then
 735                                     Delete (Obj_Dir, Deb);
 736                                  end if;
 737
 738                                  if Is_Regular_File (Rep) then
 739                                     Delete (Obj_Dir, Rep);
 740                                  end if;
 741                               end;
 742                            end if;
 743                         end if;
 744                      end;
 745                   end if;
 746                end loop;
 747             end if;
 748
 749             --  Check if a global archive and it dependency file could have
 750             --  been created and, if they exist, delete them.
 751
 752             if Project = Main_Project and then not Data.Library then
 753                Global_Archive := False;
 754
 755                for Proj in 1 .. Projects.Last loop
 756                   if Projects.Table (Proj).Other_Sources_Present then
 757                      Global_Archive := True;
 758                      exit;
 759                   end if;
 760                end loop;
 761
 762                if Global_Archive then
 763                   Clean_Archive (Project);
 764                end if;
 765             end if;
 766
 767             if Data.Other_Sources_Present then
 768                --  There is non-Ada code: delete the object files and
 769                --  the dependency files, if they exist.
 770
 771                Source_Id := Data.First_Other_Source;
 772
 773                while Source_Id /= No_Other_Source loop
 774                   Source := Other_Sources.Table (Source_Id);
 775
 776                   if Is_Regular_File
 777                        (Get_Name_String (Source.Object_Name))
 778                   then
 779                      Delete (Obj_Dir, Get_Name_String (Source.Object_Name));
 780                   end if;
 781
 782                   if Is_Regular_File (Get_Name_String (Source.Dep_Name)) then
 783                      Delete (Obj_Dir, Get_Name_String (Source.Dep_Name));
 784                   end if;
 785
 786                   Source_Id := Source.Next;
 787                end loop;
 788
 789                --  If it is a library with only non Ada sources, delete
 790                --  the fake archive and the dependency file, if they exist.
 791
 792                if Data.Library and then not Data.Languages (Lang_Ada) then
 793                   Clean_Archive (Project);
 794                end if;
 795             end if;
 796          end;
 797       end if;
 798
 799       --  If this is a library project, clean the library directory, the
 800       --  interface copy dir and, for a Stand-Alone Library, the binder
 801       --  generated files of the library.
 802
 803       --  The directories are cleaned only if switch -c is not specified.
 804
 805       if Data.Library then
 806          if not Compile_Only then
 807             Clean_Directory (Data.Library_Dir);
 808
 809             if Data.Library_Src_Dir /= No_Name
 810               and then Data.Library_Src_Dir /= Data.Library_Dir
 811             then
 812                Clean_Directory (Data.Library_Src_Dir);
 813             end if;
 814          end if;
 815
 816          if Data.Standalone_Library and then
 817             Data.Object_Directory /= No_Name
 818          then
 819             Delete_Binder_Generated_Files
 820               (Get_Name_String (Data.Object_Directory), Data.Library_Name);
 821          end if;
 822       end if;
 823
 824       if Verbose_Mode then
 825          New_Line;
 826       end if;
 827
 828       --  If switch -r is specified, call Clean_Project recursively for the
 829       --  imported projects and the project being extended.
 830
 831       if All_Projects then
 832          declare
 833             Imported : Project_List := Data.Imported_Projects;
 834             Element  : Project_Element;
 835             Process  : Boolean;
 836
 837          begin
 838             --  For each imported project, call Clean_Project if the project
 839             --  has not been processed already.
 840
 841             while Imported /= Empty_Project_List loop
 842                Element := Project_Lists.Table (Imported);
 843                Imported := Element.Next;
 844                Process := True;
 845
 846                for
 847                  J in Processed_Projects.First .. Processed_Projects.Last
 848                loop
 849                   if Element.Project = Processed_Projects.Table (J) then
 850                      Process := False;
 851                      exit;
 852                   end if;
 853                end loop;
 854
 855                if Process then
 856                   Clean_Project (Element.Project);
 857                end if;
 858             end loop;
 859
 860             --  If this project extends another project, call Clean_Project for
 861             --  the project being extended. It is guaranteed that it has not
 862             --  called before, because no other project may import or extend
 863             --  this project.
 864
 865             if Data.Extends /= No_Project then
 866                Clean_Project (Data.Extends);
 867             end if;
 868          end;
 869       end if;
 870
 871          --  For the main project, delete the executables and the
 872          --  binder generated files.
 873
 874          --  The executables are deleted only if switch -c is not specified.
 875
 876       if Project = Main_Project and then Data.Exec_Directory /= No_Name then
 877          declare
 878             Exec_Dir : constant String :=
 879               Get_Name_String (Data.Exec_Directory);
 880          begin
 881             Change_Dir (Exec_Dir);
 882
 883             for N_File in 1 .. Osint.Number_Of_Files loop
 884                Main_Source_File := Next_Main_Source;
 885
 886                if not Compile_Only then
 887                   Executable :=
 888                     Executable_Of
 889                       (Main_Project,
 890                        Main_Source_File,
 891                        Current_File_Index);
 892
 893                   if Is_Regular_File (Get_Name_String (Executable)) then
 894                      Delete (Exec_Dir, Get_Name_String (Executable));
 895                   end if;
 896                end if;
 897
 898                if Data.Object_Directory /= No_Name then
 899                   Delete_Binder_Generated_Files
 900                     (Get_Name_String
 901                        (Data.Object_Directory),
 902                      Strip_Suffix (Main_Source_File));
 903                end if;
 904             end loop;
 905          end;
 906       end if;
 907
 908       --  Change back to previous directory
 909
 910       Change_Dir (Current_Dir);
 911    end Clean_Project;
 912
 913    ---------------------
 914    -- Debug_File_Name --
 915    ---------------------
 916
 917    function Debug_File_Name (Source : Name_Id) return String is
 918    begin
 919       return Get_Name_String (Source) & Debug_Suffix;
 920    end Debug_File_Name;
 921
 922    ------------
 923    -- Delete --
 924    ------------
 925
 926    procedure Delete (In_Directory : String; File : String) is
 927       Full_Name : String (1 .. In_Directory'Length + File'Length + 1);
 928       Last : Natural := 0;
 929       Success : Boolean;
 930
 931    begin
 932       --  Indicate that at least one file is deleted or is to be deleted
 933
 934       File_Deleted := True;
 935
 936       --  Build the path name of the file to delete
 937
 938       Last := In_Directory'Length;
 939       Full_Name (1 .. Last) := In_Directory;
 940
 941       if Last > 0 and then Full_Name (Last) /= Directory_Separator then
 942          Last := Last + 1;
 943          Full_Name (Last) := Directory_Separator;
 944       end if;
 945
 946       Full_Name (Last + 1 .. Last + File'Length) := File;
 947       Last := Last + File'Length;
 948
 949       --  If switch -n was used, simply output the path name
 950
 951       if Do_Nothing then
 952          Put_Line (Full_Name (1 .. Last));
 953
 954       --  Otherwise, delete the file
 955
 956       else
 957          Delete_File (Full_Name (1 .. Last), Success);
 958
 959          if not Success then
 960             Put ("Warning: """);
 961             Put (Full_Name (1 .. Last));
 962             Put_Line (""" could not be deleted");
 963
 964          elsif Verbose_Mode or else not Quiet_Output then
 965             Put ("""");
 966             Put (Full_Name (1 .. Last));
 967             Put_Line (""" has been deleted");
 968          end if;
 969       end if;
 970    end Delete;
 971
 972    -----------------------------------
 973    -- Delete_Binder_Generated_Files --
 974    -----------------------------------
 975
 976    procedure Delete_Binder_Generated_Files (Dir : String; Source : Name_Id) is
 977       Source_Name : constant String := Get_Name_String (Source);
 978       Current     : constant String := Get_Current_Dir;
 979       Last        : constant Positive := B_Start'Length + Source_Name'Length;
 980       File_Name   : String (1 .. Last + 4);
 981
 982    begin
 983       Change_Dir (Dir);
 984
 985       --  Build the file name (before the extension)
 986
 987       File_Name (1 .. B_Start'Length) := B_Start;
 988       File_Name (B_Start'Length + 1 .. Last) := Source_Name;
 989
 990       --  Spec
 991
 992       File_Name (Last + 1 .. Last + 4) := ".ads";
 993
 994       if Is_Regular_File (File_Name (1 .. Last + 4)) then
 995          Delete (Dir, File_Name (1 .. Last + 4));
 996       end if;
 997
 998       --  Body
 999
1000       File_Name (Last + 1 .. Last + 4) := ".adb";
1001
1002       if Is_Regular_File (File_Name (1 .. Last + 4)) then
1003          Delete (Dir, File_Name (1 .. Last + 4));
1004       end if;
1005
1006       --  ALI file
1007
1008       File_Name (Last + 1 .. Last + 4) := ".ali";
1009
1010       if Is_Regular_File (File_Name (1 .. Last + 4)) then
1011          Delete (Dir, File_Name (1 .. Last + 4));
1012       end if;
1013
1014       --  Object file
1015
1016       File_Name (Last + 1 .. Last + Object_Suffix'Length) := Object_Suffix;
1017
1018       if Is_Regular_File (File_Name (1 .. Last + Object_Suffix'Length)) then
1019          Delete (Dir, File_Name (1 .. Last + Object_Suffix'Length));
1020       end if;
1021
1022       --  Change back to previous directory
1023
1024       Change_Dir (Current);
1025    end Delete_Binder_Generated_Files;
1026
1027    -----------------------
1028    -- Display_Copyright --
1029    -----------------------
1030
1031    procedure Display_Copyright is
1032    begin
1033       if not Copyright_Displayed then
1034          Copyright_Displayed := True;
1035          Put_Line ("GNATCLEAN " & Gnatvsn.Gnat_Version_String
1036                    & " Copyright 2003-2004 Free Software Foundation, Inc.");
1037       end if;
1038    end Display_Copyright;
1039
1040    -------------
1041    -- Empty_Q --
1042    -------------
1043
1044    function Empty_Q return Boolean is
1045    begin
1046       return Q_Front >= Q.Last;
1047    end Empty_Q;
1048
1049    --------------------
1050    -- Extract_From_Q --
1051    --------------------
1052
1053    procedure Extract_From_Q (Lib_File : out File_Name_Type) is
1054       Lib : constant File_Name_Type := Q.Table (Q_Front);
1055
1056    begin
1057       Q_Front  := Q_Front + 1;
1058       Lib_File := Lib;
1059    end Extract_From_Q;
1060
1061    ---------------
1062    -- Gnatclean --
1063    ---------------
1064
1065    procedure Gnatclean is
1066    begin
1067       --  Do the necessary initializations
1068
1069       Initialize;
1070
1071       --  Parse the command line, getting the switches and the executable names
1072
1073       Parse_Cmd_Line;
1074
1075       if Verbose_Mode then
1076          Display_Copyright;
1077       end if;
1078
1079       if Project_File_Name /= null then
1080
1081          --  A project file was specified by a -P switch
1082
1083          if Opt.Verbose_Mode then
1084             New_Line;
1085             Put ("Parsing Project File """);
1086             Put (Project_File_Name.all);
1087             Put_Line (""".");
1088             New_Line;
1089          end if;
1090
1091          --  Set the project parsing verbosity to whatever was specified
1092          --  by a possible -vP switch.
1093
1094          Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity);
1095
1096          --  Parse the project file.
1097          --  If there is an error, Main_Project will still be No_Project.
1098
1099          Prj.Pars.Parse
1100            (Project           => Main_Project,
1101             Project_File_Name => Project_File_Name.all,
1102             Packages_To_Check => Packages_To_Check_By_Gnatmake,
1103             Process_Languages => All_Languages);
1104
1105          if Main_Project = No_Project then
1106             Fail ("""" & Project_File_Name.all &
1107                   """ processing failed");
1108          end if;
1109
1110          if Opt.Verbose_Mode then
1111             New_Line;
1112             Put ("Parsing of Project File """);
1113             Put (Project_File_Name.all);
1114             Put (""" is finished.");
1115             New_Line;
1116          end if;
1117
1118          --  We add the source directories and the object directories
1119          --  to the search paths.
1120
1121          Add_Source_Directories (Main_Project);
1122          Add_Object_Directories (Main_Project);
1123
1124       end if;
1125
1126       Osint.Add_Default_Search_Dirs;
1127
1128       --  If a project file was specified, but no executable name, put all
1129       --  the mains of the project file (if any) as if there were on the
1130       --  command line.
1131
1132       if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
1133          declare
1134             Value : String_List_Id := Projects.Table (Main_Project).Mains;
1135             Main  : String_Element;
1136          begin
1137             while Value /= Prj.Nil_String loop
1138                Main := String_Elements.Table (Value);
1139                Osint.Add_File
1140                  (File_Name => Get_Name_String (Main.Value),
1141                   Index     => Main.Index);
1142                Value := Main.Next;
1143             end loop;
1144          end;
1145       end if;
1146
1147       --  If neither a project file nor an executable were specified,
1148       --  output the usage and exit.
1149
1150       if Main_Project = No_Project and then Osint.Number_Of_Files = 0 then
1151          Usage;
1152          return;
1153       end if;
1154
1155       if Verbose_Mode then
1156          New_Line;
1157       end if;
1158
1159       if Main_Project /= No_Project then
1160
1161          --  If a project file has been specified, call Clean_Project with the
1162          --  project id of this project file, after resetting the list of
1163          --  processed projects.
1164
1165          Processed_Projects.Init;
1166          Clean_Project (Main_Project);
1167
1168       else
1169          --  If no project file has been specified, the work is done in
1170          --  Clean_Executables.
1171
1172          Clean_Executables;
1173       end if;
1174
1175       --  In verbose mode, if Delete has not been called, indicate that
1176       --  no file needs to be deleted.
1177
1178       if Verbose_Mode and (not File_Deleted) then
1179          New_Line;
1180
1181          if Do_Nothing then
1182             Put_Line ("No file needs to be deleted");
1183          else
1184             Put_Line ("No file has been deleted");
1185          end if;
1186       end if;
1187    end Gnatclean;
1188
1189    ------------------------
1190    -- In_Extension_Chain --
1191    ------------------------
1192
1193    function In_Extension_Chain
1194      (Of_Project : Project_Id;
1195       Prj        : Project_Id) return Boolean
1196    is
1197       Data : Project_Data;
1198
1199    begin
1200       if Of_Project = Prj then
1201          return True;
1202       end if;
1203
1204       Data := Projects.Table (Of_Project);
1205
1206       while Data.Extends /= No_Project loop
1207          if Data.Extends = Prj then
1208             return True;
1209          end if;
1210
1211          Data := Projects.Table (Data.Extends);
1212       end loop;
1213
1214       Data := Projects.Table (Prj);
1215
1216       while Data.Extends /= No_Project loop
1217          if Data.Extends = Of_Project then
1218             return True;
1219          end if;
1220
1221          Data := Projects.Table (Data.Extends);
1222       end loop;
1223
1224       return False;
1225    end In_Extension_Chain;
1226
1227    ------------
1228    -- Init_Q --
1229    ------------
1230
1231    procedure Init_Q is
1232    begin
1233       Q_Front := Q.First;
1234       Q.Set_Last (Q.First);
1235    end Init_Q;
1236
1237    ----------------
1238    -- Initialize --
1239    ----------------
1240
1241    procedure Initialize is
1242    begin
1243       if not Initialized then
1244          Initialized := True;
1245
1246          --  Initialize some packages
1247
1248          Csets.Initialize;
1249          Namet.Initialize;
1250          Snames.Initialize;
1251          Prj.Initialize;
1252       end if;
1253
1254       --  Reset global variables
1255
1256       Free (Object_Directory_Path);
1257       Do_Nothing := False;
1258       File_Deleted := False;
1259       Copyright_Displayed := False;
1260       Usage_Displayed := False;
1261       Free (Project_File_Name);
1262       Main_Project := Prj.No_Project;
1263       All_Projects := False;
1264    end Initialize;
1265
1266    --------------
1267    -- Insert_Q --
1268    --------------
1269
1270    procedure Insert_Q (Lib_File : File_Name_Type) is
1271    begin
1272       --  Do not insert an empty name or an already marked source
1273
1274       if Lib_File /= No_Name and then not Is_Marked (Lib_File) then
1275          Q.Table (Q.Last) := Lib_File;
1276          Q.Increment_Last;
1277
1278          --  Mark the source that has been just added to the Q
1279
1280          Mark (Lib_File);
1281       end if;
1282    end Insert_Q;
1283
1284    ----------------------
1285    -- Object_File_Name --
1286    ----------------------
1287
1288    function Object_File_Name (Source : Name_Id) return String is
1289       Src : constant String := Get_Name_String (Source);
1290
1291    begin
1292       --  If the source name has an extension, then replace it with
1293       --  the Object suffix.
1294
1295       for Index in reverse Src'First + 1 .. Src'Last loop
1296          if Src (Index) = '.' then
1297             return Src (Src'First .. Index - 1) & Object_Suffix;
1298          end if;
1299       end loop;
1300
1301       --  If there is no dot, or if it is the first character, just add the
1302       --  ALI suffix.
1303
1304       return Src & Object_Suffix;
1305    end Object_File_Name;
1306
1307    --------------------
1308    -- Parse_Cmd_Line --
1309    --------------------
1310
1311    procedure Parse_Cmd_Line is
1312       Source_Index : Int := 0;
1313       Index : Positive := 1;
1314       Last  : constant Natural := Argument_Count;
1315    begin
1316       while Index <= Last loop
1317          declare
1318             Arg : constant String := Argument (Index);
1319
1320             procedure Bad_Argument;
1321             --  Signal bad argument
1322
1323             ------------------
1324             -- Bad_Argument --
1325             ------------------
1326
1327             procedure Bad_Argument is
1328             begin
1329                Fail ("invalid argument """, Arg, """");
1330             end Bad_Argument;
1331
1332          begin
1333             if Arg'Length /= 0 then
1334                if Arg (1) = '-' then
1335                   if Arg'Length = 1 then
1336                      Bad_Argument;
1337                   end if;
1338
1339                   case Arg (2) is
1340                      when 'a' =>
1341                         if Arg'Length < 4 or else Arg (3) /= 'O' then
1342                            Bad_Argument;
1343                         end if;
1344
1345                         Add_Lib_Search_Dir (Arg (3 .. Arg'Last));
1346
1347                      when 'c'    =>
1348                         Compile_Only := True;
1349
1350                      when 'D'    =>
1351                         if Object_Directory_Path /= null then
1352                            Fail ("duplicate -D switch");
1353
1354                         elsif Project_File_Name /= null then
1355                            Fail ("-P and -D cannot be used simultaneously");
1356                         end if;
1357
1358                         if Arg'Length > 2 then
1359                            declare
1360                               Dir : constant String := Arg (3 .. Arg'Last);
1361                            begin
1362                               if not Is_Directory (Dir) then
1363                                  Fail (Dir, " is not a directory");
1364                               else
1365                                  Add_Lib_Search_Dir (Dir);
1366                               end if;
1367                            end;
1368
1369                         else
1370                            if Index = Last then
1371                               Fail ("no directory specified after -D");
1372                            end if;
1373
1374                            Index := Index + 1;
1375
1376                            declare
1377                               Dir : constant String := Argument (Index);
1378                            begin
1379                               if not Is_Directory (Dir) then
1380                                  Fail (Dir, " is not a directory");
1381                               else
1382                                  Add_Lib_Search_Dir (Dir);
1383                               end if;
1384                            end;
1385                         end if;
1386
1387                      when 'F' =>
1388                         Full_Path_Name_For_Brief_Errors := True;
1389
1390                      when 'h' =>
1391                         Usage;
1392
1393                      when 'i' =>
1394                         if Arg'Length = 2 then
1395                            Bad_Argument;
1396                         end if;
1397
1398                         Source_Index := 0;
1399
1400                         for J in 3 .. Arg'Last loop
1401                            if Arg (J) not in '0' .. '9' then
1402                               Bad_Argument;
1403                            end if;
1404
1405                            Source_Index :=
1406                              (20 * Source_Index) +
1407                              (Character'Pos (Arg (J)) - Character'Pos ('0'));
1408                         end loop;
1409
1410                      when 'I' =>
1411                         if Arg = "-I-" then
1412                            Opt.Look_In_Primary_Dir := False;
1413
1414                         else
1415                            if Arg'Length = 2 then
1416                               Bad_Argument;
1417                            end if;
1418
1419                            Add_Lib_Search_Dir (Arg (3 .. Arg'Last));
1420                         end if;
1421
1422                      when 'n' =>
1423                         Do_Nothing := True;
1424
1425                      when 'P' =>
1426                         if Project_File_Name /= null then
1427                            Fail ("multiple -P switches");
1428
1429                         elsif Object_Directory_Path /= null then
1430                            Fail ("-D and -P cannot be used simultaneously");
1431
1432                         end if;
1433
1434                         if Arg'Length > 2 then
1435                            declare
1436                               Prj : constant String := Arg (3 .. Arg'Last);
1437                            begin
1438                               if Prj'Length > 1 and then
1439                                 Prj (Prj'First) = '='
1440                               then
1441                                  Project_File_Name :=
1442                                    new String'
1443                                      (Prj (Prj'First + 1 ..  Prj'Last));
1444                               else
1445                                  Project_File_Name := new String'(Prj);
1446                               end if;
1447                            end;
1448
1449                         else
1450                            if Index = Last then
1451                               Fail ("no project specified after -P");
1452                            end if;
1453
1454                            Index := Index + 1;
1455                            Project_File_Name := new String'(Argument (Index));
1456                         end if;
1457
1458                      when 'q' =>
1459                         Quiet_Output := True;
1460
1461                      when 'r' =>
1462                         All_Projects := True;
1463
1464                      when 'v' =>
1465                         if Arg = "-v" then
1466                            Verbose_Mode := True;
1467
1468                         elsif Arg = "-vP0" then
1469                            Prj.Com.Current_Verbosity := Prj.Default;
1470
1471                         elsif Arg = "-vP1" then
1472                            Prj.Com.Current_Verbosity := Prj.Medium;
1473
1474                         elsif Arg = "-vP2" then
1475                            Prj.Com.Current_Verbosity := Prj.High;
1476
1477                         else
1478                            Bad_Argument;
1479                         end if;
1480
1481                      when 'X' =>
1482                         if Arg'Length = 2 then
1483                            Bad_Argument;
1484                         end if;
1485
1486                         declare
1487                            Ext_Asgn  : constant String := Arg (3 .. Arg'Last);
1488                            Start     : Positive := Ext_Asgn'First;
1489                            Stop      : Natural  := Ext_Asgn'Last;
1490                            Equal_Pos : Natural;
1491                            OK        : Boolean  := True;
1492
1493                         begin
1494                            if Ext_Asgn (Start) = '"' then
1495                               if Ext_Asgn (Stop) = '"' then
1496                                  Start := Start + 1;
1497                                  Stop  := Stop - 1;
1498
1499                               else
1500                                  OK := False;
1501                               end if;
1502                            end if;
1503
1504                            Equal_Pos := Start;
1505
1506                            while Equal_Pos <= Stop
1507                              and then Ext_Asgn (Equal_Pos) /= '='
1508                            loop
1509                               Equal_Pos := Equal_Pos + 1;
1510                            end loop;
1511
1512                            if Equal_Pos = Start or else Equal_Pos > Stop then
1513                               OK := False;
1514                            end if;
1515
1516                            if OK then
1517                               Prj.Ext.Add
1518                                 (External_Name =>
1519                                    Ext_Asgn (Start .. Equal_Pos - 1),
1520                                  Value         =>
1521                                    Ext_Asgn (Equal_Pos + 1 .. Stop));
1522
1523                            else
1524                               Fail
1525                                 ("illegal external assignment '",
1526                                  Ext_Asgn, "'");
1527                            end if;
1528                         end;
1529
1530                      when others =>
1531                         Bad_Argument;
1532                   end case;
1533
1534                else
1535                   Add_File (Arg, Source_Index);
1536                end if;
1537             end if;
1538          end;
1539
1540          Index := Index + 1;
1541       end loop;
1542    end Parse_Cmd_Line;
1543
1544    -----------------------
1545    -- Repinfo_File_Name --
1546    -----------------------
1547
1548    function Repinfo_File_Name (Source : Name_Id) return String is
1549    begin
1550       return Get_Name_String (Source) & Repinfo_Suffix;
1551    end Repinfo_File_Name;
1552
1553    --------------------
1554    -- Tree_File_Name --
1555    --------------------
1556
1557    function Tree_File_Name (Source : Name_Id) return String is
1558       Src : constant String := Get_Name_String (Source);
1559
1560    begin
1561       --  If the source name has an extension, then replace it with
1562       --  the tree suffix.
1563
1564       for Index in reverse Src'First + 1 .. Src'Last loop
1565          if Src (Index) = '.' then
1566             return Src (Src'First .. Index - 1) & Tree_Suffix;
1567          end if;
1568       end loop;
1569
1570       --  If there is no dot, or if it is the first character, just add the
1571       --  tree suffix.
1572
1573       return Src & Tree_Suffix;
1574    end Tree_File_Name;
1575
1576    -----------
1577    -- Usage --
1578    -----------
1579
1580    procedure Usage is
1581    begin
1582       if not Usage_Displayed then
1583          Usage_Displayed := True;
1584          Display_Copyright;
1585          Put_Line ("Usage: gnatclean [switches] {[-innn] name}");
1586          New_Line;
1587
1588          Put_Line ("  names is one or more file names from which " &
1589                    "the .adb or .ads suffix may be omitted");
1590          Put_Line ("  names may be omitted if -P<project> is specified");
1591          New_Line;
1592
1593          Put_Line ("  -c       Only delete compiler generated files");
1594          Put_Line ("  -D dir   Specify dir as the object library");
1595          Put_Line ("  -F       Full project path name " &
1596                    "in brief error messages");
1597          Put_Line ("  -h       Display this message");
1598          Put_Line ("  -innn    Index of unit in source for following names");
1599          Put_Line ("  -n       Nothing to do: only list files to delete");
1600          Put_Line ("  -Pproj   Use GNAT Project File proj");
1601          Put_Line ("  -q       Be quiet/terse");
1602          Put_Line ("  -r       Clean all projects recursively");
1603          Put_Line ("  -v       Verbose mode");
1604          Put_Line ("  -vPx     Specify verbosity when parsing " &
1605                    "GNAT Project Files");
1606          Put_Line ("  -Xnm=val Specify an external reference " &
1607                    "for GNAT Project Files");
1608          New_Line;
1609
1610          Put_Line ("  -aOdir   Specify ALI/object files search path");
1611          Put_Line ("  -Idir    Like -aOdir");
1612          Put_Line ("  -I-      Don't look for source/library files " &
1613                    "in the default directory");
1614          New_Line;
1615       end if;
1616    end Usage;
1617
1618 begin
1619    if Hostparm.OpenVMS then
1620       Debug_Suffix (Debug_Suffix'First) := '_';
1621       Repinfo_Suffix (Repinfo_Suffix'First) := '_';
1622       B_Start (B_Start'Last) := '$';
1623    end if;
1624 end Clean;