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