+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- P R J . P R O C --
--- --
--- B o d y --
--- --
--- $Revision: 1.4.10.1 $
--- --
--- Copyright (C) 2001 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;
-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.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;
- Term_Project : constant Project_Node_Id :=
- Project_Node_Of (The_Current_Term);
- Term_Package : constant Project_Node_Id :=
- Package_Node_Of (The_Current_Term);
-
- 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 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);
-
- case Kind is
-
- when Undefined =>
-
- -- Should never happen
-
- pragma Assert (False, "undefined expression kind");
- null;
-
- when Single =>
-
- case The_Variable.Value.Kind is
-
- when Undefined =>
- null;
-
- when Single =>
- Add (Result.Value, The_Variable.Value.Value);
-
- when List =>
-
- -- Should never happen
-
- pragma Assert
- (False,
- "list cannot appear in single " &
- "string expression");
- null;
-
- end case;
-
- when List =>
- case The_Variable.Value.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.Value,
- Location => Location_Of (The_Current_Term),
- Next => Nil_String);
-
- when List =>
-
- declare
- The_List : String_List_Id :=
- The_Variable.Value.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");
- 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.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));
- 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) &
- """");
- 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;
- 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;
projects / msp430-gcc.git / blobdiff