-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2011, 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- --
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
+with Prj.Part;
with Snames;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
In_Tree : Project_Tree_Ref;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
- From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id;
Item : Project_Node_Id);
-- Process declarative items starting with From_Project_Node, and put them
In_Tree : Project_Tree_Ref;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
- From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id;
Item : Project_Node_Id)
is
-- reported, or a warning, or nothing. In the last two cases, the value
-- of the variable is set to a valid value, replacing Value.
+ procedure Process_Package_Declaration
+ (Current_Item : Project_Node_Id);
+ procedure Process_Attribute_Declaration (Current : Project_Node_Id);
+ procedure Process_Case_Construction
+ (Current_Item : Project_Node_Id);
+ procedure Process_Associative_Array
+ (Current_Item : Project_Node_Id);
+ procedure Process_Expression
+ (Current : Project_Node_Id);
+ procedure Process_Expression_For_Associative_Array
+ (Current_Item : Project_Node_Id;
+ New_Value : Variable_Value);
+ procedure Process_Expression_Variable_Decl
+ (Current_Item : Project_Node_Id;
+ New_Value : Variable_Value);
+ -- Process the various declarative items
+
---------------------------------
-- Check_Or_Set_Typed_Variable --
---------------------------------
(Value : in out Variable_Value;
Declaration : Project_Node_Id)
is
- Loc : constant Source_Ptr :=
- Location_Of (Declaration, From_Project_Node_Tree);
+ Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree);
Reset_Value : Boolean := False;
Current_String : Project_Node_Id;
-- Report an error for an empty string
if Value.Value = Empty_String then
- Error_Msg_Name_1 := Name_Of (Declaration, From_Project_Node_Tree);
+ Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
case Flags.Allow_Invalid_External is
when Error =>
-- Loop through all the valid strings for the
-- string type and compare to the string value.
- Current_String :=
- First_Literal_String
- (String_Type_Of (Declaration, From_Project_Node_Tree),
- From_Project_Node_Tree);
+ Current_String := First_Literal_String
+ (String_Type_Of (Declaration, Node_Tree), Node_Tree);
+
while Present (Current_String)
- and then String_Value_Of
- (Current_String, From_Project_Node_Tree) /= Value.Value
+ and then String_Value_Of (Current_String, Node_Tree) /=
+ Value.Value
loop
Current_String :=
- Next_Literal_String (Current_String, From_Project_Node_Tree);
+ Next_Literal_String (Current_String, Node_Tree);
end loop;
-- Report error if string value is not one for the string type
if No (Current_String) then
Error_Msg_Name_1 := Value.Value;
- Error_Msg_Name_2 :=
- Name_Of (Declaration, From_Project_Node_Tree);
+ Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
case Flags.Allow_Invalid_External is
when Error =>
if Reset_Value then
Current_String :=
First_Literal_String
- (String_Type_Of (Declaration, From_Project_Node_Tree),
- From_Project_Node_Tree);
-
- Value.Value := String_Value_Of
- (Current_String, From_Project_Node_Tree);
+ (String_Type_Of (Declaration, Node_Tree), Node_Tree);
+ Value.Value := String_Value_Of (Current_String, Node_Tree);
end if;
end Check_Or_Set_Typed_Variable;
- -- Local variables
-
- Current_Declarative_Item : Project_Node_Id;
- Current_Item : Project_Node_Id;
+ ---------------------------------
+ -- Process_Package_Declaration --
+ ---------------------------------
- -- Start of processing for Process_Declarative_Items
+ procedure Process_Package_Declaration
+ (Current_Item : Project_Node_Id) is
+ begin
+ -- Do not process a package declaration that should be ignored
- begin
- -- Loop through declarative items
+ if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then
+ -- Create the new package
- Current_Item := Empty_Node;
+ Package_Table.Increment_Last (In_Tree.Packages);
- Current_Declarative_Item := Item;
- while Present (Current_Declarative_Item) loop
+ declare
+ New_Pkg : constant Package_Id :=
+ Package_Table.Last (In_Tree.Packages);
+ The_New_Package : Package_Element;
- -- Get its data
+ Project_Of_Renamed_Package : constant Project_Node_Id :=
+ Project_Of_Renamed_Package_Of (Current_Item, Node_Tree);
- Current_Item :=
- Current_Item_Node
- (Current_Declarative_Item, From_Project_Node_Tree);
+ begin
+ -- Set the name of the new package
- -- And set Current_Declarative_Item to the next declarative item
- -- ready for the next iteration.
+ The_New_Package.Name := Name_Of (Current_Item, Node_Tree);
- Current_Declarative_Item :=
- Next_Declarative_Item
- (Current_Declarative_Item, From_Project_Node_Tree);
+ -- Insert the new package in the appropriate list
- case Kind_Of (Current_Item, From_Project_Node_Tree) is
+ if Pkg /= No_Package then
+ The_New_Package.Next :=
+ In_Tree.Packages.Table (Pkg).Decl.Packages;
+ In_Tree.Packages.Table (Pkg).Decl.Packages := New_Pkg;
- when N_Package_Declaration =>
+ else
+ The_New_Package.Next := Project.Decl.Packages;
+ Project.Decl.Packages := New_Pkg;
+ end if;
- -- Do not process a package declaration that should be ignored
+ In_Tree.Packages.Table (New_Pkg) := The_New_Package;
- if Expression_Kind_Of
- (Current_Item, From_Project_Node_Tree) /= Ignored
- then
- -- Create the new package
+ if Present (Project_Of_Renamed_Package) then
- Package_Table.Increment_Last (In_Tree.Packages);
+ -- Renamed or extending package
declare
- New_Pkg : constant Package_Id :=
- Package_Table.Last (In_Tree.Packages);
- The_New_Package : Package_Element;
+ Project_Name : constant Name_Id :=
+ Name_Of (Project_Of_Renamed_Package, Node_Tree);
+
+ Renamed_Project : constant Project_Id :=
+ Imported_Or_Extended_Project_From
+ (Project, Project_Name);
- Project_Of_Renamed_Package :
- constant Project_Node_Id :=
- Project_Of_Renamed_Package_Of
- (Current_Item, From_Project_Node_Tree);
+ Renamed_Package : constant Package_Id :=
+ Package_From
+ (Renamed_Project, In_Tree,
+ Name_Of (Current_Item, Node_Tree));
begin
- -- Set the name of the new package
+ -- For a renamed package, copy the declarations of
+ -- the renamed package, but set all the locations
+ -- to the location of the package name in the
+ -- renaming declaration.
+
+ Copy_Package_Declarations
+ (From => In_Tree.Packages.Table (Renamed_Package).Decl,
+ To => In_Tree.Packages.Table (New_Pkg).Decl,
+ New_Loc => Location_Of (Current_Item, Node_Tree),
+ Restricted => False,
+ In_Tree => In_Tree);
+ end;
- The_New_Package.Name :=
- Name_Of (Current_Item, From_Project_Node_Tree);
+ else
+ -- Set the default values of the attributes
+
+ Add_Attributes
+ (Project,
+ Project.Name,
+ Name_Id (Project.Directory.Name),
+ In_Tree,
+ In_Tree.Packages.Table (New_Pkg).Decl,
+ First_Attribute_Of
+ (Package_Id_Of (Current_Item, Node_Tree)),
+ Project_Level => False);
+ end if;
- -- Insert the new package in the appropriate list
+ -- Process declarative items (nothing to do when the
+ -- package is renaming, as the first declarative item is
+ -- null).
- if Pkg /= No_Package then
- The_New_Package.Next :=
- In_Tree.Packages.Table (Pkg).Decl.Packages;
- In_Tree.Packages.Table (Pkg).Decl.Packages :=
- New_Pkg;
+ Process_Declarative_Items
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ Node_Tree => Node_Tree,
+ Pkg => New_Pkg,
+ Item =>
+ First_Declarative_Item_Of (Current_Item, Node_Tree));
+ end;
+ end if;
+ end Process_Package_Declaration;
- else
- The_New_Package.Next := Project.Decl.Packages;
- Project.Decl.Packages := New_Pkg;
- end if;
+ -------------------------------
+ -- Process_Associative_Array --
+ -------------------------------
- In_Tree.Packages.Table (New_Pkg) :=
- The_New_Package;
+ procedure Process_Associative_Array
+ (Current_Item : Project_Node_Id)
+ is
+ Current_Item_Name : constant Name_Id :=
+ Name_Of (Current_Item, Node_Tree);
+ -- The name of the attribute
- if Present (Project_Of_Renamed_Package) then
+ Current_Location : constant Source_Ptr :=
+ Location_Of (Current_Item, Node_Tree);
- -- Renamed or extending package
+ New_Array : Array_Id;
+ -- The new associative array created
- declare
- Project_Name : constant Name_Id :=
- Name_Of
- (Project_Of_Renamed_Package,
- From_Project_Node_Tree);
-
- Renamed_Project :
- constant Project_Id :=
- Imported_Or_Extended_Project_From
- (Project, Project_Name);
-
- Renamed_Package : constant Package_Id :=
- Package_From
- (Renamed_Project, In_Tree,
- Name_Of
- (Current_Item,
- From_Project_Node_Tree));
+ Orig_Array : Array_Id;
+ -- The associative array value
- begin
- -- For a renamed package, copy the declarations of
- -- the renamed package, but set all the locations
- -- to the location of the package name in the
- -- renaming declaration.
-
- Copy_Package_Declarations
- (From =>
- In_Tree.Packages.Table (Renamed_Package).Decl,
- To =>
- In_Tree.Packages.Table (New_Pkg).Decl,
- New_Loc =>
- Location_Of
- (Current_Item, From_Project_Node_Tree),
- Restricted => False,
- In_Tree => In_Tree);
- end;
+ Orig_Project_Name : Name_Id := No_Name;
+ -- The name of the project where the associative array
+ -- value is.
- else
- -- Set the default values of the attributes
-
- Add_Attributes
- (Project,
- Project.Name,
- Name_Id (Project.Directory.Name),
- In_Tree,
- In_Tree.Packages.Table (New_Pkg).Decl,
- First_Attribute_Of
- (Package_Id_Of
- (Current_Item, From_Project_Node_Tree)),
- Project_Level => False);
+ Orig_Project : Project_Id := No_Project;
+ -- The id of the project where the associative array
+ -- value is.
- end if;
+ Orig_Package_Name : Name_Id := No_Name;
+ -- The name of the package, if any, where the associative
+ -- array value is.
- -- Process declarative items (nothing to do when the
- -- package is renaming, as the first declarative item is
- -- null).
+ Orig_Package : Package_Id := No_Package;
+ -- The id of the package, if any, where the associative
+ -- array value is.
- Process_Declarative_Items
- (Project => Project,
- In_Tree => In_Tree,
- Flags => Flags,
- From_Project_Node => From_Project_Node,
- From_Project_Node_Tree => From_Project_Node_Tree,
- Pkg => New_Pkg,
- Item =>
- First_Declarative_Item_Of
- (Current_Item, From_Project_Node_Tree));
- end;
- end if;
+ New_Element : Array_Element_Id := No_Array_Element;
+ -- Id of a new array element created
- when N_String_Type_Declaration =>
+ Prev_Element : Array_Element_Id := No_Array_Element;
+ -- Last new element id created
- -- There is nothing to process
+ Orig_Element : Array_Element_Id := No_Array_Element;
+ -- Current array element in original associative array
- null;
+ Next_Element : Array_Element_Id := No_Array_Element;
+ -- Id of the array element that follows the new element.
+ -- This is not always nil, because values for the
+ -- associative array attribute may already have been
+ -- declared, and the array elements declared are reused.
- when N_Attribute_Declaration |
- N_Typed_Variable_Declaration |
- N_Variable_Declaration =>
+ Prj : Project_List;
- if Expression_Of (Current_Item, From_Project_Node_Tree) =
- Empty_Node
- then
+ begin
+ -- First find if the associative array attribute already
+ -- has elements declared.
- -- It must be a full associative array attribute declaration
+ if Pkg /= No_Package then
+ New_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays;
+ else
+ New_Array := Project.Decl.Arrays;
+ end if;
- declare
- Current_Item_Name : constant Name_Id :=
- Name_Of
- (Current_Item,
- From_Project_Node_Tree);
- -- The name of the attribute
+ while New_Array /= No_Array
+ and then In_Tree.Arrays.Table (New_Array).Name /= Current_Item_Name
+ loop
+ New_Array := In_Tree.Arrays.Table (New_Array).Next;
+ end loop;
- Current_Location : constant Source_Ptr :=
- Location_Of
- (Current_Item,
- From_Project_Node_Tree);
+ -- If the attribute has never been declared add new entry
+ -- in the arrays of the project/package and link it.
- New_Array : Array_Id;
- -- The new associative array created
+ if New_Array = No_Array then
+ Array_Table.Increment_Last (In_Tree.Arrays);
+ New_Array := Array_Table.Last (In_Tree.Arrays);
- Orig_Array : Array_Id;
- -- The associative array value
+ if Pkg /= No_Package then
+ In_Tree.Arrays.Table (New_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => In_Tree.Packages.Table (Pkg).Decl.Arrays);
- Orig_Project_Name : Name_Id := No_Name;
- -- The name of the project where the associative array
- -- value is.
+ In_Tree.Packages.Table (Pkg).Decl.Arrays := New_Array;
- Orig_Project : Project_Id := No_Project;
- -- The id of the project where the associative array
- -- value is.
+ else
+ In_Tree.Arrays.Table (New_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => Project.Decl.Arrays);
- Orig_Package_Name : Name_Id := No_Name;
- -- The name of the package, if any, where the associative
- -- array value is.
+ Project.Decl.Arrays := New_Array;
+ end if;
+ end if;
- Orig_Package : Package_Id := No_Package;
- -- The id of the package, if any, where the associative
- -- array value is.
+ -- Find the project where the value is declared
- New_Element : Array_Element_Id := No_Array_Element;
- -- Id of a new array element created
+ Orig_Project_Name :=
+ Name_Of
+ (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree);
- Prev_Element : Array_Element_Id := No_Array_Element;
- -- Last new element id created
+ Prj := In_Tree.Projects;
+ while Prj /= null loop
+ if Prj.Project.Name = Orig_Project_Name then
+ Orig_Project := Prj.Project;
+ exit;
+ end if;
+ Prj := Prj.Next;
+ end loop;
- Orig_Element : Array_Element_Id := No_Array_Element;
- -- Current array element in original associative array
+ pragma Assert (Orig_Project /= No_Project,
+ "original project not found");
- Next_Element : Array_Element_Id := No_Array_Element;
- -- Id of the array element that follows the new element.
- -- This is not always nil, because values for the
- -- associative array attribute may already have been
- -- declared, and the array elements declared are reused.
+ if No (Associative_Package_Of (Current_Item, Node_Tree)) then
+ Orig_Array := Orig_Project.Decl.Arrays;
- Prj : Project_List;
+ else
+ -- If in a package, find the package where the value
+ -- is declared.
- begin
- -- First find if the associative array attribute already
- -- has elements declared.
+ Orig_Package_Name :=
+ Name_Of
+ (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree);
- if Pkg /= No_Package then
- New_Array := In_Tree.Packages.Table
- (Pkg).Decl.Arrays;
+ Orig_Package := Orig_Project.Decl.Packages;
+ pragma Assert (Orig_Package /= No_Package,
+ "original package not found");
- else
- New_Array := Project.Decl.Arrays;
- end if;
+ while In_Tree.Packages.Table
+ (Orig_Package).Name /= Orig_Package_Name
+ loop
+ Orig_Package := In_Tree.Packages.Table (Orig_Package).Next;
+ pragma Assert (Orig_Package /= No_Package,
+ "original package not found");
+ end loop;
- while New_Array /= No_Array
- and then In_Tree.Arrays.Table (New_Array).Name /=
- Current_Item_Name
- loop
- New_Array := In_Tree.Arrays.Table (New_Array).Next;
- end loop;
+ Orig_Array := In_Tree.Packages.Table (Orig_Package).Decl.Arrays;
+ end if;
- -- If the attribute has never been declared add new entry
- -- in the arrays of the project/package and link it.
+ -- Now look for the array
- if New_Array = No_Array then
- Array_Table.Increment_Last (In_Tree.Arrays);
- New_Array := Array_Table.Last (In_Tree.Arrays);
+ while Orig_Array /= No_Array
+ and then In_Tree.Arrays.Table (Orig_Array).Name /= Current_Item_Name
+ loop
+ Orig_Array := In_Tree.Arrays.Table (Orig_Array).Next;
+ end loop;
- if Pkg /= No_Package then
- In_Tree.Arrays.Table (New_Array) :=
- (Name => Current_Item_Name,
- Location => Current_Location,
- Value => No_Array_Element,
- Next => In_Tree.Packages.Table
- (Pkg).Decl.Arrays);
+ if Orig_Array = No_Array then
+ Error_Msg
+ (Flags,
+ "associative array value not found",
+ Location_Of (Current_Item, Node_Tree),
+ Project);
- In_Tree.Packages.Table (Pkg).Decl.Arrays :=
- New_Array;
+ else
+ Orig_Element := In_Tree.Arrays.Table (Orig_Array).Value;
- else
- In_Tree.Arrays.Table (New_Array) :=
- (Name => Current_Item_Name,
- Location => Current_Location,
- Value => No_Array_Element,
- Next => Project.Decl.Arrays);
+ -- Copy each array element
- Project.Decl.Arrays := New_Array;
- end if;
- end if;
+ while Orig_Element /= No_Array_Element loop
- -- Find the project where the value is declared
+ -- Case of first element
- Orig_Project_Name :=
- Name_Of
- (Associative_Project_Of
- (Current_Item, From_Project_Node_Tree),
- From_Project_Node_Tree);
+ if Prev_Element = No_Array_Element then
- Prj := In_Tree.Projects;
- while Prj /= null loop
- if Prj.Project.Name = Orig_Project_Name then
- Orig_Project := Prj.Project;
- exit;
- end if;
- Prj := Prj.Next;
- end loop;
+ -- And there is no array element declared yet,
+ -- create a new first array element.
- pragma Assert (Orig_Project /= No_Project,
- "original project not found");
+ if In_Tree.Arrays.Table (New_Array).Value =
+ No_Array_Element
+ then
+ Array_Element_Table.Increment_Last
+ (In_Tree.Array_Elements);
+ New_Element := Array_Element_Table.Last
+ (In_Tree.Array_Elements);
+ In_Tree.Arrays.Table (New_Array).Value := New_Element;
+ Next_Element := No_Array_Element;
- if No (Associative_Package_Of
- (Current_Item, From_Project_Node_Tree))
- then
- Orig_Array := Orig_Project.Decl.Arrays;
+ -- Otherwise, the new element is the first
- else
- -- If in a package, find the package where the value
- -- is declared.
+ else
+ New_Element := In_Tree.Arrays. Table (New_Array).Value;
+ Next_Element :=
+ In_Tree.Array_Elements.Table (New_Element).Next;
+ end if;
- Orig_Package_Name :=
- Name_Of
- (Associative_Package_Of
- (Current_Item, From_Project_Node_Tree),
- From_Project_Node_Tree);
+ -- Otherwise, reuse an existing element, or create
+ -- one if necessary.
- Orig_Package := Orig_Project.Decl.Packages;
- pragma Assert (Orig_Package /= No_Package,
- "original package not found");
+ else
+ Next_Element :=
+ In_Tree.Array_Elements.Table (Prev_Element).Next;
- while In_Tree.Packages.Table
- (Orig_Package).Name /= Orig_Package_Name
- loop
- Orig_Package := In_Tree.Packages.Table
- (Orig_Package).Next;
- pragma Assert (Orig_Package /= No_Package,
- "original package not found");
- end loop;
+ if Next_Element = No_Array_Element then
+ Array_Element_Table.Increment_Last
+ (In_Tree.Array_Elements);
+ New_Element :=
+ Array_Element_Table.Last (In_Tree.Array_Elements);
+ In_Tree.Array_Elements.Table (Prev_Element).Next :=
+ New_Element;
- Orig_Array :=
- In_Tree.Packages.Table (Orig_Package).Decl.Arrays;
- end if;
+ else
+ New_Element := Next_Element;
+ Next_Element :=
+ In_Tree.Array_Elements.Table (New_Element).Next;
+ end if;
+ end if;
- -- Now look for the array
+ -- Copy the value of the element
- while Orig_Array /= No_Array
- and then In_Tree.Arrays.Table (Orig_Array).Name /=
- Current_Item_Name
- loop
- Orig_Array := In_Tree.Arrays.Table
- (Orig_Array).Next;
- end loop;
+ In_Tree.Array_Elements.Table (New_Element) :=
+ In_Tree.Array_Elements.Table (Orig_Element);
+ In_Tree.Array_Elements.Table (New_Element).Value.Project :=
+ Project;
- if Orig_Array = No_Array then
- Error_Msg
- (Flags,
- "associative array value not found",
- Location_Of (Current_Item, From_Project_Node_Tree),
- Project);
+ -- Adjust the Next link
- else
- Orig_Element :=
- In_Tree.Arrays.Table (Orig_Array).Value;
+ In_Tree.Array_Elements.Table (New_Element).Next := Next_Element;
- -- Copy each array element
+ -- Adjust the previous id for the next element
- while Orig_Element /= No_Array_Element loop
+ Prev_Element := New_Element;
- -- Case of first element
+ -- Go to the next element in the original array
- if Prev_Element = No_Array_Element then
+ Orig_Element :=
+ In_Tree.Array_Elements.Table (Orig_Element).Next;
+ end loop;
- -- And there is no array element declared yet,
- -- create a new first array element.
+ -- Make sure that the array ends here, in case there
+ -- previously a greater number of elements.
- if In_Tree.Arrays.Table (New_Array).Value =
- No_Array_Element
- then
- Array_Element_Table.Increment_Last
- (In_Tree.Array_Elements);
- New_Element := Array_Element_Table.Last
- (In_Tree.Array_Elements);
- In_Tree.Arrays.Table
- (New_Array).Value := New_Element;
- Next_Element := No_Array_Element;
+ In_Tree.Array_Elements.Table (New_Element).Next :=
+ No_Array_Element;
+ end if;
+ end Process_Associative_Array;
- -- Otherwise, the new element is the first
+ ----------------------------------------------
+ -- Process_Expression_For_Associative_Array --
+ ----------------------------------------------
- else
- New_Element := In_Tree.Arrays.
- Table (New_Array).Value;
- Next_Element :=
- In_Tree.Array_Elements.Table
- (New_Element).Next;
- end if;
+ procedure Process_Expression_For_Associative_Array
+ (Current_Item : Project_Node_Id;
+ New_Value : Variable_Value)
+ is
+ Current_Item_Name : constant Name_Id :=
+ Name_Of (Current_Item, Node_Tree);
+ Current_Location : constant Source_Ptr :=
+ Location_Of (Current_Item, Node_Tree);
- -- Otherwise, reuse an existing element, or create
- -- one if necessary.
+ Index_Name : Name_Id :=
+ Associative_Array_Index_Of (Current_Item, Node_Tree);
- else
- Next_Element :=
- In_Tree.Array_Elements.Table
- (Prev_Element).Next;
+ Source_Index : constant Int :=
+ Source_Index_Of (Current_Item, Node_Tree);
- if Next_Element = No_Array_Element then
- Array_Element_Table.Increment_Last
- (In_Tree.Array_Elements);
- New_Element :=
- Array_Element_Table.Last
- (In_Tree.Array_Elements);
- In_Tree.Array_Elements.Table
- (Prev_Element).Next := New_Element;
+ The_Array : Array_Id;
+ The_Array_Element : Array_Element_Id := No_Array_Element;
- else
- New_Element := Next_Element;
- Next_Element :=
- In_Tree.Array_Elements.Table
- (New_Element).Next;
- end if;
- end if;
+ begin
+ if Index_Name /= All_Other_Names then
+ Index_Name := Get_Attribute_Index
+ (Node_Tree,
+ Current_Item,
+ Associative_Array_Index_Of (Current_Item, Node_Tree));
+ end if;
- -- Copy the value of the element
+ -- Look for the array in the appropriate list
- In_Tree.Array_Elements.Table
- (New_Element) :=
- In_Tree.Array_Elements.Table (Orig_Element);
- In_Tree.Array_Elements.Table
- (New_Element).Value.Project := Project;
+ if Pkg /= No_Package then
+ The_Array := In_Tree.Packages.Table (Pkg).Decl.Arrays;
+ else
+ The_Array := Project.Decl.Arrays;
+ end if;
- -- Adjust the Next link
+ while The_Array /= No_Array
+ and then In_Tree.Arrays.Table (The_Array).Name /= Current_Item_Name
+ loop
+ The_Array := In_Tree.Arrays.Table (The_Array).Next;
+ end loop;
- In_Tree.Array_Elements.Table
- (New_Element).Next := Next_Element;
+ -- If the array cannot be found, create a new entry
+ -- in the list. As The_Array_Element is initialized
+ -- to No_Array_Element, a new element will be
+ -- created automatically later
- -- Adjust the previous id for the next element
+ if The_Array = No_Array then
+ Array_Table.Increment_Last (In_Tree.Arrays);
+ The_Array := Array_Table.Last (In_Tree.Arrays);
- Prev_Element := New_Element;
+ if Pkg /= No_Package then
+ In_Tree.Arrays.Table (The_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => In_Tree.Packages.Table (Pkg).Decl.Arrays);
- -- Go to the next element in the original array
+ In_Tree.Packages.Table (Pkg).Decl.Arrays := The_Array;
- Orig_Element :=
- In_Tree.Array_Elements.Table
- (Orig_Element).Next;
- end loop;
+ else
+ In_Tree.Arrays.Table (The_Array) :=
+ (Name => Current_Item_Name,
+ Location => Current_Location,
+ Value => No_Array_Element,
+ Next => Project.Decl.Arrays);
- -- Make sure that the array ends here, in case there
- -- previously a greater number of elements.
+ Project.Decl.Arrays := The_Array;
+ end if;
- In_Tree.Array_Elements.Table
- (New_Element).Next := No_Array_Element;
- end if;
- end;
+ -- Otherwise initialize The_Array_Element as the
+ -- head of the element list.
- -- Declarations other that full associative arrays
+ else
+ The_Array_Element := In_Tree.Arrays.Table (The_Array).Value;
+ end if;
- else
- declare
- New_Value : Variable_Value :=
- Expression
- (Project => Project,
- In_Tree => In_Tree,
- Flags => Flags,
- From_Project_Node => From_Project_Node,
- From_Project_Node_Tree => From_Project_Node_Tree,
- Pkg => Pkg,
- First_Term =>
- Tree.First_Term
- (Expression_Of
- (Current_Item, From_Project_Node_Tree),
- From_Project_Node_Tree),
- Kind =>
- Expression_Kind_Of
- (Current_Item, From_Project_Node_Tree));
- -- The expression value
-
- The_Variable : Variable_Id := No_Variable;
-
- Current_Item_Name : constant Name_Id :=
- Name_Of
- (Current_Item,
- From_Project_Node_Tree);
-
- Current_Location : constant Source_Ptr :=
- Location_Of
- (Current_Item,
- From_Project_Node_Tree);
+ -- Look in the list, if any, to find an element
+ -- with the same index and same source index.
- begin
- -- Process a typed variable declaration
-
- if Kind_Of (Current_Item, From_Project_Node_Tree) =
- N_Typed_Variable_Declaration
- then
- Check_Or_Set_Typed_Variable
- (Value => New_Value,
- Declaration => Current_Item);
- end if;
+ while The_Array_Element /= No_Array_Element
+ and then
+ (In_Tree.Array_Elements.Table (The_Array_Element).Index /=
+ Index_Name
+ or else
+ In_Tree.Array_Elements.Table (The_Array_Element).Src_Index /=
+ Source_Index)
+ loop
+ The_Array_Element :=
+ In_Tree.Array_Elements.Table (The_Array_Element).Next;
+ end loop;
- -- Comment here ???
+ -- If no such element were found, create a new one
+ -- and insert it in the element list, with the
+ -- proper value.
- if Kind_Of (Current_Item, From_Project_Node_Tree) /=
- N_Attribute_Declaration
- or else
- Associative_Array_Index_Of
- (Current_Item, From_Project_Node_Tree) = No_Name
- then
- -- Case of a variable declaration or of a not
- -- associative array attribute.
+ if The_Array_Element = No_Array_Element then
+ Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
+ The_Array_Element :=
+ Array_Element_Table.Last (In_Tree.Array_Elements);
- -- First, find the list where to find the variable
- -- or attribute.
+ In_Tree.Array_Elements.Table
+ (The_Array_Element) :=
+ (Index => Index_Name,
+ Src_Index => Source_Index,
+ Index_Case_Sensitive =>
+ not Case_Insensitive (Current_Item, Node_Tree),
+ Value => New_Value,
+ Next => In_Tree.Arrays.Table (The_Array).Value);
- if Kind_Of (Current_Item, From_Project_Node_Tree) =
- N_Attribute_Declaration
- then
- if Pkg /= No_Package then
- The_Variable :=
- In_Tree.Packages.Table
- (Pkg).Decl.Attributes;
- else
- The_Variable := Project.Decl.Attributes;
- end if;
+ In_Tree.Arrays.Table (The_Array).Value := The_Array_Element;
- else
- if Pkg /= No_Package then
- The_Variable :=
- In_Tree.Packages.Table
- (Pkg).Decl.Variables;
- else
- The_Variable := Project.Decl.Variables;
- end if;
+ -- An element with the same index already exists,
+ -- just replace its value with the new one.
- end if;
+ else
+ In_Tree.Array_Elements.Table (The_Array_Element).Value :=
+ New_Value;
+ end if;
+ end Process_Expression_For_Associative_Array;
- -- Loop through the list, to find if it has already
- -- been declared.
+ --------------------------------------
+ -- Process_Expression_Variable_Decl --
+ --------------------------------------
- while The_Variable /= No_Variable
- and then
- In_Tree.Variable_Elements.Table
- (The_Variable).Name /= Current_Item_Name
- loop
- The_Variable :=
- In_Tree.Variable_Elements.Table
- (The_Variable).Next;
- end loop;
+ procedure Process_Expression_Variable_Decl
+ (Current_Item : Project_Node_Id;
+ New_Value : Variable_Value)
+ is
+ Current_Item_Name : constant Name_Id :=
+ Name_Of (Current_Item, Node_Tree);
+ The_Variable : Variable_Id := No_Variable;
- -- If it has not been declared, create a new entry
- -- in the list.
+ begin
+ -- First, find the list where to find the variable or attribute.
- if The_Variable = No_Variable then
+ if Kind_Of (Current_Item, Node_Tree) =
+ N_Attribute_Declaration
+ then
+ if Pkg /= No_Package then
+ The_Variable := In_Tree.Packages.Table (Pkg).Decl.Attributes;
+ else
+ The_Variable := Project.Decl.Attributes;
+ end if;
- -- All single string attribute should already have
- -- been declared with a default empty string value.
+ else
+ if Pkg /= No_Package then
+ The_Variable := In_Tree.Packages.Table (Pkg).Decl.Variables;
+ else
+ The_Variable := Project.Decl.Variables;
+ end if;
+ end if;
- pragma Assert
- (Kind_Of (Current_Item, From_Project_Node_Tree) /=
- N_Attribute_Declaration,
- "illegal attribute declaration for "
- & Get_Name_String (Current_Item_Name));
+ -- Loop through the list, to find if it has already been declared.
- Variable_Element_Table.Increment_Last
- (In_Tree.Variable_Elements);
- The_Variable := Variable_Element_Table.Last
- (In_Tree.Variable_Elements);
+ while The_Variable /= No_Variable
+ and then In_Tree.Variable_Elements.Table (The_Variable).Name /=
+ Current_Item_Name
+ loop
+ The_Variable :=
+ In_Tree.Variable_Elements.Table (The_Variable).Next;
+ end loop;
- -- Put the new variable in the appropriate list
+ -- If it has not been declared, create a new entry
+ -- in the list.
- if Pkg /= No_Package then
- In_Tree.Variable_Elements.Table (The_Variable) :=
- (Next =>
- In_Tree.Packages.Table
- (Pkg).Decl.Variables,
- Name => Current_Item_Name,
- Value => New_Value);
- In_Tree.Packages.Table
- (Pkg).Decl.Variables := The_Variable;
+ if The_Variable = No_Variable then
- else
- In_Tree.Variable_Elements.Table (The_Variable) :=
- (Next => Project.Decl.Variables,
- Name => Current_Item_Name,
- Value => New_Value);
- Project.Decl.Variables := The_Variable;
- end if;
+ -- All single string attribute should already have
+ -- been declared with a default empty string value.
- -- If the variable/attribute has already been
- -- declared, just change the value.
+ pragma Assert
+ (Kind_Of (Current_Item, Node_Tree) /=
+ N_Attribute_Declaration,
+ "illegal attribute declaration for "
+ & Get_Name_String (Current_Item_Name));
- else
- In_Tree.Variable_Elements.Table
- (The_Variable).Value := New_Value;
- end if;
+ Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
+ The_Variable := Variable_Element_Table.Last
+ (In_Tree.Variable_Elements);
- -- Associative array attribute
+ -- Put the new variable in the appropriate list
- else
- declare
- Index_Name : Name_Id :=
- Associative_Array_Index_Of
- (Current_Item,
- From_Project_Node_Tree);
+ if Pkg /= No_Package then
+ In_Tree.Variable_Elements.Table (The_Variable) :=
+ (Next => In_Tree.Packages.Table (Pkg).Decl.Variables,
+ Name => Current_Item_Name,
+ Value => New_Value);
+ In_Tree.Packages.Table (Pkg).Decl.Variables := The_Variable;
- Source_Index : constant Int :=
- Source_Index_Of
- (Current_Item,
- From_Project_Node_Tree);
+ else
+ In_Tree.Variable_Elements.Table (The_Variable) :=
+ (Next => Project.Decl.Variables,
+ Name => Current_Item_Name,
+ Value => New_Value);
+ Project.Decl.Variables := The_Variable;
+ end if;
- The_Array : Array_Id;
- The_Array_Element : Array_Element_Id :=
- No_Array_Element;
+ -- If the variable/attribute has already been
+ -- declared, just change the value.
- begin
- if Index_Name /= All_Other_Names then
- Index_Name := Get_Attribute_Index
- (From_Project_Node_Tree,
- Current_Item,
- Associative_Array_Index_Of
- (Current_Item, From_Project_Node_Tree));
- end if;
+ else
+ In_Tree.Variable_Elements.Table (The_Variable).Value := New_Value;
+ end if;
+ end Process_Expression_Variable_Decl;
- -- Look for the array in the appropriate list
+ ------------------------
+ -- Process_Expression --
+ ------------------------
- if Pkg /= No_Package then
- The_Array :=
- In_Tree.Packages.Table (Pkg).Decl.Arrays;
- else
- The_Array :=
- Project.Decl.Arrays;
- end if;
+ procedure Process_Expression
+ (Current : Project_Node_Id)
+ is
+ New_Value : Variable_Value :=
+ Expression
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => Node_Tree,
+ Pkg => Pkg,
+ First_Term =>
+ Tree.First_Term
+ (Expression_Of (Current, Node_Tree), Node_Tree),
+ Kind => Expression_Kind_Of (Current, Node_Tree));
- while
- The_Array /= No_Array
- and then
- In_Tree.Arrays.Table (The_Array).Name /=
- Current_Item_Name
- loop
- The_Array :=
- In_Tree.Arrays.Table (The_Array).Next;
- end loop;
+ begin
+ -- Process a typed variable declaration
- -- If the array cannot be found, create a new entry
- -- in the list. As The_Array_Element is initialized
- -- to No_Array_Element, a new element will be
- -- created automatically later
+ if Kind_Of (Current, Node_Tree) =
+ N_Typed_Variable_Declaration
+ then
+ Check_Or_Set_Typed_Variable (New_Value, Current);
+ end if;
- if The_Array = No_Array then
- Array_Table.Increment_Last (In_Tree.Arrays);
- The_Array := Array_Table.Last (In_Tree.Arrays);
+ if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration
+ or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name
+ then
+ Process_Expression_Variable_Decl (Current, New_Value);
+ else
+ Process_Expression_For_Associative_Array (Current, New_Value);
+ end if;
+ end Process_Expression;
- if Pkg /= No_Package then
- In_Tree.Arrays.Table (The_Array) :=
- (Name => Current_Item_Name,
- Location => Current_Location,
- Value => No_Array_Element,
- Next => In_Tree.Packages.Table
- (Pkg).Decl.Arrays);
+ -----------------------------------
+ -- Process_Attribute_Declaration --
+ -----------------------------------
- In_Tree.Packages.Table (Pkg).Decl.Arrays :=
- The_Array;
+ procedure Process_Attribute_Declaration (Current : Project_Node_Id) is
+ begin
+ if Expression_Of (Current, Node_Tree) = Empty_Node then
+ Process_Associative_Array (Current);
+ else
+ Process_Expression (Current);
+ end if;
+ end Process_Attribute_Declaration;
- else
- In_Tree.Arrays.Table (The_Array) :=
- (Name => Current_Item_Name,
- Location => Current_Location,
- Value => No_Array_Element,
- Next => Project.Decl.Arrays);
+ -------------------------------
+ -- Process_Case_Construction --
+ -------------------------------
- Project.Decl.Arrays := The_Array;
- end if;
+ procedure Process_Case_Construction
+ (Current_Item : Project_Node_Id)
+ is
+ The_Project : Project_Id := Project;
+ -- The id of the project of the case variable
- -- Otherwise initialize The_Array_Element as the
- -- head of the element list.
+ The_Package : Package_Id := Pkg;
+ -- The id of the package, if any, of the case variable
- else
- The_Array_Element :=
- In_Tree.Arrays.Table (The_Array).Value;
- end if;
+ The_Variable : Variable_Value := Nil_Variable_Value;
+ -- The case variable
- -- Look in the list, if any, to find an element
- -- with the same index and same source index.
+ Case_Value : Name_Id := No_Name;
+ -- The case variable value
- while The_Array_Element /= No_Array_Element
- and then
- (In_Tree.Array_Elements.Table
- (The_Array_Element).Index /= Index_Name
- or else
- In_Tree.Array_Elements.Table
- (The_Array_Element).Src_Index /= Source_Index)
- loop
- The_Array_Element :=
- In_Tree.Array_Elements.Table
- (The_Array_Element).Next;
- end loop;
+ Case_Item : Project_Node_Id := Empty_Node;
+ Choice_String : Project_Node_Id := Empty_Node;
+ Decl_Item : Project_Node_Id := Empty_Node;
- -- If no such element were found, create a new one
- -- and insert it in the element list, with the
- -- proper value.
-
- if The_Array_Element = No_Array_Element then
- Array_Element_Table.Increment_Last
- (In_Tree.Array_Elements);
- The_Array_Element :=
- Array_Element_Table.Last
- (In_Tree.Array_Elements);
-
- In_Tree.Array_Elements.Table
- (The_Array_Element) :=
- (Index => Index_Name,
- Src_Index => Source_Index,
- Index_Case_Sensitive =>
- not Case_Insensitive
- (Current_Item, From_Project_Node_Tree),
- Value => New_Value,
- Next =>
- In_Tree.Arrays.Table (The_Array).Value);
-
- In_Tree.Arrays.Table (The_Array).Value :=
- The_Array_Element;
-
- -- An element with the same index already exists,
- -- just replace its value with the new one.
+ begin
+ declare
+ Variable_Node : constant Project_Node_Id :=
+ Case_Variable_Reference_Of
+ (Current_Item,
+ Node_Tree);
- else
- In_Tree.Array_Elements.Table
- (The_Array_Element).Value := New_Value;
- end if;
- end;
- end if;
- end;
- end if;
+ Var_Id : Variable_Id := No_Variable;
+ Name : Name_Id := No_Name;
- when N_Case_Construction =>
- declare
- The_Project : Project_Id := Project;
- -- The id of the project of the case variable
+ begin
+ -- If a project was specified for the case variable,
+ -- get its id.
+
+ if Present (Project_Node_Of (Variable_Node, Node_Tree)) then
+ Name :=
+ Name_Of
+ (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
+ The_Project :=
+ Imported_Or_Extended_Project_From (Project, Name);
+ end if;
- The_Package : Package_Id := Pkg;
- -- The id of the package, if any, of the case variable
+ -- If a package were specified for the case variable,
+ -- get its id.
- The_Variable : Variable_Value := Nil_Variable_Value;
- -- The case variable
+ if Present (Package_Node_Of (Variable_Node, Node_Tree)) then
+ Name :=
+ Name_Of
+ (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
+ The_Package := Package_From (The_Project, In_Tree, Name);
+ end if;
- Case_Value : Name_Id := No_Name;
- -- The case variable value
+ Name := Name_Of (Variable_Node, Node_Tree);
- Case_Item : Project_Node_Id := Empty_Node;
- Choice_String : Project_Node_Id := Empty_Node;
- Decl_Item : Project_Node_Id := Empty_Node;
+ -- First, look for the case variable into the package,
+ -- if any.
- begin
- declare
- Variable_Node : constant Project_Node_Id :=
- Case_Variable_Reference_Of
- (Current_Item,
- From_Project_Node_Tree);
+ if The_Package /= No_Package then
+ Var_Id := In_Tree.Packages.Table (The_Package).Decl.Variables;
+ Name := Name_Of (Variable_Node, Node_Tree);
+ while Var_Id /= No_Variable
+ and then In_Tree.Variable_Elements.Table (Var_Id).Name /= Name
+ loop
+ Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next;
+ end loop;
+ end if;
- Var_Id : Variable_Id := No_Variable;
- Name : Name_Id := No_Name;
+ -- If not found in the package, or if there is no
+ -- package, look at the project level.
- begin
- -- If a project was specified for the case variable,
- -- get its id.
-
- if Present (Project_Node_Of
- (Variable_Node, From_Project_Node_Tree))
- then
- Name :=
- Name_Of
- (Project_Node_Of
- (Variable_Node, From_Project_Node_Tree),
- From_Project_Node_Tree);
- The_Project :=
- Imported_Or_Extended_Project_From (Project, Name);
- end if;
+ if Var_Id = No_Variable
+ and then No (Package_Node_Of (Variable_Node, Node_Tree))
+ then
+ Var_Id := The_Project.Decl.Variables;
+ while Var_Id /= No_Variable
+ and then In_Tree.Variable_Elements.Table (Var_Id).Name /= Name
+ loop
+ Var_Id := In_Tree.Variable_Elements.Table (Var_Id).Next;
+ end loop;
+ end if;
- -- If a package were specified for the case variable,
- -- get its id.
-
- if Present (Package_Node_Of
- (Variable_Node, From_Project_Node_Tree))
- then
- Name :=
- Name_Of
- (Package_Node_Of
- (Variable_Node, From_Project_Node_Tree),
- From_Project_Node_Tree);
- The_Package :=
- Package_From (The_Project, In_Tree, Name);
- end if;
+ if Var_Id = No_Variable then
- Name := Name_Of (Variable_Node, From_Project_Node_Tree);
+ -- Should never happen, because this has already been
+ -- checked during parsing.
- -- First, look for the case variable into the package,
- -- if any.
+ Write_Line
+ ("variable """ & Get_Name_String (Name) & """ not found");
+ raise Program_Error;
+ end if;
- if The_Package /= No_Package then
- Var_Id := In_Tree.Packages.Table
- (The_Package).Decl.Variables;
- Name :=
- Name_Of (Variable_Node, From_Project_Node_Tree);
- while Var_Id /= No_Variable
- and then
- In_Tree.Variable_Elements.Table
- (Var_Id).Name /= Name
- loop
- Var_Id := In_Tree.Variable_Elements.
- Table (Var_Id).Next;
- end loop;
- end if;
+ -- Get the case variable
- -- If not found in the package, or if there is no
- -- package, look at the project level.
+ The_Variable := In_Tree.Variable_Elements. Table (Var_Id).Value;
- if Var_Id = No_Variable
- and then
- No (Package_Node_Of
- (Variable_Node, From_Project_Node_Tree))
- then
- Var_Id := The_Project.Decl.Variables;
- while Var_Id /= No_Variable
- and then
- In_Tree.Variable_Elements.Table
- (Var_Id).Name /= Name
- loop
- Var_Id := In_Tree.Variable_Elements.
- Table (Var_Id).Next;
- end loop;
- end if;
+ if The_Variable.Kind /= Single then
- if Var_Id = No_Variable then
+ -- Should never happen, because this has already been
+ -- checked during parsing.
- -- Should never happen, because this has already been
- -- checked during parsing.
+ Write_Line ("variable""" & Get_Name_String (Name) &
+ """ is not a single string variable");
+ raise Program_Error;
+ end if;
- Write_Line ("variable """ &
- Get_Name_String (Name) &
- """ not found");
- raise Program_Error;
- end if;
+ -- Get the case variable value
+ Case_Value := The_Variable.Value;
+ end;
- -- Get the case variable
+ -- Now look into all the case items of the case construction
- The_Variable := In_Tree.Variable_Elements.
- Table (Var_Id).Value;
+ Case_Item := First_Case_Item_Of (Current_Item, Node_Tree);
- if The_Variable.Kind /= Single then
+ Case_Item_Loop :
+ while Present (Case_Item) loop
+ Choice_String := First_Choice_Of (Case_Item, Node_Tree);
- -- Should never happen, because this has already been
- -- checked during parsing.
+ -- When Choice_String is nil, it means that it is
+ -- the "when others =>" alternative.
- Write_Line ("variable""" &
- Get_Name_String (Name) &
- """ is not a single string variable");
- raise Program_Error;
- end if;
+ if No (Choice_String) then
+ Decl_Item := First_Declarative_Item_Of (Case_Item, Node_Tree);
+ exit Case_Item_Loop;
+ end if;
- -- Get the case variable value
- Case_Value := The_Variable.Value;
- end;
+ -- Look into all the alternative of this case item
- -- Now look into all the case items of the case construction
+ Choice_Loop :
+ while Present (Choice_String) loop
+ if Case_Value = String_Value_Of (Choice_String, Node_Tree) then
+ Decl_Item :=
+ First_Declarative_Item_Of (Case_Item, Node_Tree);
+ exit Case_Item_Loop;
+ end if;
- Case_Item :=
- First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
- Case_Item_Loop :
- while Present (Case_Item) loop
- Choice_String :=
- First_Choice_Of (Case_Item, From_Project_Node_Tree);
+ Choice_String := Next_Literal_String (Choice_String, Node_Tree);
+ end loop Choice_Loop;
- -- When Choice_String is nil, it means that it is
- -- the "when others =>" alternative.
+ Case_Item := Next_Case_Item (Case_Item, Node_Tree);
+ end loop Case_Item_Loop;
- if No (Choice_String) then
- Decl_Item :=
- First_Declarative_Item_Of
- (Case_Item, From_Project_Node_Tree);
- exit Case_Item_Loop;
- end if;
+ -- If there is an alternative, then we process it
- -- Look into all the alternative of this case item
+ if Present (Decl_Item) then
+ Process_Declarative_Items
+ (Project => Project,
+ In_Tree => In_Tree,
+ Flags => Flags,
+ From_Project_Node => From_Project_Node,
+ Node_Tree => Node_Tree,
+ Pkg => Pkg,
+ Item => Decl_Item);
+ end if;
+ end Process_Case_Construction;
- Choice_Loop :
- while Present (Choice_String) loop
- if Case_Value =
- String_Value_Of
- (Choice_String, From_Project_Node_Tree)
- then
- Decl_Item :=
- First_Declarative_Item_Of
- (Case_Item, From_Project_Node_Tree);
- exit Case_Item_Loop;
- end if;
+ -- Local variables
- Choice_String :=
- Next_Literal_String
- (Choice_String, From_Project_Node_Tree);
- end loop Choice_Loop;
+ Current, Decl : Project_Node_Id;
+ Kind : Project_Node_Kind;
- Case_Item :=
- Next_Case_Item (Case_Item, From_Project_Node_Tree);
- end loop Case_Item_Loop;
+ -- Start of processing for Process_Declarative_Items
- -- If there is an alternative, then we process it
+ begin
+ Decl := Item;
+ while Present (Decl) loop
+ Current := Current_Item_Node (Decl, Node_Tree);
+ Decl := Next_Declarative_Item (Decl, Node_Tree);
+ Kind := Kind_Of (Current, Node_Tree);
- if Present (Decl_Item) then
- Process_Declarative_Items
- (Project => Project,
- In_Tree => In_Tree,
- Flags => Flags,
- From_Project_Node => From_Project_Node,
- From_Project_Node_Tree => From_Project_Node_Tree,
- Pkg => Pkg,
- Item => Decl_Item);
- end if;
- end;
+ case Kind is
+ when N_Package_Declaration =>
+ Process_Package_Declaration (Current);
- when others =>
+ when N_String_Type_Declaration =>
+ -- There is nothing to process
+ null;
- -- Should never happen
+ when N_Attribute_Declaration |
+ N_Typed_Variable_Declaration |
+ N_Variable_Declaration =>
+ Process_Attribute_Declaration (Current);
+
+ when N_Case_Construction =>
+ Process_Case_Construction (Current);
- Write_Line ("Illegal declarative item: " &
- Project_Node_Kind'Image
- (Kind_Of
- (Current_Item, From_Project_Node_Tree)));
+ when others =>
+ Write_Line ("Illegal declarative item: " & Kind'Img);
raise Program_Error;
end case;
end loop;
-- And process the main project and all of the projects it depends on,
-- recursively.
+ Debug_Increase_Indent ("Process tree, phase 1");
+
Recursive_Process
(Project => Project,
In_Tree => In_Tree,
Success :=
Total_Errors_Detected = 0
and then
- (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
+ (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
+
+ if Current_Verbosity = High then
+ Debug_Decrease_Indent ("Done Process tree, phase 1, Success="
+ & Success'Img);
+ end if;
end Process_Project_Tree_Phase_1;
----------------------------------
begin
Success := True;
+ Debug_Increase_Indent ("Process tree, phase 2");
+
if Project /= No_Project then
Check (In_Tree, Project, From_Project_Node_Tree, Flags);
end if;
end loop;
end if;
+ Debug_Decrease_Indent ("Done Process tree, phase 2");
+
Success :=
Total_Errors_Detected = 0
and then
-- only projects imported through a standard "with" are processed.
-- Imported is the id of the last imported project.
+ procedure Process_Aggregated_Projects;
+ -- Process all the projects aggregated in List.
+ -- This does nothing if the project is not an aggregate project.
+
+ procedure Process_Extended_Project;
+ -- Process the extended project:
+ -- inherit all packages from the extended project that are not
+ -- explicitly defined or renamed. Also inherit the languages, if
+ -- attribute Languages is not explicitly defined.
+
-------------------------------
-- Process_Imported_Projects --
-------------------------------
With_Clause :=
First_With_Clause_Of
(From_Project_Node, From_Project_Node_Tree);
+
while Present (With_Clause) loop
Proj_Node :=
Non_Limited_Project_Node_Of
end loop;
end Process_Imported_Projects;
+ ---------------------------------
+ -- Process_Aggregated_Projects --
+ ---------------------------------
+
+ procedure Process_Aggregated_Projects is
+ List : Aggregated_Project_List;
+ Loaded_Tree : Prj.Tree.Project_Node_Id;
+ Success : Boolean := True;
+ begin
+ if Project.Qualifier /= Aggregate then
+ return;
+ end if;
+
+ Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);
+
+ Prj.Nmsc.Process_Aggregated_Projects
+ (Tree => In_Tree,
+ Project => Project,
+ Node_Tree => From_Project_Node_Tree,
+ Flags => Flags);
+
+ List := Project.Aggregated_Projects;
+ while Success and then List /= null loop
+ Prj.Part.Parse
+ (In_Tree => From_Project_Node_Tree,
+ Project => Loaded_Tree,
+ Project_File_Name => Get_Name_String (List.Path),
+ Errout_Handling => Prj.Part.Never_Finalize,
+ Current_Directory => Get_Name_String (Project.Directory.Name),
+ Is_Config_File => False,
+ Flags => Flags);
+
+ Success := not Prj.Tree.No (Loaded_Tree);
+
+ if Success then
+ Recursive_Process
+ (In_Tree => In_Tree,
+ Project => List.Project,
+ Flags => Flags,
+ From_Project_Node => Loaded_Tree,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Extended_By => No_Project);
+ else
+ Debug_Output ("Failed to parse", Name_Id (List.Path));
+ end if;
+
+ List := List.Next;
+ end loop;
+
+ Debug_Decrease_Indent ("Done Process_Aggregated_Projects");
+ end Process_Aggregated_Projects;
+
+ ------------------------------
+ -- Process_Extended_Project --
+ ------------------------------
+
+ procedure Process_Extended_Project is
+ Extended_Pkg : Package_Id;
+ Current_Pkg : Package_Id;
+ Element : Package_Element;
+ First : constant Package_Id := Project.Decl.Packages;
+ Attribute1 : Variable_Id;
+ Attribute2 : Variable_Id;
+ Attr_Value1 : Variable;
+ Attr_Value2 : Variable;
+
+ begin
+ Extended_Pkg := Project.Extends.Decl.Packages;
+ while Extended_Pkg /= No_Package loop
+ Element := In_Tree.Packages.Table (Extended_Pkg);
+
+ Current_Pkg := First;
+ while Current_Pkg /= No_Package
+ and then In_Tree.Packages.Table (Current_Pkg).Name /=
+ Element.Name
+ loop
+ Current_Pkg :=
+ In_Tree.Packages.Table (Current_Pkg).Next;
+ end loop;
+
+ if Current_Pkg = No_Package then
+ Package_Table.Increment_Last
+ (In_Tree.Packages);
+ Current_Pkg := Package_Table.Last (In_Tree.Packages);
+ In_Tree.Packages.Table (Current_Pkg) :=
+ (Name => Element.Name,
+ Decl => No_Declarations,
+ Parent => No_Package,
+ Next => Project.Decl.Packages);
+ Project.Decl.Packages := Current_Pkg;
+ Copy_Package_Declarations
+ (From => Element.Decl,
+ To =>
+ In_Tree.Packages.Table (Current_Pkg).Decl,
+ New_Loc => No_Location,
+ Restricted => True,
+ In_Tree => In_Tree);
+ end if;
+
+ Extended_Pkg := Element.Next;
+ end loop;
+
+ -- Check if attribute Languages is declared in the
+ -- extending project.
+
+ Attribute1 := Project.Decl.Attributes;
+ while Attribute1 /= No_Variable loop
+ Attr_Value1 := In_Tree.Variable_Elements.
+ Table (Attribute1);
+ exit when Attr_Value1.Name = Snames.Name_Languages;
+ Attribute1 := Attr_Value1.Next;
+ end loop;
+
+ if Attribute1 = No_Variable or else
+ Attr_Value1.Value.Default
+ then
+ -- Attribute Languages is not declared in the extending
+ -- project. Check if it is declared in the project being
+ -- extended.
+
+ Attribute2 := Project.Extends.Decl.Attributes;
+ while Attribute2 /= No_Variable loop
+ Attr_Value2 := In_Tree.Variable_Elements.
+ Table (Attribute2);
+ exit when Attr_Value2.Name = Snames.Name_Languages;
+ Attribute2 := Attr_Value2.Next;
+ end loop;
+
+ if Attribute2 /= No_Variable and then
+ not Attr_Value2.Value.Default
+ then
+ -- As attribute Languages is declared in the project
+ -- being extended, copy its value for the extending
+ -- project.
+
+ if Attribute1 = No_Variable then
+ Variable_Element_Table.Increment_Last
+ (In_Tree.Variable_Elements);
+ Attribute1 := Variable_Element_Table.Last
+ (In_Tree.Variable_Elements);
+ Attr_Value1.Next := Project.Decl.Attributes;
+ Project.Decl.Attributes := Attribute1;
+ end if;
+
+ Attr_Value1.Name := Snames.Name_Languages;
+ Attr_Value1.Value := Attr_Value2.Value;
+ In_Tree.Variable_Elements.Table
+ (Attribute1) := Attr_Value1;
+ end if;
+ end if;
+ end Process_Extended_Project;
+
-- Start of processing for Recursive_Process
begin
return;
end if;
- Project := new Project_Data'(Empty_Project);
+ Project := new Project_Data'
+ (Empty_Project
+ (Project_Qualifier_Of
+ (From_Project_Node, From_Project_Node_Tree)));
In_Tree.Projects := new Project_List_Element'
(Project => Project,
Next => In_Tree.Projects);
Project.Name := Name;
Project.Display_Name := Name_Node.Display_Name;
- Project.Qualifier :=
- Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
-
Get_Name_String (Name);
-- If name starts with the virtual prefix, flag the project as
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
- From_Project_Node_Tree => From_Project_Node_Tree,
+ Node_Tree => From_Project_Node_Tree,
Pkg => No_Package,
Item => First_Declarative_Item_Of
(Declaration_Node,
From_Project_Node_Tree));
- -- If it is an extending project, inherit all packages
- -- from the extended project that are not explicitly defined
- -- or renamed. Also inherit the languages, if attribute Languages
- -- is not explicitly defined.
-
if Project.Extends /= No_Project then
- declare
- Extended_Pkg : Package_Id;
- Current_Pkg : Package_Id;
- Element : Package_Element;
- First : constant Package_Id :=
- Project.Decl.Packages;
- Attribute1 : Variable_Id;
- Attribute2 : Variable_Id;
- Attr_Value1 : Variable;
- Attr_Value2 : Variable;
-
- begin
- Extended_Pkg := Project.Extends.Decl.Packages;
- while Extended_Pkg /= No_Package loop
- Element := In_Tree.Packages.Table (Extended_Pkg);
-
- Current_Pkg := First;
- while Current_Pkg /= No_Package
- and then In_Tree.Packages.Table (Current_Pkg).Name /=
- Element.Name
- loop
- Current_Pkg :=
- In_Tree.Packages.Table (Current_Pkg).Next;
- end loop;
-
- if Current_Pkg = No_Package then
- Package_Table.Increment_Last
- (In_Tree.Packages);
- Current_Pkg := Package_Table.Last (In_Tree.Packages);
- In_Tree.Packages.Table (Current_Pkg) :=
- (Name => Element.Name,
- Decl => No_Declarations,
- Parent => No_Package,
- Next => Project.Decl.Packages);
- Project.Decl.Packages := Current_Pkg;
- Copy_Package_Declarations
- (From => Element.Decl,
- To =>
- In_Tree.Packages.Table (Current_Pkg).Decl,
- New_Loc => No_Location,
- Restricted => True,
- In_Tree => In_Tree);
- end if;
-
- Extended_Pkg := Element.Next;
- end loop;
-
- -- Check if attribute Languages is declared in the
- -- extending project.
-
- Attribute1 := Project.Decl.Attributes;
- while Attribute1 /= No_Variable loop
- Attr_Value1 := In_Tree.Variable_Elements.
- Table (Attribute1);
- exit when Attr_Value1.Name = Snames.Name_Languages;
- Attribute1 := Attr_Value1.Next;
- end loop;
-
- if Attribute1 = No_Variable or else
- Attr_Value1.Value.Default
- then
- -- Attribute Languages is not declared in the extending
- -- project. Check if it is declared in the project being
- -- extended.
-
- Attribute2 := Project.Extends.Decl.Attributes;
- while Attribute2 /= No_Variable loop
- Attr_Value2 := In_Tree.Variable_Elements.
- Table (Attribute2);
- exit when Attr_Value2.Name = Snames.Name_Languages;
- Attribute2 := Attr_Value2.Next;
- end loop;
-
- if Attribute2 /= No_Variable and then
- not Attr_Value2.Value.Default
- then
- -- As attribute Languages is declared in the project
- -- being extended, copy its value for the extending
- -- project.
-
- if Attribute1 = No_Variable then
- Variable_Element_Table.Increment_Last
- (In_Tree.Variable_Elements);
- Attribute1 := Variable_Element_Table.Last
- (In_Tree.Variable_Elements);
- Attr_Value1.Next := Project.Decl.Attributes;
- Project.Decl.Attributes := Attribute1;
- end if;
-
- Attr_Value1.Name := Snames.Name_Languages;
- Attr_Value1.Value := Attr_Value2.Value;
- In_Tree.Variable_Elements.Table
- (Attribute1) := Attr_Value1;
- end if;
- end if;
- end;
+ Process_Extended_Project;
end if;
Process_Imported_Projects (Imported, Limited_With => True);
+
+ if Err_Vars.Total_Errors_Detected = 0 then
+ Process_Aggregated_Projects;
+ end if;
end;
end if;
end Recursive_Process;
projects / gcc.git / commitdiff