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