Commit 9d5598bf by Arnaud Charlet

[multiple changes]

2013-04-23  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Significant
	rewrite to make sure Is_Ignore is properly captured when aspect
	is declared.
	* sem_ch6.adb: Minor reformatting.
	* sem_prag.adb (Analyze_Pragma): Do not test policy at time of
	pragma for the case of a pragma coming from an aspect (already
	tested when we analyzed the aspect).

2013-04-23  Vincent Celier  <celier@adacore.com>

	* prj-conf.adb (Parse_Project_And_Apply_Config): New
	Boolean parameter Implicit_Project, defaulted to False. Call
	Prj.Part.Parse with Implicit_Project.
	* prj-conf.ads (Parse_Project_And_Apply_Config): New Boolean
	parameter Implicit_Project, defaulted to False.
	* prj-part.adb (Parse_Single_Project): New Boolean parameter
	Implicit_Project, defaulted to False. When Implicit_Project is
	True, change the Directory of the project node to the Current_Dir.
	* prj-part.ads (Parse): New Boolean parameter, defaulted to False

2013-04-23  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Minor reformatting.

From-SVN: r198184
parent 72267417
2013-04-23 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Significant
rewrite to make sure Is_Ignore is properly captured when aspect
is declared.
* sem_ch6.adb: Minor reformatting.
* sem_prag.adb (Analyze_Pragma): Do not test policy at time of
pragma for the case of a pragma coming from an aspect (already
tested when we analyzed the aspect).
2013-04-23 Vincent Celier <celier@adacore.com>
* prj-conf.adb (Parse_Project_And_Apply_Config): New
Boolean parameter Implicit_Project, defaulted to False. Call
Prj.Part.Parse with Implicit_Project.
* prj-conf.ads (Parse_Project_And_Apply_Config): New Boolean
parameter Implicit_Project, defaulted to False.
* prj-part.adb (Parse_Single_Project): New Boolean parameter
Implicit_Project, defaulted to False. When Implicit_Project is
True, change the Directory of the project node to the Current_Dir.
* prj-part.ads (Parse): New Boolean parameter, defaulted to False
2013-04-23 Robert Dewar <dewar@adacore.com>
* exp_util.adb: Minor reformatting.
2013-04-23 Robert Dewar <dewar@adacore.com>
* xoscons.adb: Minor reformatting.
2013-04-23 Hristian Kirtchev <kirtchev@adacore.com>
......
......@@ -2586,9 +2586,11 @@ package body Exp_Util is
begin
Start_String;
Internal_Full_Qualified_Name (E);
if Append_NUL then
Store_String_Char (Get_Char_Code (ASCII.NUL));
end if;
return End_String;
end Fully_Qualified_Name_String;
......
......@@ -1558,7 +1558,8 @@ package body Prj.Conf is
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
On_Load_Config : Config_File_Hook := null)
On_Load_Config : Config_File_Hook := null;
Implicit_Project : Boolean := False)
is
begin
pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
......@@ -1578,7 +1579,8 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => False,
Env => Env);
Env => Env,
Implicit_Project => Implicit_Project);
if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node;
......
......@@ -55,7 +55,8 @@ package Prj.Conf is
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
On_Load_Config : Config_File_Hook := null);
On_Load_Config : Config_File_Hook := null;
Implicit_Project : Boolean := False);
-- Find the main configuration project and parse the project tree rooted at
-- this configuration project.
--
......@@ -85,6 +86,11 @@ package Prj.Conf is
-- Any error in generating or parsing the config file is reported via the
-- Invalid_Config exception, with an appropriate message. Any error while
-- parsing the project file results in No_Project.
--
-- If Implicit_Project is True, the main project file being parsed is
-- deemed to be in the current working directory, even if it is not the
-- case.
-- Why is this ever useful???
procedure Process_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2012, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2013, 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- --
......@@ -191,7 +191,8 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Env : in out Environment);
Env : in out Environment;
Implicit_Project : Boolean := False);
-- 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
......@@ -201,6 +202,10 @@ package body Prj.Part is
--
-- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply.
--
-- If Implicit_Project is True, change the Directory of the project node
-- to be the Current_Dir. Recursive calls to Parse_Single_Project are
-- always done with the default False value for Implicit_Project.
procedure Pre_Parse_Context_Clause
(In_Tree : Project_Node_Tree_Ref;
......@@ -530,7 +535,8 @@ package body Prj.Part is
Current_Directory : String := "";
Is_Config_File : Boolean;
Env : in out Prj.Tree.Environment;
Target_Name : String := "")
Target_Name : String := "";
Implicit_Project : Boolean := False)
is
Dummy : Boolean;
pragma Warnings (Off, Dummy);
......@@ -598,7 +604,8 @@ package body Prj.Part is
Depth => 0,
Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File,
Env => Env);
Env => Env,
Implicit_Project => Implicit_Project);
exception
when Types.Unrecoverable_Error =>
......@@ -1230,7 +1237,8 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Env : in out Environment)
Env : in out Environment;
Implicit_Project : Boolean := False)
is
Path_Name : constant String := Get_Name_String (Path_Name_Id);
......@@ -1394,7 +1402,10 @@ package body Prj.Part is
Tree.Reset_State;
Scan (In_Tree);
if not Is_Config_File and then Name_From_Path = No_Name then
if not Is_Config_File
and then Name_From_Path = No_Name
and then not Implicit_Project
then
-- The project file name is not correct (no or bad extension, or not
-- following Ada identifier's syntax).
......@@ -1977,6 +1988,13 @@ package body Prj.Part is
Tree.Restore_And_Free (Project_Comment_State);
Debug_Decrease_Indent;
if Project /= Empty_Node and then Implicit_Project then
Name_Len := 0;
Add_Str_To_Name_Buffer (Current_Dir);
Add_Char_To_Name_Buffer (Dir_Sep);
In_Tree.Project_Nodes.Table (Project).Directory := Name_Find;
end if;
end Parse_Single_Project;
-----------------------
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2013, 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- --
......@@ -47,7 +47,8 @@ package Prj.Part is
Current_Directory : String := "";
Is_Config_File : Boolean;
Env : in out Prj.Tree.Environment;
Target_Name : String := "");
Target_Name : String := "";
Implicit_Project : Boolean := False);
-- 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,
......@@ -66,5 +67,10 @@ package Prj.Part is
-- Target_Name will be used to initialize the default project path, unless
-- In_Tree.Project_Path has already been initialized (which is the
-- recommended use).
--
-- If Implicit_Project is True, the main project file being parsed is
-- deemed to be in the current working directory, even if it is not the
-- case.
-- Why is this ever useful???
end Prj.Part;
......@@ -12083,15 +12083,11 @@ package body Sem_Ch6 is
declare
New_Expr : constant Node_Id :=
Get_Pragma_Arg
(Next
(First
(Pragma_Argument_Associations
(Next (First (Pragma_Argument_Associations
(Inherited_Precond))));
Old_Expr : constant Node_Id :=
Get_Pragma_Arg
(Next
(First
(Pragma_Argument_Associations
(Next (First (Pragma_Argument_Associations
(Precond))));
begin
......@@ -12404,8 +12400,7 @@ package body Sem_Ch6 is
declare
Post_Proc : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => Name_uPostconditions);
Make_Defining_Identifier (Loc, Chars => Name_uPostconditions);
-- The entity for the _Postconditions procedure
begin
......
......@@ -2138,12 +2138,7 @@ package body Sem_Prag is
-- For a pragma PPC in the extended main source unit, record enabled
-- status in SCO.
-- This may seem redundant with the call to Check_Kind test that
-- occurs later on when the pragma is rewritten into a pragma Check
-- but is actually required in the case of a postcondition within a
-- generic.
if Check_Kind (Pname) = Name_Check and then not Split_PPC (N) then
if not Is_Ignored (N) and then not Split_PPC (N) then
Set_SCO_Pragma_Enabled (Loc);
end if;
......@@ -6775,15 +6770,21 @@ package body Sem_Prag is
Pname := Chars (Identifier (Corresponding_Aspect (N)));
end if;
-- Check applicable policy. We skip this for a pragma that came from
-- an aspect, since we already dealt with the Disable case, and we set
-- the Is_Ignored flag at the time the aspect was analyzed.
if not From_Aspect_Specification (N) then
Check_Applicable_Policy (N);
-- If pragma is disabled, rewrite as Null statement and skip analysis
-- If pragma is disabled, rewrite as NULL and skip analysis
if Is_Disabled (N) then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
raise Pragma_Exit;
end if;
end if;
-- Preset arguments
......@@ -8109,6 +8110,16 @@ package body Sem_Prag is
-- Set Check_On to indicate check status
-- If this comes from an aspect, we have already taken care of
-- the policy active when the aspect was analyzed, and Is_Ignore
-- is set appriately already.
if From_Aspect_Specification (N) then
Check_On := not Is_Ignored (N);
-- Otherwise check the status right now
else
case Check_Kind (Cname) is
when Name_Ignore =>
Check_On := False;
......@@ -8129,6 +8140,7 @@ package body Sem_Prag is
when others =>
raise Program_Error;
end case;
end if;
-- If check kind was not Disable, then continue pragma analysis
......
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