gcc/ada/clean.adb

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