Skip to content

R
riscv-gcc-1
Commit bd0a4cab by Emmanuel Briot Committed by Arnaud Charlet
Options

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.

From-SVN: r146955
parent 69cb258c
Showing with 115 additions and 74 deletions
gcc/ada/ChangeLog
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
......
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");
......
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");
......
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
......
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);
......
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;
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);
......
gcc/ada/prj-nmsc.adb
......@@ -274,8 +274,10 @@ package body Prj.Nmsc is
procedure Check_Naming_Schemes
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Check the naming scheme part of Data
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
......@@ -2636,7 +2639,8 @@ package body Prj.Nmsc is
procedure Check_Naming_Schemes
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
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;
......
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
......
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
......
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;
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;
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;
-----------------------
......
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;
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 --
--------------
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment