gcc/ada/clean.adb

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