From: Vincent Celier Date: Wed, 15 Feb 2006 09:43:00 +0000 (+0100) Subject: prj.ads (Error_Warning): New enumeration type X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=97b7ca6ffff4e2f3ba40e9cfdb8d86ecc797ee78;p=gcc.git prj.ads (Error_Warning): New enumeration type 2006-02-13 Vincent Celier * prj.ads (Error_Warning): New enumeration type * prj-nmsc.ads, prj-nmsc.adb (Error_Msg): If location parameter is unknown, use the location of the project to report the error. (When_No_Sources): New global variable (Report_No_Ada_Sources): New procedure (Check): New parameter When_No_Sources. Set value of global variable When_No_Sources, (Find_Sources): Call Report_No_Ada_Sources when appropriate (Get_Sources_From_File): Ditto (Warn_If_Not_Sources): Better warning messages indicating the unit name and the file name. * prj-pars.ads, prj-pars.adb (Parse): New parameter When_No_Sources. Call Prj.Proc.Process with parameter When_No_Sources. * prj-proc.ads, prj-proc.adb (Check): New parameter When_No_Sources. Call Recursive_Check with parameter When_No_Sources. (Recursive_Check): New parameter When_No_Sources. Call itself and Prj.Nmsc.Check with parameter When_No_Sources. (Process): New parameter When_No_Sources. Call Check with parameter When_No_Sources. (Copy_Package_Declarations): New procedure to copy renamed parameters and setting the location of the declared attributes to the location of the renamed package. (Process_Declarative_Items): Call Copy_Package_Declarations for renamed packages. From-SVN: r111084 --- diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 3a7dd9630e9..67d59201d98 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2006, 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- -- @@ -27,11 +27,10 @@ with Err_Vars; use Err_Vars; with Fmap; use Fmap; with Hostparm; -with MLib.Tgt; +with MLib.Tgt; use MLib.Tgt; with Namet; use Namet; with Osint; use Osint; with Output; use Output; -with MLib.Tgt; use MLib.Tgt; with Prj.Env; use Prj.Env; with Prj.Err; with Prj.Util; use Prj.Util; @@ -54,6 +53,10 @@ package body Prj.Nmsc is Error_Report : Put_Line_Access := null; -- Set to point to error reporting procedure + When_No_Sources : Error_Warning := Error; + -- Indicates what should be done when there is no Ada sources in a non + -- extending Ada project. + ALI_Suffix : constant String := ".ali"; -- File suffix for ali files @@ -352,6 +355,12 @@ package body Prj.Nmsc is -- When Naming_Exceptions is True, mark the found sources as such, to -- later remove those that are not named in a list of sources. + procedure Report_No_Ada_Sources + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Location : Source_Ptr); + -- Report an error or a warning depending on the value of When_No_Sources + procedure Show_Source_Dirs (Project : Project_Id; In_Tree : Project_Tree_Ref); -- List all the source directories of a project @@ -398,15 +407,17 @@ package body Prj.Nmsc is ----------- procedure Check - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Report_Error : Put_Line_Access; - Follow_Links : Boolean) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Report_Error : Put_Line_Access; + Follow_Links : Boolean; + When_No_Sources : Error_Warning) is Data : Project_Data := In_Tree.Projects.Table (Project); Extending : Boolean := False; begin + Nmsc.When_No_Sources := When_No_Sources; Error_Report := Report_Error; Recursive_Dirs.Reset; @@ -2793,6 +2804,7 @@ package body Prj.Nmsc is Msg : String; Flag_Location : Source_Ptr) is + Real_Location : Source_Ptr := Flag_Location; Error_Buffer : String (1 .. 5_000); Error_Last : Natural := 0; Msg_Name : Natural := 0; @@ -2832,8 +2844,14 @@ package body Prj.Nmsc is -- Start of processing for Error_Msg begin + -- If location of error is unknown, use the location of the project + + if Real_Location = No_Location then + Real_Location := In_Tree.Projects.Table (Project).Location; + end if; + if Error_Report = null then - Prj.Err.Error_Msg (Msg, Flag_Location); + Prj.Err.Error_Msg (Msg, Real_Location); return; end if; @@ -3024,10 +3042,7 @@ package body Prj.Nmsc is Data.Ada_Sources_Present := True; elsif Data.Extends = No_Project then - Error_Msg - (Project, In_Tree, - "there are no Ada sources in this project", - Data.Location); + Report_No_Ada_Sources (Project, In_Tree, Data.Location); end if; end if; end Find_Sources; @@ -4243,12 +4258,10 @@ package body Prj.Nmsc is Get_Path_Names_And_Record_Sources (Follow_Links); -- We should have found at least one source. - -- If not, report an error. + -- If not, report an error/warning. if Data.Sources = Nil_String then - Error_Msg (Project, In_Tree, - "there are no Ada sources in this project", - Location); + Report_No_Ada_Sources (Project, In_Tree, Location); end if; end Get_Sources_From_File; @@ -5304,6 +5317,30 @@ package body Prj.Nmsc is end if; end Record_Other_Sources; + --------------------------- + -- Report_No_Ada_Sources -- + --------------------------- + + procedure Report_No_Ada_Sources + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Location : Source_Ptr) + is + begin + case When_No_Sources is + when Silent => + null; + + when Warning | Error => + Error_Msg_Warn := When_No_Sources = Warning; + + Error_Msg + (Project, In_Tree, + " Project_Node, From_Project_Node_Tree => Project_Node_Tree, Report_Error => null, - Follow_Links => Opt.Follow_Links); + Follow_Links => Opt.Follow_Links, + When_No_Sources => When_No_Sources); Prj.Err.Finalize; if not Success then @@ -99,7 +101,7 @@ package body Prj.Pars is -- Set_Verbosity -- ------------------- - procedure Set_Verbosity (To : in Verbosity) is + procedure Set_Verbosity (To : Verbosity) is begin Current_Verbosity := To; end Set_Verbosity; diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads index d94b0720f24..237a9341b1e 100644 --- a/gcc/ada/prj-pars.ads +++ b/gcc/ada/prj-pars.ads @@ -35,7 +35,8 @@ package Prj.Pars is (In_Tree : Project_Tree_Ref; Project : out Project_Id; Project_File_Name : String; - Packages_To_Check : String_List_Access := All_Packages); + Packages_To_Check : String_List_Access := All_Packages; + When_No_Sources : Error_Warning := Error); -- Parse a project files and all its imported project files, in the -- project tree In_Tree. -- @@ -46,5 +47,8 @@ package Prj.Pars is -- Packages_To_Check indicates the packages where any unknown attribute -- produces an error. For other packages, an unknown attribute produces -- a warning. + -- + -- When_No_Sources indicates what should be done when no sources + -- are found in a project for a specified or implied language. end Prj.Pars; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index f9b5619c5bc..f79afc9e6c8 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -65,12 +65,21 @@ package body Prj.Proc is -- values to the package or project with declarations Decl. procedure Check - (In_Tree : Project_Tree_Ref; - Project : in out Project_Id; - Follow_Links : Boolean); + (In_Tree : Project_Tree_Ref; + Project : in out Project_Id; + Follow_Links : Boolean; + When_No_Sources : Error_Warning); -- Set all projects to not checked, then call Recursive_Check for the -- main project Project. Project is set to No_Project if errors occurred. + procedure Copy_Package_Declarations + (From : Declarations; + To : in out Declarations; + New_Loc : Source_Ptr; + In_Tree : Project_Tree_Ref); + -- Copy a package declaration From to To for a renamed package. Change the + -- locations of all the attributes to New_Loc. + function Expression (Project : Project_Id; In_Tree : Project_Tree_Ref; @@ -119,9 +128,10 @@ package body Prj.Proc is -- Then process the declarative items of the project. procedure Recursive_Check - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Follow_Links : Boolean); + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Follow_Links : Boolean; + When_No_Sources : Error_Warning); -- If Project is not marked as checked, mark it as checked, call -- Check_Naming_Scheme for the project, then call itself for a -- possible extended project and all the imported projects of Project. @@ -225,9 +235,10 @@ package body Prj.Proc is ----------- procedure Check - (In_Tree : Project_Tree_Ref; - Project : in out Project_Id; - Follow_Links : Boolean) + (In_Tree : Project_Tree_Ref; + Project : in out Project_Id; + Follow_Links : Boolean; + When_No_Sources : Error_Warning) is begin -- Make sure that all projects are marked as not checked @@ -238,9 +249,136 @@ package body Prj.Proc is In_Tree.Projects.Table (Index).Checked := False; end loop; - Recursive_Check (Project, In_Tree, Follow_Links); + Recursive_Check (Project, In_Tree, Follow_Links, When_No_Sources); end Check; + ------------------------------- + -- Copy_Package_Declarations -- + ------------------------------- + + procedure Copy_Package_Declarations + (From : Declarations; + To : in out Declarations; + New_Loc : Source_Ptr; + In_Tree : Project_Tree_Ref) + is + V1 : Variable_Id := From.Attributes; + V2 : Variable_Id := No_Variable; + Var : Variable; + A1 : Array_Id := From.Arrays; + A2 : Array_Id := No_Array; + Arr : Array_Data; + E1 : Array_Element_Id; + E2 : Array_Element_Id := No_Array_Element; + Elm : Array_Element; + + begin + -- To avoid references in error messages to attribute declarations in + -- an original package that has been renamed, copy all the attribute + -- declarations of the package and change all locations to New_Loc, + -- the location of the renamed package. + + -- First single attributes + + while V1 /= No_Variable loop + + -- Copy the attribute + + Var := In_Tree.Variable_Elements.Table (V1); + V1 := Var.Next; + + -- Remove the Next component + + Var.Next := No_Variable; + + -- Change the location to New_Loc + + Var.Value.Location := New_Loc; + Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements); + + -- Put in new declaration + + if To.Attributes = No_Variable then + To.Attributes := + Variable_Element_Table.Last (In_Tree.Variable_Elements); + + else + In_Tree.Variable_Elements.Table (V2).Next := + Variable_Element_Table.Last (In_Tree.Variable_Elements); + end if; + + V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements); + In_Tree.Variable_Elements.Table (V2) := Var; + end loop; + + -- Then the associated array attributes + + while A1 /= No_Array loop + + -- Copy the array + + Arr := In_Tree.Arrays.Table (A1); + A1 := Arr.Next; + + -- Remove the Next component + + Arr.Next := No_Array; + + Array_Table.Increment_Last (In_Tree.Arrays); + + -- Create new Array declaration + if To.Arrays = No_Array then + To.Arrays := Array_Table.Last (In_Tree.Arrays); + + else + In_Tree.Arrays.Table (A2).Next := + Array_Table.Last (In_Tree.Arrays); + end if; + + A2 := Array_Table.Last (In_Tree.Arrays); + + -- Don't store the array, as its first element has not been set yet + + -- Copy the array elements of the array + + E1 := Arr.Value; + Arr.Value := No_Array_Element; + + while E1 /= No_Array_Element loop + + -- Copy the array element + + Elm := In_Tree.Array_Elements.Table (E1); + E1 := Elm.Next; + + -- Remove the Next component + + Elm.Next := No_Array_Element; + + -- Change the location + + Elm.Value.Location := New_Loc; + Array_Element_Table.Increment_Last (In_Tree.Array_Elements); + + -- Create new array element + + if Arr.Value = No_Array_Element then + Arr.Value := Array_Element_Table.Last (In_Tree.Array_Elements); + else + In_Tree.Array_Elements.Table (E2).Next := + Array_Element_Table.Last (In_Tree.Array_Elements); + end if; + + E2 := Array_Element_Table.Last (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table (E2) := Elm; + end loop; + + -- Finally, store the new array + + In_Tree.Arrays.Table (A2) := Arr; + end loop; + end Copy_Package_Declarations; + ---------------- -- Expression -- ---------------- @@ -998,7 +1136,8 @@ package body Prj.Proc is From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Report_Error : Put_Line_Access; - Follow_Links : Boolean := True) + Follow_Links : Boolean := True; + When_No_Sources : Error_Warning := Error) is Obj_Dir : Name_Id; Extending : Project_Id; @@ -1024,7 +1163,7 @@ package body Prj.Proc is Extended_By => No_Project); if Project /= No_Project then - Check (In_Tree, Project, Follow_Links); + Check (In_Tree, Project, Follow_Links, When_No_Sources); end if; -- If main project is an extending all project, set the object @@ -1233,11 +1372,20 @@ package body Prj.Proc is From_Project_Node_Tree)); begin - -- For a renamed package, set declarations to - -- the declarations of the renamed package. - - In_Tree.Packages.Table (New_Pkg).Decl := - In_Tree.Packages.Table (Renamed_Package).Decl; + -- 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), + In_Tree => In_Tree); end; -- Standard package declaration, not renaming @@ -2106,9 +2254,10 @@ package body Prj.Proc is --------------------- procedure Recursive_Check - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Follow_Links : Boolean) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + Follow_Links : Boolean; + When_No_Sources : Error_Warning) is Data : Project_Data; Imported_Project_List : Project_List := Empty_Project_List; @@ -2130,7 +2279,8 @@ package body Prj.Proc is -- Call itself for a possible extended project. -- (if there is no extended project, then nothing happens). - Recursive_Check (Data.Extends, In_Tree, Follow_Links); + Recursive_Check + (Data.Extends, In_Tree, Follow_Links, When_No_Sources); -- Call itself for all imported projects @@ -2139,7 +2289,7 @@ package body Prj.Proc is Recursive_Check (In_Tree.Project_Lists.Table (Imported_Project_List).Project, - In_Tree, Follow_Links); + In_Tree, Follow_Links, When_No_Sources); Imported_Project_List := In_Tree.Project_Lists.Table (Imported_Project_List).Next; @@ -2151,7 +2301,8 @@ package body Prj.Proc is Write_Line (""""); end if; - Prj.Nmsc.Check (Project, In_Tree, Error_Report, Follow_Links); + Prj.Nmsc.Check + (Project, In_Tree, Error_Report, Follow_Links, When_No_Sources); end if; end Recursive_Check; diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index a94137542e2..ec384052cae 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -39,7 +39,8 @@ package Prj.Proc is From_Project_Node : Project_Node_Id; From_Project_Node_Tree : Project_Node_Tree_Ref; Report_Error : Put_Line_Access; - Follow_Links : Boolean := True); + Follow_Links : Boolean := True; + When_No_Sources : Error_Warning := Error); -- 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. @@ -49,6 +50,9 @@ package Prj.Proc is -- still valid if they point to a file which is outside of the project), -- and that no directory has a name which is a valid source name. -- + -- When_No_Sources indicates what should be done when no sources + -- are found in a project for a specified or implied language. + -- -- Process is a bit of a junk name, how about Process_Project_Tree??? end Prj.Proc; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index e360bddb410..474920460e1 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -72,6 +72,16 @@ package Prj is -- The standard project file name extension. It is not a constant, because -- Canonical_Case_File_Name is called on this variable in the body of Prj. + type Error_Warning is (Silent, Warning, Error); + -- Severity of some situations, such as: no Ada sources in a project where + -- Ada is one of the language. + -- + -- When the situation occurs, the behaviour depends on the setting: + -- + -- - Silent: no action + -- - Warning: issue a warning, does not cause the tool to fail + -- - Error: issue an error, causes the tool to fail + ----------------------------------------------------- -- Multi-language Stuff That Will be Modified Soon -- -----------------------------------------------------