gnatls.adb: Add 3 spaces before the default project directory when...

2007-04-20  Vincent Celier  <celier@adacore.com>

	* gnatls.adb: 
	Add 3 spaces before the default project directory when displaying
	the project search path.
	Add new command line switch '-l' to display license information.

From-SVN: r125418

gcc/ada/gnatls.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -111,10 +111,11 @@ procedure Gnatls is
    Print_Object     : Boolean := True;
    --  Flags controlling the form of the output
 
-   Dependable  : Boolean := False;  --  flag -d
-   Also_Predef : Boolean := False;
-
-   Very_Verbose_Mode : Boolean := False; --  flag -V
+   Also_Predef       : Boolean := False;  --  -a
+   Dependable        : Boolean := False;  --  -d
+   License           : Boolean := False;  --  -l
+   Very_Verbose_Mode : Boolean := False;  --  -V
+   --  Command line flags
 
    Unit_Start   : Integer;
    Unit_End     : Integer;
@@ -177,6 +178,10 @@ procedure Gnatls is
    procedure Usage;
    --  Print usage message
 
+   procedure Output_License_Information;
+   --  Output license statement, and if not found, output reference to
+   --  COPYING.
+
    function Image (Restriction : Restriction_Id) return String;
    --  Returns the capitalized image of Restriction
 
@@ -253,10 +258,10 @@ procedure Gnatls is
          end if;
       end loop;
 
-      Error_Msg_Name_1 := Units.Table (U).Uname;
-      Error_Msg_Name_2 := ALIs.Table (A).Afile;
+      Error_Msg_Unit_1 := Units.Table (U).Uname;
+      Error_Msg_File_1 := ALIs.Table (A).Afile;
       Write_Eol;
-      Error_Msg ("wrong ALI format, can't find dependency line for & in %");
+      Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
       Exit_Program (E_Fatal);
    end Corresponding_Sdep_Entry;
 
@@ -682,7 +687,7 @@ procedure Gnatls is
 
          --  Output Name
 
-         Output_Name (Units.Table (U).Uname);
+         Output_Name (Name_Id (Units.Table (U).Uname));
 
          --  Output Kind
 
@@ -768,7 +773,7 @@ procedure Gnatls is
          Output_Token (T_With);
          N_Indents := N_Indents + 1;
 
-         Output_Name (Withs.Table (W).Uname);
+         Output_Name (Name_Id (Withs.Table (W).Uname));
 
          --  Output Kind
 
@@ -815,6 +820,50 @@ procedure Gnatls is
       return Result;
    end Image;
 
+   --------------------------------
+   -- Output_License_Information --
+   --------------------------------
+
+   procedure Output_License_Information is
+      Params_File_Name : constant String := "gnatlic.adl";
+      --  Name of license file
+
+      Lo   : constant Source_Ptr := 1;
+      Hi   : Source_Ptr;
+      Text : Source_Buffer_Ptr;
+
+   begin
+      Name_Len := 0;
+      Add_Str_To_Name_Buffer (Params_File_Name);
+      Read_Source_File (Name_Find, Lo, Hi, Text);
+
+      if Text /= null then
+
+         --  Omit last character (end-of-file marker) in output
+
+         Write_Str (String (Text (Lo .. Hi - 1)));
+         Write_Eol;
+
+         --  The following condition is determined at compile time: disable
+         --  "condition is always true/false" warning.
+
+         pragma Warnings (Off);
+      elsif Build_Type /= GPL and then Build_Type /= FSF then
+         pragma Warnings (On);
+
+         Write_Str ("License file missing, please contact AdaCore.");
+         Write_Eol;
+
+      else
+         Write_Str ("Please refer to file COPYING in your distribution"
+                  & " for license terms.");
+         Write_Eol;
+
+      end if;
+
+      Exit_Program (E_Success);
+   end Output_License_Information;
+
    -------------------
    -- Output_Object --
    -------------------
@@ -1219,6 +1268,7 @@ procedure Gnatls is
                when 'o' => Reset_Print; Print_Object := True;
                when 'v' => Verbose_Mode              := True;
                when 'd' => Dependable                := True;
+               when 'l' => License                   := True;
                when 'V' => Very_Verbose_Mode         := True;
 
                when others => null;
@@ -1395,6 +1445,11 @@ procedure Gnatls is
                                "depend");
       Write_Eol;
 
+      --  Line for -l
+
+      Write_Str ("  -l         output license information");
+      Write_Eol;
+
       --  Line for -v
 
       Write_Str ("  -v         verbose output, full path and unit " &
@@ -1478,6 +1533,15 @@ begin
       Next_Arg := Next_Arg + 1;
    end loop Scan_Args;
 
+   --  If -l (output license information) is given, it must be the only switch
+
+   if License and then Arg_Count /= 2 then
+      Write_Str ("Can't use -l with another switch");
+      Write_Eol;
+      Usage;
+      Exit_Program (E_Fatal);
+   end if;
+
    --  Add the source and object directories specified on the
    --  command line, if any, to the searched directories.
 
@@ -1639,6 +1703,7 @@ begin
                Name_Buffer (Name_Len + 1 .. Name_Len + 4) := "gnat";
                Name_Buffer (Name_Len + 5) := Directory_Separator;
                Name_Len := Name_Len + 5;
+               Write_Str ("   ");
                Write_Line
                  (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
             end if;
@@ -1654,6 +1719,13 @@ begin
       Usage;
    end if;
 
+   --  Output license information when requested
+
+   if License then
+      Output_License_Information;
+      Exit_Program (E_Success);
+   end if;
+
    if not More_Lib_Files then
       if not Print_Usage and then not Verbose_Mode then
          Usage;