------------------------------------------------------------------------------
--                                                                          --
--                      GNAT METRICS TOOLS COMPONENTS                       --
--                                                                          --
--                     M E T R I C S . C O M P U T E                        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2002-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.Command_Line;           use Ada.Command_Line;
with Ada.Text_IO;                use Ada.Text_IO;

with GNAT.OS_Lib;                use GNAT.OS_Lib;

with Asis;                       use Asis;
with Asis.Ada_Environments;      use Asis.Ada_Environments;
with Asis.Compilation_Units;     use Asis.Compilation_Units;
with Asis.Declarations;          use Asis.Declarations;
with Asis.Elements;              use Asis.Elements;
with Asis.Errors;
with Asis.Exceptions;            use Asis.Exceptions;
with Asis.Extensions;            use Asis.Extensions;
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Asis.Implementation;
with Asis.Iterator;              use Asis.Iterator;
with Asis.Text;                  use Asis.Text;

with ASIS_UL.Common;
with ASIS_UL.Compiler_Options;   use ASIS_UL.Compiler_Options;
with ASIS_UL.Options;

with METRICS.ASIS_Utilities;     use METRICS.ASIS_Utilities;
with METRICS.Common;             use METRICS.Common;
with METRICS.Environment;        use METRICS.Environment;
with METRICS.Metric_Definitions; use METRICS.Metric_Definitions;
with METRICS.Options;            use METRICS.Options;
with METRICS.Output;             use METRICS.Output;
with METRICS.Source_Table;       use METRICS.Source_Table;

package body METRICS.Compute is

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

   procedure Process_Main_Source (SF : SF_Id);
   --  Processes the source file stored under SF index into source file table.
   --  The caller is responsible to keep the actual parameter inside the
   --  range of the existing table entries. The processing consists of
   --  creating the tree file for this source, and if the tree is successfully
   --  created, then the metrics are computed (and reported) for the main unit
   --  in this tree. Then gnatmetric tries to process all the non-processed
   --  sources which can be processed on the base of this tree. When all
   --  possible sources are processed, the tree file is deleted from the
   --  temporary directory.

   procedure Compute_Unit_Metrics
     (The_CU : Asis.Compilation_Unit;
      SF     : SF_Id);
   --  This procedure computes add reports metrics for the given pair of
   --  ASIS Compilation Unit and its source file (given with full directory
   --  information in absolute form), provided that this Compilation Unit
   --  exists in The_Contest (which is currently open). The caller is
   --  responsible for the fact that this pair Unit - file name is correct, and
   --  that the unit exists in the context and that the context is open.

   procedure Process_Sources (Only_Bodies : Boolean := False);
   --  Processes sources stores in the sources table trying to minimize
   --  compilations needed to create the tree files. If Only_Bodies is set ON,
   --  only files with .adb suffixes are compiled for the trees.

   procedure Create_Tree (SF : SF_Id; Success : out Boolean);
   --  Tries to create the tree file for the given source file. The tree file
   --  and the corresponding ALI file are placed into a temporary directory.
   --  If the attempt is successful, Success is set ON, otherwise it is set
   --  OFF.

   function Compute_Line_Metrics
     (SF :   SF_Id   := No_SF_Id;
      El :   Element := Nil_Element)
      return Line_Metrics_Record;
   --  Computes line metrics for its argument. If SF is not No_SF_Id, then
   --  the line metrics are computed for the whole source file, otherwise
   --  they are computed for the Element argument (in case of Nil_Element or if
   --  not Is_Text_Available (El) zero is returned as a computed value for all
   --  the line metrics

   type Line_Kinds is (Blank_Line, Code_Line, Comment_Line);
   function Line_Kind (Line_Img : Program_Text) return Line_Kinds;
   --  Scans the line image and detects if the line is a blank line, a line
   --  containing at least one non-comment character or a comment line

   function Is_White_Space (W_Ch : Wide_Character) return Boolean;
   --  Checks if the argument id a white space.

   procedure Compute_And_Report_Element_Metrics
     (Program_Unit         : Element;
      Nesting_Level        : Natural := 0;
      SF                   : SF_Id   := No_SF_Id;
      Include_Nested_Units : Boolean := True);
   --  Computes all possible metrics for its argument Program_Unit.
   --  Nesting_Level sets the indentation level for the output. If SF is not
   --  equal to No_SF_Id (and if Program_Unit represents the library item from
   --  the corresponding source file) , this means that some element metrics
   --  should be stored in source file table as the data to be used to form the
   --  global statistics. If Include_Nested_Units is set ON, metrics are
   --  computed and reported for all the enclosing program units.
   --
   --  Metrics are computed for ASIS Elements representing program units, for
   --  more details see the body of Is_Program_Unit test function which makes
   --  the corresponding check

   procedure Compute_Complexity
     (Body_El : Element;
      Depth   : Natural);
   --  Computes and prints out the cyclomatic and loop nesting complexity for
   --  Body_El. This information is outputted into the out file which is
   --  specific for the source being analyzed. The Depth parameter is used to
   --  format the output.

   procedure Output_Source (SF : SF_Id);
   --  Output into Stderr the tracing information about SF. This procedure
   --  decreases the counter of the sources which have to be processed
   --  (Sources_Left)

   ----------------------------------------
   -- Compute_And_Report_Element_Metrics --
   ----------------------------------------

   procedure Compute_And_Report_Element_Metrics
     (Program_Unit         : Element;
      Nesting_Level        : Natural := 0;
      SF                   : SF_Id   := No_SF_Id;
      Include_Nested_Units : Boolean := True)
   is
      Element_Metrics : Element_Metrics_Record := Zero_Element_Metrics;
      Line_Metrics    : Line_Metrics_Record    := Zero_Line_Metrics;

      Public_Subprogram_Count : Metric_Count := 0;
      Subprogram_Body_Count   : Metric_Count := 0;

      Public_Types_Count          : Metric_Count := 0;
      Public_Types_Detailed_Count : Public_Types_Details
        := Zero_Public_Types_Details;
      All_Types_Count             : Metric_Count := 0;

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

      Is_Library_Item       : Boolean := False;
      May_Have_Nested_Units : Boolean := False;

      --  Now we define two traversals needed to collect metrics. The first
      --  traversal analyzes the argument unit only, without getting into any
      --  nested program unit. When this traversal is completed and the
      --  corresponding report is generated, we start the second traversal
      --  in order to collect the detailed metrics for nested program units.
      --  This second traversal looks for the elements being program units for
      --  which metrics should be collected and recursively calls this
      --  Compute_And_Report_Element_Metrics procedure for them. This is not
      --  very effective but this allows to avoid using complicated
      --  data structures for organizing the well-structured output. The
      --  goal is to output all the metrics for a program unit first, and only
      --  after that to output metrics for its enclosed units

      type Global_State_Type is record
         Progran_Unit_Nesting : Metric_Count;
         Construct_Nesting    : Metric_Count;
      end record;

      type Local_State_Type is record
         Top_Unit : Boolean;
         --  Is use as a flag to prevent a second processing of the same
         --  Program_Unit element

         Depth    : Natural;
         --  Sets the indentation for the output
      end record;

      Global_State   : Global_State_Type := (0, 0);

      Local_State    : Local_State_Type;
      Control        : Traverse_Control := Continue;

      procedure First_Pre_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Global_State_Type);
      --  Computes and collects different Element metrics

      procedure First_Post_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Global_State_Type);

      procedure Collect_Global_Metrics is new Traverse_Element
        (Pre_Operation     => First_Pre_Operation,
         Post_Operation    => First_Post_Operation,
         State_Information => Global_State_Type);
      --  This procedure makes the first traversal: it computes metrics for
      --  the argument element. It does not go inside the enclosed program
      --  units. For METRICS.Simple_Driverr, we call it for the top unit
      --  declaration

      procedure Second_Pre_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Local_State_Type);
      --  This procedure detects for which Elements being visited all the
      --  detailed metrics should be computed and then calls the
      --  Compute_And_Report_Element_Metrics procedure for them

      procedure Second_Post_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Local_State_Type);

      procedure Collect_Local_Metrics is new Traverse_Element
        (Pre_Operation     => Second_Pre_Operation,
         Post_Operation    => Second_Post_Operation,
         State_Information => Local_State_Type);
      --  This procedure makes the second traversal in order to compute and to
      --  print out metrics for all the enclosed program units

      -------------------------
      -- First_Pre_Operation --
      -------------------------

      procedure First_Pre_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Global_State_Type)
      is
         El_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);
         pragma Unreferenced (Control);

         procedure Recompute_Max_Nesting_Level;
         --  Increases State.Construct_Nesting and recomputes
         --  Element_Metrics.Construct_Nesting

         procedure Recompute_Max_Nesting_Level is
         begin
            State.Construct_Nesting := State.Construct_Nesting + 1;

            if State.Construct_Nesting >
               Element_Metrics.Max_Construct_Nesting
            then
               Element_Metrics.Max_Construct_Nesting :=
                 State.Construct_Nesting;
            end if;

         end Recompute_Max_Nesting_Level;

      begin

         if Compute_Construct_Nesting
          and then
            Adds_New_Nesting_Level (El_Kind)
         then
            Recompute_Max_Nesting_Level;
         end if;

         case El_Kind is
            when Flat_Statement_Kinds =>

               if El_Kind /= A_Terminate_Alternative_Statement and then
                  Compute_All_Statements
               then
                  Element_Metrics.All_Statements :=
                    Element_Metrics.All_Statements + 1;
               end if;

            when Flat_Declaration_Kinds =>

               if Compute_All_Declarations then
                  Element_Metrics.All_Declarations :=
                     Element_Metrics.All_Declarations + 1;
               end if;

               --  Compute the program unit nesting. Note, that we count
               --  the top-level unit for which the maximal nesting level
               --  is computed, so we'll have to subtract 1 from the result

               if Compute_Progam_Unit_Nesting and then
                  May_Have_Nested_Units       and then
                  Is_RM_Program_Unit (Element)
               then
                  State.Progran_Unit_Nesting := State.Progran_Unit_Nesting + 1;

                  if State.Progran_Unit_Nesting >
                     Element_Metrics.Max_Program_Unit_Nesting
                  then
                     Element_Metrics.Max_Program_Unit_Nesting :=
                       State.Progran_Unit_Nesting;
                  end if;

               end if;

               if Is_Library_Item            and then
                  May_Have_Subprogram_Bodies and then

                  (El_Kind = A_Procedure_Body_Declaration
                  or else
                   El_Kind = A_Function_Body_Declaration)

               then
                  Subprogram_Body_Count := Subprogram_Body_Count + 1;
               end if;

               if Is_Library_Item
                 and then
                  May_Have_Public_Subprograms
                 and then
                  (El_Kind = A_Procedure_Declaration         or else
                   El_Kind = A_Function_Declaration          or else
                   El_Kind = A_Generic_Procedure_Declaration or else
                   El_Kind = A_Generic_Function_Declaration)
                 and then
                   not Is_Private (Element)
               then
                  --  Note, that this condition does not allow to count the
                  --  library level subprogram body which acts as a spec
                  --  as an public subprogram. So we have to do this
                  --  outside the traversal.
                  Public_Subprogram_Count := Public_Subprogram_Count + 1;
               end if;

               if Is_Library_Item       and then
                  May_Have_Public_Types and then
                  not Is_Private (Element)
               then

                  Public_Types_Count := Public_Types_Count + 1;

                  case El_Kind is
                     when A_Task_Type_Declaration =>
                        Public_Types_Detailed_Count.Task_Types :=
                          Public_Types_Detailed_Count.Task_Types + 1;

                     when A_Protected_Type_Declaration =>
                        Public_Types_Detailed_Count.Protected_Types :=
                          Public_Types_Detailed_Count.Protected_Types + 1;

                     when A_Private_Type_Declaration |
                          A_Private_Extension_Declaration =>
                        Public_Types_Detailed_Count.Private_Types :=
                          Public_Types_Detailed_Count.Private_Types + 1;

                        if Trait_Kind (Element) in
                           An_Abstract_Trait ..
                           An_Abstract_Limited_Private_Trait
                        then
                           Public_Types_Detailed_Count.Abstract_Types :=
                             Public_Types_Detailed_Count.Abstract_Types + 1;
                        end if;

                        if El_Kind = A_Private_Type_Declaration and then
                           Definition_Kind (Type_Declaration_View (Element)) =
                           A_Tagged_Private_Type_Definition
                        then
                           Public_Types_Detailed_Count.Tagged_Types :=
                             Public_Types_Detailed_Count.Tagged_Types + 1;
                        end if;

                     when An_Ordinary_Type_Declaration =>

                        if Trait_Kind (Element) = An_Abstract_Trait then
                           Public_Types_Detailed_Count.Abstract_Types :=
                             Public_Types_Detailed_Count.Abstract_Types + 1;
                        end if;

                        if Type_Kind (Type_Declaration_View (Element)) =
                           A_Tagged_Record_Type_Definition
                        then
                           Public_Types_Detailed_Count.Tagged_Types :=
                             Public_Types_Detailed_Count.Tagged_Types + 1;
                        end if;

                     when others =>
                        --  It's not a type to count
                        Public_Types_Count := Public_Types_Count - 1;
                  end case;

               end if;

               if Is_Library_Item and then
                  May_Have_Type_Definitions
               then

                  case El_Kind is
                     when A_Task_Type_Declaration         |
                          A_Protected_Type_Declaration    |
                          A_Private_Type_Declaration      |
                          A_Private_Extension_Declaration =>

                        All_Types_Count := All_Types_Count + 1;

                     when An_Ordinary_Type_Declaration =>

                        --  We do not count the full declarations for private
                        --  types

                        if not (Is_Private (Element) and then
                           Declaration_Kind
                             (Corresponding_Type_Declaration (Element)) in
                           A_Private_Type_Declaration ..
                           A_Private_Extension_Declaration)
                        then
                           All_Types_Count := All_Types_Count + 1;
                        end if;

                     when others =>
                        null;
                  end case;
               end if;

            when others =>
               null;
         end case;

      end First_Pre_Operation;

      --------------------------
      -- First_Post_Operation --
      --------------------------

      procedure First_Post_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Global_State_Type)
      is
      begin

         pragma Unreferenced (Control);

         if Compute_Progam_Unit_Nesting and then
            May_Have_Nested_Units       and then
            Is_RM_Program_Unit (Element)
         then
            State.Progran_Unit_Nesting := State.Progran_Unit_Nesting - 1;
         end if;

         if Compute_Construct_Nesting
          and then
            Adds_New_Nesting_Level (Flat_Element_Kind (Element))
         then
            State.Construct_Nesting := State.Construct_Nesting - 1;
         end if;

      end First_Post_Operation;

      --------------------------
      -- Second_Pre_Operation --
      --------------------------

      procedure Second_Pre_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Local_State_Type)
      is
      begin

         if State.Top_Unit then
            State.Top_Unit := False;
            return;
         end if;

         if Is_Program_Unit (Element) then

            Compute_And_Report_Element_Metrics
              (Program_Unit => Element,
               Nesting_Level => State.Depth);

            Control := Abandon_Children;
         end if;

      end Second_Pre_Operation;

      ---------------------------
      -- Second_Post_Operation --
      ---------------------------

      procedure Second_Post_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Local_State_Type)
      is
      begin
         pragma Unreferenced (Element);
         pragma Unreferenced (Control);
         pragma Unreferenced (State);

         null;

      end Second_Post_Operation;

   begin  --  Compute_And_Report_Element_Metrics

      if not Is_Program_Unit (Program_Unit) then
         return;
      end if;

      --  Starting the first traversal:

      Is_Library_Item :=
        SF /= No_SF_Id and then Is_Equal (Program_Unit, The_Unit);

      May_Have_Nested_Units :=
        May_Contain_Program_Units (Flat_Element_Kind (Program_Unit));

      Report ("");
      Report_Program_Unit (Program_Unit, Nesting_Level, Is_Library_Item);

      --  Compute and report line metrics:

      Line_Metrics := Compute_Line_Metrics (El => Program_Unit);

      if Line_Metrics_Set then
         Report ("");
         Report ("=== Code line metrics ===", Depth => Nesting_Level);

         if Compute_All_Lines then
            Report
              ("all lines           :" & Line_Metrics.All_Lines'Img,
               Depth => Nesting_Level + 1);

            Output_XML_Metric
              ("all_lines",
               Line_Metrics.All_Lines,
               Depth => Nesting_Level + 3);
         end if;

         if Compute_Code_Lines then
            Report
              ("code lines          :" & Line_Metrics.Code_Lines'Img,
               Depth => Nesting_Level + 1);

            Output_XML_Metric
              ("code_lines",
               Line_Metrics.Code_Lines,
               Depth => Nesting_Level + 3);
         end if;

         if Compute_Comment_Lines then
            Report
              ("comment lines       :" & Line_Metrics.Comment_Lines'Img,
               Depth => Nesting_Level + 1);

            Output_XML_Metric
              ("comment_lines",
               Line_Metrics.Comment_Lines,
               Depth => Nesting_Level + 3);
         end if;

         if Compute_EOL_Comments then
            Report
              ("end-of-line comments:" & Line_Metrics.EOL_Comments'Img,
               Depth => Nesting_Level + 1);

            Output_XML_Metric
              ("eol_comments",
               Line_Metrics.EOL_Comments,
               Depth => Nesting_Level + 3);
         end if;

         if Compute_Blank_Lines then
            Report
              ("blank lines         :" & Line_Metrics.Blank_Lines'Img,
               Depth => Nesting_Level + 1);

            Output_XML_Metric
              ("blank_lines",
               Line_Metrics.Blank_Lines,
               Depth => Nesting_Level + 3);
         end if;

      end if;

      --  Compute and report element metrics:

      if Compute_All_Statements
        or else
         Compute_All_Declarations
        or else
         Compute_Progam_Unit_Nesting
        or else
         Compute_Construct_Nesting
        or else
         (Is_Library_Item and then
          (Compute_Public_Subprograms or else
           Compute_All_Subprograms    or else
           Compute_Public_Types       or else
           Compute_All_Types))
      then

         Collect_Global_Metrics (Program_Unit, Control, Global_State);

         if Is_Library_Item and then
            CU_Class = A_Public_Declaration_And_Body
         then
            Public_Subprogram_Count := 1;
         end if;

         Report ("");
         Report ("=== Element metrics ===", Depth => Nesting_Level);

         if Is_Library_Item       and then
            May_Have_Public_Types and then
            Public_Types_Count > 0
         then
            Report
              ("public types             :" &
               Public_Types_Count'Img,
               Depth => Nesting_Level + 1);

            Output_XML_Metric
              ("public_types",
               Public_Types_Count,
               Depth => Nesting_Level + 3);

            if Details_Present (Public_Types_Detailed_Count) then

               Report ("   including", Depth => Nesting_Level + 1);

               if Public_Types_Detailed_Count.Abstract_Types > 0 then
                  Report
                    ("abstract types  :" &
                     Public_Types_Detailed_Count.Abstract_Types'Img,
                     Depth => Nesting_Level + 2);

                  Output_XML_Metric
                    ("abstract_types",
                     Public_Types_Detailed_Count.Abstract_Types,
                     Depth => Nesting_Level + 3);
               end if;

               if Public_Types_Detailed_Count.Tagged_Types > 0 then
                  Report
                    ("tagged types    :" &
                     Public_Types_Detailed_Count.Tagged_Types'Img,
                     Depth => Nesting_Level + 2);

                  Output_XML_Metric
                    ("tagged_types",
                     Public_Types_Detailed_Count.Tagged_Types,
                     Depth => Nesting_Level + 3);
               end if;

               if Public_Types_Detailed_Count.Private_Types > 0 then
                  Report
                    ("private types   :" &
                     Public_Types_Detailed_Count.Private_Types'Img,
                     Depth => Nesting_Level + 2);

                  Output_XML_Metric
                    ("private_types",
                     Public_Types_Detailed_Count.Private_Types,
                     Depth => Nesting_Level + 3);
               end if;

               if Public_Types_Detailed_Count.Task_Types > 0 then
                  Report
                    ("task types      :" &
                     Public_Types_Detailed_Count.Task_Types'Img,
                     Depth => Nesting_Level + 2);

                  Output_XML_Metric
                    ("task_types",
                     Public_Types_Detailed_Count.Task_Types,
                     Depth => Nesting_Level + 3);
               end if;

               if Public_Types_Detailed_Count.Protected_Types > 0 then
                  Report
                    ("protected types :" &
                     Public_Types_Detailed_Count.Protected_Types'Img,
                     Depth => Nesting_Level + 2);

                  Output_XML_Metric
                    ("protected_types",
                     Public_Types_Detailed_Count.Protected_Types,
                     Depth => Nesting_Level + 3);
               end if;

            end if;

            Global_Statistics.Public_Types :=
              Global_Statistics.Public_Types + Public_Types_Count;

            Add_Public_Types_Details (Public_Types_Detailed_Count);

            Global_Statistics.Computed_Public_Types :=
              Global_Statistics.Computed_Public_Types + 1;

         end if;

         if Is_Library_Item                and then
            May_Have_Type_Definitions and then
            All_Types_Count > 0
         then
            Report
              ("all type definitions     :" &
               All_Types_Count'Img,
               Depth => Nesting_Level + 1);

            Output_XML_Metric
              ("all_types",
               All_Types_Count,
               Depth => Nesting_Level + 3);

            Global_Statistics.All_Types :=
              Global_Statistics.All_Types + All_Types_Count;

            Global_Statistics.Computed_All_Types :=
              Global_Statistics.Computed_All_Types + 1;

         end if;

         if Is_Library_Item            and then
            Compute_Public_Subprograms and then
            May_Have_Public_Subprograms
         then
            Report
              ("public subprograms       :" &
               Public_Subprogram_Count'Img,
               Depth => Nesting_Level + 1);

               Output_XML_Metric
                 ("public_subprograms",
                  Public_Subprogram_Count,
                  Depth => Nesting_Level + 3);

            if Public_Subprogram_Count > 0 then
               Global_Statistics.Public_Subprograms :=
                 Global_Statistics.Public_Subprograms +
                 Public_Subprogram_Count;

               Global_Statistics.Computed_Public_Subprograms :=
                 Global_Statistics.Computed_Public_Subprograms + 1;
            end if;

         end if;

         if Is_Library_Item  and then
            May_Have_Subprogram_Bodies
         then
            Report
              ("all subprogram bodies    :" &
               Subprogram_Body_Count'Img,
               Depth => Nesting_Level + 1);

               Output_XML_Metric
                 ("all_subprograms",
                  Subprogram_Body_Count,
                  Depth => Nesting_Level + 3);

            if Subprogram_Body_Count > 0 then
               Global_Statistics.All_Subprograms :=
                 Global_Statistics.All_Subprograms +
                 Subprogram_Body_Count;

               Global_Statistics.Computed_All_Subprograms :=
                 Global_Statistics.Computed_All_Subprograms + 1;
            end if;
         end if;

         if Compute_All_Statements then
            Report
              ("all statements           :" &
               Element_Metrics.All_Statements'Img,
               Depth => Nesting_Level + 1);

               Output_XML_Metric
                 ("all_stmts",
                  Element_Metrics.All_Statements,
                  Depth => Nesting_Level + 3);

            if Is_Library_Item then
               --  Collect the global statistics for all the units being
               --  processed

               Global_Statistics.Element_Metrics.All_Statements :=
                 Global_Statistics.Element_Metrics.All_Statements +
                 Element_Metrics.All_Statements;
            end if;

         end if;

         if Compute_All_Declarations then
            Report
              ("all declarations         :" &
               Element_Metrics.All_Declarations'Img,
               Depth => Nesting_Level + 1);

               Output_XML_Metric
                 ("all_dcls",
                  Element_Metrics.All_Declarations,
                  Depth => Nesting_Level + 3);

            if Is_Library_Item then
               --  Collect the global statistics for all the units being
               --  processed

               Global_Statistics.Element_Metrics.All_Declarations :=
                 Global_Statistics.Element_Metrics.All_Declarations +
                 Element_Metrics.All_Declarations;
            end if;

         end if;

         if Compute_Progam_Unit_Nesting and then
            May_Have_Nested_Units       and then
            Element_Metrics.Max_Program_Unit_Nesting > 1
         then
            Element_Metrics.Max_Program_Unit_Nesting :=
              Element_Metrics.Max_Program_Unit_Nesting - 1;

            Report
              ("maximal unit nesting     :" &
               Element_Metrics.Max_Program_Unit_Nesting'Img,
               Depth => Nesting_Level + 1);

               Output_XML_Metric
                 ("unit_nesting",
                  Element_Metrics.Max_Program_Unit_Nesting,
                  Depth => Nesting_Level + 3);
         end if;

         if Compute_Construct_Nesting then

            Report
              ("maximal construct nesting:" &
               Element_Metrics.Max_Construct_Nesting'Img,
               Depth => Nesting_Level + 1);

               Output_XML_Metric
                 ("construct_nesting",
                  Element_Metrics.Max_Construct_Nesting,
                  Depth => Nesting_Level + 3);
         end if;

         if Is_Library_Item then
            Global_Statistics.Computed_Element_Metrics :=
              Global_Statistics.Computed_Element_Metrics + 1;
         end if;

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

            Report
              ("logical SLOC             :" & LSLOC'Img,
               Depth => Nesting_Level + 1);

               Output_XML_Metric
                 ("lsloc",
                  LSLOC,
                  Depth => Nesting_Level + 3);
         end if;

      end if;

      --  Compute and report complexity:

      if Is_Executable_Body (Program_Unit) and then
         Complexity_Metrics_Set
      then
         Compute_Complexity (Program_Unit, Depth => Nesting_Level);
      end if;

      --  And now, if needed we go gown in the argument structure

      if Include_Nested_Units then
         Local_State.Top_Unit := True;
         Local_State.Depth := Nesting_Level + 1;
         Collect_Local_Metrics (Program_Unit, Control, Local_State);
      end if;

      Close_Tag ("unit", Nesting_Level + 2);

   exception

   --  In case of an ASIS exception we report it and go ahead with computing
   --  other metrics for other sources. Otherwise we let the exception
   --  propagate out of this routine to raise Fatal_Error at upper level
      when Ex : Asis.Exceptions.ASIS_Inappropriate_Context          |
                Asis.Exceptions.ASIS_Inappropriate_Container        |
                Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit |
                Asis.Exceptions.ASIS_Inappropriate_Element          |
                Asis.Exceptions.ASIS_Inappropriate_Line             |
                Asis.Exceptions.ASIS_Inappropriate_Line_Number      |
                Asis.Exceptions.ASIS_Failed                         =>

         METRICS.Output.Report_Unhandled_ASIS_Exception (Ex);

         if SF /= No_SF_Id then
            Set_Source_Status (SF, Error_Detected);
         end if;

         Asis.Implementation.Set_Status;
   end Compute_And_Report_Element_Metrics;

   ------------------------
   -- Compute_Complexity --
   ------------------------

   procedure Compute_Complexity
     (Body_El : Element;
      Depth   : Natural)
   is
      Stmt_Complexity : Metric_Count := 1;
      --  The cyclomatic complexity computed from control statement only
      --  (without taking into account short circuit forms). The initial value
      --  is the minimal possible complexity of a simplest real program

      Short_Circuit_Complexity : Metric_Count := 0;
      --  The cyclomatic complexity computed from short circuit forms only

      Cyclomatic_Complexity : Metric_Count := 0;
      --  Here we have to compute the McCabe cyclomatic complexity

      Essential_Complexity : Metric_Count := 1;
      --  Essential complexity, that is, a complexity introduced by
      --  "non-structural" control statements only. A control statement is
      --  non-structural if it contains any kind of transferring the control
      --  from outside the statement.

      Max_Loop_Nesting : Metric_Count := 0;
      --  Maximal loop nesting level

      Tmp : Metric_Count;

      Control : Traverse_Control := Continue;

      type Complexity_State_Type is record
         Loop_Nesting : Metric_Count;
      end record;

      State : Complexity_State_Type := (Loop_Nesting => 0);

      procedure Check_Complexity
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Complexity_State_Type);
      --  Checks if the element being visited add some value to the body
      --  complexity. Increases the corresponding complexity counter if it
      --  does. We use global variables for this counters to avoid passing
      --  complicated data structure as the traversal state

      procedure Complexity_Post_Op
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Complexity_State_Type);
      --  Corrects the loop nesting counter back to zero.

      procedure Collect_Complexity is new Traverse_Element
        (Pre_Operation     => Check_Complexity,
         Post_Operation    => Complexity_Post_Op,
         State_Information => Complexity_State_Type);

      ----------------------
      -- Check_Complexity --
      ----------------------

      procedure Check_Complexity
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Complexity_State_Type)
      is
         Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);
      begin

         --  How we compute the cyclomatic complexity:
         --
         --  1. Control statements:
         --
         --     IF adds 1 + the number of ELSIF paths
         --
         --     CASE statement adds the number of alternatives minus 1
         --
         --     WHILE loop always adds 1
         --
         --     FOR loop adds 1 unless we can detect that in any case this
         --          loop will be executes at least once
         --
         --     LOOP (condition-less) adds nothing
         --
         --     EXIT statement adds 1 if contains the exit condition, otherwise
         --          adds nothing
         --
         --     GOTO statement adds nothing
         --
         --     RETURN statement adds nothing
         --
         --     SELECT STATEMENTS:
         --
         --        SELECTIVE_ACCEPT is treaded as a CASE statement (number of
         --           alternatives minus 1). Opposite to IF statement, ELSE
         --           path adds 1 to the complexity (that is, for IF,
         --           both IF ... END IF; and IF ... ELSE ... END IF; adds 1,
         --           whereas
         --              SELECT
         --                 ...
         --              OR
         --                 ...
         --              END SELECT;
         --           adds 1, but
         --
         --              SELECT
         --                 ...
         --              OR
         --                 ...
         --              ELSE
         --                 ...
         --              END SELECT;
         --           adds 2
         --
         --        TIMED_ENTRY_CALL, CONDITIONAL_ENTRY_CALL and
         --        ASYNCHRONOUS_SELECT add 1 (they are considered as an IF
         --           statement with no ELSIF parts
         --
         --  2. We do not check if some code or some path is dead (unreachable)
         --
         --  3. We do not take into account the code in the exception handlers
         --     (only the main statement sequence is analyzed). RAISE statement
         --     adds nothing
         --
         --  4. A short-circuit control form add to the complexity value the
         --     number of AND THEN or OR ELSE at the given level (that is, if
         --     we have
         --
         --       Bool := A and then (B and then C) and then E;
         --
         --     we consider this as two short-circuit control forms: the outer
         --     adds to the complexity 2 and the inner adds 1.
         --
         --     Any short-circuit control form is taken into account, including
         --     expressions being parts of type and object definitions.
         --
         --  5. Any enclosed body is just skipped and is not taken into
         --     account (But the statements from enclosed package body are
         --     executed when this body is elaborated - is it a hole in
         --     complexity computation???)
         --

         case Arg_Kind is

            when Flat_Statement_Kinds =>

               Tmp := Statement_Complexity (Element);

               if not Is_Static_Loop (Element) then
                  Stmt_Complexity := Stmt_Complexity + Tmp;
               end if;

               if Arg_Kind = A_Loop_Statement then
                  --  We do not count unconditional loops when computing
                  --  cyclomatic complexity (But why?)
                  Tmp := 1;
               end if;

               if Tmp > 0                      and then
                  Compute_Essential_Complexity and then
                  Is_Non_Structural_Statement (Element, Treat_Exit_As_Goto)
               then
                  Essential_Complexity := Essential_Complexity + Tmp;
               end if;

               if Compute_Loop_Nesting and then
                  Arg_Kind in A_Loop_Statement .. A_For_Loop_Statement
               then
                  State.Loop_Nesting := State.Loop_Nesting + 1;

                  if Max_Loop_Nesting < State.Loop_Nesting then
                     Max_Loop_Nesting := State.Loop_Nesting;
                  end if;

               end if;

            when An_And_Then_Short_Circuit |
                 An_Or_Else_Short_Circuit  =>

               if Compute_Cyclomatic_Complexity then
                  Short_Circuit_Complexity :=
                    Short_Circuit_Complexity +
                    Control_Form_Complexity (Element);
               end if;

            when Flat_Definition_Kinds                               |
                 An_Ordinary_Type_Declaration                        |
                 A_Protected_Type_Declaration                        |
                 An_Incomplete_Type_Declaration                      |
                 A_Private_Type_Declaration                          |
                 A_Private_Extension_Declaration                     |
                 A_Subtype_Declaration                               |
                 A_Deferred_Constant_Declaration                     |
                 A_Single_Task_Declaration                           |
                 A_Single_Protected_Declaration                      |
                 An_Integer_Number_Declaration                       |
                 A_Real_Number_Declaration                           |
                 A_Procedure_Declaration                             |
                 A_Function_Declaration                              |
                 An_Object_Renaming_Declaration ..
                 A_Generic_Function_Renaming_Declaration             |
                 A_Protected_Body_Declaration                        |
                 An_Entry_Declaration                                |
                 A_Procedure_Body_Stub ..  A_Protected_Body_Stub     |
                 An_Exception_Declaration                            |
                 A_Generic_Procedure_Declaration ..
                 A_Generic_Package_Declaration                       |
                 A_Package_Instantiation .. A_Function_Instantiation |
                 A_Formal_Object_Declaration ..
                 A_Formal_Package_Declaration_With_Box               |
                 An_Exception_Handler                                |
                 Flat_Clause_Kinds                                   =>

               --  We just do not go inside
               Control := Abandon_Children;

            when A_Procedure_Body_Declaration |
                 A_Function_Body_Declaration  |
                 A_Package_Body_Declaration   |
                 A_Task_Body_Declaration      |
                 An_Entry_Body_Declaration    =>

               if not Is_Equal (Element, Body_El) then
                  --  We do not go inside local bodies
                  Control := Abandon_Children;
               end if;

            when others =>
               null;
         end case;

      end Check_Complexity;

      ------------------------
      -- Complexity_Post_Op --
      ------------------------

      procedure Complexity_Post_Op
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Complexity_State_Type)
      is
         pragma Unreferenced (Control);
         El_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);
      begin

         if Compute_Loop_Nesting and then
            El_Kind in A_Loop_Statement .. A_For_Loop_Statement
         then
            State.Loop_Nesting := State.Loop_Nesting - 1;
         end if;

      end Complexity_Post_Op;

   begin  --  Compute_Complexity

      Collect_Complexity (Body_El, Control, State);

      Report ("");
      Report ("=== Complexity metrics ===", Depth => Depth);

      if Compute_Cyclomatic_Complexity then
         Report ("statement complexity     :" &
                 Stmt_Complexity'Img,
                 Depth => Depth + 1);

         Output_XML_Metric
           ("statement_complexity",
            Stmt_Complexity,
            Depth => Depth + 3);

         Report ("short-circuit complexity :" & Short_Circuit_Complexity'Img,
                 Depth => Depth + 1);

         Output_XML_Metric
           ("short_circuit_complexity",
            Short_Circuit_Complexity,
            Depth => Depth + 3);

         Cyclomatic_Complexity := Stmt_Complexity + Short_Circuit_Complexity;

         Report ("cyclomatic complexity    :" & Cyclomatic_Complexity'Img,
                  Depth => Depth + 1);

         Output_XML_Metric
           ("cyclomatic_complexity",
            Cyclomatic_Complexity,
            Depth => Depth + 3);

      end if;

      if Compute_Essential_Complexity then
         Report ("essential complexity     :" & Essential_Complexity'Img,
                 Depth => Depth + 1);

         Output_XML_Metric
           ("essential_complexity",
            Essential_Complexity,
            Depth => Depth + 3);
      end if;

      if Compute_Loop_Nesting then
         Report
           ("maximum loop nesting     :" & Max_Loop_Nesting'Img,
            Depth => Depth + 1);

         Output_XML_Metric
           ("max_loop_nesting",
            Max_Loop_Nesting,
            Depth => Depth + 3);
      end if;

   exception
      when Ex : others =>
         Report
           ("Failed to compute the complexity",
           Depth => Depth + 1);
         Report_Unhandled_ASIS_Exception (Ex);
   end Compute_Complexity;

   --------------------------
   -- Compute_Line_Metrics --
   --------------------------

   function Compute_Line_Metrics
     (SF :   SF_Id   := No_SF_Id;
      El :   Element := Nil_Element)
      return Line_Metrics_Record
   is
      Result   : Line_Metrics_Record := Zero_Line_Metrics;
      The_Span : Span;
   begin

      if not Line_Metrics_Set or else
         (SF = No_SF_Id
            and then
         (Is_Nil (El) or else not Is_Text_Available (El)))
      then
         return Zero_Line_Metrics;
      end if;

      if SF /= No_SF_Id then
         The_Span := Compilation_Span (The_Unit);
      else
         The_Span := Element_Span (El);
      end if;

      if Compute_All_Lines then
         Result.All_Lines :=
           Metric_Count (The_Span.Last_Line - The_Span.First_Line + 1);
      end if;

      if Selective_Line_Metrics_Set then

         declare
            Source_Lines : constant Line_List := Lines (The_Unit, The_Span);
            Current_Line_Kind : Line_Kinds;
         begin

            for J in Source_Lines'Range loop

               if Compute_Code_Lines    or else
                  Compute_Comment_Lines or else
                  Compute_Blank_Lines
               then
                  Current_Line_Kind :=
                    Line_Kind (Line_Image (Source_Lines (J)));

                  case Current_Line_Kind is
                     when Blank_Line =>

                        if Compute_Blank_Lines then
                           Result.Blank_Lines := Result.Blank_Lines + 1;
                        end if;

                     when Code_Line =>

                        if Compute_Code_Lines then
                           Result.Code_Lines := Result.Code_Lines + 1;
                        end if;

                     when Comment_Line =>

                        if Compute_Comment_Lines then
                           Result.Comment_Lines := Result.Comment_Lines + 1;
                        end if;

                  end case;

               end if;

               if Compute_EOL_Comments          and then
                  Current_Line_Kind = Code_Line and then
                  Comment_Image (Source_Lines (J))'Length /= 0
               then
                  Result.EOL_Comments := Result.EOL_Comments + 1;
               end if;

            end loop;

         end;

      end if;

      return Result;

   exception
   --  In case of an ASIS exception we report it and go ahead with computing
   --  other metrics for other sources. Otherwise we let the exception
   --  propagate out of this routine to raise Fatal_Error at upper level
      when Ex : Asis.Exceptions.ASIS_Inappropriate_Context          |
                Asis.Exceptions.ASIS_Inappropriate_Container        |
                Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit |
                Asis.Exceptions.ASIS_Inappropriate_Element          |
                Asis.Exceptions.ASIS_Inappropriate_Line             |
                Asis.Exceptions.ASIS_Inappropriate_Line_Number      |
                Asis.Exceptions.ASIS_Failed                         =>

         METRICS.Output.Report_Unhandled_ASIS_Exception (Ex);

         if SF /= No_SF_Id then
            Set_Source_Status (SF, Error_Detected);
         end if;

         Asis.Implementation.Set_Status;

         return Zero_Line_Metrics;
   end Compute_Line_Metrics;

   ---------------------
   -- Compute_Metrics --
   ---------------------

   procedure Compute_Metrics is
   begin

      if ASIS_UL.Options.ASIS_2005_Mode then
         Asis.Implementation.Initialize ("-asis05 -ws");
      else
         Asis.Implementation.Initialize ("-ws");
      end if;

      Process_Sources (Only_Bodies => True);
      Process_Sources;

      Asis.Implementation.Finalize;
   end Compute_Metrics;

   --------------------------
   -- Compute_Unit_Metrics --
   --------------------------

   procedure Compute_Unit_Metrics
     (The_CU : Asis.Compilation_Unit;
      SF     : SF_Id)
   is
      File_Line_Metrics : Line_Metrics_Record;
   begin
      The_Unit := Unit_Declaration (The_CU);

      CU_Kind  := Unit_Kind (The_CU);
      CU_Class := Unit_Class (The_CU);

      Set_Global_Metrics_Flags;

      File_Line_Metrics := Compute_Line_Metrics (SF);

      Set_All_Lines     (SF, File_Line_Metrics.All_Lines);
      Set_Code_Lines    (SF, File_Line_Metrics.Code_Lines);
      Set_Comment_Lines (SF, File_Line_Metrics.Comment_Lines);
      Set_EOL_Comments  (SF, File_Line_Metrics.EOL_Comments);
      Set_Blank_Lines   (SF, File_Line_Metrics.Blank_Lines);

      Set_Source_Out_File (SF);

      Generate_Header (SF);

      Generate_Line_Output (SF);

      --  Compute_Element_Metrics (SF);

      Compute_And_Report_Element_Metrics
        (Program_Unit         => The_Unit,
         Nesting_Level        => 0,
         SF                   => SF,
         Include_Nested_Units => Compute_Local_Metrics);

      --  Generate_Element_Output (SF);

      if Source_Status (SF) /=  Error_Detected then
         Set_Source_Status (SF, Processed);
      end if;

      if Is_Open (Source_Output_File) then
         Close (Source_Output_File);
      end if;

      Close_Tag ("file", Depth => 1);

   end Compute_Unit_Metrics;

   -----------------
   -- Create_Tree --
   -----------------
   procedure Create_Tree (SF : SF_Id; Success : out Boolean) is
   begin

      if Debug_Output then
         Info ("gnatmetric: Creating the tree for " & Source_Name (SF));

         Info_No_EOL ("gcc -c -gnatc -gnatt -gnatws");

         for J in Arg_List'Range loop
            Info_No_EOL (" " &  Arg_List (J).all);
         end loop;

         Info (" -x ada " &  Source_Name (SF));
      end if;

      Compile
       (new String'(Source_Name (SF)),
        Arg_List.all,
        Success,
        GCC => ASIS_UL.Common.Gcc_To_Call);

   end Create_Tree;

   --------------------
   -- Is_White_Space --
   --------------------

   function Is_White_Space (W_Ch : Wide_Character) return Boolean is
      Ch : constant Character := To_Character (W_Ch);
   begin
      return (False
         or else Ch = ' '
         or else Ch = ASCII.HT);
   end Is_White_Space;

   ---------------
   -- Line_Kind --
   ---------------

   function Line_Kind (Line_Img : Program_Text) return Line_Kinds is
      Idx       : Natural    := 0;
      Result    : Line_Kinds := Blank_Line;
   begin

      for J in Line_Img'Range loop

         if not Is_White_Space (Line_Img (J)) then
            Idx := J;
            exit;
         end if;

      end loop;

      if Idx > 0 then

         if Line_Img (Idx) = '-' and then
            Idx < Line_Img'Last  and then
            Line_Img (Idx + 1) = '-'
         then
            Result := Comment_Line;
         else
            Result := Code_Line;
         end if;

      end if;

      return Result;

   end Line_Kind;

   -------------------
   -- Output_Source --
   -------------------

   procedure Output_Source (SF : SF_Id) is
      N : constant String := Natural'Image (Sources_Left);
   begin

      if Progress_Indicator_Mode then
         declare
            Current : constant Integer := Total_Sources - Sources_Left + 1;
            Percent : String :=
              Integer'Image ((Current * 100) / Total_Sources);
         begin
            Percent (1) := '(';
            Put_Line (Standard_Output,
                     "completed" & Integer'Image (Current) & " out of"
                    & Integer'Image (Total_Sources) & " "
                    & Percent & "%)...");
         end;
      end if;

      if Verbose_Mode then
         Info ("[" & N (2 .. N'Last) & "]  " & Short_Source_Name (SF));

      elsif not (Quiet_Mode or Progress_Indicator_Mode) then
         Info_No_EOL ("Units remaining:");
         Info_No_EOL (N);
         Info_No_EOL ("     ");
         Info_No_EOL ((1 => ASCII.CR));
      end if;

      Sources_Left := Sources_Left - 1;

   end Output_Source;

   --------------------------
   -- Process__Main_Source --
   --------------------------

   procedure Process_Main_Source (SF : SF_Id) is
      Success : Boolean;
      use type Asis.Errors.Error_Kinds; --  for EC12-013
   begin

      Output_Source (SF);

      Create_Tree (SF, Success);

      if not Success then
         Set_Source_Status (SF, Not_A_Legal_Source);

         Error ("gnatmetric: " & Source_Name (SF) &
                " is not a legal Ada source");

         GNATMETRIC_Exit_Status := Ada.Command_Line.Failure;

         return;

      end if;

      Associate
       (The_Context => The_Context,
        Name        => "",
        Parameters  => "-C1 "
                      & To_Wide_String (Suffixless_Name (SF) & ".adt"));

      declare
         use type Asis.Errors.Error_Kinds;
      begin
         Open (The_Context);
         Success := True;
      exception
         when ASIS_Failed =>
            --  The only known situation when we can not open a C1 context for
            --  newly created tree is recompilation of System (see D617-017)

            if Asis.Implementation.Status = Asis.Errors.Use_Error
              and then
               Asis.Implementation.Diagnosis = "Internal implementation error:"
               & " Asis.Ada_Environments.Open - System is recompiled"
            then
               Error
                 ("gnatmetric: can not process redefinition of System in " &
                    Source_Name (SF));

               Set_Source_Status (SF, Not_A_Legal_Source);
               Success := False;
            else
               raise;
            end if;

      end;

      if Success then

         The_CU := Main_Unit_In_Current_Tree (The_Context);
         Compute_Unit_Metrics (The_CU, SF);

         declare
            All_CUs : constant Compilation_Unit_List :=
              Asis.Compilation_Units.Compilation_Units (The_Context);
            Next_SF : SF_Id;
         begin

            for J in All_CUs'Range loop

               if Unit_Origin (All_CUs (J)) = An_Application_Unit then
                  --  It is rather unlikely that a metrics tool will be used
                  --  for non-user-provided units

                  Next_SF :=
                    File_Find (Normalize_Pathname
                      (To_String (Text_Name (All_CUs (J))),
                       Resolve_Links  => False,
                       Case_Sensitive => False));

                  if Present (Next_SF) and then
                     Source_Status (Next_SF) = Waiting
                  then
                     The_CU := All_CUs (J);
                     Output_Source (Next_SF);
                     Compute_Unit_Metrics (All_CUs (J), Next_SF);
                  end if;

               end if;

            end loop;

         exception
            when Ex : others =>
               Error ("gnatmetric: unknown bug detected when processing " &
                     Source_Name (Next_SF));
               Error ("Please submit bug report to report@gnat.com");
               Report_Unhandled_Exception (Ex);
               Source_Clean_Up (Next_SF);
               raise Fatal_Error;

         end;

      end if;

      Source_Clean_Up (SF);

   exception

      when Program_Error =>
         Error ("gnatmetric: installation problem - check gnatmetric and " &
                "GNAT versions");
         raise Fatal_Error;

      when Fatal_Error =>
         raise;

      when Ex : others =>

         if Asis.Implementation.Status = Asis.Errors.Use_Error
           and then
            Asis.Implementation.Diagnosis =
            "Cannot process Ada sources compiled with -gnat05"
         then
            --  EC12-013: This path should be removed when ASIS 2005 is
            --  implemented
            Error ("gnatmetric: Ada 2005 not supported yet, exiting");
         else
            Error ("gnatmetric: unknown bug detected when processing " &
                    Source_Name (SF));
            Error ("Please submit bug report to report@gnat.com");
            Report_Unhandled_Exception (Ex);
         end if;

         Source_Clean_Up (SF);
         raise Fatal_Error;

   end Process_Main_Source;

   ---------------------
   -- Process_Sources --
   ---------------------

   procedure Process_Sources (Only_Bodies : Boolean := False) is
      Next_SF : SF_Id;
   begin
      Reset_Source_Iterator;

      Next_SF := Next_Non_Processed_Source (Only_Bodies);

      while Present (Next_SF) loop
         Process_Main_Source (Next_SF);
         Next_SF := Next_Non_Processed_Source (Only_Bodies);
      end loop;

   end Process_Sources;

end METRICS.Compute;
