------------------------------------------------------------------------------
--                                                                          --
--                      GNAT METRICS TOOLS COMPONENTS                       --
--                                                                          --
--                       M E T R I C S . O U T P U T                        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2003-2007, AdaCore                      --
--                                                                          --
-- GNAT Metrics Toolset  is free software;  you can  redistribute it and/or --
-- modify it under terms of the  GNU General Public License as published by --
-- the Free Software Foundation;  either version 2, or (at your option) any --
-- later version.  GNAT Metrics Toolset is  distributed in the hope that it --
-- will be useful, but  WITHOUT ANY WARRANTY; without even the implied war- --
-- ranty of  MERCHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the --
-- GNU General Public License for more details.  You should have received a --
-- copy of the  GNU General Public License distributed with  GNAT; see file --
-- COPYING.  If not,  write to the  Free Software  Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
-- GNAT Metrics Toolset is maintained by AdaCore (http://www.adacore.com).  --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;    use Ada.Characters.Handling;
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
with Ada.Text_IO;                use Ada.Text_IO;

with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
with GNAT.OS_Lib;                use GNAT.OS_Lib;

with Asis.Compilation_Units;     use Asis.Compilation_Units;
with Asis.Declarations;          use Asis.Declarations;
with Asis.Elements;              use Asis.Elements;
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Asis.Implementation;        use Asis.Implementation;
with Asis.Text;                  use Asis.Text;

with Gnatvsn;

with METRICS.ASIS_Utilities;     use METRICS.ASIS_Utilities;
with METRICS.Common;             use METRICS.Common;
with METRICS.Options;            use METRICS.Options;

package body METRICS.Output is

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Report_No_EOL (Message : String; Depth : Natural := 0);
   --  Send Message into output file. The message is not appended with
   --  platform-specific EOL. Depth is used to send the indentation if needed.
   --  This procedure should not be used for generating XML output

   procedure Report_XML
     (Message : String;
      Depth   :   Natural   := 0);
   --  Sends the message into the XML output file. The message is appended with
   --  platform-specific EOL. Depth is used to send the indentation if needed.
   --  Does nothing if Generate_XML_Output is set OFF

   ----------------
   -- Brief_Help --
   ----------------

   procedure Brief_Help is
   begin
      Info ("usage: gnatmetric [options] {filename} {-files filename} " &
           "[gcc_switches]");
      Info (" options:");
      Info (" -v    - verbose mode");
      Info (" -q    - quiet mode");
      Info (" -dv   - generate debug output");
      Info (" -dd   - generate string to be used as input for progress "&
            "indicator");
      Info ("");
      Info (" -nocc - do not compute the McCabe Cyclomatic Complexity");
      Info (" -noec - do not compute the Essential Complexity");
      Info (" -nonl - do not compute maximal loop nesting level");
      Info (" -ne   - do not consider exit statements as gotos when");
      Info ("         computing Essential Complexity");
      Info ("");
      Info (" -nolocal - do not compute detailed metrics for local " &
            "program units");
      Info ("");
      Info (" line metrics (when not specified explicitly, all line metrics");
      Info (" are set on, otherwise only specified metrics are computed):");
      Info ("  -la    - the number of all lines");
      Info ("  -lcode - the number of code lines");
      Info ("  -lcomm - the number of comment lines");
      Info ("  -leol  - the number of code lines also containing comments");
      Info ("  -lb    - the number of blank lines");
      Info ("");
      Info (" element metrics (when not specified explicitly, all element " &
             "metrics");
      Info (" are set on, otherwise only specified metrics are computed):");
      Info ("  -ed  - the total number of declarations");
      Info ("  -es  - the total number of statements");
      Info ("  -eps - the number of public subprograms in a compilation " &
             "unit");
      Info ("  -eas - the number of all the subprograms in a compilation " &
             "unit");
      Info ("  -ept - the number of public types in a compilation unit");
      Info ("  -eat - the number of all the types in a compilation unit");
      Info ("  -enu - the maximal program unit nesting level");
      Info ("  -ec  - the maximal construct nesting level");
      Info ("");
      Info (" output file control:");
      Info ("  -d dirname     - put files with detailed metrics into " &
            "'dirname'");
      Info ("  -x             - generate the XML output");
      Info ("  -nt            - do not generate the output in text form, " &
            "implies '-x'");
      Info ("  -o file-suffix - the suffix for the file to put the detailed" &
            " metrics for");
      Info ("                   a source file (file-suffix should follow " &
            "the OS");
      Info ("                   file name conventions and contain '.' or '$'" &
            "character)");
      Info ("  -og filename   - the name of the file to put the global " &
            "metrics info into");
      Info ("                   (if not set, this info is sent to Stdout),");
      Info ("                   ignored if -nt is used");
      Info ("  -ox filename   - the name of the file to put the XML " &
            "output into, implies '-x'");
      Info ("  -sfn           - use short source file name in the output");
      Info ("");
      Info ("");
      Info (" filename        - the name of the Ada source file for which " &
            "metrics ");
      Info ("                   should be computed. Wildcards are allowed");
      Info (" -files filename - the name of the text file containing a list " &
            "of Ada");
      Info ("                   source files for which metrics should " &
            "be computed.");

      Info (" gcc_switches  '-cargs switches' where 'switches' is " &
            "a list of of switches");
      Info ("               that are valid switches for gcc");
   end Brief_Help;

   ---------------
   -- Close_Tag --
   ---------------

   procedure Close_Tag (Tag_Name : String; Depth : Natural := 0) is
   begin
      Report_XML ("</" & Tag_Name & '>', Depth => Depth);
   end Close_Tag;

   -----------
   -- Error --
   -----------

   procedure Error (Message : String) is
   begin
      Put_Line (Standard_Error, Message);
      --  May be, latter we'll add some error counting
   end Error;

   ---------------------
   -- Generate_Header --
   ---------------------

   procedure Generate_Header (SF : SF_Id) is
   begin

      if Generate_Text_Output then
         Report ("Metrics computed for " &  Source_Name_For_Output (SF));
         Report ("containing " & CU_Profile (The_CU));
      end if;

      if Generate_XML_Output then
         Report_XML
           ("<file name=" & '"' &
             Source_Name_For_Output (SF) & """>", Depth => 1);
      end if;

   end Generate_Header;

   --------------------------
   -- Generate_Line_Output --
   --------------------------

   procedure Generate_Line_Output (SF : SF_Id) is
      Tmp : Metric_Count;
   begin

      if Line_Metrics_Set then
         Report ("");
         Report ("=== Code line metrics ===");
      else
         return;
      end if;

      if Source_Status (SF) = Error_Detected then
         Report ("WARNING! errors are detected when processing the file");
         Report ("         COMPUTED LINE METRIC VALUES ARE NOT SAFE");

      else
         Global_Statistics.Computed_Line_Metrics :=
           Global_Statistics.Computed_Line_Metrics + 1;
      end if;

      if Compute_All_Lines then
         Report_No_EOL ("  all lines           :");
         Tmp := Get_All_Lines (SF);

         if Computed (Tmp) then
            Report (Tmp'Img);

            Output_XML_Metric ("all_lines", Tmp, Depth => 2);

            Global_Statistics.Line_Metrics.All_Lines :=
              Global_Statistics.Line_Metrics.All_Lines + Tmp;
         else
            Report (" unknown");
         end if;

      end if;

      if Compute_Code_Lines then
         Report_No_EOL ("  code lines          :");
         Tmp := Get_Code_Lines (SF);

         if Computed (Tmp) then
            Report (Tmp'Img);

            Output_XML_Metric ("code_lines", Tmp, Depth => 2);

            Global_Statistics.Line_Metrics.Code_Lines :=
              Global_Statistics.Line_Metrics.Code_Lines + Tmp;
         else
            Report (" unknown");
         end if;

      end if;

      if Compute_Comment_Lines then
         Report_No_EOL ("  comment lines       :");
         Tmp := Get_Comment_Lines (SF);

         if Computed (Tmp) then
            Report (Tmp'Img);

            Output_XML_Metric ("comment_lines", Tmp, Depth => 2);

            Global_Statistics.Line_Metrics.Comment_Lines :=
              Global_Statistics.Line_Metrics.Comment_Lines + Tmp;
         else
            Report (" unknown");
         end if;

      end if;

      if Compute_EOL_Comments then
         Report_No_EOL ("  end-of-line comments:");
         Tmp := Get_EOL_Comments (SF);

         if Computed (Tmp) then
            Report (Tmp'Img);

            Output_XML_Metric ("eol_comments", Tmp, Depth => 2);

            Global_Statistics.Line_Metrics.EOL_Comments :=
              Global_Statistics.Line_Metrics.EOL_Comments + Tmp;
         else
            Report (" unknown");
         end if;

      end if;

      if Compute_Blank_Lines then
         Report_No_EOL ("  blank lines         :");
         Tmp := Get_Blank_Lines (SF);

         if Computed (Tmp) then
            Report (Tmp'Img);

            Output_XML_Metric ("blank_lines", Tmp, Depth => 2);

            Global_Statistics.Line_Metrics.Blank_Lines :=
              Global_Statistics.Line_Metrics.Blank_Lines + Tmp;
         else
            Report (" unknown");
         end if;

      end if;

   end Generate_Line_Output;

   ----------
   -- Info --
   ----------

   procedure Info (Message : String) is
   begin
      Put_Line (Standard_Error, Message);
   end Info;

   -----------------
   -- Info_No_EOL --
   -----------------

   procedure Info_No_EOL (Message : String) is
   begin
      Put (Standard_Error, Message);
   end Info_No_EOL;

   --------------
   -- Open_Tag --
   --------------

   procedure Open_Tag (Tag_Name : String) is
   begin
      --  ??? Indentation!!!
      Put_Line (XML_Out_File, '<' & Tag_Name & '>');
   end Open_Tag;

   -----------------------
   -- Output_XML_Metric --
   -----------------------

   procedure Output_XML_Metric
     (Metric : String;
      Value  : Metric_Count;
      Depth  : Natural := 0)
   is
      Value_Image : constant String := Value'Img;
   begin
      Report_XML
        ("<metric name=" &
         '"' & Metric & '"' &
         '>' & Value_Image (2 .. Value_Image'Last) & "</metric>",
         Depth => Depth);
   end Output_XML_Metric;

   ------------
   -- Report --
   ------------

   procedure Report
     (Message : String;
      Depth   :   Natural := 0)
   is
      Indent : constant String := Depth * Indent_String;
   begin

      if Generate_Text_Output then
         Put      (Indent);
         Put_Line (Message);
      end if;

   end Report;

   ----------------
   -- Report_XML --
   ----------------

   procedure Report_XML
     (Message : String;
      Depth   :   Natural := 0)
   is
      Indent : constant String := Depth * Indent_String;
   begin

      if Generate_XML_Output then
         Put      (XML_Out_File, Indent);
         Put_Line (XML_Out_File, Message);
      end if;

   end Report_XML;

   ------------------------------
   -- Report_Global_Statistics --
   ------------------------------

   procedure Report_Global_Statistics is
      LSLOC : Metric_Count := 0;
      --  Used to compute the logical SLOC (all declarations + all statement)

      ITD : Public_Types_Details
        renames Global_Statistics.Public_Types_Detailed;
   begin

      if Generate_Text_Output then

--         if Global_Statistics.Computed_Line_Metrics >= 2 then

         Set_Global_Metrics_Output;

         Report ("Line metrics summed over" &
                 Global_Statistics.Computed_Line_Metrics'Img & " units");

         if Compute_All_Lines then
            Report ("  all lines           :" &
                    Global_Statistics.Line_Metrics.All_Lines'Img);
         end if;

         if Compute_Code_Lines then
            Report ("  code lines          :" &
                    Global_Statistics.Line_Metrics.Code_Lines'Img);
         end if;

         if Compute_Comment_Lines then
            Report ("  comment lines       :" &
                    Global_Statistics.Line_Metrics.Comment_Lines'Img);
         end if;

         if Compute_EOL_Comments then
            Report ("  end-of-line comments:" &
                    Global_Statistics.Line_Metrics.EOL_Comments'Img);
         end if;

         if Compute_Blank_Lines then
            Report ("  blank lines         :" &
                    Global_Statistics.Line_Metrics.Blank_Lines 'Img);
         end if;

--         end if;

--         if Global_Statistics.Computed_Element_Metrics >= 2 then
         Report ("");
         Report ("Element metrics summed over" &
                 Global_Statistics.Computed_Element_Metrics'Img & " units");

         if Compute_All_Statements then
            Report ("  all statements      :" &
                    Global_Statistics.Element_Metrics.All_Statements'Img);
         end if;

         if Compute_All_Declarations then
            Report ("  all declarations    :" &
                    Global_Statistics.Element_Metrics.All_Declarations'Img);
         end if;

         if Compute_All_Declarations and then Compute_All_Statements then

            LSLOC :=
              Global_Statistics.Element_Metrics.All_Statements +
              Global_Statistics.Element_Metrics.All_Declarations;

            Report ("  logical SLOC        :" & LSLOC'Img);

         end if;

--         end if;

         if Compute_Public_Types                         and then
--            Global_Statistics.Computed_Public_Types >= 2 and then
            Global_Statistics.Public_Types          >  0
         then
            Report ("");
            Report (Global_Statistics.Public_Types'Img &
                    " public types in" &
                    Global_Statistics.Computed_Public_Types'Img &
                    " units");

            if Details_Present (ITD) then

               Report (" including");

               if ITD.Abstract_Types > 0 then
                  Report
                    (ITD.Abstract_Types'Img & " abstract types", Depth => 1);
               end if;

               if ITD.Tagged_Types > 0 then
                  Report (ITD.Tagged_Types'Img & " tagged types", Depth => 1);
               end if;

               if ITD.Private_Types > 0 then
                  Report
                    (ITD.Private_Types'Img & " private types", Depth => 1);
               end if;

               if ITD.Task_Types > 0 then
                  Report (ITD.Task_Types'Img & " task types", Depth => 1);
               end if;

               if ITD.Protected_Types > 0 then
                  Report
                    (ITD.Protected_Types'Img & " protected types", Depth => 1);
               end if;

            end if;

         end if;

         if Compute_All_Types                         and then
--            Global_Statistics.Computed_All_Types >= 2 and then
            Global_Statistics.All_Types          >  0
         then
            Report ("");
            Report (Global_Statistics.All_Types'Img &
                    " type declarations in" &
                    Global_Statistics.Computed_All_Types'Img &
                    " units");
         end if;

         if Compute_Public_Subprograms                         and then
--            Global_Statistics.Computed_Public_Subprograms >= 2 and then
            Global_Statistics.Public_Subprograms          >  0
         then
            Report ("");
            Report (Global_Statistics.Public_Subprograms'Img &
                    " public subprograms in" &
                    Global_Statistics.Computed_Public_Subprograms'Img &
                    " units");
         end if;

         if Compute_All_Subprograms                         and then
--            Global_Statistics.Computed_All_Subprograms >= 2 and then
            Global_Statistics.All_Subprograms          >  0
         then
            Report ("");
            Report (Global_Statistics.All_Subprograms'Img &
                    " subprogram bodies in" &
                    Global_Statistics.Computed_All_Subprograms'Img &
                    " units");
         end if;

         Set_Output (Standard_Output);
      end if;

      if Generate_XML_Output then

         --  XML output. Here we output all the computed metric values, even
         --  if we have only one unit or if this value is zero.

         --  ??? Indentation!!!

         if Compute_All_Lines then
            Output_XML_Metric
              ("all_lines", Global_Statistics.Line_Metrics.All_Lines);
         end if;

         if Compute_Code_Lines then
            Output_XML_Metric
              ("code_lines", Global_Statistics.Line_Metrics.Code_Lines);
         end if;

         if Compute_Comment_Lines then
            Output_XML_Metric
              ("comment_lines", Global_Statistics.Line_Metrics.Comment_Lines);
         end if;

         if Compute_EOL_Comments then
            Output_XML_Metric
              ("eol_comments", Global_Statistics.Line_Metrics.EOL_Comments);
         end if;

         if Compute_Blank_Lines then
            Output_XML_Metric
              ("blank_lines", Global_Statistics.Line_Metrics.Blank_Lines);
         end if;

         if Compute_All_Statements then
            Output_XML_Metric
              ("all_stmts", Global_Statistics.Element_Metrics.All_Statements);
         end if;

         if Compute_All_Declarations then
            Output_XML_Metric
              ("all_dcls", Global_Statistics.Element_Metrics.All_Declarations);
         end if;

         if Compute_All_Declarations and then Compute_All_Statements then
            LSLOC :=
              Global_Statistics.Element_Metrics.All_Statements +
              Global_Statistics.Element_Metrics.All_Declarations;

            Output_XML_Metric ("lsloc", LSLOC);
         end if;

         if Compute_Public_Subprograms then
            Output_XML_Metric
              ("public_subprograms",
               Global_Statistics.Public_Subprograms);
         end if;

         if Compute_All_Subprograms then
            Output_XML_Metric
              ("all_subprograms", Global_Statistics.All_Subprograms);
         end if;

         if Compute_Public_Types then
            Output_XML_Metric
             ("public_types", Global_Statistics.Public_Types);
         end if;

         --  ??? Interface type details

         if Compute_All_Types then
            Output_XML_Metric ("all_types", Global_Statistics.All_Types);
         end if;

         Close_Tag ("global");

      end if;

   end Report_Global_Statistics;

   -------------------
   -- Report_No_EOL --
   -------------------

   procedure Report_No_EOL (Message : String; Depth : Natural := 0) is
      Indent : constant String := Depth * Indent_String;
   begin

      if Generate_Text_Output then
         Put (Current_Output, Indent);
         Put (Current_Output, Message);
      end if;

   end Report_No_EOL;

   -------------------------
   -- Report_Program_Unit --
   -------------------------

   procedure Report_Program_Unit
     (El           : Element;
      Depth        : Natural;
      Library_Item : Boolean := False)
   is
      Arg_Kind  : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Indent    : constant String             := Depth * Indent_String;
      Def_Name  : constant Element            := Names (El) (1);
      Name_Str  : constant String             :=
        To_String (Defining_Name_Image (Def_Name));
      Unit_Span : constant Span               := Element_Span (El);

      First_Line_Str : constant String := Unit_Span.First_Line'Img;
      First_Col_Str  : constant String := Unit_Span.First_Column'Img;

      function XML_Name_Str return String;
      --  Generates XML name for a defining operator symbol by replacing
      --  '"', '<', '>', '&' with the appropriate strings. For a defining
      --  identifier or defining A_Defining_Expanded_Name returns Name_Str

      function Program_Unit_Kind return String;
      --  Returns the string describing the kind of a program unit)

      function Program_Unit_Kind return String is
      begin
         case Arg_Kind is

            --  Specs:

            when A_Task_Type_Declaration =>
               return ("task type");

            when  A_Protected_Type_Declaration =>
               return ("protected type");

            when A_Single_Task_Declaration =>
               return ("task object");

            when A_Single_Protected_Declaration =>
               return ("protected object");

            when A_Procedure_Declaration =>
               return ("procedure");

            when A_Function_Declaration =>
               return ("function");

            when A_Package_Declaration =>
               return ("package");

            when A_Package_Renaming_Declaration =>
               return ("package renaming");

            when A_Procedure_Renaming_Declaration =>
               return ("procedure renaming");

            when A_Function_Renaming_Declaration =>
               return ("function renaming");

            when A_Generic_Package_Renaming_Declaration =>
               return ("generic package renaming");

            when A_Generic_Procedure_Renaming_Declaration =>
               return ("generic procedure renaming");

            when A_Generic_Function_Renaming_Declaration =>
               return ("generic function renaming");

            when A_Generic_Procedure_Declaration =>
               return ("generic procedure");

            when A_Generic_Function_Declaration =>
               return ("generic function");

            when A_Generic_Package_Declaration =>
               return ("generic package");

            when A_Package_Instantiation =>
               return ("package instantiation");

            when A_Procedure_Instantiation =>
               return ("procedure instantiation");

            when A_Function_Instantiation =>
               return ("function instantiation");

            --  Bodies:

            when A_Task_Body_Declaration =>
               return ("task body");

            when A_Protected_Body_Declaration =>
               return ("protected body");

            when An_Entry_Body_Declaration =>
               return ("entry body");

            when A_Package_Body_Declaration =>
               return ("package body");

            when A_Procedure_Body_Declaration =>
               return ("procedure body");

            when A_Function_Body_Declaration  =>
               return ("function body");

            when others =>
                  return ("WHAT THE HELL!!! ");
         end case;
      end Program_Unit_Kind;

      function XML_Name_Str return String is
      begin

         if Name_Str = """<""" then
            return "&quot;&lt;&quot;";

         elsif Name_Str = """<=""" then
            return "&quot;&lt;=&quot;";

         elsif Name_Str = """>""" then
            return "&quot;&gt;&quot;";

         elsif Name_Str = """>=""" then
            return "&quot;&gt;=&quot;";

         elsif Name_Str = """&""" then
            return "&quot;&amp;&quot;";

         elsif Defining_Name_Kind (Def_Name) = A_Defining_Operator_Symbol then
            return "&quot;" &
                   Name_Str (Name_Str'First + 1 .. Name_Str'Last - 1) &
                   "&quot;";

         else
            return Name_Str;
         end if;
      end XML_Name_Str;

   begin
      Report_No_EOL (Indent);
      Report_No_EOL (Name_Str);
      Report_No_EOL (" (");

      Report_No_EOL (Program_Unit_Kind);

      if Library_Item then

         if Unit_Kind (Enclosing_Compilation_Unit (El)) in A_Subunit then
            Report_No_EOL (" - subunit");
         else
            Report_No_EOL (" - library item");
         end if;

      end if;

      Report_No_EOL (" at lines ");
      Report_No_EOL (Unit_Span.First_Line'Img);
      Report_No_EOL (":");
      Report_No_EOL (Unit_Span.Last_Line'Img);
      Report        (")");

      Report_XML
        ("<unit name=""" & XML_Name_Str                           &
         """ kind=""" & Program_Unit_Kind                         &
         """ line=""" & First_Line_Str (2 .. First_Line_Str'Last) &
         """ col="""  & First_Col_Str  (2 .. First_Col_Str'Last)  & """>",
         Depth => Depth + 2);

   end Report_Program_Unit;

   -------------------------------------
   -- Report_Unhandled_ASIS_Exception --
   -------------------------------------

   procedure Report_Unhandled_ASIS_Exception (Ex : Exception_Occurrence) is
   begin
      Error ("ASIS exception (" & Exception_Name (Ex) & ") is raised");
      Error ("ASIS Error Status is " & Status'Img);
      Error ("ASIS Diagnosis is " & To_String (Diagnosis));

      Set_Status;
   end Report_Unhandled_ASIS_Exception;

   --------------------------------
   -- Report_Unhandled_Exception --
   --------------------------------

   procedure Report_Unhandled_Exception (Ex : Exception_Occurrence) is
   begin
      Error (Exception_Information (Ex));
   end Report_Unhandled_Exception;

   -------------------------------
   -- Set_Global_Metrics_Output --
   -------------------------------

   procedure Set_Global_Metrics_Output is
   begin

      if Global_File_Name /= null then

         begin

            --  If we are here, we for sure are in our temporary directory

            Change_Dir ("..");

            if GNAT.OS_Lib.Is_Regular_File (Global_File_Name.all) then
               Open (Global_Out_File, Out_File, Global_File_Name.all);
            else
               Create (Global_Out_File, Out_File, Global_File_Name.all);
            end if;

         exception
            when others =>
               Error ("gnatmetric: can not open " & Global_File_Name.all);
               Error ("check the file name");
         end;

         Set_Output (Global_Out_File);
      else
         Set_Output (Standard_Output);
      end if;

      Set_Error  (Standard_Error);
      Global_Output := Current_Output;
   end Set_Global_Metrics_Output;

   -------------------------
   -- Set_Source_Out_File --
   -------------------------

   procedure Set_Source_Out_File (SF : SF_Id) is
      S : constant String := Source_Out_File (SF);
   begin

      if not Generate_Text_Output then
         return;
      end if;

      if GNAT.OS_Lib.Is_Regular_File (S) then
         Open (Source_Output_File, Out_File, S);
      else
         Create (Source_Output_File, Out_File, S);
      end if;

      Set_Output (Source_Output_File);

   exception
      when others =>
         Error ("gnatmetric: can not write in " & S);
         raise Fatal_Error;
   end Set_Source_Out_File;

   ----------------------
   -- Set_XML_Out_File --
   ----------------------

   procedure Set_XML_Out_File is
   begin

      if Generate_XML_Output then

         begin

            if GNAT.OS_Lib.Is_Regular_File (XML_File_Name.all) then
               Open (XML_Out_File, Out_File, XML_File_Name.all);
            else
               Create (XML_Out_File, Out_File, XML_File_Name.all);
            end if;

         exception
            when others =>
               Generate_XML_Output := False;
               Error ("gnatmetric: can not open " & XML_File_Name.all);
               Error ("check the file name");

               if not Generate_Text_Output then
                  --  No need to do anything - we have no file to output the
                  --  result
                  raise Fatal_Error;
               end if;

         end;

         Report_XML ("<?xml version=""1.0""?>");
         Open_Tag ("global");
      end if;

   end Set_XML_Out_File;

   ------------------
   -- Version_Info --
   ------------------

   procedure Version_Info is
   begin
      Info_No_EOL ("GNATMETRIC (built with ");
      Info_No_EOL (To_String (ASIS_Implementor_Version));
      Info (")");

      Info_No_EOL ("Copyright 2005-");
      Info_No_EOL (Gnatvsn.Current_Year);
      Info        (", AdaCore");
   end Version_Info;

end METRICS.Output;
