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