diff options
Diffstat (limited to 'gcc/ada/prj-dect.adb')
| -rw-r--r-- | gcc/ada/prj-dect.adb | 570 |
1 files changed, 328 insertions, 242 deletions
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index e030236afe8..0b64d9b4b2c 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc -- +-- Copyright (C) 2001-2005 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- -- @@ -45,40 +45,50 @@ package body Prj.Dect is -- (In_Project). procedure Parse_Attribute_Declaration - (Attribute : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Attribute : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse an attribute declaration. procedure Parse_Case_Construction - (Case_Construction : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Case_Construction : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse a case construction procedure Parse_Declarative_Items - (Declarations : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Declarations : out Project_Node_Id; In_Zone : Zone; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id); + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse declarative items. Depending on In_Zone, some declarative -- items may be forbiden. procedure Parse_Package_Declaration - (Package_Declaration : out Project_Node_Id; - Current_Project : Project_Node_Id); + (In_Tree : Project_Node_Tree_Ref; + Package_Declaration : out Project_Node_Id; + Current_Project : Project_Node_Id; + Packages_To_Check : String_List_Access); -- Parse a package declaration procedure Parse_String_Type_Declaration - (String_Type : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + String_Type : out Project_Node_Id; Current_Project : Project_Node_Id); -- type <name> is ( <literal_string> { , <literal_string> } ) ; procedure Parse_Variable_Declaration - (Variable : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Variable : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id); -- Parse a variable assignment @@ -90,25 +100,31 @@ package body Prj.Dect is ----------- procedure Parse - (Declarations : out Project_Node_Id; - Current_Project : Project_Node_Id; - Extends : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Declarations : out Project_Node_Id; + Current_Project : Project_Node_Id; + Extends : Project_Node_Id; + Packages_To_Check : String_List_Access) is First_Declarative_Item : Project_Node_Id := Empty_Node; begin - Declarations := Default_Project_Node (Of_Kind => N_Project_Declaration); - Set_Location_Of (Declarations, To => Token_Ptr); - Set_Extended_Project_Of (Declarations, To => Extends); - Set_Project_Declaration_Of (Current_Project, Declarations); + Declarations := + Default_Project_Node + (Of_Kind => N_Project_Declaration, In_Tree => In_Tree); + Set_Location_Of (Declarations, In_Tree, To => Token_Ptr); + Set_Extended_Project_Of (Declarations, In_Tree, To => Extends); + Set_Project_Declaration_Of (Current_Project, In_Tree, Declarations); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Project, - First_Attribute => Prj.Attr.Attribute_First, - Current_Project => Current_Project, - Current_Package => Empty_Node); + (Declarations => First_Declarative_Item, + In_Tree => In_Tree, + In_Zone => In_Project, + First_Attribute => Prj.Attr.Attribute_First, + Current_Project => Current_Project, + Current_Package => Empty_Node, + Packages_To_Check => Packages_To_Check); Set_First_Declarative_Item_Of - (Declarations, To => First_Declarative_Item); + (Declarations, In_Tree, To => First_Declarative_Item); end Parse; --------------------------------- @@ -116,10 +132,12 @@ package body Prj.Dect is --------------------------------- procedure Parse_Attribute_Declaration - (Attribute : out Project_Node_Id; - First_Attribute : Attribute_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Attribute : out Project_Node_Id; + First_Attribute : Attribute_Node_Id; + Current_Project : Project_Node_Id; + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access) is Current_Attribute : Attribute_Node_Id := First_Attribute; Full_Associative_Array : Boolean := False; @@ -129,13 +147,15 @@ package body Prj.Dect is Warning : Boolean := False; begin - Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration); - Set_Location_Of (Attribute, To => Token_Ptr); + Attribute := + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, In_Tree => In_Tree); + Set_Location_Of (Attribute, In_Tree, To => Token_Ptr); Set_Previous_Line_Node (Attribute); -- Scan past "for" - Scan; + Scan (In_Tree); -- Body may be an attribute name @@ -148,8 +168,8 @@ package body Prj.Dect is if Token = Tok_Identifier then Attribute_Name := Token_Name; - Set_Name_Of (Attribute, To => Token_Name); - Set_Location_Of (Attribute, To => Token_Ptr); + Set_Name_Of (Attribute, In_Tree, To => Token_Name); + Set_Location_Of (Attribute, In_Tree, To => Token_Ptr); -- Find the attribute @@ -161,9 +181,9 @@ package body Prj.Dect is if Current_Attribute = Empty_Attribute then if Current_Package /= Empty_Node - and then Expression_Kind_Of (Current_Package) = Ignored + and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored then - Pkg_Id := Package_Id_Of (Current_Package); + Pkg_Id := Package_Id_Of (Current_Package, In_Tree); Add_Attribute (Pkg_Id, Token_Name, Current_Attribute); Error_Msg_Name_1 := Token_Name; Error_Msg ("?unknown attribute {", Token_Ptr); @@ -173,17 +193,17 @@ package body Prj.Dect is -- if inside a package that does not need to be checked. Warning := Current_Package /= Empty_Node and then - Current_Packages_To_Check /= All_Packages; + Packages_To_Check /= All_Packages; if Warning then -- Check that we are not in a package to check - Get_Name_String (Name_Of (Current_Package)); + Get_Name_String (Name_Of (Current_Package, In_Tree)); - for Index in Current_Packages_To_Check'Range loop + for Index in Packages_To_Check'Range loop if Name_Buffer (1 .. Name_Len) = - Current_Packages_To_Check (Index).all + Packages_To_Check (Index).all then Warning := False; exit; @@ -207,29 +227,29 @@ package body Prj.Dect is Case_Insensitive_Associative_Array .. Optional_Index_Case_Insensitive_Associative_Array then - Set_Case_Insensitive (Attribute, To => True); + Set_Case_Insensitive (Attribute, In_Tree, To => True); end if; - Scan; -- past the attribute name + Scan (In_Tree); -- past the attribute name end if; -- Change obsolete names of attributes to the new names if Current_Package /= Empty_Node - and then Expression_Kind_Of (Current_Package) /= Ignored + and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored then - case Name_Of (Attribute) is + case Name_Of (Attribute, In_Tree) is when Snames.Name_Specification => - Set_Name_Of (Attribute, To => Snames.Name_Spec); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec); when Snames.Name_Specification_Suffix => - Set_Name_Of (Attribute, To => Snames.Name_Spec_Suffix); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix); when Snames.Name_Implementation => - Set_Name_Of (Attribute, To => Snames.Name_Body); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body); when Snames.Name_Implementation_Suffix => - Set_Name_Of (Attribute, To => Snames.Name_Body_Suffix); + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix); when others => null; @@ -251,24 +271,24 @@ package body Prj.Dect is Get_Name_String (Attribute_Name_Of (Current_Attribute)) & """ cannot be an associative array", - Location_Of (Attribute)); + Location_Of (Attribute, In_Tree)); elsif Attribute_Kind_Of (Current_Attribute) = Unknown then Set_Attribute_Kind_Of (Current_Attribute, To => Associative_Array); end if; - Scan; -- past the left parenthesis + Scan (In_Tree); -- past the left parenthesis Expect (Tok_String_Literal, "literal string"); if Token = Tok_String_Literal then - Set_Associative_Array_Index_Of (Attribute, Token_Name); - Scan; -- past the literal string index + Set_Associative_Array_Index_Of (Attribute, In_Tree, Token_Name); + Scan (In_Tree); -- past the literal string index if Token = Tok_At then case Attribute_Kind_Of (Current_Attribute) is when Optional_Index_Associative_Array | Optional_Index_Case_Insensitive_Associative_Array => - Scan; + Scan (In_Tree); Expect (Tok_Integer_Literal, "integer literal"); if Token = Tok_Integer_Literal then @@ -282,19 +302,20 @@ package body Prj.Dect is if Index = 0 then Error_Msg ("index cannot be zero", Token_Ptr); else - Set_Source_Index_Of (Attribute, To => Index); + Set_Source_Index_Of + (Attribute, In_Tree, To => Index); end if; end; - Scan; + Scan (In_Tree); end if; when others => Error_Msg ("index not allowed here", Token_Ptr); - Scan; + Scan (In_Tree); if Token = Tok_Integer_Literal then - Scan; + Scan (In_Tree); end if; end case; end if; @@ -303,7 +324,7 @@ package body Prj.Dect is Expect (Tok_Right_Paren, "`)`"); if Token = Tok_Right_Paren then - Scan; -- past the right parenthesis + Scan (In_Tree); -- past the right parenthesis end if; else @@ -328,14 +349,14 @@ package body Prj.Dect is if Current_Attribute /= Empty_Attribute then Set_Expression_Kind_Of - (Attribute, To => Variable_Kind_Of (Current_Attribute)); + (Attribute, In_Tree, To => Variable_Kind_Of (Current_Attribute)); Optional_Index := Optional_Index_Of (Current_Attribute); end if; Expect (Tok_Use, "USE"); if Token = Tok_Use then - Scan; + Scan (In_Tree); if Full_Associative_Array then @@ -368,15 +389,15 @@ package body Prj.Dect is -- in the project being extended. The_Project := Imported_Or_Extended_Project_Of - (Current_Project, Token_Name); + (Current_Project, In_Tree, Token_Name); if The_Project = Empty_Node then Error_Msg ("unknown project", Location); - Scan; -- past the project name + Scan (In_Tree); -- past the project name else Project_Name := Token_Name; - Scan; -- past the project name + Scan (In_Tree); -- past the project name -- If this is inside a package, a dot followed by the -- name of the package must followed the project name. @@ -388,7 +409,7 @@ package body Prj.Dect is The_Project := Empty_Node; else - Scan; -- past the dot + Scan (In_Tree); -- past the dot Expect (Tok_Identifier, "identifier"); if Token /= Tok_Identifier then @@ -396,23 +417,29 @@ package body Prj.Dect is -- If it is not the same package name, issue error - elsif Token_Name /= Name_Of (Current_Package) then + elsif + Token_Name /= Name_Of (Current_Package, In_Tree) + then The_Project := Empty_Node; Error_Msg ("not the same package as " & - Get_Name_String (Name_Of (Current_Package)), + Get_Name_String + (Name_Of (Current_Package, In_Tree)), Token_Ptr); else - The_Package := First_Package_Of (The_Project); + The_Package := + First_Package_Of (The_Project, In_Tree); -- Look for the package node while The_Package /= Empty_Node - and then Name_Of (The_Package) /= Token_Name + and then + Name_Of (The_Package, In_Tree) /= Token_Name loop The_Package := - Next_Package_In_Project (The_Package); + Next_Package_In_Project + (The_Package, In_Tree); end loop; -- If the package cannot be found in the @@ -427,7 +454,7 @@ package body Prj.Dect is Token_Ptr); end if; - Scan; -- past the package name + Scan (In_Tree); -- past the package name end if; end if; end if; @@ -444,7 +471,7 @@ package body Prj.Dect is The_Project := Empty_Node; else - Scan; -- past the apostrophe + Scan (In_Tree); -- past the apostrophe Expect (Tok_Identifier, "identifier"); if Token /= Tok_Identifier then @@ -459,7 +486,7 @@ package body Prj.Dect is Error_Msg ("invalid name, should be %", Token_Ptr); end if; - Scan; -- past the attribute name + Scan (In_Tree); -- past the attribute name end if; end if; end if; @@ -477,8 +504,8 @@ package body Prj.Dect is -- characterizes full associative array attribute -- declarations. - Set_Associative_Project_Of (Attribute, The_Project); - Set_Associative_Package_Of (Attribute, The_Package); + Set_Associative_Project_Of (Attribute, In_Tree, The_Project); + Set_Associative_Package_Of (Attribute, In_Tree, The_Package); end if; end; @@ -496,11 +523,12 @@ package body Prj.Dect is -- Get the expression value and set it in the attribute node Parse_Expression - (Expression => Expression, + (In_Tree => In_Tree, + Expression => Expression, Current_Project => Current_Project, Current_Package => Current_Package, Optional_Index => Optional_Index); - Set_Expression_Of (Attribute, To => Expression); + Set_Expression_Of (Attribute, In_Tree, To => Expression); -- If the expression is legal, but not of the right kind -- for the attribute, issue an error. @@ -508,12 +536,12 @@ package body Prj.Dect is if Current_Attribute /= Empty_Attribute and then Expression /= Empty_Node and then Variable_Kind_Of (Current_Attribute) /= - Expression_Kind_Of (Expression) + Expression_Kind_Of (Expression, In_Tree) then if Variable_Kind_Of (Current_Attribute) = Undefined then Set_Variable_Kind_Of (Current_Attribute, - To => Expression_Kind_Of (Expression)); + To => Expression_Kind_Of (Expression, In_Tree)); else Error_Msg @@ -545,10 +573,12 @@ package body Prj.Dect is ----------------------------- procedure Parse_Case_Construction - (Case_Construction : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Case_Construction : out Project_Node_Id; First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access) is Current_Item : Project_Node_Id := Empty_Node; Next_Item : Project_Node_Id := Empty_Node; @@ -569,12 +599,13 @@ package body Prj.Dect is begin Case_Construction := - Default_Project_Node (Of_Kind => N_Case_Construction); - Set_Location_Of (Case_Construction, To => Token_Ptr); + Default_Project_Node + (Of_Kind => N_Case_Construction, In_Tree => In_Tree); + Set_Location_Of (Case_Construction, In_Tree, To => Token_Ptr); -- Scan past "case" - Scan; + Scan (In_Tree); -- Get the switch variable @@ -583,24 +614,25 @@ package body Prj.Dect is if Token = Tok_Identifier then Variable_Location := Token_Ptr; Parse_Variable_Reference - (Variable => Case_Variable, + (In_Tree => In_Tree, + Variable => Case_Variable, Current_Project => Current_Project, Current_Package => Current_Package); Set_Case_Variable_Reference_Of - (Case_Construction, To => Case_Variable); + (Case_Construction, In_Tree, To => Case_Variable); else if Token /= Tok_Is then - Scan; + Scan (In_Tree); end if; end if; if Case_Variable /= Empty_Node then - String_Type := String_Type_Of (Case_Variable); + String_Type := String_Type_Of (Case_Variable, In_Tree); if String_Type = Empty_Node then Error_Msg ("variable """ & - Get_Name_String (Name_Of (Case_Variable)) & + Get_Name_String (Name_Of (Case_Variable, In_Tree)) & """ is not typed", Variable_Location); end if; @@ -615,38 +647,43 @@ package body Prj.Dect is -- Scan past "is" - Scan; + Scan (In_Tree); end if; - Start_New_Case_Construction (String_Type); + Start_New_Case_Construction (In_Tree, String_Type); When_Loop : while Token = Tok_When loop if First_Case_Item then - Current_Item := Default_Project_Node (Of_Kind => N_Case_Item); - Set_First_Case_Item_Of (Case_Construction, To => Current_Item); + Current_Item := + Default_Project_Node + (Of_Kind => N_Case_Item, In_Tree => In_Tree); + Set_First_Case_Item_Of + (Case_Construction, In_Tree, To => Current_Item); First_Case_Item := False; else - Next_Item := Default_Project_Node (Of_Kind => N_Case_Item); - Set_Next_Case_Item (Current_Item, To => Next_Item); + Next_Item := + Default_Project_Node + (Of_Kind => N_Case_Item, In_Tree => In_Tree); + Set_Next_Case_Item (Current_Item, In_Tree, To => Next_Item); Current_Item := Next_Item; end if; - Set_Location_Of (Current_Item, To => Token_Ptr); + Set_Location_Of (Current_Item, In_Tree, To => Token_Ptr); -- Scan past "when" - Scan; + Scan (In_Tree); if Token = Tok_Others then When_Others := True; -- Scan past "others" - Scan; + Scan (In_Tree); Expect (Tok_Arrow, "`=>`"); Set_End_Of_Line (Current_Item); @@ -655,46 +692,52 @@ package body Prj.Dect is -- Empty_Node in Field1 of a Case_Item indicates -- the "when others =>" branch. - Set_First_Choice_Of (Current_Item, To => Empty_Node); + Set_First_Choice_Of (Current_Item, In_Tree, To => Empty_Node); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Case_Construction, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Current_Package); + (In_Tree => In_Tree, + Declarations => First_Declarative_Item, + In_Zone => In_Case_Construction, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); -- "when others =>" must be the last branch, so save the -- Case_Item and exit Set_First_Declarative_Item_Of - (Current_Item, To => First_Declarative_Item); + (Current_Item, In_Tree, To => First_Declarative_Item); exit When_Loop; else - Parse_Choice_List (First_Choice => First_Choice); - Set_First_Choice_Of (Current_Item, To => First_Choice); + Parse_Choice_List + (In_Tree => In_Tree, + First_Choice => First_Choice); + Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice); Expect (Tok_Arrow, "`=>`"); Set_End_Of_Line (Current_Item); Set_Previous_Line_Node (Current_Item); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Case_Construction, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Current_Package); + (In_Tree => In_Tree, + Declarations => First_Declarative_Item, + In_Zone => In_Case_Construction, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); Set_First_Declarative_Item_Of - (Current_Item, To => First_Declarative_Item); + (Current_Item, In_Tree, To => First_Declarative_Item); end if; end loop When_Loop; End_Case_Construction (Check_All_Labels => not When_Others and not Quiet_Output, - Case_Location => Location_Of (Case_Construction)); + Case_Location => Location_Of (Case_Construction, In_Tree)); Expect (Tok_End, "`END CASE`"); Remove_Next_End_Node; @@ -703,7 +746,7 @@ package body Prj.Dect is -- Scan past "end" - Scan; + Scan (In_Tree); Expect (Tok_Case, "CASE"); @@ -711,7 +754,7 @@ package body Prj.Dect is -- Scan past "case" - Scan; + Scan (In_Tree); Expect (Tok_Semicolon, "`;`"); Set_Previous_End_Node (Case_Construction); @@ -723,11 +766,13 @@ package body Prj.Dect is ----------------------------- procedure Parse_Declarative_Items - (Declarations : out Project_Node_Id; - In_Zone : Zone; - First_Attribute : Attribute_Node_Id; - Current_Project : Project_Node_Id; - Current_Package : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Declarations : out Project_Node_Id; + In_Zone : Zone; + First_Attribute : Attribute_Node_Id; + Current_Project : Project_Node_Id; + Current_Package : Project_Node_Id; + Packages_To_Check : String_List_Access) is Current_Declarative_Item : Project_Node_Id := Empty_Node; Next_Declarative_Item : Project_Node_Id := Empty_Node; @@ -742,7 +787,7 @@ package body Prj.Dect is -- the first token of the declarative element. -- Scan past it - Scan; + Scan (In_Tree); Item_Location := Token_Ptr; @@ -755,7 +800,8 @@ package body Prj.Dect is end if; Parse_Variable_Declaration - (Current_Declaration, + (In_Tree, + Current_Declaration, Current_Project => Current_Project, Current_Package => Current_Package); @@ -765,17 +811,19 @@ package body Prj.Dect is when Tok_For => Parse_Attribute_Declaration - (Attribute => Current_Declaration, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Current_Package); + (In_Tree => In_Tree, + Attribute => Current_Declaration, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); Set_End_Of_Line (Current_Declaration); Set_Previous_Line_Node (Current_Declaration); when Tok_Null => - Scan; -- past "null" + Scan (In_Tree); -- past "null" when Tok_Package => @@ -786,8 +834,10 @@ package body Prj.Dect is end if; Parse_Package_Declaration - (Package_Declaration => Current_Declaration, - Current_Project => Current_Project); + (In_Tree => In_Tree, + Package_Declaration => Current_Declaration, + Current_Project => Current_Project, + Packages_To_Check => Packages_To_Check); Set_Previous_End_Node (Current_Declaration); @@ -801,7 +851,8 @@ package body Prj.Dect is end if; Parse_String_Type_Declaration - (String_Type => Current_Declaration, + (In_Tree => In_Tree, + String_Type => Current_Declaration, Current_Project => Current_Project); Set_End_Of_Line (Current_Declaration); @@ -812,10 +863,12 @@ package body Prj.Dect is -- Case construction Parse_Case_Construction - (Case_Construction => Current_Declaration, + (In_Tree => In_Tree, + Case_Construction => Current_Declaration, First_Attribute => First_Attribute, Current_Project => Current_Project, - Current_Package => Current_Package); + Current_Package => Current_Package, + Packages_To_Check => Packages_To_Check); Set_Previous_End_Node (Current_Declaration); @@ -837,24 +890,27 @@ package body Prj.Dect is if Current_Declaration /= Empty_Node then if Current_Declarative_Item = Empty_Node then Current_Declarative_Item := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, In_Tree => In_Tree); Declarations := Current_Declarative_Item; else Next_Declarative_Item := - Default_Project_Node (Of_Kind => N_Declarative_Item); + Default_Project_Node + (Of_Kind => N_Declarative_Item, In_Tree => In_Tree); Set_Next_Declarative_Item - (Current_Declarative_Item, To => Next_Declarative_Item); + (Current_Declarative_Item, In_Tree, + To => Next_Declarative_Item); Current_Declarative_Item := Next_Declarative_Item; end if; Set_Current_Item_Node - (Current_Declarative_Item, To => Current_Declaration); - Set_Location_Of (Current_Declarative_Item, To => Item_Location); + (Current_Declarative_Item, In_Tree, + To => Current_Declaration); + Set_Location_Of + (Current_Declarative_Item, In_Tree, To => Item_Location); end if; - end loop; - end Parse_Declarative_Items; ------------------------------- @@ -862,8 +918,10 @@ package body Prj.Dect is ------------------------------- procedure Parse_Package_Declaration - (Package_Declaration : out Project_Node_Id; - Current_Project : Project_Node_Id) + (In_Tree : Project_Node_Tree_Ref; + Package_Declaration : out Project_Node_Id; + Current_Project : Project_Node_Id; + Packages_To_Check : String_List_Access) is First_Attribute : Attribute_Node_Id := Empty_Attribute; Current_Package : Package_Node_Id := Empty_Package; @@ -871,17 +929,17 @@ package body Prj.Dect is begin Package_Declaration := - Default_Project_Node (Of_Kind => N_Package_Declaration); - Set_Location_Of (Package_Declaration, To => Token_Ptr); + Default_Project_Node + (Of_Kind => N_Package_Declaration, In_Tree => In_Tree); + Set_Location_Of (Package_Declaration, In_Tree, To => Token_Ptr); -- Scan past "package" - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then - - Set_Name_Of (Package_Declaration, To => Token_Name); + Set_Name_Of (Package_Declaration, In_Tree, To => Token_Name); Current_Package := Package_Node_Id_Of (Token_Name); @@ -890,36 +948,39 @@ package body Prj.Dect is else Error_Msg ("?""" & - Get_Name_String (Name_Of (Package_Declaration)) & + Get_Name_String + (Name_Of (Package_Declaration, In_Tree)) & """ is not a known package name", Token_Ptr); -- Set the package declaration to "ignored" so that it is not -- processed by Prj.Proc.Process. - Set_Expression_Kind_Of (Package_Declaration, Ignored); + Set_Expression_Kind_Of (Package_Declaration, In_Tree, Ignored); -- Add the unknown package in the list of packages Add_Unknown_Package (Token_Name, Current_Package); end if; - Set_Package_Id_Of (Package_Declaration, To => Current_Package); + Set_Package_Id_Of + (Package_Declaration, In_Tree, To => Current_Package); declare - Current : Project_Node_Id := First_Package_Of (Current_Project); + Current : Project_Node_Id := + First_Package_Of (Current_Project, In_Tree); begin while Current /= Empty_Node - and then Name_Of (Current) /= Token_Name + and then Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_Package_In_Project (Current); + Current := Next_Package_In_Project (Current, In_Tree); end loop; if Current /= Empty_Node then Error_Msg ("package """ & - Get_Name_String (Name_Of (Package_Declaration)) & + Get_Name_String (Name_Of (Package_Declaration, In_Tree)) & """ is declared twice in the same project", Token_Ptr); @@ -927,23 +988,23 @@ package body Prj.Dect is -- Add the package to the project list Set_Next_Package_In_Project - (Package_Declaration, - To => First_Package_Of (Current_Project)); + (Package_Declaration, In_Tree, + To => First_Package_Of (Current_Project, In_Tree)); Set_First_Package_Of - (Current_Project, To => Package_Declaration); + (Current_Project, In_Tree, To => Package_Declaration); end if; end; -- Scan past the package name - Scan; + Scan (In_Tree); end if; if Token = Tok_Renames then -- Scan past "renames" - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); @@ -951,20 +1012,23 @@ package body Prj.Dect is declare Project_Name : constant Name_Id := Token_Name; Clause : Project_Node_Id := - First_With_Clause_Of (Current_Project); + First_With_Clause_Of (Current_Project, In_Tree); The_Project : Project_Node_Id := Empty_Node; Extended : constant Project_Node_Id := Extended_Project_Of - (Project_Declaration_Of (Current_Project)); + (Project_Declaration_Of + (Current_Project, In_Tree), + In_Tree); begin while Clause /= Empty_Node loop - -- Only non limited imported projects may be used - -- in a renames declaration. + -- Only non limited imported projects may be used in a + -- renames declaration. - The_Project := Non_Limited_Project_Node_Of (Clause); + The_Project := + Non_Limited_Project_Node_Of (Clause, In_Tree); exit when The_Project /= Empty_Node - and then Name_Of (The_Project) = Project_Name; - Clause := Next_With_Clause_Of (Clause); + and then Name_Of (The_Project, In_Tree) = Project_Name; + Clause := Next_With_Clause_Of (Clause, In_Tree); end loop; if Clause = Empty_Node then @@ -972,9 +1036,10 @@ package body Prj.Dect is -- if it's the name of an eventual extended project. if Extended /= Empty_Node - and then Name_Of (Extended) = Project_Name then + and then Name_Of (Extended, In_Tree) = Project_Name + then Set_Project_Of_Renamed_Package_Of - (Package_Declaration, To => Extended); + (Package_Declaration, In_Tree, To => Extended); else Error_Msg_Name_1 := Project_Name; Error_Msg @@ -982,35 +1047,37 @@ package body Prj.Dect is end if; else Set_Project_Of_Renamed_Package_Of - (Package_Declaration, To => The_Project); + (Package_Declaration, In_Tree, To => The_Project); end if; end; - Scan; + Scan (In_Tree); Expect (Tok_Dot, "`.`"); if Token = Tok_Dot then - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then - if Name_Of (Package_Declaration) /= Token_Name then + if Name_Of (Package_Declaration, In_Tree) /= Token_Name then Error_Msg ("not the same package name", Token_Ptr); elsif - Project_Of_Renamed_Package_Of (Package_Declaration) - /= Empty_Node + Project_Of_Renamed_Package_Of + (Package_Declaration, In_Tree) /= Empty_Node then declare Current : Project_Node_Id := First_Package_Of (Project_Of_Renamed_Package_Of - (Package_Declaration)); + (Package_Declaration, In_Tree), + In_Tree); begin while Current /= Empty_Node - and then Name_Of (Current) /= Token_Name + and then Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_Package_In_Project (Current); + Current := + Next_Package_In_Project (Current, In_Tree); end loop; if Current = Empty_Node then @@ -1023,7 +1090,7 @@ package body Prj.Dect is end; end if; - Scan; + Scan (In_Tree); end if; end if; end if; @@ -1038,14 +1105,16 @@ package body Prj.Dect is Set_Next_End_Node (Package_Declaration); Parse_Declarative_Items - (Declarations => First_Declarative_Item, - In_Zone => In_Package, - First_Attribute => First_Attribute, - Current_Project => Current_Project, - Current_Package => Package_Declaration); + (In_Tree => In_Tree, + Declarations => First_Declarative_Item, + In_Zone => In_Package, + First_Attribute => First_Attribute, + Current_Project => Current_Project, + Current_Package => Package_Declaration, + Packages_To_Check => Packages_To_Check); Set_First_Declarative_Item_Of - (Package_Declaration, To => First_Declarative_Item); + (Package_Declaration, In_Tree, To => First_Declarative_Item); Expect (Tok_End, "END"); @@ -1053,7 +1122,7 @@ package body Prj.Dect is -- Scan past "end" - Scan; + Scan (In_Tree); end if; -- We should have the name of the package after "end" @@ -1061,10 +1130,10 @@ package body Prj.Dect is Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier - and then Name_Of (Package_Declaration) /= No_Name - and then Token_Name /= Name_Of (Package_Declaration) + and then Name_Of (Package_Declaration, In_Tree) /= No_Name + and then Token_Name /= Name_Of (Package_Declaration, In_Tree) then - Error_Msg_Name_1 := Name_Of (Package_Declaration); + Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree); Error_Msg ("expected {", Token_Ptr); end if; @@ -1072,7 +1141,7 @@ package body Prj.Dect is -- Scan past the package name - Scan; + Scan (In_Tree); end if; Expect (Tok_Semicolon, "`;`"); @@ -1089,7 +1158,8 @@ package body Prj.Dect is ----------------------------------- procedure Parse_String_Type_Declaration - (String_Type : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + String_Type : out Project_Node_Id; Current_Project : Project_Node_Id) is Current : Project_Node_Id := Empty_Node; @@ -1097,25 +1167,26 @@ package body Prj.Dect is begin String_Type := - Default_Project_Node (Of_Kind => N_String_Type_Declaration); + Default_Project_Node + (Of_Kind => N_String_Type_Declaration, In_Tree => In_Tree); - Set_Location_Of (String_Type, To => Token_Ptr); + Set_Location_Of (String_Type, In_Tree, To => Token_Ptr); -- Scan past "type" - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then - Set_Name_Of (String_Type, To => Token_Name); + Set_Name_Of (String_Type, In_Tree, To => Token_Name); - Current := First_String_Type_Of (Current_Project); + Current := First_String_Type_Of (Current_Project, In_Tree); while Current /= Empty_Node and then - Name_Of (Current) /= Token_Name + Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_String_Type (Current); + Current := Next_String_Type (Current, In_Tree); end loop; if Current /= Empty_Node then @@ -1124,11 +1195,11 @@ package body Prj.Dect is """", Token_Ptr); else - Current := First_Variable_Of (Current_Project); + Current := First_Variable_Of (Current_Project, In_Tree); while Current /= Empty_Node - and then Name_Of (Current) /= Token_Name + and then Name_Of (Current, In_Tree) /= Token_Name loop - Current := Next_Variable (Current); + Current := Next_Variable (Current, In_Tree); end loop; if Current /= Empty_Node then @@ -1137,35 +1208,38 @@ package body Prj.Dect is """ is already a variable name", Token_Ptr); else Set_Next_String_Type - (String_Type, To => First_String_Type_Of (Current_Project)); - Set_First_String_Type_Of (Current_Project, To => String_Type); + (String_Type, In_Tree, + To => First_String_Type_Of (Current_Project, In_Tree)); + Set_First_String_Type_Of + (Current_Project, In_Tree, To => String_Type); end if; end if; -- Scan past the name - Scan; + Scan (In_Tree); end if; Expect (Tok_Is, "IS"); if Token = Tok_Is then - Scan; + Scan (In_Tree); end if; Expect (Tok_Left_Paren, "`(`"); if Token = Tok_Left_Paren then - Scan; + Scan (In_Tree); end if; - Parse_String_Type_List (First_String => First_String); - Set_First_Literal_String (String_Type, To => First_String); + Parse_String_Type_List + (In_Tree => In_Tree, First_String => First_String); + Set_First_Literal_String (String_Type, In_Tree, To => First_String); Expect (Tok_Right_Paren, "`)`"); if Token = Tok_Right_Paren then - Scan; + Scan (In_Tree); end if; end Parse_String_Type_Declaration; @@ -1175,7 +1249,8 @@ package body Prj.Dect is -------------------------------- procedure Parse_Variable_Declaration - (Variable : out Project_Node_Id; + (In_Tree : Project_Node_Tree_Ref; + Variable : out Project_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id) is @@ -1190,20 +1265,21 @@ package body Prj.Dect is begin Variable := - Default_Project_Node (Of_Kind => N_Variable_Declaration); - Set_Name_Of (Variable, To => Variable_Name); - Set_Location_Of (Variable, To => Token_Ptr); + Default_Project_Node + (Of_Kind => N_Variable_Declaration, In_Tree => In_Tree); + Set_Name_Of (Variable, In_Tree, To => Variable_Name); + Set_Location_Of (Variable, In_Tree, To => Token_Ptr); -- Scan past the variable name - Scan; + Scan (In_Tree); if Token = Tok_Colon then -- Typed string variable declaration - Scan; - Set_Kind_Of (Variable, N_Typed_Variable_Declaration); + Scan (In_Tree); + Set_Kind_Of (Variable, In_Tree, N_Typed_Variable_Declaration); Expect (Tok_Identifier, "identifier"); OK := Token = Tok_Identifier; @@ -1211,7 +1287,7 @@ package body Prj.Dect is if OK then String_Type_Name := Token_Name; Type_Location := Token_Ptr; - Scan; + Scan (In_Tree); if Token = Tok_Dot then Project_String_Type_Name := String_Type_Name; @@ -1219,13 +1295,13 @@ package body Prj.Dect is -- Scan past the dot - Scan; + Scan (In_Tree); Expect (Tok_Identifier, "identifier"); if Token = Tok_Identifier then String_Type_Name := Token_Name; Type_Location := Token_Ptr; - Scan; + Scan (In_Tree); else OK := False; end if; @@ -1234,7 +1310,7 @@ package body Prj.Dect is if OK then declare Current : Project_Node_Id := - First_String_Type_Of (Current_Project); + First_String_Type_Of (Current_Project, In_Tree); begin if Project_String_Type_Name /= No_Name then @@ -1242,7 +1318,7 @@ package body Prj.Dect is The_Project_Name_And_Node : constant Tree_Private_Part.Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get - (Project_String_Type_Name); + (In_Tree.Projects_HT, Project_String_Type_Name); use Tree_Private_Part; @@ -1259,15 +1335,15 @@ package body Prj.Dect is else Current := First_String_Type_Of - (The_Project_Name_And_Node.Node); + (The_Project_Name_And_Node.Node, In_Tree); end if; end; end if; while Current /= Empty_Node - and then Name_Of (Current) /= String_Type_Name + and then Name_Of (Current, In_Tree) /= String_Type_Name loop - Current := Next_String_Type (Current); + Current := Next_String_Type (Current, In_Tree); end loop; if Current = Empty_Node then @@ -1278,7 +1354,7 @@ package body Prj.Dect is OK := False; else Set_String_Type_Of - (Variable, To => Current); + (Variable, In_Tree, To => Current); end if; end; end if; @@ -1290,7 +1366,7 @@ package body Prj.Dect is OK := OK and (Token = Tok_Colon_Equal); if Token = Tok_Colon_Equal then - Scan; + Scan (In_Tree); end if; -- Get the single string or string list value @@ -1298,24 +1374,26 @@ package body Prj.Dect is Expression_Location := Token_Ptr; Parse_Expression - (Expression => Expression, + (In_Tree => In_Tree, + Expression => Expression, Current_Project => Current_Project, Current_Package => Current_Package, Optional_Index => False); - Set_Expression_Of (Variable, To => Expression); + Set_Expression_Of (Variable, In_Tree, To => Expression); if Expression /= Empty_Node then -- A typed string must have a single string value, not a list - if Kind_Of (Variable) = N_Typed_Variable_Declaration - and then Expression_Kind_Of (Expression) = List + if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration + and then Expression_Kind_Of (Expression, In_Tree) = List then Error_Msg ("expression must be a single string", Expression_Location); end if; Set_Expression_Kind_Of - (Variable, To => Expression_Kind_Of (Expression)); + (Variable, In_Tree, + To => Expression_Kind_Of (Expression, In_Tree)); end if; if OK then @@ -1324,41 +1402,49 @@ package body Prj.Dect is begin if Current_Package /= Empty_Node then - The_Variable := First_Variable_Of (Current_Package); + The_Variable := First_Variable_Of (Current_Package, In_Tree); elsif Current_Project /= Empty_Node then - The_Variable := First_Variable_Of (Current_Project); + The_Variable := First_Variable_Of (Current_Project, In_Tree); end if; while The_Variable /= Empty_Node - and then Name_Of (The_Variable) /= Variable_Name + and then Name_Of (The_Variable, In_Tree) /= Variable_Name loop - The_Variable := Next_Variable (The_Variable); + The_Variable := Next_Variable (The_Variable, In_Tree); end loop; if The_Variable = Empty_Node then if Current_Package /= Empty_Node then Set_Next_Variable - (Variable, To => First_Variable_Of (Current_Package)); - Set_First_Variable_Of (Current_Package, To => Variable); + (Variable, In_Tree, + To => First_Variable_Of (Current_Package, In_Tree)); + Set_First_Variable_Of + (Current_Package, In_Tree, To => Variable); elsif Current_Project /= Empty_Node then Set_Next_Variable - (Variable, To => First_Variable_Of (Current_Project)); - Set_First_Variable_Of (Current_Project, To => Variable); + (Variable, In_Tree, + To => First_Variable_Of (Current_Project, In_Tree)); + Set_First_Variable_Of + (Current_Project, In_Tree, To => Variable); end if; else - if Expression_Kind_Of (Variable) /= Undefined then - if Expression_Kind_Of (The_Variable) = Undefined then + if Expression_Kind_Of (Variable, In_Tree) /= Undefined then + if + Expression_Kind_Of (The_Variable, In_Tree) = Undefined + then Set_Expression_Kind_Of - (The_Variable, To => Expression_Kind_Of (Variable)); + (The_Variable, In_Tree, + To => Expression_Kind_Of (Variable, In_Tree)); else - if Expression_Kind_Of (The_Variable) /= - Expression_Kind_Of (Variable) + if Expression_Kind_Of (The_Variable, In_Tree) /= + Expression_Kind_Of (Variable, In_Tree) then Error_Msg ("wrong expression kind for variable """ & - Get_Name_String (Name_Of (The_Variable)) & + Get_Name_String + (Name_Of (The_Variable, In_Tree)) & """", Expression_Location); end if; |