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