prj-proc.adb   [plain text]

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              P R J . P R O C                             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                                                                          --
--          Copyright (C) 2001-2002 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- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty 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,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Errout;   use Errout;
with Namet;    use Namet;
with Opt;
with Output;   use Output;
with Prj.Attr; use Prj.Attr;
with Prj.Com;  use Prj.Com;
with Prj.Ext;  use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
with Stringt;  use Stringt;

with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.HTable;

package body Prj.Proc is

   Error_Report : Put_Line_Access := null;

   package Processed_Projects is new GNAT.HTable.Simple_HTable
     (Header_Num => Header_Num,
      Element    => Project_Id,
      No_Element => No_Project,
      Key        => Name_Id,
      Hash       => Hash,
      Equal      => "=");
   --  This hash table contains all processed projects

   procedure Add (To_Exp : in out String_Id; Str : String_Id);
   --  Concatenate two strings and returns another string if both
   --  arguments are not null string.

   procedure Add_Attributes
     (Decl     : in out Declarations;
      First    : Attribute_Node_Id);
   --  Add all attributes, starting with First, with their default
   --  values to the package or project with declarations Decl.

   function Expression
     (Project           : Project_Id;
      From_Project_Node : Project_Node_Id;
      Pkg               : Package_Id;
      First_Term        : Project_Node_Id;
      Kind              : Variable_Kind)
      return              Variable_Value;
   --  From N_Expression project node From_Project_Node, compute the value
   --  of an expression and return it as a Variable_Value.

   function Imported_Or_Modified_Project_From
     (Project   : Project_Id;
      With_Name : Name_Id)
      return      Project_Id;
   --  Find an imported or modified project of Project whose name is With_Name

   function Package_From
     (Project   : Project_Id;
      With_Name : Name_Id)
      return      Package_Id;
   --  Find the package of Project whose name is With_Name

   procedure Process_Declarative_Items
     (Project           : Project_Id;
      From_Project_Node : Project_Node_Id;
      Pkg               : Package_Id;
      Item              : Project_Node_Id);
   --  Process declarative items starting with From_Project_Node, and put them
   --  in declarations Decl. This is a recursive procedure; it calls itself for
   --  a package declaration or a case construction.

   procedure Recursive_Process
     (Project           : out Project_Id;
      From_Project_Node : Project_Node_Id;
      Modified_By       : Project_Id);
   --  Process project with node From_Project_Node in the tree.
   --  Do nothing if From_Project_Node is Empty_Node.
   --  If project has already been processed, simply return its project id.
   --  Otherwise create a new project id, mark it as processed, call itself
   --  recursively for all imported projects and a modified project, if any.
   --  Then process the declarative items of the project.

   procedure Check (Project : in out Project_Id);
   --  Set all projects to not checked, then call Recursive_Check for the
   --  main project Project. Project is set to No_Project if errors occurred.

   procedure Recursive_Check (Project : Project_Id);
   --  If Project is marked as not checked, mark it as checked, call
   --  Check_Naming_Scheme for the project, then call itself for a
   --  possible modified project and all the imported projects of Project.

   ---------
   -- Add --
   ---------

   procedure Add (To_Exp : in out String_Id; Str : String_Id) is
   begin
      if To_Exp = Types.No_String or else String_Length (To_Exp) = 0 then

         --  To_Exp is nil or empty. The result is Str.

         To_Exp := Str;

      --  If Str is nil, then do not change To_Ext

      elsif Str /= No_String then
         Start_String (To_Exp);
         Store_String_Chars (Str);
         To_Exp := End_String;
      end if;
   end Add;

   --------------------
   -- Add_Attributes --
   --------------------

   procedure Add_Attributes
     (Decl           : in out Declarations;
      First          : Attribute_Node_Id) is
      The_Attribute  : Attribute_Node_Id := First;
      Attribute_Data : Attribute_Record;

   begin
      while The_Attribute /= Empty_Attribute loop
         Attribute_Data := Attributes.Table (The_Attribute);

         if Attribute_Data.Kind_2 /= Associative_Array then
            declare
               New_Attribute : Variable_Value;

            begin
               case Attribute_Data.Kind_1 is

                  --  Undefined should not happen

                  when Undefined =>
                     pragma Assert
                       (False, "attribute with an undefined kind");
                     raise Program_Error;

                  --  Single attributes have a default value of empty string

                  when Single =>
                     New_Attribute :=
                       (Kind     => Single,
                        Location => No_Location,
                        Default  => True,
                        Value    => Empty_String);

                  --  List attributes have a default value of nil list

                  when List =>
                     New_Attribute :=
                       (Kind     => List,
                        Location => No_Location,
                        Default  => True,
                        Values   => Nil_String);

               end case;

               Variable_Elements.Increment_Last;
               Variable_Elements.Table (Variable_Elements.Last) :=
                 (Next  => Decl.Attributes,
                  Name  => Attribute_Data.Name,
                  Value => New_Attribute);
               Decl.Attributes := Variable_Elements.Last;
            end;
         end if;

         The_Attribute := Attributes.Table (The_Attribute).Next;
      end loop;

   end Add_Attributes;

   -----------
   -- Check --
   -----------

   procedure Check (Project : in out Project_Id) is
   begin
      --  Make sure that all projects are marked as not checked

      for Index in 1 .. Projects.Last loop
         Projects.Table (Index).Checked := False;
      end loop;

      Recursive_Check (Project);

      if Errout.Total_Errors_Detected > 0 then
         Project := No_Project;
      end if;

   end Check;

   ----------------
   -- Expression --
   ----------------

   function Expression
     (Project           : Project_Id;
      From_Project_Node : Project_Node_Id;
      Pkg               : Package_Id;
      First_Term        : Project_Node_Id;
      Kind              : Variable_Kind)
      return              Variable_Value
   is
      The_Term : Project_Node_Id := First_Term;
      --  The term in the expression list

      The_Current_Term : Project_Node_Id := Empty_Node;
      --  The current term node id

      Term_Kind : Variable_Kind;
      --  The kind of the current term

      Result : Variable_Value (Kind => Kind);
      --  The returned result

      Last : String_List_Id := Nil_String;
      --  Reference to the last string elements in Result, when Kind is List.

   begin
      Result.Location := Location_Of (First_Term);

      --  Process each term of the expression, starting with First_Term

      while The_Term /= Empty_Node loop

         --  We get the term data and kind ...

         Term_Kind := Expression_Kind_Of (The_Term);

         The_Current_Term := Current_Term (The_Term);

         case Kind_Of (The_Current_Term) is

            when N_Literal_String =>

               case Kind is

                  when Undefined =>

                     --  Should never happen

                     pragma Assert (False, "Undefined expression kind");
                     raise Program_Error;

                  when Single =>
                     Add (Result.Value, String_Value_Of (The_Current_Term));

                  when List =>

                     String_Elements.Increment_Last;

                     if Last = Nil_String then

                        --  This can happen in an expression such as
                        --  () & "toto"

                        Result.Values := String_Elements.Last;

                     else
                        String_Elements.Table (Last).Next :=
                          String_Elements.Last;
                     end if;

                     Last := String_Elements.Last;
                     String_Elements.Table (Last) :=
                       (Value    => String_Value_Of (The_Current_Term),
                        Location => Location_Of (The_Current_Term),
                        Next     => Nil_String);

               end case;

            when N_Literal_String_List =>

               declare
                  String_Node : Project_Node_Id :=
                                  First_Expression_In_List (The_Current_Term);

                  Value : Variable_Value;

               begin
                  if String_Node /= Empty_Node then

                     --  If String_Node is nil, it is an empty list,
                     --  there is nothing to do

                     Value := Expression
                       (Project           => Project,
                        From_Project_Node => From_Project_Node,
                        Pkg               => Pkg,
                        First_Term        => Tree.First_Term (String_Node),
                        Kind              => Single);
                     String_Elements.Increment_Last;

                     if Result.Values = Nil_String then

                        --  This literal string list is the first term
                        --  in a string list expression

                        Result.Values := String_Elements.Last;

                     else
                        String_Elements.Table (Last).Next :=
                          String_Elements.Last;
                     end if;

                     Last := String_Elements.Last;
                     String_Elements.Table (Last) :=
                       (Value    => Value.Value,
                        Location => Value.Location,
                        Next     => Nil_String);

                     loop
                        --  Add the other element of the literal string list
                        --  one after the other

                        String_Node :=
                          Next_Expression_In_List (String_Node);

                        exit when String_Node = Empty_Node;

                        Value :=
                          Expression
                          (Project           => Project,
                           From_Project_Node => From_Project_Node,
                           Pkg               => Pkg,
                           First_Term        => Tree.First_Term (String_Node),
                           Kind              => Single);

                        String_Elements.Increment_Last;
                        String_Elements.Table (Last).Next :=
                          String_Elements.Last;
                        Last := String_Elements.Last;
                        String_Elements.Table (Last) :=
                          (Value    => Value.Value,
                           Location => Value.Location,
                           Next     => Nil_String);
                     end loop;

                  end if;

               end;

            when N_Variable_Reference | N_Attribute_Reference =>

               declare
                  The_Project     : Project_Id  := Project;
                  The_Package     : Package_Id  := Pkg;
                  The_Name        : Name_Id     := No_Name;
                  The_Variable_Id : Variable_Id := No_Variable;
                  The_Variable    : Variable_Value;
                  Term_Project    : constant Project_Node_Id :=
                                      Project_Node_Of (The_Current_Term);
                  Term_Package    : constant Project_Node_Id :=
                                      Package_Node_Of (The_Current_Term);
                  Index           : String_Id   := No_String;

               begin
                  if Term_Project /= Empty_Node and then
                     Term_Project /= From_Project_Node
                  then
                     --  This variable or attribute comes from another project

                     The_Name := Name_Of (Term_Project);
                     The_Project := Imported_Or_Modified_Project_From
                       (Project => Project, With_Name => The_Name);
                  end if;

                  if Term_Package /= Empty_Node then

                     --  This is an attribute of a package

                     The_Name := Name_Of (Term_Package);
                     The_Package := Projects.Table (The_Project).Decl.Packages;

                     while The_Package /= No_Package
                       and then Packages.Table (The_Package).Name /= The_Name
                     loop
                        The_Package := Packages.Table (The_Package).Next;
                     end loop;

                     pragma Assert
                       (The_Package /= No_Package,
                        "package not found.");

                  elsif Kind_Of (The_Current_Term) = N_Attribute_Reference then
                     The_Package := No_Package;
                  end if;

                  The_Name := Name_Of (The_Current_Term);

                  if Kind_Of (The_Current_Term) = N_Attribute_Reference then
                     Index := Associative_Array_Index_Of (The_Current_Term);
                  end if;

                  --  If it is not an associative array attribute

                  if Index = No_String then

                     --  It is not an associative array attribute

                     if The_Package /= No_Package then

                        --  First, if there is a package, look into the package

                        if
                          Kind_Of (The_Current_Term) = N_Variable_Reference
                        then
                           The_Variable_Id :=
                             Packages.Table (The_Package).Decl.Variables;

                        else
                           The_Variable_Id :=
                             Packages.Table (The_Package).Decl.Attributes;
                        end if;

                        while The_Variable_Id /= No_Variable
                          and then
                          Variable_Elements.Table (The_Variable_Id).Name /=
                          The_Name
                        loop
                           The_Variable_Id :=
                             Variable_Elements.Table (The_Variable_Id).Next;
                        end loop;

                     end if;

                     if The_Variable_Id = No_Variable then

                        --  If we have not found it, look into the project

                        if
                          Kind_Of (The_Current_Term) = N_Variable_Reference
                        then
                           The_Variable_Id :=
                             Projects.Table (The_Project).Decl.Variables;

                        else
                           The_Variable_Id :=
                             Projects.Table (The_Project).Decl.Attributes;
                        end if;

                        while The_Variable_Id /= No_Variable
                          and then
                          Variable_Elements.Table (The_Variable_Id).Name /=
                          The_Name
                        loop
                           The_Variable_Id :=
                             Variable_Elements.Table (The_Variable_Id).Next;
                        end loop;

                     end if;

                     pragma Assert (The_Variable_Id /= No_Variable,
                                      "variable or attribute not found");

                     The_Variable := Variable_Elements.Table
                                                    (The_Variable_Id).Value;

                  else

                     --  It is an associative array attribute

                     declare
                        The_Array   : Array_Id := No_Array;
                        The_Element : Array_Element_Id := No_Array_Element;
                        Array_Index : Name_Id := No_Name;
                     begin
                        if The_Package /= No_Package then
                           The_Array :=
                             Packages.Table (The_Package).Decl.Arrays;

                        else
                           The_Array :=
                             Projects.Table (The_Project).Decl.Arrays;
                        end if;

                        while The_Array /= No_Array
                          and then Arrays.Table (The_Array).Name /= The_Name
                        loop
                           The_Array := Arrays.Table (The_Array).Next;
                        end loop;

                        if The_Array /= No_Array then
                           The_Element := Arrays.Table (The_Array).Value;

                           String_To_Name_Buffer (Index);

                           if Case_Insensitive (The_Current_Term) then
                              To_Lower (Name_Buffer (1 .. Name_Len));
                           end if;

                           Array_Index := Name_Find;

                           while The_Element /= No_Array_Element
                             and then Array_Elements.Table (The_Element).Index
                                                         /= Array_Index
                           loop
                              The_Element :=
                                Array_Elements.Table (The_Element).Next;
                           end loop;

                        end if;

                        if The_Element /= No_Array_Element then
                           The_Variable :=
                             Array_Elements.Table (The_Element).Value;

                        else
                           if
                             Expression_Kind_Of (The_Current_Term) = List
                           then
                              The_Variable :=
                                (Kind     => List,
                                 Location => No_Location,
                                 Default  => True,
                                 Values   => Nil_String);

                           else
                              The_Variable :=
                                (Kind     => Single,
                                 Location => No_Location,
                                 Default  => True,
                                 Value    => Empty_String);
                           end if;

                        end if;

                     end;

                  end if;

                  case Kind is

                     when Undefined =>

                        --  Should never happen

                        pragma Assert (False, "undefined expression kind");
                        null;

                     when Single =>

                        case The_Variable.Kind is

                           when Undefined =>
                              null;

                           when Single =>
                              Add (Result.Value, The_Variable.Value);

                           when List =>

                              --  Should never happen

                              pragma Assert
                                (False,
                                 "list cannot appear in single " &
                                 "string expression");
                              null;

                        end case;

                     when List =>
                        case The_Variable.Kind is

                           when Undefined =>
                              null;

                           when Single =>
                              String_Elements.Increment_Last;

                              if Last = Nil_String then

                                 --  This can happen in an expression such as
                                 --  () & Var

                                 Result.Values := String_Elements.Last;

                              else
                                 String_Elements.Table (Last).Next :=
                                   String_Elements.Last;
                              end if;

                              Last := String_Elements.Last;
                              String_Elements.Table (Last) :=
                                (Value    => The_Variable.Value,
                                 Location => Location_Of (The_Current_Term),
                                 Next     => Nil_String);

                           when List =>

                              declare
                                 The_List : String_List_Id :=
                                              The_Variable.Values;

                              begin
                                 while The_List /= Nil_String loop
                                    String_Elements.Increment_Last;

                                    if Last = Nil_String then
                                       Result.Values := String_Elements.Last;

                                    else
                                       String_Elements.Table (Last).Next :=
                                         String_Elements.Last;

                                    end if;

                                    Last := String_Elements.Last;
                                    String_Elements.Table (Last) :=
                                      (Value    =>
                                         String_Elements.Table
                                                          (The_List).Value,
                                       Location => Location_Of
                                                          (The_Current_Term),
                                       Next     => Nil_String);
                                    The_List :=
                                      String_Elements.Table (The_List).Next;

                                 end loop;
                              end;
                        end case;
                  end case;
               end;

            when N_External_Value =>
               String_To_Name_Buffer
                 (String_Value_Of (External_Reference_Of (The_Current_Term)));

               declare
                  Name    : constant Name_Id  := Name_Find;
                  Default : String_Id         := No_String;
                  Value   : String_Id         := No_String;

                  Default_Node : constant Project_Node_Id :=
                                   External_Default_Of (The_Current_Term);

               begin
                  if Default_Node /= Empty_Node then
                     Default := String_Value_Of (Default_Node);
                  end if;

                  Value := Prj.Ext.Value_Of (Name, Default);

                  if Value = No_String then
                     if Error_Report = null then
                        Error_Msg
                          ("undefined external reference",
                           Location_Of (The_Current_Term));

                     else
                        Error_Report
                          ("""" & Get_Name_String (Name) &
                           """ is an undefined external reference",
                           Project);
                     end if;

                     Value := Empty_String;

                  end if;

                  case Kind is

                     when Undefined =>
                        null;

                     when Single =>
                        Add (Result.Value, Value);

                     when List =>
                        String_Elements.Increment_Last;

                        if Last = Nil_String then
                           Result.Values := String_Elements.Last;

                        else
                           String_Elements.Table (Last).Next :=
                             String_Elements.Last;
                        end if;

                        Last := String_Elements.Last;
                        String_Elements.Table (Last) :=
                          (Value    => Value,
                           Location => Location_Of (The_Current_Term),
                           Next     => Nil_String);

                  end case;

               end;

            when others =>

               --  Should never happen

               pragma Assert
                 (False,
                  "illegal node kind in an expression");
               raise Program_Error;

         end case;

         The_Term := Next_Term (The_Term);
      end loop;

      return Result;
   end Expression;

   ---------------------------------------
   -- Imported_Or_Modified_Project_From --
   ---------------------------------------

   function Imported_Or_Modified_Project_From
     (Project   : Project_Id;
      With_Name : Name_Id)
      return      Project_Id
   is
      Data : constant Project_Data := Projects.Table (Project);
      List : Project_List          := Data.Imported_Projects;

   begin
      --  First check if it is the name of a modified project

      if Data.Modifies /= No_Project
        and then Projects.Table (Data.Modifies).Name = With_Name
      then
         return Data.Modifies;

      else
         --  Then check the name of each imported project

         while List /= Empty_Project_List
           and then
             Projects.Table
               (Project_Lists.Table (List).Project).Name /= With_Name

         loop
            List := Project_Lists.Table (List).Next;
         end loop;

         pragma Assert
           (List /= Empty_Project_List,
           "project not found");

         return Project_Lists.Table (List).Project;
      end if;
   end Imported_Or_Modified_Project_From;

   ------------------
   -- Package_From --
   ------------------

   function Package_From
     (Project   : Project_Id;
      With_Name : Name_Id)
      return      Package_Id
   is
      Data   : constant Project_Data := Projects.Table (Project);
      Result : Package_Id := Data.Decl.Packages;

   begin
      --  Check the name of each existing package of Project

      while Result /= No_Package
        and then
        Packages.Table (Result).Name /= With_Name
      loop
         Result := Packages.Table (Result).Next;
      end loop;

      if Result = No_Package then
         --  Should never happen
         Write_Line ("package """ & Get_Name_String (With_Name) &
                     """ not found");
         raise Program_Error;

      else
         return Result;
      end if;
   end Package_From;

   -------------
   -- Process --
   -------------

   procedure Process
     (Project           : out Project_Id;
      From_Project_Node : Project_Node_Id;
      Report_Error      : Put_Line_Access)
   is
   begin
      Error_Report := Report_Error;

      --  Make sure there is no projects in the data structure

      Projects.Set_Last (No_Project);
      Processed_Projects.Reset;

      --  And process the main project and all of the projects it depends on,
      --  recursively

      Recursive_Process
        (Project           => Project,
         From_Project_Node => From_Project_Node,
         Modified_By       => No_Project);

      if Errout.Total_Errors_Detected > 0 then
         Project := No_Project;
      end if;

      if Project /= No_Project then
         Check (Project);
      end if;
   end Process;

   -------------------------------
   -- Process_Declarative_Items --
   -------------------------------

   procedure Process_Declarative_Items
     (Project           : Project_Id;
      From_Project_Node : Project_Node_Id;
      Pkg               : Package_Id;
      Item              : Project_Node_Id) is

      Current_Declarative_Item : Project_Node_Id := Item;

      Current_Item : Project_Node_Id := Empty_Node;

   begin
      --  For each declarative item

      while Current_Declarative_Item /= Empty_Node loop

         --  Get its data

         Current_Item := Current_Item_Node (Current_Declarative_Item);

         --  And set Current_Declarative_Item to the next declarative item
         --  ready for the next iteration

         Current_Declarative_Item := Next_Declarative_Item
                                            (Current_Declarative_Item);

         case Kind_Of (Current_Item) is

            when N_Package_Declaration =>
               Packages.Increment_Last;

               declare
                  New_Pkg         : constant Package_Id := Packages.Last;
                  The_New_Package : Package_Element;

                  Project_Of_Renamed_Package : constant Project_Node_Id :=
                                                 Project_Of_Renamed_Package_Of
                                                   (Current_Item);

               begin
                  The_New_Package.Name := Name_Of (Current_Item);

                  if Pkg /= No_Package then
                     The_New_Package.Next :=
                       Packages.Table (Pkg).Decl.Packages;
                     Packages.Table (Pkg).Decl.Packages := New_Pkg;
                  else
                     The_New_Package.Next :=
                       Projects.Table (Project).Decl.Packages;
                     Projects.Table (Project).Decl.Packages := New_Pkg;
                  end if;

                  Packages.Table (New_Pkg) := The_New_Package;

                  if Project_Of_Renamed_Package /= Empty_Node then

                     --  Renamed package

                     declare
                        Project_Name : constant Name_Id :=
                                         Name_Of
                                           (Project_Of_Renamed_Package);

                        Renamed_Project : constant Project_Id :=
                                            Imported_Or_Modified_Project_From
                                              (Project, Project_Name);

                        Renamed_Package : constant Package_Id :=
                                            Package_From
                                              (Renamed_Project,
                                               Name_Of (Current_Item));

                     begin
                        Packages.Table (New_Pkg).Decl :=
                          Packages.Table (Renamed_Package).Decl;
                     end;

                  else
                     --  Set the default values of the attributes

                     Add_Attributes
                       (Packages.Table (New_Pkg).Decl,
                        Package_Attributes.Table
                           (Package_Id_Of (Current_Item)).First_Attribute);

                     Process_Declarative_Items
                       (Project           => Project,
                        From_Project_Node => From_Project_Node,
                        Pkg               => New_Pkg,
                        Item              => First_Declarative_Item_Of
                                                             (Current_Item));
                  end if;

               end;

            when N_String_Type_Declaration =>

               --  There is nothing to process

               null;

            when N_Attribute_Declaration      |
                 N_Typed_Variable_Declaration |
                 N_Variable_Declaration       =>

                  pragma Assert (Expression_Of (Current_Item) /= Empty_Node,
                                 "no expression for an object declaration");

               declare
                  New_Value : constant Variable_Value :=
                                Expression
                                  (Project           => Project,
                                   From_Project_Node => From_Project_Node,
                                   Pkg               => Pkg,
                                   First_Term        =>
                                     Tree.First_Term (Expression_Of
                                                              (Current_Item)),
                                   Kind              =>
                                     Expression_Kind_Of (Current_Item));

                  The_Variable : Variable_Id := No_Variable;

                  Current_Item_Name : constant Name_Id :=
                                        Name_Of (Current_Item);

               begin
                  if Kind_Of (Current_Item) = N_Typed_Variable_Declaration then

                     if String_Equal (New_Value.Value, Empty_String) then
                        Error_Msg_Name_1 := Name_Of (Current_Item);

                        if Error_Report = null then
                           Error_Msg
                             ("no value defined for %",
                              Location_Of (Current_Item));

                        else
                           Error_Report
                             ("no value defined for " &
                              Get_Name_String (Error_Msg_Name_1),
                              Project);
                        end if;

                     else
                        declare
                           Current_String : Project_Node_Id :=
                                              First_Literal_String
                                                (String_Type_Of
                                                  (Current_Item));

                        begin
                           while Current_String /= Empty_Node
                             and then not String_Equal
                                            (String_Value_Of (Current_String),
                                             New_Value.Value)
                           loop
                              Current_String :=
                                Next_Literal_String (Current_String);
                           end loop;

                           if Current_String = Empty_Node then
                              String_To_Name_Buffer (New_Value.Value);
                              Error_Msg_Name_1 := Name_Find;
                              Error_Msg_Name_2 := Name_Of (Current_Item);

                              if Error_Report = null then
                                 Error_Msg
                                   ("value { is illegal for typed string %",
                                    Location_Of (Current_Item));

                              else
                                 Error_Report
                                   ("value """ &
                                    Get_Name_String (Error_Msg_Name_1) &
                                    """ is illegal for typed string """ &
                                    Get_Name_String (Error_Msg_Name_2) &
                                    """",
                                    Project);
                              end if;
                           end if;
                        end;
                     end if;
                  end if;

                  if Kind_Of (Current_Item) /= N_Attribute_Declaration
                    or else
                      Associative_Array_Index_Of (Current_Item) = No_String
                  then
                     --  Usual case

                     --  Code below really needs more comments ???

                     if Kind_Of (Current_Item) = N_Attribute_Declaration then
                        if Pkg /= No_Package then
                           The_Variable :=
                             Packages.Table (Pkg).Decl.Attributes;

                        else
                           The_Variable :=
                             Projects.Table (Project).Decl.Attributes;
                        end if;

                     else
                        if Pkg /= No_Package then
                           The_Variable :=
                             Packages.Table (Pkg).Decl.Variables;

                        else
                           The_Variable :=
                             Projects.Table (Project).Decl.Variables;
                        end if;

                     end if;

                     while
                       The_Variable /= No_Variable
                         and then
                           Variable_Elements.Table (The_Variable).Name /=
                                                          Current_Item_Name
                     loop
                        The_Variable :=
                          Variable_Elements.Table (The_Variable).Next;
                     end loop;

                     if The_Variable = No_Variable then
                        pragma Assert
                          (Kind_Of (Current_Item) /= N_Attribute_Declaration,
                           "illegal attribute declaration");

                        Variable_Elements.Increment_Last;
                        The_Variable := Variable_Elements.Last;

                        if Pkg /= No_Package then
                           Variable_Elements.Table (The_Variable) :=
                             (Next    =>
                                Packages.Table (Pkg).Decl.Variables,
                              Name    => Current_Item_Name,
                              Value   => New_Value);
                           Packages.Table (Pkg).Decl.Variables := The_Variable;

                        else
                           Variable_Elements.Table (The_Variable) :=
                             (Next    =>
                                Projects.Table (Project).Decl.Variables,
                              Name    => Current_Item_Name,
                              Value   => New_Value);
                           Projects.Table (Project).Decl.Variables :=
                             The_Variable;
                        end if;

                     else
                        Variable_Elements.Table (The_Variable).Value :=
                          New_Value;

                     end if;

                  else
                     --  Associative array attribute

                     String_To_Name_Buffer
                       (Associative_Array_Index_Of (Current_Item));

                     if Case_Insensitive (Current_Item) then
                        GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len));
                     end if;

                     declare
                        The_Array : Array_Id;

                        The_Array_Element : Array_Element_Id :=
                                              No_Array_Element;

                        Index_Name : constant Name_Id := Name_Find;

                     begin

                        if Pkg /= No_Package then
                           The_Array := Packages.Table (Pkg).Decl.Arrays;

                        else
                           The_Array := Projects.Table (Project).Decl.Arrays;
                        end if;

                        while
                          The_Array /= No_Array
                            and then Arrays.Table (The_Array).Name /=
                                                           Current_Item_Name
                        loop
                           The_Array := Arrays.Table (The_Array).Next;
                        end loop;

                        if The_Array = No_Array then
                           Arrays.Increment_Last;
                           The_Array := Arrays.Last;

                           if Pkg /= No_Package then
                              Arrays.Table (The_Array) :=
                                (Name  => Current_Item_Name,
                                 Value => No_Array_Element,
                                 Next  => Packages.Table (Pkg).Decl.Arrays);
                              Packages.Table (Pkg).Decl.Arrays := The_Array;

                           else
                              Arrays.Table (The_Array) :=
                                (Name  => Current_Item_Name,
                                 Value => No_Array_Element,
                                 Next  =>
                                   Projects.Table (Project).Decl.Arrays);
                              Projects.Table (Project).Decl.Arrays :=
                                The_Array;
                           end if;

                        else
                           The_Array_Element := Arrays.Table (The_Array).Value;
                        end if;

                        while The_Array_Element /= No_Array_Element
                          and then
                            Array_Elements.Table (The_Array_Element).Index /=
                                                                  Index_Name
                        loop
                           The_Array_Element :=
                             Array_Elements.Table (The_Array_Element).Next;
                        end loop;

                        if The_Array_Element = No_Array_Element then
                           Array_Elements.Increment_Last;
                           The_Array_Element := Array_Elements.Last;
                           Array_Elements.Table (The_Array_Element) :=
                             (Index  => Index_Name,
                              Value  => New_Value,
                              Next   => Arrays.Table (The_Array).Value);
                           Arrays.Table (The_Array).Value := The_Array_Element;

                        else
                           Array_Elements.Table (The_Array_Element).Value :=
                             New_Value;
                        end if;
                     end;
                  end if;
               end;

            when N_Case_Construction =>
               declare
                  The_Project   : Project_Id      := Project;
                  The_Package   : Package_Id      := Pkg;
                  The_Variable  : Variable_Value  := Nil_Variable_Value;
                  Case_Value    : String_Id       := No_String;
                  Case_Item     : Project_Node_Id := Empty_Node;
                  Choice_String : Project_Node_Id := Empty_Node;
                  Decl_Item     : Project_Node_Id := Empty_Node;

               begin
                  declare
                     Variable_Node : constant Project_Node_Id :=
                                       Case_Variable_Reference_Of
                                         (Current_Item);

                     Var_Id : Variable_Id := No_Variable;
                     Name   : Name_Id     := No_Name;

                  begin
                     if Project_Node_Of (Variable_Node) /= Empty_Node then
                        Name := Name_Of (Project_Node_Of (Variable_Node));
                        The_Project :=
                          Imported_Or_Modified_Project_From (Project, Name);
                     end if;

                     if Package_Node_Of (Variable_Node) /= Empty_Node then
                        Name := Name_Of (Package_Node_Of (Variable_Node));
                        The_Package := Package_From (The_Project, Name);
                     end if;

                     Name := Name_Of (Variable_Node);

                     if The_Package /= No_Package then
                        Var_Id := Packages.Table (The_Package).Decl.Variables;
                        Name := Name_Of (Variable_Node);
                        while Var_Id /= No_Variable
                          and then
                            Variable_Elements.Table (Var_Id).Name /= Name
                        loop
                           Var_Id := Variable_Elements.Table (Var_Id).Next;
                        end loop;
                     end if;

                     if Var_Id = No_Variable
                       and then Package_Node_Of (Variable_Node) = Empty_Node
                     then
                        Var_Id := Projects.Table (The_Project).Decl.Variables;
                        while Var_Id /= No_Variable
                          and then
                            Variable_Elements.Table (Var_Id).Name /= Name
                        loop
                           Var_Id := Variable_Elements.Table (Var_Id).Next;
                        end loop;
                     end if;

                     if Var_Id = No_Variable then

                        --  Should never happen

                        Write_Line ("variable """ &
                                    Get_Name_String (Name) &
                                    """ not found");
                        raise Program_Error;
                     end if;

                     The_Variable := Variable_Elements.Table (Var_Id).Value;

                     if The_Variable.Kind /= Single then

                        --  Should never happen

                        Write_Line ("variable""" &
                                    Get_Name_String (Name) &
                                    """ is not a single string variable");
                        raise Program_Error;
                     end if;

                     Case_Value := The_Variable.Value;
                  end;

                  Case_Item := First_Case_Item_Of (Current_Item);
                  Case_Item_Loop :
                     while Case_Item /= Empty_Node loop
                        Choice_String := First_Choice_Of (Case_Item);

                        if Choice_String = Empty_Node then
                           Decl_Item := First_Declarative_Item_Of (Case_Item);
                           exit Case_Item_Loop;
                        end if;

                        Choice_Loop :
                           while Choice_String /= Empty_Node loop
                              if String_Equal (Case_Value,
                                               String_Value_Of (Choice_String))
                              then
                                 Decl_Item :=
                                   First_Declarative_Item_Of (Case_Item);
                                 exit Case_Item_Loop;
                              end if;

                              Choice_String :=
                                Next_Literal_String (Choice_String);
                           end loop Choice_Loop;
                        Case_Item := Next_Case_Item (Case_Item);
                     end loop Case_Item_Loop;

                  if Decl_Item /= Empty_Node then
                     Process_Declarative_Items
                       (Project           => Project,
                        From_Project_Node => From_Project_Node,
                        Pkg               => Pkg,
                        Item              => Decl_Item);
                  end if;
               end;

            when others =>

               --  Should never happen

               Write_Line ("Illegal declarative item: " &
                           Project_Node_Kind'Image (Kind_Of (Current_Item)));
               raise Program_Error;
         end case;
      end loop;
   end Process_Declarative_Items;

   ---------------------
   -- Recursive_Check --
   ---------------------

   procedure Recursive_Check (Project : Project_Id) is
      Data                  : Project_Data;
      Imported_Project_List : Project_List := Empty_Project_List;

   begin
      --  Do nothing if Project is No_Project, or Project has already
      --  been marked as checked.

      if Project /= No_Project
        and then not Projects.Table (Project).Checked
      then
         Data := Projects.Table (Project);

         --  Call itself for a possible modified project.
         --  (if there is no modified project, then nothing happens).

         Recursive_Check (Data.Modifies);

         --  Call itself for all imported projects

         Imported_Project_List := Data.Imported_Projects;
         while Imported_Project_List /= Empty_Project_List loop
            Recursive_Check
              (Project_Lists.Table (Imported_Project_List).Project);
            Imported_Project_List :=
              Project_Lists.Table (Imported_Project_List).Next;
         end loop;

         --  Mark project as checked

         Projects.Table (Project).Checked := True;

         if Opt.Verbose_Mode then
            Write_Str ("Checking project file """);
            Write_Str (Get_Name_String (Data.Name));
            Write_Line ("""");
         end if;

         Prj.Nmsc.Ada_Check (Project, Error_Report);
      end if;
   end Recursive_Check;

   -----------------------
   -- Recursive_Process --
   -----------------------

   procedure Recursive_Process
     (Project           : out Project_Id;
      From_Project_Node : Project_Node_Id;
      Modified_By       : Project_Id)
   is
      With_Clause : Project_Node_Id;

   begin
      if From_Project_Node = Empty_Node then
         Project := No_Project;

      else
         declare
            Processed_Data   : Project_Data := Empty_Project;
            Imported         : Project_List := Empty_Project_List;
            Declaration_Node : Project_Node_Id := Empty_Node;
            Name             : constant Name_Id :=
                                 Name_Of (From_Project_Node);

         begin
            Project := Processed_Projects.Get (Name);

            if Project /= No_Project then
               return;
            end if;

            Projects.Increment_Last;
            Project := Projects.Last;
            Processed_Projects.Set (Name, Project);

            Processed_Data.Name        := Name;
            Processed_Data.Path_Name   := Path_Name_Of (From_Project_Node);
            Processed_Data.Location    := Location_Of (From_Project_Node);
            Processed_Data.Directory   := Directory_Of (From_Project_Node);
            Processed_Data.Modified_By := Modified_By;
            Processed_Data.Naming      := Standard_Naming_Data;

            Add_Attributes (Processed_Data.Decl, Attribute_First);
            With_Clause := First_With_Clause_Of (From_Project_Node);

            while With_Clause /= Empty_Node loop
               declare
                  New_Project : Project_Id;
                  New_Data    : Project_Data;

               begin
                  Recursive_Process
                    (Project           => New_Project,
                     From_Project_Node => Project_Node_Of (With_Clause),
                     Modified_By       => No_Project);
                  New_Data := Projects.Table (New_Project);

                  --  If we were the first project to import it,
                  --  set First_Referred_By to us.

                  if New_Data.First_Referred_By = No_Project then
                     New_Data.First_Referred_By := Project;
                     Projects.Table (New_Project) := New_Data;
                  end if;

                  --  Add this project to our list of imported projects

                  Project_Lists.Increment_Last;
                  Project_Lists.Table (Project_Lists.Last) :=
                    (Project => New_Project, Next => Empty_Project_List);

                  --  Imported is the id of the last imported project.
                  --  If it is nil, then this imported project is our first.

                  if Imported = Empty_Project_List then
                     Processed_Data.Imported_Projects := Project_Lists.Last;

                  else
                     Project_Lists.Table (Imported).Next := Project_Lists.Last;
                  end if;

                  Imported := Project_Lists.Last;

                  With_Clause := Next_With_Clause_Of (With_Clause);
               end;
            end loop;

            Declaration_Node := Project_Declaration_Of (From_Project_Node);

            Recursive_Process
              (Project           => Processed_Data.Modifies,
               From_Project_Node => Modified_Project_Of (Declaration_Node),
               Modified_By       => Project);

            Projects.Table (Project) := Processed_Data;

            Process_Declarative_Items
              (Project           => Project,
               From_Project_Node => From_Project_Node,
               Pkg               => No_Package,
               Item              => First_Declarative_Item_Of
                                      (Declaration_Node));

         end;
      end if;
   end Recursive_Process;

end Prj.Proc;