diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-04-29 12:10:28 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-04-29 12:10:28 +0000 |
commit | a648402ed3bc2e88c2a75d87d66c21d361d7e1d8 (patch) | |
tree | 699db50c8964626cd1cf978fd50f643e924d553c | |
parent | a7ed52be304abe39cdf800db3d19feb66de21a1d (diff) | |
download | gcc-a648402ed3bc2e88c2a75d87d66c21d361d7e1d8.tar.gz |
2009-04-29 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,
prj-part.ads, prj.adb, prj.ads, clean.adb, prj-dect.adb, prj-dect.ads,
prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb, prj-pars.ads, prj-makr.adb
(Set_In_Configuration, In_Configuration): Removed.
Replaced by an extra parameter Is_Config_File in several parameter to
avoid global variables to store the state of the parser.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146955 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/ada/clean.adb | 3 | ||||
-rw-r--r-- | gcc/ada/gnatcmd.adb | 3 | ||||
-rw-r--r-- | gcc/ada/make.adb | 3 | ||||
-rw-r--r-- | gcc/ada/prj-dect.adb | 47 | ||||
-rw-r--r-- | gcc/ada/prj-dect.ads | 6 | ||||
-rw-r--r-- | gcc/ada/prj-makr.adb | 3 | ||||
-rw-r--r-- | gcc/ada/prj-nmsc.adb | 22 | ||||
-rw-r--r-- | gcc/ada/prj-nmsc.ads | 5 | ||||
-rw-r--r-- | gcc/ada/prj-pars.adb | 11 | ||||
-rw-r--r-- | gcc/ada/prj-pars.ads | 8 | ||||
-rw-r--r-- | gcc/ada/prj-part.adb | 81 | ||||
-rw-r--r-- | gcc/ada/prj-part.ads | 8 | ||||
-rw-r--r-- | gcc/ada/prj-proc.adb | 26 | ||||
-rw-r--r-- | gcc/ada/prj-proc.ads | 10 | ||||
-rw-r--r-- | gcc/ada/prj.adb | 20 | ||||
-rw-r--r-- | gcc/ada/prj.ads | 9 |
17 files changed, 171 insertions, 103 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cfa9a88786e..ba2afc96823 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2009-04-29 Emmanuel Briot <briot@adacore.com> + + * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb, + prj-part.ads, prj.adb, prj.ads, clean.adb, prj-dect.adb, prj-dect.ads, + prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb, prj-pars.ads, prj-makr.adb + (Set_In_Configuration, In_Configuration): Removed. + Replaced by an extra parameter Is_Config_File in several parameter to + avoid global variables to store the state of the parser. + 2009-04-29 Ed Schonberg <schonberg@adacore.com> * sinfo.ads, sinfo.adb: New attribute Next_Implicit_With, to chain diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index eac192903b3..04512e7778f 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1373,7 +1373,8 @@ package body Clean is (Project => Main_Project, In_Tree => Project_Tree, Project_File_Name => Project_File_Name.all, - Packages_To_Check => Packages_To_Check_By_Gnatmake); + Packages_To_Check => Packages_To_Check_By_Gnatmake, + Is_Config_File => False); if Main_Project = No_Project then Fail ("""" & Project_File_Name.all & """ processing failed"); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 899f71db577..81e9bc4191d 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1884,7 +1884,8 @@ begin (Project => Project, In_Tree => Project_Tree, Project_File_Name => Project_File.all, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => False); if Project = Prj.No_Project then Fail ("""" & Project_File.all & """ processing failed"); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 59f0ab145b6..3206bc1b009 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6843,7 +6843,8 @@ package body Make is (Project => Main_Project, In_Tree => Project_Tree, Project_File_Name => Project_File_Name.all, - Packages_To_Check => Packages_To_Check_By_Gnatmake); + Packages_To_Check => Packages_To_Check_By_Gnatmake, + Is_Config_File => False); -- The parsing of project files may have changed the current output diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 37ae74bfb10..49bd50e0e4c 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -63,7 +63,8 @@ package body Prj.Dect is First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; - Packages_To_Check : String_List_Access); + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean); -- Parse a case construction procedure Parse_Declarative_Items @@ -73,16 +74,22 @@ package body Prj.Dect is First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; - Packages_To_Check : String_List_Access); + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean); -- Parse declarative items. Depending on In_Zone, some declarative -- items may be forbidden. + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. procedure Parse_Package_Declaration (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 + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean); + -- Parse a package declaration. + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. procedure Parse_String_Type_Declaration (In_Tree : Project_Node_Tree_Ref; @@ -108,7 +115,8 @@ package body Prj.Dect is Declarations : out Project_Node_Id; Current_Project : Project_Node_Id; Extends : Project_Node_Id; - Packages_To_Check : String_List_Access) + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean) is First_Declarative_Item : Project_Node_Id := Empty_Node; @@ -126,7 +134,8 @@ package body Prj.Dect is First_Attribute => Prj.Attr.Attribute_First, Current_Project => Current_Project, Current_Package => Empty_Node, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => Is_Config_File); Set_First_Declarative_Item_Of (Declarations, In_Tree, To => First_Declarative_Item); end Parse; @@ -605,7 +614,8 @@ package body Prj.Dect is First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; - Packages_To_Check : String_List_Access) + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean) is Current_Item : Project_Node_Id := Empty_Node; Next_Item : Project_Node_Id := Empty_Node; @@ -728,7 +738,8 @@ package body Prj.Dect is First_Attribute => First_Attribute, Current_Project => Current_Project, Current_Package => Current_Package, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => Is_Config_File); -- "when others =>" must be the last branch, so save the -- Case_Item and exit @@ -754,7 +765,8 @@ package body Prj.Dect is First_Attribute => First_Attribute, Current_Project => Current_Project, Current_Package => Current_Package, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => Is_Config_File); Set_First_Declarative_Item_Of (Current_Item, In_Tree, To => First_Declarative_Item); @@ -799,7 +811,8 @@ package body Prj.Dect is First_Attribute : Attribute_Node_Id; Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; - Packages_To_Check : String_List_Access) + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean) is Current_Declarative_Item : Project_Node_Id := Empty_Node; Next_Declarative_Item : Project_Node_Id := Empty_Node; @@ -893,7 +906,8 @@ package body Prj.Dect is (In_Tree => In_Tree, Package_Declaration => Current_Declaration, Current_Project => Current_Project, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => Is_Config_File); Set_Previous_End_Node (Current_Declaration); @@ -924,7 +938,8 @@ package body Prj.Dect is First_Attribute => First_Attribute, Current_Project => Current_Project, Current_Package => Current_Package, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => Is_Config_File); Set_Previous_End_Node (Current_Declaration); @@ -977,7 +992,8 @@ package body Prj.Dect is (In_Tree : Project_Node_Tree_Ref; Package_Declaration : out Project_Node_Id; Current_Project : Project_Node_Id; - Packages_To_Check : String_List_Access) + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean) is First_Attribute : Attribute_Node_Id := Empty_Attribute; Current_Package : Package_Node_Id := Empty_Package; @@ -1101,7 +1117,7 @@ package body Prj.Dect is end if; if Token = Tok_Renames then - if In_Configuration then + if Is_Config_File then Error_Msg ("no package renames in configuration projects", Token_Ptr); end if; @@ -1216,7 +1232,8 @@ package body Prj.Dect is First_Attribute => First_Attribute, Current_Project => Current_Project, Current_Package => Package_Declaration, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => Is_Config_File); Set_First_Declarative_Item_Of (Package_Declaration, In_Tree, To => First_Declarative_Item); diff --git a/gcc/ada/prj-dect.ads b/gcc/ada/prj-dect.ads index 287c39043df..d5a592daae7 100644 --- a/gcc/ada/prj-dect.ads +++ b/gcc/ada/prj-dect.ads @@ -34,7 +34,8 @@ private package Prj.Dect is Declarations : out Prj.Tree.Project_Node_Id; Current_Project : Prj.Tree.Project_Node_Id; Extends : Prj.Tree.Project_Node_Id; - Packages_To_Check : String_List_Access); + Packages_To_Check : String_List_Access; + Is_Config_File : Boolean); -- Parse project declarative items -- -- In_Tree is the project node tree @@ -52,5 +53,8 @@ private package Prj.Dect is -- For legal packages declared in project Current_Project that are not in -- Packages_To_Check, only the syntax of the declarations are checked, not -- the attribute names and kinds. + -- + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. end Prj.Dect; diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 1274c4f3bf1..7ae8c3d9a21 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2009, 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- -- @@ -845,6 +845,7 @@ package body Prj.Makr is Project_File_Name => Output_Name.all, Always_Errout_Finalize => False, Store_Comments => True, + Is_Config_File => False, Current_Directory => Get_Current_Dir, Packages_To_Check => Packages_To_Check_By_Gnatname); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 9c1aea0c0aa..5a76d397a29 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -273,9 +273,11 @@ package body Prj.Nmsc is -- Check that a name is a valid Ada unit name procedure Check_Naming_Schemes - (Project : Project_Id; - In_Tree : Project_Tree_Ref); - -- Check the naming scheme part of Data + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Is_Config_File : Boolean); + -- Check the naming scheme part of Data. + -- Is_Config_File should be True if Project is a config file (.cgpr) procedure Check_Configuration (Project : Project_Id; @@ -788,7 +790,8 @@ package body Prj.Nmsc is Report_Error : Put_Line_Access; When_No_Sources : Error_Warning; Current_Dir : String; - Proc_Data : in out Processing_Data) + Proc_Data : in out Processing_Data; + Is_Config_File : Boolean) is Extending : Boolean := False; @@ -836,7 +839,7 @@ package body Prj.Nmsc is Extending := Project.Extends /= No_Project; - Check_Naming_Schemes (Project, In_Tree); + Check_Naming_Schemes (Project, In_Tree, Is_Config_File); if Get_Mode = Ada_Only then Prepare_Ada_Naming_Exceptions @@ -2635,8 +2638,9 @@ package body Prj.Nmsc is -------------------------- procedure Check_Naming_Schemes - (Project : Project_Id; - In_Tree : Project_Tree_Ref) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Is_Config_File : Boolean) is Naming_Id : constant Package_Id := Util.Value_Of (Name_Naming, Project.Decl.Packages, In_Tree); @@ -3316,7 +3320,7 @@ package body Prj.Nmsc is begin -- No Naming package or parsing a configuration file? nothing to do - if Naming_Id /= No_Package and not In_Configuration then + if Naming_Id /= No_Package and not Is_Config_File then Naming := In_Tree.Packages.Table (Naming_Id); if Current_Verbosity = High then @@ -4366,7 +4370,7 @@ package body Prj.Nmsc is Error_Msg (Project, In_Tree, - "a standard project cannot have no language declared", + "a standard project must have at least one language", Languages.Location); end if; diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index 88b88702aae..7728d766b4b 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -46,7 +46,8 @@ private package Prj.Nmsc is Report_Error : Put_Line_Access; When_No_Sources : Error_Warning; Current_Dir : String; - Proc_Data : in out Processing_Data); + Proc_Data : in out Processing_Data; + Is_Config_File : Boolean); -- Perform consistency and semantic checks on a project, starting from the -- project tree parsed from the .gpr file. This procedure interprets the -- various case statements in the project based on the current environment @@ -68,6 +69,8 @@ private package Prj.Nmsc is -- -- When_No_Sources indicates what should be done when no sources of a -- language are found in a project where this language is declared. + -- + -- Is_Config_File should be True if Project is config file (.cgpr) private type Processing_Data is record diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index 0cdd9ad3604..86f47ec67d2 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2009, 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,7 +45,8 @@ package body Prj.Pars is Project_File_Name : String; Packages_To_Check : String_List_Access := All_Packages; When_No_Sources : Error_Warning := Error; - Reset_Tree : Boolean := True) + Reset_Tree : Boolean := True; + Is_Config_File : Boolean) is Project_Node_Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data; @@ -66,7 +67,8 @@ package body Prj.Pars is Project_File_Name => Project_File_Name, Always_Errout_Finalize => False, Packages_To_Check => Packages_To_Check, - Current_Directory => Current_Dir); + Current_Directory => Current_Dir, + Is_Config_File => Is_Config_File); -- If there were no error, process the tree @@ -80,7 +82,8 @@ package body Prj.Pars is Report_Error => null, When_No_Sources => When_No_Sources, Reset_Tree => Reset_Tree, - Current_Dir => Current_Dir); + Current_Dir => Current_Dir, + Is_Config_File => Is_Config_File); Prj.Err.Finalize; if not Success then diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads index 8c22ba48141..02f149131a9 100644 --- a/gcc/ada/prj-pars.ads +++ b/gcc/ada/prj-pars.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2009, 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- -- @@ -36,7 +36,8 @@ package Prj.Pars is Project_File_Name : String; Packages_To_Check : String_List_Access := All_Packages; When_No_Sources : Error_Warning := Error; - Reset_Tree : Boolean := True); + Reset_Tree : Boolean := True; + Is_Config_File : Boolean); -- Parse a project files and all its imported project files, in the -- project tree In_Tree. -- @@ -53,5 +54,8 @@ package Prj.Pars is -- -- When Reset_Tree is True, all the project data are removed from the -- project table before processing. + -- + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. end Prj.Pars; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 77a98bc1f34..1390f476737 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2009, 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- -- @@ -164,21 +164,28 @@ package body Prj.Part is In_Limited : Boolean; Packages_To_Check : String_List_Access; Depth : Natural; - Current_Dir : String); + Current_Dir : String; + Is_Config_File : Boolean); -- Parse a project file. This is a recursive procedure: it calls itself for -- imported and extended projects. When From_Extended is not None, if the -- project has already been parsed and is an extended project A, return the -- ultimate (not extended) project that extends A. When In_Limited is True, -- the importing path includes at least one "limited with". When parsing -- configuration projects, do not allow a depth > 1. + -- + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. procedure Pre_Parse_Context_Clause (In_Tree : Project_Node_Tree_Ref; - Context_Clause : out With_Id); + Context_Clause : out With_Id; + Is_Config_File : Boolean); -- Parse the context clause of a project. Store the paths and locations of -- the imported projects in table Withs. Does nothing if there is no -- context clause (if the current token is not "with" or "limited" followed -- by "with"). + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. procedure Post_Parse_Context_Clause (Context_Clause : With_Id; @@ -190,13 +197,16 @@ package body Prj.Part is In_Limited : Boolean; Packages_To_Check : String_List_Access; Depth : Natural; - Current_Dir : String); + Current_Dir : String; + Is_Config_File : Boolean); -- Parse the imported projects that have been stored in table Withs, if -- any. From_Extended is used for the call to Parse_Single_Project below. -- When In_Limited is True, the importing path includes at least one -- "limited with". When Limited_Withs is False, only non limited withed -- projects are parsed. When Limited_Withs is True, only limited withed -- projects are parsed. + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. function Project_Path_Name_Of (Project_File_Name : String; @@ -210,7 +220,9 @@ package body Prj.Part is -- This includes the directory separator as the last character. -- Returns "./" if Path_Name contains no directory separator. - function Project_Name_From (Path_Name : String) return Name_Id; + function Project_Name_From + (Path_Name : String; + Is_Config_File : Boolean) return Name_Id; -- Returns the name of the project that corresponds to its path name. -- Returns No_Name if the path name is invalid, because the corresponding -- project name does not have the syntax of an ada identifier. @@ -475,7 +487,8 @@ package body Prj.Part is Always_Errout_Finalize : Boolean; Packages_To_Check : String_List_Access := All_Packages; Store_Comments : Boolean := False; - Current_Directory : String := "") + Current_Directory : String := ""; + Is_Config_File : Boolean) is Dummy : Boolean; pragma Warnings (Off, Dummy); @@ -533,7 +546,8 @@ package body Prj.Part is In_Limited => False, Packages_To_Check => Packages_To_Check, Depth => 0, - Current_Dir => Current_Directory); + Current_Dir => Current_Directory, + Is_Config_File => Is_Config_File); -- If Project is an extending-all project, create the eventual -- virtual extending projects and check that there are no illegally @@ -642,7 +656,8 @@ package body Prj.Part is procedure Pre_Parse_Context_Clause (In_Tree : Project_Node_Tree_Ref; - Context_Clause : out With_Id) + Context_Clause : out With_Id; + Is_Config_File : Boolean) is Current_With_Clause : With_Id := No_With; Limited_With : Boolean := False; @@ -663,7 +678,7 @@ package body Prj.Part is Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree); Limited_With := Token = Tok_Limited; - if In_Configuration then + if Is_Config_File then Error_Msg ("configuration project cannot import " & "other configuration projects", @@ -747,7 +762,8 @@ package body Prj.Part is In_Limited : Boolean; Packages_To_Check : String_List_Access; Depth : Natural; - Current_Dir : String) + Current_Dir : String; + Is_Config_File : Boolean) is Current_With_Clause : With_Id := Context_Clause; @@ -886,7 +902,8 @@ package body Prj.Part is In_Limited => Limited_Withs, Packages_To_Check => Packages_To_Check, Depth => Depth, - Current_Dir => Current_Dir); + Current_Dir => Current_Dir, + Is_Config_File => Is_Config_File); else Extends_All := Is_Extending_All (Withed_Project, In_Tree); @@ -947,7 +964,8 @@ package body Prj.Part is In_Limited : Boolean; Packages_To_Check : String_List_Access; Depth : Natural; - Current_Dir : String) + Current_Dir : String; + Is_Config_File : Boolean) is Normed_Path_Name : Path_Name_Type; Canonical_Path_Name : Path_Name_Type; @@ -963,7 +981,8 @@ package body Prj.Part is Tree_Private_Part.Projects_Htable.Get_First (In_Tree.Projects_HT); - Name_From_Path : constant Name_Id := Project_Name_From (Path_Name); + Name_From_Path : constant Name_Id := + Project_Name_From (Path_Name, Is_Config_File => Is_Config_File); Name_Of_Project : Name_Id := No_Name; Duplicated : Boolean := False; @@ -1124,7 +1143,7 @@ package body Prj.Part is Tree.Reset_State; Scan (In_Tree); - if not In_Configuration and then Name_From_Path = No_Name then + if not Is_Config_File and then Name_From_Path = No_Name then -- The project file name is not correct (no or bad extension, or not -- following Ada identifier's syntax). @@ -1147,6 +1166,7 @@ package body Prj.Part is Pre_Parse_Context_Clause (In_Tree => In_Tree, + Is_Config_File => Is_Config_File, Context_Clause => First_With); Project := Default_Project_Node @@ -1185,7 +1205,7 @@ package body Prj.Part is Scan (In_Tree); when Snames.Name_Configuration => - if not In_Configuration then + if not Is_Config_File then Error_Msg ("configuration projects cannot belong to a user" & " project tree", Token_Ptr); @@ -1199,7 +1219,7 @@ package body Prj.Part is end if; if Proj_Qualifier /= Unspecified then - if In_Configuration then + if Is_Config_File then Error_Msg ("a configuration project cannot be qualified except " & "as configuration project", Qualifier_Location); @@ -1257,7 +1277,7 @@ package body Prj.Part is if Token = Tok_Extends then - if In_Configuration then + if Is_Config_File then Error_Msg ("extending configuration project not allowed", Token_Ptr); end if; @@ -1310,13 +1330,13 @@ package body Prj.Part is begin -- Output a warning if the actual name is not the expected name - if not In_Configuration + if not Is_Config_File and then (Name_From_Path /= No_Name) and then Expected_Name /= Name_From_Path then Error_Msg_Name_1 := Expected_Name; - if In_Configuration then + if Is_Config_File then Extension := new String'(Config_Project_File_Extension); else @@ -1355,11 +1375,12 @@ package body Prj.Part is In_Limited => In_Limited, Packages_To_Check => Packages_To_Check, Depth => Depth + 1, - Current_Dir => Current_Dir); + Current_Dir => Current_Dir, + Is_Config_File => Is_Config_File); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); end; - if not In_Configuration then + if not Is_Config_File then declare Name_And_Node : Tree_Private_Part.Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_First @@ -1460,7 +1481,8 @@ package body Prj.Part is In_Limited => In_Limited, Packages_To_Check => Packages_To_Check, Depth => Depth + 1, - Current_Dir => Current_Dir); + Current_Dir => Current_Dir, + Is_Config_File => Is_Config_File); end; if Present (Extended_Project) then @@ -1596,7 +1618,8 @@ package body Prj.Part is Declarations => Project_Declaration, Current_Project => Project, Extends => Extended_Project, - Packages_To_Check => Packages_To_Check); + Packages_To_Check => Packages_To_Check, + Is_Config_File => Is_Config_File); Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration); if Present (Extended_Project) @@ -1717,7 +1740,8 @@ package body Prj.Part is In_Limited => In_Limited, Packages_To_Check => Packages_To_Check, Depth => Depth + 1, - Current_Dir => Current_Dir); + Current_Dir => Current_Dir, + Is_Config_File => Is_Config_File); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); end; @@ -1745,7 +1769,10 @@ package body Prj.Part is -- Project_Name_From -- ----------------------- - function Project_Name_From (Path_Name : String) return Name_Id is + function Project_Name_From + (Path_Name : String; + Is_Config_File : Boolean) return Name_Id + is Canonical : String (1 .. Path_Name'Length) := Path_Name; First : Natural := Canonical'Last; Last : Natural := First; @@ -1778,11 +1805,11 @@ package body Prj.Part is -- If we have a dot, check that it is followed by the correct extension if First > 0 and then Canonical (First) = '.' then - if (not In_Configuration + if (not Is_Config_File and then Canonical (First .. Last) = Project_File_Extension and then First /= 1) or else - (In_Configuration + (Is_Config_File and then Canonical (First .. Last) = Config_Project_File_Extension and then First /= 1) diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index e1c69c5ab83..3906ad7cb61 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2009, 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- -- @@ -36,7 +36,8 @@ package Prj.Part is Always_Errout_Finalize : Boolean; Packages_To_Check : String_List_Access := All_Packages; Store_Comments : Boolean := False; - Current_Directory : String := ""); + Current_Directory : String := ""; + Is_Config_File : Boolean); -- Parse project file and all its imported project files and create a tree. -- Return the node for the project (or Empty_Node if parsing failed). If -- Always_Errout_Finalize is True, Errout.Finalize is called in all cases, @@ -48,5 +49,8 @@ package Prj.Part is -- -- Current_Directory is used for optimization purposes only, avoiding extra -- system calls. + -- + -- Is_Config_File should be set to True if the project represents a config + -- file (.cgpr) since some specific checks apply. end Prj.Part; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 4fbc0a783b4..b302972732b 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -82,10 +82,12 @@ package body Prj.Proc is (In_Tree : Project_Tree_Ref; Project : Project_Id; Current_Dir : String; - When_No_Sources : Error_Warning); + When_No_Sources : Error_Warning; + Is_Config_File : Boolean); -- Set all projects to not checked, then call Recursive_Check for the -- main project Project. Project is set to No_Project if errors occurred. -- Current_Dir is for optimization purposes, avoiding extra system calls. + -- Is_Config_File should be True if Project is a config file (.cgpr) procedure Copy_Package_Declarations (From : Declarations; @@ -149,6 +151,7 @@ package body Prj.Proc is Current_Dir : String_Access; When_No_Sources : Error_Warning; Proc_Data : Processing_Data; + Is_Config_File : Boolean; end record; -- Data passed to Recursive_Check -- Current_Dir is for optimization purposes, avoiding extra system calls. @@ -279,7 +282,8 @@ package body Prj.Proc is (In_Tree : Project_Tree_Ref; Project : Project_Id; Current_Dir : String; - When_No_Sources : Error_Warning) + When_No_Sources : Error_Warning; + Is_Config_File : Boolean) is Dir : aliased String := Current_Dir; @@ -292,6 +296,7 @@ package body Prj.Proc is Data.In_Tree := In_Tree; Data.Current_Dir := Dir'Unchecked_Access; Data.When_No_Sources := When_No_Sources; + Data.Is_Config_File := Is_Config_File; Initialize (Data.Proc_Data); Check_All_Projects (Project, Data, Imported_First => True); @@ -1231,7 +1236,8 @@ package body Prj.Proc is Report_Error : Put_Line_Access; When_No_Sources : Error_Warning := Error; Reset_Tree : Boolean := True; - Current_Dir : String := "") + Current_Dir : String := ""; + Is_Config_File : Boolean) is begin Process_Project_Tree_Phase_1 @@ -1243,7 +1249,7 @@ package body Prj.Proc is Report_Error => Report_Error, Reset_Tree => Reset_Tree); - if not In_Configuration then + if not Is_Config_File then Process_Project_Tree_Phase_2 (In_Tree => In_Tree, Project => Project, @@ -1252,7 +1258,8 @@ package body Prj.Proc is From_Project_Node_Tree => From_Project_Node_Tree, Report_Error => Report_Error, When_No_Sources => When_No_Sources, - Current_Dir => Current_Dir); + Current_Dir => Current_Dir, + Is_Config_File => Is_Config_File); end if; end Process; @@ -2305,7 +2312,8 @@ package body Prj.Proc is From_Project_Node_Tree : Project_Node_Tree_Ref; Report_Error : Put_Line_Access; When_No_Sources : Error_Warning := Error; - Current_Dir : String) + Current_Dir : String; + Is_Config_File : Boolean) is Obj_Dir : Path_Name_Type; Extending : Project_Id; @@ -2319,7 +2327,8 @@ package body Prj.Proc is Success := True; if Project /= No_Project then - Check (In_Tree, Project, Current_Dir, When_No_Sources); + Check (In_Tree, Project, Current_Dir, When_No_Sources, + Is_Config_File => Is_Config_File); end if; -- If main project is an extending all project, set the object @@ -2442,7 +2451,8 @@ package body Prj.Proc is Prj.Nmsc.Check (Project, Data.In_Tree, Error_Report, Data.When_No_Sources, - Data.Current_Dir.all, Data.Proc_Data); + Data.Current_Dir.all, Data.Proc_Data, + Is_Config_File => Data.Is_Config_File); end Recursive_Check; ----------------------- diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index 1074f3ad202..f95f210a50e 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -40,7 +40,8 @@ package Prj.Proc is Report_Error : Put_Line_Access; When_No_Sources : Error_Warning := Error; Reset_Tree : Boolean := True; - Current_Dir : String := ""); + Current_Dir : String := ""; + Is_Config_File : Boolean); -- Process a project file tree into project file data structures. If -- Report_Error is null, use the error reporting mechanism. Otherwise, -- report errors using Report_Error. @@ -54,10 +55,12 @@ package Prj.Proc is -- project table before processing. -- -- Process is a bit of a junk name, how about Process_Project_Tree??? - + -- -- The two procedures that follow are implementing procedure Process in -- two successive phases. They are used by gprbuild/gprclean to add the -- configuration attributes between the two phases. + -- + -- Is_Config_File should be true if Project is a config file (.cgpr) procedure Process_Project_Tree_Phase_1 (In_Tree : Project_Tree_Ref; @@ -77,7 +80,8 @@ package Prj.Proc is From_Project_Node_Tree : Project_Node_Tree_Ref; Report_Error : Put_Line_Access; When_No_Sources : Error_Warning := Error; - Current_Dir : String); + Current_Dir : String; + Is_Config_File : Boolean); -- See documentation of parameters in procedure Process above end Prj.Proc; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index b5f924d3aa5..30f40fb0035 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -49,8 +49,6 @@ package body Prj is Current_Mode : Mode := Ada_Only; - Configuration_Mode : Boolean := False; - The_Empty_String : Name_Id; Default_Ada_Spec_Suffix_Id : File_Name_Type; @@ -600,15 +598,6 @@ package body Prj is return The_Casing_Images (Casing).all; end Image; - ---------------------- - -- In_Configuration -- - ---------------------- - - function In_Configuration return Boolean is - begin - return Configuration_Mode; - end In_Configuration; - ---------------- -- Initialize -- ---------------- @@ -1059,15 +1048,6 @@ package body Prj is In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element; end Set_Body_Suffix; - -------------------------- - -- Set_In_Configuration -- - -------------------------- - - procedure Set_In_Configuration (Value : Boolean) is - begin - Configuration_Mode := Value; - end Set_In_Configuration; - -------------- -- Set_Mode -- -------------- diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index e903fbc3946..c08abf5dd21 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -99,12 +99,6 @@ package Prj is -- can ignore such errors when they don't need to build directly. Calling -- Set_Mode will reset this variable, default is for Ada_Only. - function In_Configuration return Boolean; - pragma Inline (In_Configuration); - - procedure Set_In_Configuration (Value : Boolean); - pragma Inline (Set_In_Configuration); - All_Packages : constant String_List_Access; -- Default value of parameter Packages of procedures Parse, in Prj.Pars and -- Prj.Part, indicating that all packages should be checked. @@ -1121,7 +1115,8 @@ package Prj is Config : Project_Configuration; Path : Path_Information := No_Path_Information; - -- The path name of the project file + -- The path name of the project file. This include base name of the + -- project file Virtual : Boolean := False; -- True for virtual extending projects |