gcc/ada/gnatls.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               G N A T L S                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2018, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 pragma Ada_2012;
  27
  28 with ALI;         use ALI;
  29 with ALI.Util;    use ALI.Util;
  30 with Binderr;     use Binderr;
  31 with Butil;       use Butil;
  32 with Csets;
  33 with Fname;       use Fname;
  34 with Gnatvsn;     use Gnatvsn;
  35 with Make_Util;   use Make_Util;
  36 with Namet;       use Namet;
  37 with Opt;         use Opt;
  38 with Osint;       use Osint;
  39 with Osint.L;     use Osint.L;
  40 with Output;      use Output;
  41 with Rident;      use Rident;
  42 with Sdefault;
  43 with Snames;
  44 with Stringt;
  45 with Switch;      use Switch;
  46 with Types;       use Types;
  47
  48 with GNAT.Case_Util;            use GNAT.Case_Util;
  49 with GNAT.Command_Line;         use GNAT.Command_Line;
  50 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  51 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  52
  53 procedure Gnatls is
  54    pragma Ident (Gnat_Static_Version_String);
  55
  56    --  NOTE : The following string may be used by other tools, such as GPS. So
  57    --  it can only be modified if these other uses are checked and coordinated.
  58
  59    Project_Search_Path : constant String := "Project Search Path:";
  60    --  Label displayed in verbose mode before the directories in the project
  61    --  search path. Do not modify without checking NOTE above.
  62
  63    Prj_Path : String_Access;
  64
  65    Max_Column : constant := 80;
  66
  67    No_Obj : aliased String := "<no_obj>";
  68
  69    No_Runtime : Boolean := False;
  70    --  Set to True if there is no default runtime and --RTS= is not specified
  71
  72    type File_Status is (
  73      OK,                  --  matching timestamp
  74      Checksum_OK,         --  only matching checksum
  75      Not_Found,           --  file not found on source PATH
  76      Not_Same,            --  neither checksum nor timestamp matching
  77      Not_First_On_PATH);  --  matching file hidden by Not_Same file on path
  78
  79    type Dir_Data;
  80    type Dir_Ref is access Dir_Data;
  81
  82    type Dir_Data is record
  83       Value : String_Access;
  84       Next  : Dir_Ref;
  85    end record;
  86    --  Simply linked list of dirs
  87
  88    First_Source_Dir : Dir_Ref;
  89    Last_Source_Dir  : Dir_Ref;
  90    --  The list of source directories from the command line.
  91    --  These directories are added using Osint.Add_Src_Search_Dir
  92    --  after those of the GNAT Project File, if any.
  93
  94    First_Lib_Dir : Dir_Ref;
  95    Last_Lib_Dir  : Dir_Ref;
  96    --  The list of object directories from the command line.
  97    --  These directories are added using Osint.Add_Lib_Search_Dir
  98    --  after those of the GNAT Project File, if any.
  99
 100    Main_File : File_Name_Type;
 101    Ali_File  : File_Name_Type;
 102    Text      : Text_Buffer_Ptr;
 103    Next_Arg  : Positive;
 104
 105    Too_Long : Boolean := False;
 106    --  When True, lines are too long for multi-column output and each
 107    --  item of information is on a different line.
 108
 109    Selective_Output : Boolean := False;
 110    Print_Usage      : Boolean := False;
 111    Print_Unit       : Boolean := True;
 112    Print_Source     : Boolean := True;
 113    Print_Object     : Boolean := True;
 114    --  Flags controlling the form of the output
 115
 116    Also_Predef       : Boolean := False;  --  -a
 117    Dependable        : Boolean := False;  --  -d
 118    License           : Boolean := False;  --  -l
 119    Very_Verbose_Mode : Boolean := False;  --  -V
 120    --  Command line flags
 121
 122    Unit_Start   : Integer;
 123    Unit_End     : Integer;
 124    Source_Start : Integer;
 125    Source_End   : Integer;
 126    Object_Start : Integer;
 127    Object_End   : Integer;
 128    --  Various column starts and ends
 129
 130    Spaces : constant String (1 .. Max_Column) := (others => ' ');
 131
 132    RTS_Specified : String_Access := null;
 133    --  Used to detect multiple use of --RTS= switch
 134
 135    Exit_Status : Exit_Code_Type := E_Success;
 136    --  Reset to E_Fatal if bad error found
 137
 138    -----------------------
 139    -- Local Subprograms --
 140    -----------------------
 141
 142    procedure Add_Lib_Dir (Dir : String);
 143    --  Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
 144
 145    procedure Add_Source_Dir (Dir : String);
 146    --  Add a source directory in the list First_Source_Dir-Last_Source_Dir
 147
 148    procedure Find_General_Layout;
 149    --  Determine the structure of the output (multi columns or not, etc)
 150
 151    procedure Find_Status
 152      (FS       : in out File_Name_Type;
 153       Stamp    : Time_Stamp_Type;
 154       Checksum : Word;
 155       Status   : out File_Status);
 156    --  Determine the file status (Status) of the file represented by FS with
 157    --  the expected Stamp and checksum given as argument. FS will be updated
 158    --  to the full file name if available.
 159
 160    function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
 161    --  Give the Sdep entry corresponding to the unit U in ali record A
 162
 163    procedure Output_Object (O : File_Name_Type);
 164    --  Print out the name of the object when requested
 165
 166    procedure Output_Source (Sdep_I : Sdep_Id);
 167    --  Print out the name and status of the source corresponding to this
 168    --  sdep entry.
 169
 170    procedure Output_Status (FS : File_Status; Verbose : Boolean);
 171    --  Print out FS either in a coded form if verbose is false or in an
 172    --  expanded form otherwise.
 173
 174    procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
 175    --  Print out information on the unit when requested
 176
 177    procedure Reset_Print;
 178    --  Reset Print flags properly when selective output is chosen
 179
 180    procedure Scan_Ls_Arg (Argv : String);
 181    --  Scan and process user specific arguments (Argv is a single argument)
 182
 183    procedure Search_RTS (Name : String);
 184    --  Find include and objects path for the RTS name.
 185
 186    procedure Usage;
 187    --  Print usage message
 188
 189    procedure Output_License_Information;
 190    pragma No_Return (Output_License_Information);
 191    --  Output license statement, and if not found, output reference to COPYING
 192
 193    function Image (Restriction : Restriction_Id) return String;
 194    --  Returns the capitalized image of Restriction
 195
 196    function Normalize (Path : String) return String;
 197    --  Returns a normalized path name. On Windows, the directory separators are
 198    --  set to '\' in Normalize_Pathname.
 199
 200    ------------------------------------------
 201    -- GNATDIST specific output subprograms --
 202    ------------------------------------------
 203
 204    package GNATDIST is
 205
 206       --  Any modification to this subunit requires synchronization with the
 207       --  GNATDIST sources.
 208
 209       procedure Output_ALI (A : ALI_Id);
 210       --  Comment required saying what this routine does ???
 211
 212       procedure Output_No_ALI (Afile : File_Name_Type);
 213       --  Comments required saying what this routine does ???
 214
 215    end GNATDIST;
 216
 217    ------------------------------
 218    -- Support for project path --
 219    ------------------------------
 220
 221    package Prj_Env is
 222
 223       procedure Initialize_Default_Project_Path
 224         (Self         : in out String_Access;
 225          Target_Name  : String;
 226          Runtime_Name : String := "");
 227       --  Initialize Self. It will then contain the default project path on
 228       --  the given target and runtime (including directories specified by the
 229       --  environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
 230       --  ADA_PROJECT_PATH). If one of the directory or Target_Name is "-",
 231       --  then the path contains only those directories specified by the
 232       --  environment variables (except "-"). This does nothing if Self has
 233       --  already been initialized.
 234
 235       procedure Add_Directories
 236         (Self    : in out String_Access;
 237          Path    : String;
 238          Prepend : Boolean := False);
 239       --  Add one or more directories to the path. Directories added with this
 240       --  procedure are added in order after the current directory and before
 241       --  the path given by the environment variable GPR_PROJECT_PATH. A value
 242       --  of "-" will remove the default project directory from the project
 243       --  path.
 244       --
 245       --  Calls to this subprogram must be performed before the first call to
 246       --  Find_Project below, or PATH will be added at the end of the search
 247       --  path.
 248
 249       function Get_Runtime_Path
 250         (Self : String_Access;
 251          Path : String) return String_Access;
 252       --  Compute the full path for the project-based runtime name.
 253       --  Path is simply searched on the project path.
 254
 255    end Prj_Env;
 256
 257    -----------------
 258    -- Add_Lib_Dir --
 259    -----------------
 260
 261    procedure Add_Lib_Dir (Dir : String) is
 262    begin
 263       if First_Lib_Dir = null then
 264          First_Lib_Dir :=
 265            new Dir_Data'
 266              (Value => new String'(Dir),
 267               Next  => null);
 268          Last_Lib_Dir := First_Lib_Dir;
 269
 270       else
 271          Last_Lib_Dir.Next :=
 272            new Dir_Data'
 273              (Value => new String'(Dir),
 274               Next  => null);
 275          Last_Lib_Dir := Last_Lib_Dir.Next;
 276       end if;
 277    end Add_Lib_Dir;
 278
 279    --------------------
 280    -- Add_Source_Dir --
 281    --------------------
 282
 283    procedure Add_Source_Dir (Dir : String) is
 284    begin
 285       if First_Source_Dir = null then
 286          First_Source_Dir :=
 287            new Dir_Data'
 288              (Value => new String'(Dir),
 289               Next  => null);
 290          Last_Source_Dir := First_Source_Dir;
 291
 292       else
 293          Last_Source_Dir.Next :=
 294            new Dir_Data'
 295              (Value => new String'(Dir),
 296               Next  => null);
 297          Last_Source_Dir := Last_Source_Dir.Next;
 298       end if;
 299    end Add_Source_Dir;
 300
 301    ------------------------------
 302    -- Corresponding_Sdep_Entry --
 303    ------------------------------
 304
 305    function Corresponding_Sdep_Entry
 306      (A : ALI_Id;
 307       U : Unit_Id) return Sdep_Id
 308    is
 309    begin
 310       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 311          if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
 312             return D;
 313          end if;
 314       end loop;
 315
 316       Error_Msg_Unit_1 := Units.Table (U).Uname;
 317       Error_Msg_File_1 := ALIs.Table (A).Afile;
 318       Write_Eol;
 319       Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
 320       Exit_Program (E_Fatal);
 321       return No_Sdep_Id;
 322    end Corresponding_Sdep_Entry;
 323
 324    -------------------------
 325    -- Find_General_Layout --
 326    -------------------------
 327
 328    procedure Find_General_Layout is
 329       Max_Unit_Length : Integer := 11;
 330       Max_Src_Length  : Integer := 11;
 331       Max_Obj_Length  : Integer := 11;
 332
 333       Len : Integer;
 334       FS  : File_Name_Type;
 335
 336    begin
 337       --  Compute maximum of each column
 338
 339       for Id in ALIs.First .. ALIs.Last loop
 340          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
 341          if Also_Predef or else not Is_Internal_Unit then
 342
 343             if Print_Unit then
 344                Len := Name_Len - 1;
 345                Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
 346             end if;
 347
 348             if Print_Source then
 349                FS := Full_Source_Name (ALIs.Table (Id).Sfile);
 350
 351                if FS = No_File then
 352                   Get_Name_String (ALIs.Table (Id).Sfile);
 353                   Name_Len := Name_Len + 13;
 354                else
 355                   Get_Name_String (FS);
 356                end if;
 357
 358                Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
 359             end if;
 360
 361             if Print_Object then
 362                if ALIs.Table (Id).No_Object then
 363                   Max_Obj_Length :=
 364                     Integer'Max (Max_Obj_Length, No_Obj'Length);
 365                else
 366                   Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
 367                   Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
 368                end if;
 369             end if;
 370          end if;
 371       end loop;
 372
 373       --  Verify is output is not wider than maximum number of columns
 374
 375       Too_Long :=
 376         Verbose_Mode
 377           or else
 378             (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
 379
 380       --  Set start and end of columns
 381
 382       Object_Start := 1;
 383       Object_End   := Object_Start - 1;
 384
 385       if Print_Object then
 386          Object_End   := Object_Start + Max_Obj_Length;
 387       end if;
 388
 389       Unit_Start := Object_End + 1;
 390       Unit_End   := Unit_Start - 1;
 391
 392       if Print_Unit then
 393          Unit_End   := Unit_Start + Max_Unit_Length;
 394       end if;
 395
 396       Source_Start := Unit_End + 1;
 397
 398       if Source_Start > Spaces'Last then
 399          Source_Start := Spaces'Last;
 400       end if;
 401
 402       Source_End := Source_Start - 1;
 403
 404       if Print_Source then
 405          Source_End := Source_Start + Max_Src_Length;
 406       end if;
 407    end Find_General_Layout;
 408
 409    -----------------
 410    -- Find_Status --
 411    -----------------
 412
 413    procedure Find_Status
 414      (FS       : in out File_Name_Type;
 415       Stamp    : Time_Stamp_Type;
 416       Checksum : Word;
 417       Status   : out File_Status)
 418    is
 419       Tmp1 : File_Name_Type;
 420       Tmp2 : File_Name_Type;
 421
 422    begin
 423       Tmp1 := Full_Source_Name (FS);
 424
 425       if Tmp1 = No_File then
 426          Status := Not_Found;
 427
 428       elsif File_Stamp (Tmp1) = Stamp then
 429          FS     := Tmp1;
 430          Status := OK;
 431
 432       elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
 433          FS := Tmp1;
 434          Status := Checksum_OK;
 435
 436       else
 437          Tmp2 := Matching_Full_Source_Name (FS, Stamp);
 438
 439          if Tmp2 = No_File then
 440             Status := Not_Same;
 441             FS     := Tmp1;
 442
 443          else
 444             Status := Not_First_On_PATH;
 445             FS := Tmp2;
 446          end if;
 447       end if;
 448    end Find_Status;
 449
 450    --------------
 451    -- GNATDIST --
 452    --------------
 453
 454    package body GNATDIST is
 455
 456       N_Flags   : Natural;
 457       N_Indents : Natural := 0;
 458
 459       type Token_Type is
 460         (T_No_ALI,
 461          T_ALI,
 462          T_Unit,
 463          T_With,
 464          T_Source,
 465          T_Afile,
 466          T_Ofile,
 467          T_Sfile,
 468          T_Name,
 469          T_Main,
 470          T_Kind,
 471          T_Flags,
 472          T_Preelaborated,
 473          T_Pure,
 474          T_Has_RACW,
 475          T_Remote_Types,
 476          T_Shared_Passive,
 477          T_RCI,
 478          T_Predefined,
 479          T_Internal,
 480          T_Is_Generic,
 481          T_Procedure,
 482          T_Function,
 483          T_Package,
 484          T_Subprogram,
 485          T_Spec,
 486          T_Body);
 487
 488       Image : constant array (Token_Type) of String_Access :=
 489                 (T_No_ALI         => new String'("No_ALI"),
 490                  T_ALI            => new String'("ALI"),
 491                  T_Unit           => new String'("Unit"),
 492                  T_With           => new String'("With"),
 493                  T_Source         => new String'("Source"),
 494                  T_Afile          => new String'("Afile"),
 495                  T_Ofile          => new String'("Ofile"),
 496                  T_Sfile          => new String'("Sfile"),
 497                  T_Name           => new String'("Name"),
 498                  T_Main           => new String'("Main"),
 499                  T_Kind           => new String'("Kind"),
 500                  T_Flags          => new String'("Flags"),
 501                  T_Preelaborated  => new String'("Preelaborated"),
 502                  T_Pure           => new String'("Pure"),
 503                  T_Has_RACW       => new String'("Has_RACW"),
 504                  T_Remote_Types   => new String'("Remote_Types"),
 505                  T_Shared_Passive => new String'("Shared_Passive"),
 506                  T_RCI            => new String'("RCI"),
 507                  T_Predefined     => new String'("Predefined"),
 508                  T_Internal       => new String'("Internal"),
 509                  T_Is_Generic     => new String'("Is_Generic"),
 510                  T_Procedure      => new String'("procedure"),
 511                  T_Function       => new String'("function"),
 512                  T_Package        => new String'("package"),
 513                  T_Subprogram     => new String'("subprogram"),
 514                  T_Spec           => new String'("spec"),
 515                  T_Body           => new String'("body"));
 516
 517       procedure Output_Name  (N : Name_Id);
 518       --  Remove any encoding info (%b and %s) and output N
 519
 520       procedure Output_Afile (A : File_Name_Type);
 521       procedure Output_Ofile (O : File_Name_Type);
 522       procedure Output_Sfile (S : File_Name_Type);
 523       --  Output various names. Check that the name is different from no name.
 524       --  Otherwise, skip the output.
 525
 526       procedure Output_Token (T : Token_Type);
 527       --  Output token using specific format. That is several indentations and:
 528       --
 529       --  T_No_ALI  .. T_With : <token> & " =>" & NL
 530       --  T_Source  .. T_Kind : <token> & " => "
 531       --  T_Flags             : <token> & " =>"
 532       --  T_Preelab .. T_Body : " " & <token>
 533
 534       procedure Output_Sdep  (S : Sdep_Id);
 535       procedure Output_Unit  (U : Unit_Id);
 536       procedure Output_With  (W : With_Id);
 537       --  Output this entry as a global section (like ALIs)
 538
 539       ------------------
 540       -- Output_Afile --
 541       ------------------
 542
 543       procedure Output_Afile (A : File_Name_Type) is
 544       begin
 545          if A /= No_File then
 546             Output_Token (T_Afile);
 547             Write_Name (A);
 548             Write_Eol;
 549          end if;
 550       end Output_Afile;
 551
 552       ----------------
 553       -- Output_ALI --
 554       ----------------
 555
 556       procedure Output_ALI (A : ALI_Id) is
 557       begin
 558          Output_Token (T_ALI);
 559          N_Indents := N_Indents + 1;
 560
 561          Output_Afile (ALIs.Table (A).Afile);
 562          Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
 563          Output_Sfile (ALIs.Table (A).Sfile);
 564
 565          --  Output Main
 566
 567          if ALIs.Table (A).Main_Program /= None then
 568             Output_Token (T_Main);
 569
 570             if ALIs.Table (A).Main_Program = Proc then
 571                Output_Token (T_Procedure);
 572             else
 573                Output_Token (T_Function);
 574             end if;
 575
 576             Write_Eol;
 577          end if;
 578
 579          --  Output Units
 580
 581          for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
 582             Output_Unit (U);
 583          end loop;
 584
 585          --  Output Sdeps
 586
 587          for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 588             Output_Sdep (S);
 589          end loop;
 590
 591          N_Indents := N_Indents - 1;
 592       end Output_ALI;
 593
 594       -------------------
 595       -- Output_No_ALI --
 596       -------------------
 597
 598       procedure Output_No_ALI (Afile : File_Name_Type) is
 599       begin
 600          Output_Token (T_No_ALI);
 601          N_Indents := N_Indents + 1;
 602          Output_Afile (Afile);
 603          N_Indents := N_Indents - 1;
 604       end Output_No_ALI;
 605
 606       -----------------
 607       -- Output_Name --
 608       -----------------
 609
 610       procedure Output_Name (N : Name_Id) is
 611       begin
 612          --  Remove any encoding info (%s or %b)
 613
 614          Get_Name_String (N);
 615
 616          if Name_Len > 2
 617            and then Name_Buffer (Name_Len - 1) = '%'
 618          then
 619             Name_Len := Name_Len - 2;
 620          end if;
 621
 622          Output_Token (T_Name);
 623          Write_Str (Name_Buffer (1 .. Name_Len));
 624          Write_Eol;
 625       end Output_Name;
 626
 627       ------------------
 628       -- Output_Ofile --
 629       ------------------
 630
 631       procedure Output_Ofile (O : File_Name_Type) is
 632       begin
 633          if O /= No_File then
 634             Output_Token (T_Ofile);
 635             Write_Name (O);
 636             Write_Eol;
 637          end if;
 638       end Output_Ofile;
 639
 640       -----------------
 641       -- Output_Sdep --
 642       -----------------
 643
 644       procedure Output_Sdep (S : Sdep_Id) is
 645       begin
 646          Output_Token (T_Source);
 647          Write_Name (Sdep.Table (S).Sfile);
 648          Write_Eol;
 649       end Output_Sdep;
 650
 651       ------------------
 652       -- Output_Sfile --
 653       ------------------
 654
 655       procedure Output_Sfile (S : File_Name_Type) is
 656          FS : File_Name_Type := S;
 657
 658       begin
 659          if FS /= No_File then
 660
 661             --  We want to output the full source name
 662
 663             FS := Full_Source_Name (FS);
 664
 665             --  There is no full source name. This occurs for instance when a
 666             --  withed unit has a spec file but no body file. This situation is
 667             --  not a problem for GNATDIST since the unit may be located on a
 668             --  partition we do not want to build. However, we need to locate
 669             --  the spec file and to find its full source name. Replace the
 670             --  body file name with the spec file name used to compile the
 671             --  current unit when possible.
 672
 673             if FS = No_File then
 674                Get_Name_String (S);
 675
 676                if Name_Len > 4
 677                  and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
 678                then
 679                   Name_Buffer (Name_Len) := 's';
 680                   FS := Full_Source_Name (Name_Find);
 681                end if;
 682             end if;
 683          end if;
 684
 685          if FS /= No_File then
 686             Output_Token (T_Sfile);
 687             Write_Name (FS);
 688             Write_Eol;
 689          end if;
 690       end Output_Sfile;
 691
 692       ------------------
 693       -- Output_Token --
 694       ------------------
 695
 696       procedure Output_Token (T : Token_Type) is
 697       begin
 698          case T is
 699             when T_No_ALI .. T_Flags =>
 700                for J in 1 .. N_Indents loop
 701                   Write_Str ("   ");
 702                end loop;
 703
 704                Write_Str (Image (T).all);
 705
 706                for J in Image (T)'Length .. 12 loop
 707                   Write_Char (' ');
 708                end loop;
 709
 710                Write_Str ("=>");
 711
 712                if T in T_No_ALI .. T_With then
 713                   Write_Eol;
 714                elsif T in T_Source .. T_Name then
 715                   Write_Char (' ');
 716                end if;
 717
 718             when T_Preelaborated .. T_Body =>
 719                if T in T_Preelaborated .. T_Is_Generic then
 720                   if N_Flags = 0 then
 721                      Output_Token (T_Flags);
 722                   end if;
 723
 724                   N_Flags := N_Flags + 1;
 725                end if;
 726
 727                Write_Char (' ');
 728                Write_Str  (Image (T).all);
 729          end case;
 730       end Output_Token;
 731
 732       -----------------
 733       -- Output_Unit --
 734       -----------------
 735
 736       procedure Output_Unit (U : Unit_Id) is
 737       begin
 738          Output_Token (T_Unit);
 739          N_Indents := N_Indents + 1;
 740
 741          --  Output Name
 742
 743          Output_Name (Name_Id (Units.Table (U).Uname));
 744
 745          --  Output Kind
 746
 747          Output_Token (T_Kind);
 748
 749          if Units.Table (U).Unit_Kind = 'p' then
 750             Output_Token (T_Package);
 751          else
 752             Output_Token (T_Subprogram);
 753          end if;
 754
 755          if Name_Buffer (Name_Len) = 's' then
 756             Output_Token (T_Spec);
 757          else
 758             Output_Token (T_Body);
 759          end if;
 760
 761          Write_Eol;
 762
 763          --  Output source file name
 764
 765          Output_Sfile (Units.Table (U).Sfile);
 766
 767          --  Output Flags
 768
 769          N_Flags := 0;
 770
 771          if Units.Table (U).Preelab then
 772             Output_Token (T_Preelaborated);
 773          end if;
 774
 775          if Units.Table (U).Pure then
 776             Output_Token (T_Pure);
 777          end if;
 778
 779          if Units.Table (U).Has_RACW then
 780             Output_Token (T_Has_RACW);
 781          end if;
 782
 783          if Units.Table (U).Remote_Types then
 784             Output_Token (T_Remote_Types);
 785          end if;
 786
 787          if Units.Table (U).Shared_Passive then
 788             Output_Token (T_Shared_Passive);
 789          end if;
 790
 791          if Units.Table (U).RCI then
 792             Output_Token (T_RCI);
 793          end if;
 794
 795          if Units.Table (U).Predefined then
 796             Output_Token (T_Predefined);
 797          end if;
 798
 799          if Units.Table (U).Internal then
 800             Output_Token (T_Internal);
 801          end if;
 802
 803          if Units.Table (U).Is_Generic then
 804             Output_Token (T_Is_Generic);
 805          end if;
 806
 807          if N_Flags > 0 then
 808             Write_Eol;
 809          end if;
 810
 811          --  Output Withs
 812
 813          for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
 814             Output_With (W);
 815          end loop;
 816
 817          N_Indents := N_Indents - 1;
 818       end Output_Unit;
 819
 820       -----------------
 821       -- Output_With --
 822       -----------------
 823
 824       procedure Output_With (W : With_Id) is
 825       begin
 826          Output_Token (T_With);
 827          N_Indents := N_Indents + 1;
 828
 829          Output_Name (Name_Id (Withs.Table (W).Uname));
 830
 831          --  Output Kind
 832
 833          Output_Token (T_Kind);
 834
 835          if Name_Buffer (Name_Len) = 's' then
 836             Output_Token (T_Spec);
 837          else
 838             Output_Token (T_Body);
 839          end if;
 840
 841          Write_Eol;
 842
 843          Output_Afile (Withs.Table (W).Afile);
 844          Output_Sfile (Withs.Table (W).Sfile);
 845
 846          N_Indents := N_Indents - 1;
 847       end Output_With;
 848
 849    end GNATDIST;
 850
 851    -----------
 852    -- Image --
 853    -----------
 854
 855    function Image (Restriction : Restriction_Id) return String is
 856       Result : String := Restriction'Img;
 857       Skip   : Boolean := True;
 858
 859    begin
 860       for J in Result'Range loop
 861          if Skip then
 862             Skip := False;
 863             Result (J) := To_Upper (Result (J));
 864
 865          elsif Result (J) = '_' then
 866             Skip := True;
 867
 868          else
 869             Result (J) := To_Lower (Result (J));
 870          end if;
 871       end loop;
 872
 873       return Result;
 874    end Image;
 875
 876    ---------------
 877    -- Normalize --
 878    ---------------
 879
 880    function Normalize (Path : String) return String is
 881    begin
 882       return Normalize_Pathname (Path);
 883    end Normalize;
 884
 885    --------------------------------
 886    -- Output_License_Information --
 887    --------------------------------
 888
 889    procedure Output_License_Information is
 890    begin
 891       case Build_Type is
 892          when others =>
 893             Write_Str ("Please refer to file COPYING in your distribution"
 894                      & " for license terms.");
 895             Write_Eol;
 896       end case;
 897
 898       Exit_Program (E_Success);
 899    end Output_License_Information;
 900
 901    -------------------
 902    -- Output_Object --
 903    -------------------
 904
 905    procedure Output_Object (O : File_Name_Type) is
 906       Object_Name : String_Access;
 907
 908    begin
 909       if Print_Object then
 910          if O /= No_File then
 911             Get_Name_String (O);
 912             Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 913          else
 914             Object_Name := No_Obj'Unchecked_Access;
 915          end if;
 916
 917          Write_Str (Object_Name.all);
 918
 919          if Print_Source or else Print_Unit then
 920             if Too_Long then
 921                Write_Eol;
 922                Write_Str ("   ");
 923             else
 924                Write_Str (Spaces
 925                 (Object_Start + Object_Name'Length .. Object_End));
 926             end if;
 927          end if;
 928       end if;
 929    end Output_Object;
 930
 931    -------------------
 932    -- Output_Source --
 933    -------------------
 934
 935    procedure Output_Source (Sdep_I : Sdep_Id) is
 936       Stamp       : Time_Stamp_Type;
 937       Checksum    : Word;
 938       FS          : File_Name_Type;
 939       Status      : File_Status;
 940       Object_Name : String_Access;
 941
 942    begin
 943       if Sdep_I = No_Sdep_Id then
 944          return;
 945       end if;
 946
 947       Stamp    := Sdep.Table (Sdep_I).Stamp;
 948       Checksum := Sdep.Table (Sdep_I).Checksum;
 949       FS       := Sdep.Table (Sdep_I).Sfile;
 950
 951       if Print_Source then
 952          Find_Status (FS, Stamp, Checksum, Status);
 953          Get_Name_String (FS);
 954
 955          Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 956
 957          if Verbose_Mode then
 958             Write_Str ("  Source => ");
 959             Write_Str (Object_Name.all);
 960
 961             if not Too_Long then
 962                Write_Str
 963                  (Spaces (Source_Start + Object_Name'Length .. Source_End));
 964             end if;
 965
 966             Output_Status (Status, Verbose => True);
 967             Write_Eol;
 968             Write_Str ("   ");
 969
 970          else
 971             if not Selective_Output then
 972                Output_Status (Status, Verbose => False);
 973             end if;
 974
 975             Write_Str (Object_Name.all);
 976          end if;
 977       end if;
 978    end Output_Source;
 979
 980    -------------------
 981    -- Output_Status --
 982    -------------------
 983
 984    procedure Output_Status (FS : File_Status; Verbose : Boolean) is
 985    begin
 986       if Verbose then
 987          case FS is
 988             when OK =>
 989                Write_Str (" unchanged");
 990
 991             when Checksum_OK =>
 992                Write_Str (" slightly modified");
 993
 994             when Not_Found =>
 995                Write_Str (" file not found");
 996
 997             when Not_Same =>
 998                Write_Str (" modified");
 999
1000             when Not_First_On_PATH =>
1001                Write_Str (" unchanged version not first on PATH");
1002          end case;
1003
1004       else
1005          case FS is
1006             when OK =>
1007                Write_Str ("  OK ");
1008
1009             when Checksum_OK =>
1010                Write_Str (" MOK ");
1011
1012             when Not_Found =>
1013                Write_Str (" ??? ");
1014
1015             when Not_Same =>
1016                Write_Str (" DIF ");
1017
1018             when Not_First_On_PATH =>
1019                Write_Str (" HID ");
1020          end case;
1021       end if;
1022    end Output_Status;
1023
1024    -----------------
1025    -- Output_Unit --
1026    -----------------
1027
1028    procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
1029       Kind : Character;
1030       U    : Unit_Record renames Units.Table (U_Id);
1031
1032    begin
1033       if Print_Unit then
1034          Get_Name_String (U.Uname);
1035          Kind := Name_Buffer (Name_Len);
1036          Name_Len := Name_Len - 2;
1037
1038          if not Verbose_Mode then
1039             Write_Str (Name_Buffer (1 .. Name_Len));
1040
1041          else
1042             Write_Str ("Unit => ");
1043             Write_Eol;
1044             Write_Str ("     Name   => ");
1045             Write_Str (Name_Buffer (1 .. Name_Len));
1046             Write_Eol;
1047             Write_Str ("     Kind   => ");
1048
1049             if Units.Table (U_Id).Unit_Kind = 'p' then
1050                Write_Str ("package ");
1051             else
1052                Write_Str ("subprogram ");
1053             end if;
1054
1055             if Kind = 's' then
1056                Write_Str ("spec");
1057             else
1058                Write_Str ("body");
1059             end if;
1060          end if;
1061
1062          if Verbose_Mode then
1063             if U.Preelab             or else
1064                U.No_Elab             or else
1065                U.Pure                or else
1066                U.Dynamic_Elab        or else
1067                U.Has_RACW            or else
1068                U.Remote_Types        or else
1069                U.Shared_Passive      or else
1070                U.RCI                 or else
1071                U.Predefined          or else
1072                U.Internal            or else
1073                U.Is_Generic          or else
1074                U.Init_Scalars        or else
1075                U.SAL_Interface       or else
1076                U.Body_Needed_For_SAL or else
1077                U.Elaborate_Body
1078             then
1079                Write_Eol;
1080                Write_Str ("     Flags  =>");
1081
1082                if U.Preelab then
1083                   Write_Str (" Preelaborable");
1084                end if;
1085
1086                if U.No_Elab then
1087                   Write_Str (" No_Elab_Code");
1088                end if;
1089
1090                if U.Pure then
1091                   Write_Str (" Pure");
1092                end if;
1093
1094                if U.Dynamic_Elab then
1095                   Write_Str (" Dynamic_Elab");
1096                end if;
1097
1098                if U.Has_RACW then
1099                   Write_Str (" Has_RACW");
1100                end if;
1101
1102                if U.Remote_Types then
1103                   Write_Str (" Remote_Types");
1104                end if;
1105
1106                if U.Shared_Passive then
1107                   Write_Str (" Shared_Passive");
1108                end if;
1109
1110                if U.RCI then
1111                   Write_Str (" RCI");
1112                end if;
1113
1114                if U.Predefined then
1115                   Write_Str (" Predefined");
1116                end if;
1117
1118                if U.Internal then
1119                   Write_Str (" Internal");
1120                end if;
1121
1122                if U.Is_Generic then
1123                   Write_Str (" Is_Generic");
1124                end if;
1125
1126                if U.Init_Scalars then
1127                   Write_Str (" Init_Scalars");
1128                end if;
1129
1130                if U.SAL_Interface then
1131                   Write_Str (" SAL_Interface");
1132                end if;
1133
1134                if U.Body_Needed_For_SAL then
1135                   Write_Str (" Body_Needed_For_SAL");
1136                end if;
1137
1138                if U.Elaborate_Body then
1139                   Write_Str (" Elaborate Body");
1140                end if;
1141
1142                if U.Remote_Types then
1143                   Write_Str (" Remote_Types");
1144                end if;
1145
1146                if U.Shared_Passive then
1147                   Write_Str (" Shared_Passive");
1148                end if;
1149
1150                if U.Predefined then
1151                   Write_Str (" Predefined");
1152                end if;
1153             end if;
1154
1155             declare
1156                Restrictions : constant Restrictions_Info :=
1157                                 ALIs.Table (ALI).Restrictions;
1158
1159             begin
1160                --  If the source was compiled with pragmas Restrictions,
1161                --  Display these restrictions.
1162
1163                if Restrictions.Set /= (All_Restrictions => False) then
1164                   Write_Eol;
1165                   Write_Str ("     pragma Restrictions  =>");
1166
1167                   --  For boolean restrictions, just display the name of the
1168                   --  restriction; for valued restrictions, also display the
1169                   --  restriction value.
1170
1171                   for Restriction in All_Restrictions loop
1172                      if Restrictions.Set (Restriction) then
1173                         Write_Eol;
1174                         Write_Str ("       ");
1175                         Write_Str (Image (Restriction));
1176
1177                         if Restriction in All_Parameter_Restrictions then
1178                            Write_Str (" =>");
1179                            Write_Str (Restrictions.Value (Restriction)'Img);
1180                         end if;
1181                      end if;
1182                   end loop;
1183                end if;
1184
1185                --  If the unit violates some Restrictions, display the list of
1186                --  these restrictions.
1187
1188                if Restrictions.Violated /= (All_Restrictions => False) then
1189                   Write_Eol;
1190                   Write_Str ("     Restrictions violated =>");
1191
1192                   --  For boolean restrictions, just display the name of the
1193                   --  restriction. For valued restrictions, also display the
1194                   --  restriction value.
1195
1196                   for Restriction in All_Restrictions loop
1197                      if Restrictions.Violated (Restriction) then
1198                         Write_Eol;
1199                         Write_Str ("       ");
1200                         Write_Str (Image (Restriction));
1201
1202                         if Restriction in All_Parameter_Restrictions then
1203                            if Restrictions.Count (Restriction) > 0 then
1204                               Write_Str (" =>");
1205
1206                               if Restrictions.Unknown (Restriction) then
1207                                  Write_Str (" at least");
1208                               end if;
1209
1210                               Write_Str (Restrictions.Count (Restriction)'Img);
1211                            end if;
1212                         end if;
1213                      end if;
1214                   end loop;
1215                end if;
1216             end;
1217          end if;
1218
1219          if Print_Source then
1220             if Too_Long then
1221                Write_Eol;
1222                Write_Str ("   ");
1223             else
1224                Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
1225             end if;
1226          end if;
1227       end if;
1228    end Output_Unit;
1229
1230    package body Prj_Env is
1231
1232       Uninitialized_Prefix : constant String := '#' & Path_Separator;
1233       --  Prefix to indicate that the project path has not been initialized
1234       --  yet. Must be two characters long.
1235
1236       ---------------------
1237       -- Add_Directories --
1238       ---------------------
1239
1240       procedure Add_Directories
1241         (Self    : in out String_Access;
1242          Path    : String;
1243          Prepend : Boolean := False)
1244       is
1245          Tmp : String_Access;
1246
1247       begin
1248          if Self = null then
1249             Self := new String'(Uninitialized_Prefix & Path);
1250          else
1251             Tmp := Self;
1252             if Prepend then
1253                Self := new String'(Path & Path_Separator & Tmp.all);
1254             else
1255                Self := new String'(Tmp.all & Path_Separator & Path);
1256             end if;
1257             Free (Tmp);
1258          end if;
1259       end Add_Directories;
1260
1261       -------------------------------------
1262       -- Initialize_Default_Project_Path --
1263       -------------------------------------
1264
1265       procedure Initialize_Default_Project_Path
1266         (Self         : in out String_Access;
1267          Target_Name  : String;
1268          Runtime_Name : String := "")
1269       is
1270          Add_Default_Dir : Boolean := Target_Name /= "-";
1271          First           : Positive;
1272          Last            : Positive;
1273
1274          Ada_Project_Path      : constant String := "ADA_PROJECT_PATH";
1275          Gpr_Project_Path      : constant String := "GPR_PROJECT_PATH";
1276          Gpr_Project_Path_File : constant String := "GPR_PROJECT_PATH_FILE";
1277          --  Names of alternate env. variables that contain path name(s) of
1278          --  directories where project files may reside. They are taken into
1279          --  account in this order: GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH,
1280          --  ADA_PROJECT_PATH.
1281
1282          Gpr_Prj_Path_File : String_Access;
1283          Gpr_Prj_Path      : String_Access;
1284          Ada_Prj_Path      : String_Access;
1285          --  The path name(s) of directories where project files may reside.
1286          --  May be empty.
1287
1288          Prefix  : String_Ptr;
1289          Runtime : String_Ptr;
1290
1291          procedure Add_Target (Suffix : String);
1292          --  Add :<prefix>/<target>/Suffix to the project path
1293
1294          FD  : File_Descriptor;
1295          Len : Integer;
1296
1297          ----------------
1298          -- Add_Target --
1299          ----------------
1300
1301          procedure Add_Target (Suffix : String) is
1302             Extra_Sep : constant String :=
1303                (if Target_Name (Target_Name'Last) = '/' then
1304                   ""
1305                 else
1306                   (1 => Directory_Separator));
1307             --  Note: Target_Name has a trailing / when it comes from Sdefault
1308
1309          begin
1310             Add_Str_To_Name_Buffer
1311               (Path_Separator & Prefix.all & Target_Name & Extra_Sep & Suffix);
1312          end Add_Target;
1313
1314       --  Start of processing for Initialize_Default_Project_Path
1315
1316       begin
1317          if Self /= null
1318            and then (Self'Length = 0
1319                       or else Self (Self'First) /= '#')
1320          then
1321             return;
1322          end if;
1323
1324          --  The current directory is always first in the search path. Since
1325          --  the Project_Path currently starts with '#:' as a sign that it is
1326          --  not initialized, we simply replace '#' with '.'
1327
1328          if Self = null then
1329             Self := new String'('.' & Path_Separator);
1330          else
1331             Self (Self'First) := '.';
1332          end if;
1333
1334          --  Then the reset of the project path (if any) currently contains the
1335          --  directories added through Add_Search_Project_Directory
1336
1337          --  If environment variables are defined and not empty, add their
1338          --  content
1339
1340          Gpr_Prj_Path_File := Getenv (Gpr_Project_Path_File);
1341          Gpr_Prj_Path      := Getenv (Gpr_Project_Path);
1342          Ada_Prj_Path      := Getenv (Ada_Project_Path);
1343
1344          if Gpr_Prj_Path_File.all /= "" then
1345             FD := Open_Read (Gpr_Prj_Path_File.all, GNAT.OS_Lib.Text);
1346
1347             if FD = Invalid_FD then
1348                Osint.Fail
1349                  ("warning: could not read project path file """
1350                   & Gpr_Prj_Path_File.all & """");
1351             end if;
1352
1353             Len := Integer (File_Length (FD));
1354
1355             declare
1356                Buffer : String (1 .. Len);
1357                Index  : Positive := 1;
1358                Last   : Positive;
1359                Tmp    : String_Access;
1360
1361             begin
1362                --  Read the file
1363
1364                Len := Read (FD, Buffer (1)'Address, Len);
1365                Close (FD);
1366
1367                --  Scan the file line by line
1368
1369                while Index < Buffer'Last loop
1370
1371                   --  Find the end of line
1372
1373                   Last := Index;
1374                   while Last <= Buffer'Last
1375                     and then Buffer (Last) /= ASCII.LF
1376                     and then Buffer (Last) /= ASCII.CR
1377                   loop
1378                      Last := Last + 1;
1379                   end loop;
1380
1381                   --  Ignore empty lines
1382
1383                   if Last > Index then
1384                      Tmp := Self;
1385                      Self :=
1386                        new String'
1387                          (Tmp.all & Path_Separator &
1388                           Buffer (Index .. Last - 1));
1389                      Free (Tmp);
1390                   end if;
1391
1392                   --  Find the beginning of the next line
1393
1394                   Index := Last;
1395                   while Buffer (Index) = ASCII.CR or else
1396                         Buffer (Index) = ASCII.LF
1397                   loop
1398                      Index := Index + 1;
1399                   end loop;
1400                end loop;
1401             end;
1402
1403          end if;
1404
1405          if Gpr_Prj_Path.all /= "" then
1406             Add_Directories (Self, Gpr_Prj_Path.all);
1407          end if;
1408
1409          Free (Gpr_Prj_Path);
1410
1411          if Ada_Prj_Path.all /= "" then
1412             Add_Directories (Self, Ada_Prj_Path.all);
1413          end if;
1414
1415          Free (Ada_Prj_Path);
1416
1417          --  Copy to Name_Buffer, since we will need to manipulate the path
1418
1419          Name_Len := Self'Length;
1420          Name_Buffer (1 .. Name_Len) := Self.all;
1421
1422          --  Scan the directory path to see if "-" is one of the directories.
1423          --  Remove each occurrence of "-" and set Add_Default_Dir to False.
1424          --  Also resolve relative paths and symbolic links.
1425
1426          First := 3;
1427          loop
1428             while First <= Name_Len
1429               and then (Name_Buffer (First) = Path_Separator)
1430             loop
1431                First := First + 1;
1432             end loop;
1433
1434             exit when First > Name_Len;
1435
1436             Last := First;
1437
1438             while Last < Name_Len
1439               and then Name_Buffer (Last + 1) /= Path_Separator
1440             loop
1441                Last := Last + 1;
1442             end loop;
1443
1444             --  If the directory is "-", set Add_Default_Dir to False and
1445             --  remove from path.
1446
1447             if Name_Buffer (First .. Last) = "-" then
1448                Add_Default_Dir := False;
1449
1450                for J in Last + 1 .. Name_Len loop
1451                   Name_Buffer (J - 2) := Name_Buffer (J);
1452                end loop;
1453
1454                Name_Len := Name_Len - 2;
1455
1456                --  After removing the '-', go back one character to get the
1457                --  next directory correctly.
1458
1459                Last := Last - 1;
1460
1461             else
1462                declare
1463                   New_Dir : constant String :=
1464                               Normalize_Pathname
1465                                 (Name_Buffer (First .. Last),
1466                                  Resolve_Links => Opt.Follow_Links_For_Dirs);
1467                   New_Len  : Positive;
1468                   New_Last : Positive;
1469
1470                begin
1471                   --  If the absolute path was resolved and is different from
1472                   --  the original, replace original with the resolved path.
1473
1474                   if New_Dir /= Name_Buffer (First .. Last)
1475                     and then New_Dir'Length /= 0
1476                   then
1477                      New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
1478                      New_Last := First + New_Dir'Length - 1;
1479                      Name_Buffer (New_Last + 1 .. New_Len) :=
1480                        Name_Buffer (Last + 1 .. Name_Len);
1481                      Name_Buffer (First .. New_Last) := New_Dir;
1482                      Name_Len := New_Len;
1483                      Last := New_Last;
1484                   end if;
1485                end;
1486             end if;
1487
1488             First := Last + 1;
1489          end loop;
1490
1491          Free (Self);
1492
1493          --  Set the initial value of Current_Project_Path
1494
1495          if Add_Default_Dir then
1496             if Sdefault.Search_Dir_Prefix = null then
1497
1498                --  gprbuild case
1499
1500                Prefix := new String'(Executable_Prefix_Path);
1501
1502             else
1503                Prefix := new String'(Sdefault.Search_Dir_Prefix.all
1504                                      & ".." & Dir_Separator
1505                                      & ".." & Dir_Separator
1506                                      & ".." & Dir_Separator
1507                                      & ".." & Dir_Separator);
1508             end if;
1509
1510             if Prefix.all /= "" then
1511                if Target_Name /= "" then
1512
1513                   if Runtime_Name /= "" then
1514                      if Base_Name (Runtime_Name) = Runtime_Name then
1515
1516                         --  $prefix/$target/$runtime/lib/gnat
1517
1518                         Add_Target
1519                           (Runtime_Name & Directory_Separator &
1520                            "lib" & Directory_Separator & "gnat");
1521
1522                         --  $prefix/$target/$runtime/share/gpr
1523
1524                         Add_Target
1525                           (Runtime_Name & Directory_Separator &
1526                              "share" & Directory_Separator & "gpr");
1527
1528                      else
1529                         Runtime :=
1530                           new String'(Normalize_Pathname (Runtime_Name));
1531
1532                         --  $runtime_dir/lib/gnat
1533
1534                         Add_Str_To_Name_Buffer
1535                           (Path_Separator & Runtime.all & Directory_Separator &
1536                            "lib" & Directory_Separator & "gnat");
1537
1538                         --  $runtime_dir/share/gpr
1539
1540                         Add_Str_To_Name_Buffer
1541                           (Path_Separator & Runtime.all & Directory_Separator &
1542                            "share" & Directory_Separator & "gpr");
1543                      end if;
1544                   end if;
1545
1546                   --  $prefix/$target/lib/gnat
1547
1548                   Add_Target
1549                     ("lib" & Directory_Separator & "gnat");
1550
1551                   --  $prefix/$target/share/gpr
1552
1553                   Add_Target
1554                     ("share" & Directory_Separator & "gpr");
1555                end if;
1556
1557                --  $prefix/share/gpr
1558
1559                Add_Str_To_Name_Buffer
1560                  (Path_Separator & Prefix.all & "share"
1561                   & Directory_Separator & "gpr");
1562
1563                --  $prefix/lib/gnat
1564
1565                Add_Str_To_Name_Buffer
1566                  (Path_Separator & Prefix.all & "lib"
1567                   & Directory_Separator & "gnat");
1568             end if;
1569
1570             Free (Prefix);
1571          end if;
1572
1573          Self := new String'(Name_Buffer (1 .. Name_Len));
1574       end Initialize_Default_Project_Path;
1575
1576       -----------------------
1577       -- Get_Runtime_Path --
1578       -----------------------
1579
1580       function Get_Runtime_Path
1581         (Self : String_Access;
1582          Path : String) return String_Access
1583       is
1584          First : Natural;
1585          Last  : Natural;
1586
1587       begin
1588
1589          if Is_Absolute_Path (Path) then
1590             if Is_Directory (Path) then
1591                return new String'(Path);
1592             else
1593                return null;
1594             end if;
1595
1596          else
1597             --  Because we do not want to resolve symbolic links, we cannot
1598             --  use Locate_Regular_File. Instead we try each possible path
1599             --  successively.
1600
1601             First := Self'First;
1602             while First <= Self'Last loop
1603                while First <= Self'Last
1604                  and then Self (First) = Path_Separator
1605                loop
1606                   First := First + 1;
1607                end loop;
1608
1609                exit when First > Self'Last;
1610
1611                Last := First;
1612                while Last < Self'Last
1613                  and then Self (Last + 1) /= Path_Separator
1614                loop
1615                   Last := Last + 1;
1616                end loop;
1617
1618                Name_Len := 0;
1619
1620                if not Is_Absolute_Path (Self (First .. Last)) then
1621                   Add_Str_To_Name_Buffer (Get_Current_Dir);  -- ??? System call
1622                   Add_Char_To_Name_Buffer (Directory_Separator);
1623                end if;
1624
1625                Add_Str_To_Name_Buffer (Self (First .. Last));
1626                Add_Char_To_Name_Buffer (Directory_Separator);
1627                Add_Str_To_Name_Buffer (Path);
1628
1629                if Is_Directory (Name_Buffer (1 .. Name_Len)) then
1630                   return new String'(Name_Buffer (1 .. Name_Len));
1631                end if;
1632
1633                First := Last + 1;
1634             end loop;
1635          end if;
1636
1637          return null;
1638       end Get_Runtime_Path;
1639
1640    end Prj_Env;
1641
1642    -----------------
1643    -- Reset_Print --
1644    -----------------
1645
1646    procedure Reset_Print is
1647    begin
1648       if not Selective_Output then
1649          Selective_Output := True;
1650          Print_Source := False;
1651          Print_Object := False;
1652          Print_Unit   := False;
1653       end if;
1654    end Reset_Print;
1655
1656    ----------------
1657    -- Search_RTS --
1658    ----------------
1659
1660    procedure Search_RTS (Name : String) is
1661       Src_Path : String_Ptr;
1662       Lib_Path : String_Ptr;
1663       --  Paths for source and include subdirs
1664
1665       Rts_Full_Path : String_Access;
1666       --  Full path for RTS project
1667
1668    begin
1669       --  Try to find the RTS
1670
1671       Src_Path := Get_RTS_Search_Dir (Name, Include);
1672       Lib_Path := Get_RTS_Search_Dir (Name, Objects);
1673
1674       --  For non-project RTS, both the include and the objects directories
1675       --  must be present.
1676
1677       if Src_Path /= null and then Lib_Path /= null then
1678          Add_Search_Dirs (Src_Path, Include);
1679          Add_Search_Dirs (Lib_Path, Objects);
1680          Prj_Env.Initialize_Default_Project_Path
1681            (Prj_Path,
1682             Target_Name  => Sdefault.Target_Name.all,
1683             Runtime_Name => Name);
1684          return;
1685       end if;
1686
1687       if Lib_Path /= null then
1688          Osint.Fail ("RTS path not valid: missing adainclude directory");
1689       elsif Src_Path /= null then
1690          Osint.Fail ("RTS path not valid: missing adalib directory");
1691       end if;
1692
1693       --  Try to find the RTS on the project path. First setup the project path
1694
1695       Prj_Env.Initialize_Default_Project_Path
1696         (Prj_Path,
1697          Target_Name  => Sdefault.Target_Name.all,
1698          Runtime_Name => Name);
1699
1700       Rts_Full_Path := Prj_Env.Get_Runtime_Path (Prj_Path, Name);
1701
1702       if Rts_Full_Path /= null then
1703
1704          --  Directory name was found on the project path. Look for the
1705          --  include subdirectory(s).
1706
1707          Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
1708
1709          if Src_Path /= null then
1710             Add_Search_Dirs (Src_Path, Include);
1711
1712             --  Add the lib subdirectory if it exists
1713
1714             Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);
1715
1716             if Lib_Path /= null then
1717                Add_Search_Dirs (Lib_Path, Objects);
1718             end if;
1719
1720             return;
1721          end if;
1722       end if;
1723
1724       Osint.Fail
1725         ("RTS path not valid: missing adainclude and adalib directories");
1726    end Search_RTS;
1727
1728    -------------------
1729    -- Scan_Ls_Arg --
1730    -------------------
1731
1732    procedure Scan_Ls_Arg (Argv : String) is
1733       FD  : File_Descriptor;
1734       Len : Integer;
1735       OK  : Boolean;
1736
1737    begin
1738       pragma Assert (Argv'First = 1);
1739
1740       if Argv'Length = 0 then
1741          return;
1742       end if;
1743
1744       OK := True;
1745       if Argv (1) = '-' then
1746          if Argv'Length = 1 then
1747             Fail ("switch character cannot be followed by a blank");
1748
1749          --  Processing for -I-
1750
1751          elsif Argv (2 .. Argv'Last) = "I-" then
1752             Opt.Look_In_Primary_Dir := False;
1753
1754          --  Forbid -?- or -??- where ? is any character
1755
1756          elsif (Argv'Length = 3 and then Argv (3) = '-')
1757            or else (Argv'Length = 4 and then Argv (4) = '-')
1758          then
1759             Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
1760
1761          --  Processing for -Idir
1762
1763          elsif Argv (2) = 'I' then
1764             Add_Source_Dir (Argv (3 .. Argv'Last));
1765             Add_Lib_Dir (Argv (3 .. Argv'Last));
1766
1767          --  Processing for -aIdir (to gcc this is like a -I switch)
1768
1769          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
1770             Add_Source_Dir (Argv (4 .. Argv'Last));
1771
1772          --  Processing for -aOdir
1773
1774          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
1775             Add_Lib_Dir (Argv (4 .. Argv'Last));
1776
1777          --  Processing for -aLdir (to gnatbind this is like a -aO switch)
1778
1779          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
1780             Add_Lib_Dir (Argv (4 .. Argv'Last));
1781
1782          --  Processing for -aP<dir>
1783
1784          elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
1785             Prj_Env.Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
1786
1787          --  Processing for -nostdinc
1788
1789          elsif Argv (2 .. Argv'Last) = "nostdinc" then
1790             Opt.No_Stdinc := True;
1791
1792          --  Processing for one character switches
1793
1794          elsif Argv'Length = 2 then
1795             case Argv (2) is
1796                when 'a' => Also_Predef               := True;
1797                when 'h' => Print_Usage               := True;
1798                when 'u' => Reset_Print; Print_Unit   := True;
1799                when 's' => Reset_Print; Print_Source := True;
1800                when 'o' => Reset_Print; Print_Object := True;
1801                when 'v' => Verbose_Mode              := True;
1802                when 'd' => Dependable                := True;
1803                when 'l' => License                   := True;
1804                when 'V' => Very_Verbose_Mode         := True;
1805
1806                when others => OK := False;
1807             end case;
1808
1809          --  Processing for -files=file
1810
1811          elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
1812             FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
1813
1814             if FD = Invalid_FD then
1815                Osint.Fail ("could not find text file """ &
1816                            Argv (8 .. Argv'Last) & '"');
1817             end if;
1818
1819             Len := Integer (File_Length (FD));
1820
1821             declare
1822                Buffer : String (1 .. Len + 1);
1823                Index  : Positive := 1;
1824                Last   : Positive;
1825
1826             begin
1827                --  Read the file
1828
1829                Len := Read (FD, Buffer (1)'Address, Len);
1830                Buffer (Buffer'Last) := ASCII.NUL;
1831                Close (FD);
1832
1833                --  Scan the file line by line
1834
1835                while Index < Buffer'Last loop
1836
1837                   --  Find the end of line
1838
1839                   Last := Index;
1840                   while Last <= Buffer'Last
1841                     and then Buffer (Last) /= ASCII.LF
1842                     and then Buffer (Last) /= ASCII.CR
1843                   loop
1844                      Last := Last + 1;
1845                   end loop;
1846
1847                   --  Ignore empty lines
1848
1849                   if Last > Index then
1850                      Add_File (Buffer (Index .. Last - 1));
1851                   end if;
1852
1853                   --  Find the beginning of the next line
1854
1855                   Index := Last;
1856                   while Buffer (Index) = ASCII.CR or else
1857                         Buffer (Index) = ASCII.LF
1858                   loop
1859                      Index := Index + 1;
1860                   end loop;
1861                end loop;
1862             end;
1863
1864          --  Processing for --RTS=path
1865
1866          elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
1867             if Argv'Length <= 6 or else Argv (6) /= '='then
1868                Osint.Fail ("missing path for --RTS");
1869
1870             else
1871                --  Check that it is the first time we see this switch or, if
1872                --  it is not the first time, the same path is specified.
1873
1874                if RTS_Specified = null then
1875                   RTS_Specified := new String'(Argv (7 .. Argv'Last));
1876
1877                elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
1878                   Osint.Fail ("--RTS cannot be specified multiple times");
1879                end if;
1880
1881                --  Valid --RTS switch
1882
1883                Opt.No_Stdinc := True;
1884                Opt.RTS_Switch := True;
1885             end if;
1886
1887          else
1888             OK := False;
1889          end if;
1890
1891       --  If not a switch, it must be a file name
1892
1893       else
1894          Add_File (Argv);
1895       end if;
1896
1897       if not OK then
1898          Write_Str ("warning: unknown switch """);
1899          Write_Str (Argv);
1900          Write_Line ("""");
1901       end if;
1902
1903    end Scan_Ls_Arg;
1904
1905    -----------
1906    -- Usage --
1907    -----------
1908
1909    procedure Usage is
1910    begin
1911       --  Usage line
1912
1913       Write_Str ("Usage: ");
1914       Osint.Write_Program_Name;
1915       Write_Str ("  switches  [list of object files]");
1916       Write_Eol;
1917       Write_Eol;
1918
1919       --  GNATLS switches
1920
1921       Write_Str ("switches:");
1922       Write_Eol;
1923
1924       Display_Usage_Version_And_Help;
1925
1926       --  Line for -a
1927
1928       Write_Str ("  -a         also output relevant predefined units");
1929       Write_Eol;
1930
1931       --  Line for -u
1932
1933       Write_Str ("  -u         output only relevant unit names");
1934       Write_Eol;
1935
1936       --  Line for -h
1937
1938       Write_Str ("  -h         output this help message");
1939       Write_Eol;
1940
1941       --  Line for -s
1942
1943       Write_Str ("  -s         output only relevant source names");
1944       Write_Eol;
1945
1946       --  Line for -o
1947
1948       Write_Str ("  -o         output only relevant object names");
1949       Write_Eol;
1950
1951       --  Line for -d
1952
1953       Write_Str ("  -d         output sources on which specified units " &
1954                                "depend");
1955       Write_Eol;
1956
1957       --  Line for -l
1958
1959       Write_Str ("  -l         output license information");
1960       Write_Eol;
1961
1962       --  Line for -v
1963
1964       Write_Str ("  -v         verbose output, full path and unit " &
1965                                "information");
1966       Write_Eol;
1967       Write_Eol;
1968
1969       --  Line for -files=
1970
1971       Write_Str ("  -files=fil files are listed in text file 'fil'");
1972       Write_Eol;
1973
1974       --  Line for -aI switch
1975
1976       Write_Str ("  -aIdir     specify source files search path");
1977       Write_Eol;
1978
1979       --  Line for -aO switch
1980
1981       Write_Str ("  -aOdir     specify object files search path");
1982       Write_Eol;
1983
1984       --  Line for -aP switch
1985
1986       Write_Str ("  -aPdir     specify project search path");
1987       Write_Eol;
1988
1989       --  Line for -I switch
1990
1991       Write_Str ("  -Idir      like -aIdir -aOdir");
1992       Write_Eol;
1993
1994       --  Line for -I- switch
1995
1996       Write_Str ("  -I-        do not look for sources & object files");
1997       Write_Str (" in the default directory");
1998       Write_Eol;
1999
2000       --  Line for -nostdinc
2001
2002       Write_Str ("  -nostdinc  do not look for source files");
2003       Write_Str (" in the system default directory");
2004       Write_Eol;
2005
2006       --  Line for --RTS
2007
2008       Write_Str ("  --RTS=dir  specify the default source and object search"
2009                  & " path");
2010       Write_Eol;
2011
2012       --  File Status explanation
2013
2014       Write_Eol;
2015       Write_Str (" file status can be:");
2016       Write_Eol;
2017
2018       for ST in File_Status loop
2019          Write_Str ("   ");
2020          Output_Status (ST, Verbose => False);
2021          Write_Str (" ==> ");
2022          Output_Status (ST, Verbose => True);
2023          Write_Eol;
2024       end loop;
2025    end Usage;
2026
2027    procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
2028
2029 --  Start of processing for Gnatls
2030
2031 begin
2032    --  Initialize standard packages
2033
2034    Csets.Initialize;
2035    Snames.Initialize;
2036    Stringt.Initialize;
2037
2038    --  First check for --version or --help
2039
2040    Check_Version_And_Help ("GNATLS", "1992");
2041
2042    --  Loop to scan out arguments
2043
2044    Next_Arg := 1;
2045    Scan_Args : while Next_Arg < Arg_Count loop
2046       declare
2047          Next_Argv : String (1 .. Len_Arg (Next_Arg));
2048       begin
2049          Fill_Arg (Next_Argv'Address, Next_Arg);
2050          Scan_Ls_Arg (Next_Argv);
2051       end;
2052
2053       Next_Arg := Next_Arg + 1;
2054    end loop Scan_Args;
2055
2056    --  If -l (output license information) is given, it must be the only switch
2057
2058    if License then
2059       if Arg_Count = 2 then
2060          Output_License_Information;
2061          Exit_Program (E_Success);
2062
2063       else
2064          Set_Standard_Error;
2065          Write_Str ("Can't use -l with another switch");
2066          Write_Eol;
2067          Try_Help;
2068          Exit_Program (E_Fatal);
2069       end if;
2070    end if;
2071
2072    --  Handle --RTS switch
2073
2074    if RTS_Specified /= null then
2075       Search_RTS (RTS_Specified.all);
2076    end if;
2077
2078    --  Add the source and object directories specified on the command line, if
2079    --  any, to the searched directories.
2080
2081    while First_Source_Dir /= null loop
2082       Add_Src_Search_Dir (First_Source_Dir.Value.all);
2083       First_Source_Dir := First_Source_Dir.Next;
2084    end loop;
2085
2086    while First_Lib_Dir /= null loop
2087       Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
2088       First_Lib_Dir := First_Lib_Dir.Next;
2089    end loop;
2090
2091    --  Finally, add the default directories
2092
2093    Osint.Add_Default_Search_Dirs;
2094
2095    --  If --RTS= is not specified, check if there is a default runtime
2096
2097    if RTS_Specified = null then
2098       declare
2099          FD   : File_Descriptor;
2100          Text : Source_Buffer_Ptr;
2101          Hi   : Source_Ptr;
2102
2103       begin
2104          Name_Buffer (1 .. 10) := "system.ads";
2105          Name_Len := 10;
2106
2107          Read_Source_File (Name_Find, 0, Hi, Text, FD);
2108
2109          if Null_Source_Buffer_Ptr (Text) then
2110             No_Runtime := True;
2111          end if;
2112       end;
2113    end if;
2114
2115    if Verbose_Mode then
2116       Write_Eol;
2117       Display_Version ("GNATLS", "1997");
2118       Write_Eol;
2119
2120       if No_Runtime then
2121          Write_Str
2122            ("Default runtime not available. Use --RTS= with a valid runtime");
2123          Write_Eol;
2124          Write_Eol;
2125          Exit_Status := E_Warnings;
2126       end if;
2127
2128       Write_Str ("Source Search Path:");
2129       Write_Eol;
2130
2131       for J in 1 .. Nb_Dir_In_Src_Search_Path loop
2132          Write_Str ("   ");
2133
2134          if Dir_In_Src_Search_Path (J)'Length = 0 then
2135             Write_Str ("<Current_Directory>");
2136             Write_Eol;
2137
2138          elsif not No_Runtime then
2139             Write_Str
2140               (Normalize
2141                  (To_Host_Dir_Spec
2142                       (Dir_In_Src_Search_Path (J).all, True).all));
2143             Write_Eol;
2144          end if;
2145       end loop;
2146
2147       Write_Eol;
2148       Write_Eol;
2149       Write_Str ("Object Search Path:");
2150       Write_Eol;
2151
2152       for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
2153          Write_Str ("   ");
2154
2155          if Dir_In_Obj_Search_Path (J)'Length = 0 then
2156             Write_Str ("<Current_Directory>");
2157             Write_Eol;
2158
2159          elsif not No_Runtime then
2160             Write_Str
2161               (Normalize
2162                  (To_Host_Dir_Spec
2163                       (Dir_In_Obj_Search_Path (J).all, True).all));
2164             Write_Eol;
2165          end if;
2166       end loop;
2167
2168       Write_Eol;
2169       Write_Eol;
2170       Write_Str (Project_Search_Path);
2171       Write_Eol;
2172       Write_Str ("   <Current_Directory>");
2173       Write_Eol;
2174
2175       Prj_Env.Initialize_Default_Project_Path
2176         (Prj_Path, Target_Name => Sdefault.Target_Name.all);
2177
2178       declare
2179          First        : Natural;
2180          Last         : Natural;
2181
2182       begin
2183
2184          if Prj_Path.all /= "" then
2185             First := Prj_Path'First;
2186             loop
2187                while First <= Prj_Path'Last
2188                  and then (Prj_Path (First) = Path_Separator)
2189                loop
2190                   First := First + 1;
2191                end loop;
2192
2193                exit when First > Prj_Path'Last;
2194
2195                Last := First;
2196                while Last < Prj_Path'Last
2197                  and then Prj_Path (Last + 1) /= Path_Separator
2198                loop
2199                   Last := Last + 1;
2200                end loop;
2201
2202                if First /= Last or else Prj_Path (First) /= '.' then
2203
2204                   --  If the directory is ".", skip it as it is the current
2205                   --  directory and it is already the first directory in the
2206                   --  project path.
2207
2208                   Write_Str ("   ");
2209                   Write_Str
2210                     (Normalize
2211                       (To_Host_Dir_Spec
2212                         (Prj_Path (First .. Last), True).all));
2213                   Write_Eol;
2214                end if;
2215
2216                First := Last + 1;
2217             end loop;
2218          end if;
2219       end;
2220
2221       Write_Eol;
2222    end if;
2223
2224    --  Output usage information when requested
2225
2226    if Print_Usage then
2227       Usage;
2228    end if;
2229
2230    if not More_Lib_Files then
2231       if not Print_Usage and then not Verbose_Mode then
2232          if Arg_Count = 1 then
2233             Usage;
2234          else
2235             Try_Help;
2236             Exit_Status := E_Fatal;
2237          end if;
2238       end if;
2239
2240       Exit_Program (Exit_Status);
2241    end if;
2242
2243    Initialize_ALI;
2244    Initialize_ALI_Source;
2245
2246    --  Print out all libraries for which no ALI files can be located
2247
2248    while More_Lib_Files loop
2249       Main_File := Next_Main_Lib_File;
2250       Ali_File  := Full_Lib_File_Name (Lib_File_Name (Main_File));
2251
2252       if Ali_File = No_File then
2253          if Very_Verbose_Mode then
2254             GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
2255
2256          else
2257             Set_Standard_Error;
2258             Write_Str ("Can't find library info for ");
2259             Get_Name_String (Main_File);
2260             Write_Char ('"'); -- "
2261             Write_Str (Name_Buffer (1 .. Name_Len));
2262             Write_Char ('"'); -- "
2263             Write_Eol;
2264             Exit_Status := E_Fatal;
2265          end if;
2266
2267       else
2268          Ali_File := Strip_Directory (Ali_File);
2269
2270          if Get_Name_Table_Int (Ali_File) = 0 then
2271             Text := Read_Library_Info (Ali_File, True);
2272
2273             declare
2274                Discard : ALI_Id;
2275             begin
2276                Discard :=
2277                  Scan_ALI
2278                    (Ali_File,
2279                     Text,
2280                     Ignore_ED     => False,
2281                     Err           => False,
2282                     Ignore_Errors => True);
2283             end;
2284
2285             Free (Text);
2286          end if;
2287       end if;
2288    end loop;
2289
2290    --  Reset default output file descriptor, if needed
2291
2292    Set_Standard_Output;
2293
2294    if Very_Verbose_Mode then
2295       for A in ALIs.First .. ALIs.Last loop
2296          GNATDIST.Output_ALI (A);
2297       end loop;
2298
2299       return;
2300    end if;
2301
2302    Find_General_Layout;
2303
2304    for Id in ALIs.First .. ALIs.Last loop
2305       declare
2306          Last_U : Unit_Id;
2307
2308       begin
2309          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
2310
2311          if Also_Predef or else not Is_Internal_Unit then
2312             if ALIs.Table (Id).No_Object then
2313                Output_Object (No_File);
2314             else
2315                Output_Object (ALIs.Table (Id).Ofile_Full_Name);
2316             end if;
2317
2318             --  In verbose mode print all main units in the ALI file, otherwise
2319             --  just print the first one to ease columnwise printout
2320
2321             if Verbose_Mode then
2322                Last_U := ALIs.Table (Id).Last_Unit;
2323             else
2324                Last_U := ALIs.Table (Id).First_Unit;
2325             end if;
2326
2327             for U in ALIs.Table (Id).First_Unit .. Last_U loop
2328                if U /= ALIs.Table (Id).First_Unit
2329                  and then Selective_Output
2330                  and then Print_Unit
2331                then
2332                   Write_Eol;
2333                end if;
2334
2335                Output_Unit (Id, U);
2336
2337                --  Output source now, unless if it will be done as part of
2338                --  outputing dependencies.
2339
2340                if not (Dependable and then Print_Source) then
2341                   Output_Source (Corresponding_Sdep_Entry (Id, U));
2342                end if;
2343             end loop;
2344
2345             --  Print out list of units on which this unit depends (D lines)
2346
2347             if Dependable and then Print_Source then
2348                if Verbose_Mode then
2349                   Write_Str ("depends upon");
2350                   Write_Eol;
2351                   Write_Str ("   ");
2352                else
2353                   Write_Eol;
2354                end if;
2355
2356                for D in
2357                  ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
2358                loop
2359                   if Also_Predef
2360                     or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
2361                   then
2362                      if Verbose_Mode then
2363                         Write_Str ("   ");
2364                         Output_Source (D);
2365
2366                      elsif Too_Long then
2367                         Write_Str ("   ");
2368                         Output_Source (D);
2369                         Write_Eol;
2370
2371                      else
2372                         Write_Str (Spaces (1 .. Source_Start - 2));
2373                         Output_Source (D);
2374                         Write_Eol;
2375                      end if;
2376                   end if;
2377                end loop;
2378             end if;
2379
2380             Write_Eol;
2381          end if;
2382       end;
2383    end loop;
2384
2385    --  All done. Set proper exit status
2386
2387    Namet.Finalize;
2388    Exit_Program (Exit_Status);
2389 end Gnatls;