aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-04-23 11:50:31 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2013-04-23 11:50:31 +0200
commit9d5598bf839e572e6262367af623d1e1af91c4a6 (patch)
tree736488b1564594a20c6544bb39015355c43363c0
parent72267417bd5d1072812339dee3bf426b686f81b6 (diff)
downloadgcc-9d5598bf839e572e6262367af623d1e1af91c4a6.zip
gcc-9d5598bf839e572e6262367af623d1e1af91c4a6.tar.gz
gcc-9d5598bf839e572e6262367af623d1e1af91c4a6.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog26
-rw-r--r--gcc/ada/exp_util.adb2
-rw-r--r--gcc/ada/prj-conf.adb6
-rw-r--r--gcc/ada/prj-conf.ads8
-rw-r--r--gcc/ada/prj-part.adb30
-rw-r--r--gcc/ada/prj-part.ads10
-rw-r--r--gcc/ada/sem_ch13.adb366
-rw-r--r--gcc/ada/sem_ch6.adb17
-rw-r--r--gcc/ada/sem_prag.adb66
9 files changed, 325 insertions, 206 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c6d114d..b81550c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,31 @@
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>
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c38b023..03442ac 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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;
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 9ba624c..48241ef 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -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;
diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads
index 7154e55..172356f 100644
--- a/gcc/ada/prj-conf.ads
+++ b/gcc/ada/prj-conf.ads
@@ -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;
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index 5d09dbe..7f617a0 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -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;
-----------------------
diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads
index 708142d..438ec9d 100644
--- a/gcc/ada/prj-part.ads
+++ b/gcc/ada/prj-part.ads
@@ -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;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b144411..24970f1 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -961,7 +961,7 @@ package body Sem_Ch13 is
Aspect := First (L);
Aspect_Loop : while Present (Aspect) loop
- declare
+ Analyze_One_Aspect : declare
Expr : constant Node_Id := Expression (Aspect);
Id : constant Node_Id := Identifier (Aspect);
Loc : constant Source_Ptr := Sloc (Aspect);
@@ -977,12 +977,22 @@ package body Sem_Ch13 is
-- is set below when Expr is present.
procedure Analyze_Aspect_External_Or_Link_Name;
- -- This routine performs the analysis of the External_Name or
- -- Link_Name aspects.
+ -- Perform analysis of the External_Name or Link_Name aspects
procedure Analyze_Aspect_Implicit_Dereference;
- -- This routine performs the analysis of the Implicit_Dereference
- -- aspects.
+ -- Perform analysis of the Implicit_Dereference aspects
+
+ procedure Make_Aitem_Pragma
+ (Pragma_Argument_Associations : List_Id;
+ Pragma_Name : Name_Id);
+ -- This is a wrapper for Make_Pragma used for converting aspects
+ -- to pragmas. It takes care of Sloc (set from Loc) and building
+ -- the pragma identifier from the given name. In addition the
+ -- flags Class_Present and Split_PPC are set from the aspect
+ -- node, as well as Is_Ignored. This routine also sets the
+ -- From_Aspect_Specification in the resulting pragma node to
+ -- True, and sets Corresponding_Aspect to point to the aspect.
+ -- The resulting pragma is assigned to Aitem.
------------------------------------------
-- Analyze_Aspect_External_Or_Link_Name --
@@ -1051,6 +1061,42 @@ package body Sem_Ch13 is
end if;
end Analyze_Aspect_Implicit_Dereference;
+ -----------------------
+ -- Make_Aitem_Pragma --
+ -----------------------
+
+ procedure Make_Aitem_Pragma
+ (Pragma_Argument_Associations : List_Id;
+ Pragma_Name : Name_Id)
+ is
+ begin
+ -- We should never get here if aspect was disabled
+
+ pragma Assert (not Is_Disabled (Aspect));
+
+ -- Build the pragma
+
+ Aitem :=
+ Make_Pragma (Loc,
+ Pragma_Argument_Associations =>
+ Pragma_Argument_Associations,
+ Pragma_Identifier =>
+ Make_Identifier (Sloc (Id), Pragma_Name),
+ Class_Present => Class_Present (Aspect),
+ Split_PPC => Split_PPC (Aspect));
+
+ -- Set additional semantic fields
+
+ if Is_Ignored (Aspect) then
+ Set_Is_Ignored (Aitem);
+ end if;
+
+ Set_Corresponding_Aspect (Aitem, Aspect);
+ Set_From_Aspect_Specification (Aitem, True);
+ end Make_Aitem_Pragma;
+
+ -- Start of processing for Analyze_One_Aspect
+
begin
-- Skip aspect if already analyzed (not clear if this is needed)
@@ -1059,7 +1105,8 @@ package body Sem_Ch13 is
end if;
-- Skip looking at aspect if it is totally disabled. Just mark
- -- it as such for later reference in the tree.
+ -- it as such for later reference in the tree. This also sets
+ -- the Is_Ignored flag appropriately.
Check_Applicable_Policy (Aspect);
@@ -1218,36 +1265,32 @@ package body Sem_Ch13 is
-- referring to the entity, and the second argument is the
-- aspect definition expression.
+ -- Suppress/Unsuppress
+
when Aspect_Suppress |
Aspect_Unsuppress =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => New_Occurrence_Of (E, Loc)),
-
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))),
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => New_Occurrence_Of (E, Loc)),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Chars (Id));
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)));
+ -- Synchronization
- -- The aspect corresponds to pragma Implemented. Construct the
- -- pragma.
+ -- Corresponds to pragma Implemented, construct the pragma
when Aspect_Synchronization =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => New_Occurrence_Of (E, Loc)),
-
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Implemented));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => New_Occurrence_Of (E, Loc)),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Implemented);
-- No delay is required since the only values are: By_Entry
-- | By_Protected_Procedure | By_Any | Optional which don't
@@ -1255,16 +1298,18 @@ package body Sem_Ch13 is
Delay_Required := False;
+ -- Attach Handler
+
when Aspect_Attach_Handler =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Attach_Handler),
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Ent),
- Expression => Ent),
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Attach_Handler);
+
+ -- Dynamic_Predicate, Predicate, Static_Predicate
when Aspect_Dynamic_Predicate |
Aspect_Predicate |
@@ -1274,16 +1319,13 @@ package body Sem_Ch13 is
-- flags recording whether it is static/dynamic). We also
-- set flags recording this in the type itself.
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Ent),
- Expression => Ent),
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))),
- Class_Present => Class_Present (Aspect),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Predicate));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Predicate);
-- Mark type has predicates, and remember what kind of
-- aspect lead to this predicate (we need this to access
@@ -1301,9 +1343,7 @@ package body Sem_Ch13 is
-- has a freeze node, because that is the one that will be
-- visible at freeze time.
- if Is_Private_Type (E)
- and then Present (Full_View (E))
- then
+ if Is_Private_Type (E) and then Present (Full_View (E)) then
Set_Has_Predicates (Full_View (E));
if A_Id = Aspect_Dynamic_Predicate then
@@ -1321,6 +1361,8 @@ package body Sem_Ch13 is
-- referring to the entity, and the first argument is the
-- aspect definition expression.
+ -- Convention
+
when Aspect_Convention =>
-- The aspect may be part of the specification of an import
@@ -1387,30 +1429,28 @@ package body Sem_Ch13 is
Append_To (Arg_List, E_Assoc);
end if;
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => Arg_List,
- Pragma_Identifier =>
- Make_Identifier (Loc, P_Name));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => Arg_List,
+ Pragma_Name => P_Name);
end;
- -- The following three aspects can be specified for a
- -- subprogram body, in which case we generate pragmas for them
- -- and insert them ahead of local declarations, rather than
- -- after the body.
+ -- CPU, Interrupt_Priority, Priority
+
+ -- These three aspects can be specified for a subprogram body,
+ -- in which case we generate pragmas for them and insert them
+ -- ahead of local declarations, rather than after the body.
when Aspect_CPU |
Aspect_Interrupt_Priority |
Aspect_Priority =>
if Nkind (N) = N_Subprogram_Body then
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Chars (Id));
+
else
Aitem :=
Make_Attribute_Definition_Clause (Loc,
@@ -1419,17 +1459,17 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr));
end if;
+ -- Warnings
+
when Aspect_Warnings =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr)),
- Make_Pragma_Argument_Association (Loc,
- Expression => New_Occurrence_Of (E, Loc))),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)),
- Class_Present => Class_Present (Aspect));
+
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr)),
+ Make_Pragma_Argument_Association (Loc,
+ Expression => New_Occurrence_Of (E, Loc))),
+ Pragma_Name => Chars (Id));
-- We don't have to play the delay game here, since the only
-- values are ON/OFF which don't get analyzed anyway.
@@ -1443,6 +1483,8 @@ package body Sem_Ch13 is
-- entity, a second argument that is the expression and a third
-- argument that is an appropriate message.
+ -- Invariant, Type_Invariant
+
when Aspect_Invariant |
Aspect_Type_Invariant =>
@@ -1450,16 +1492,13 @@ package body Sem_Ch13 is
-- an invariant must apply to a private type, or appear in
-- the private part of a spec and apply to a completion.
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Ent),
- Expression => Ent),
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))),
- Class_Present => Class_Present (Aspect),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Invariant));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent),
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Invariant);
-- Add message unless exception messages are suppressed
@@ -1482,50 +1521,49 @@ package body Sem_Ch13 is
-- Case 2d : Aspects that correspond to a pragma with one
-- argument.
- when Aspect_Abstract_State =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Abstract_State),
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => Relocate_Node (Expr))));
+ -- Abstract_State
+ when Aspect_Abstract_State =>
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Abstract_State);
Delay_Required := False;
+ -- Depends
+
-- Aspect Depends must be delayed because it mentions names
-- of inputs and output that are classified by aspect Global.
when Aspect_Depends =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Depends),
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => Relocate_Node (Expr))));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Depends);
+
+ -- Global
-- Aspect Global must be delayed because it can mention names
-- and benefit from the forward visibility rules applicable to
-- aspects of subprograms.
when Aspect_Global =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Global),
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => Relocate_Node (Expr))));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Global);
+
+ -- Relative_Deadline
when Aspect_Relative_Deadline =>
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => Relocate_Node (Expr))),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Relative_Deadline));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Relative_Deadline);
-- If the aspect applies to a task, the corresponding pragma
-- must appear within its declarations, not after.
@@ -1562,6 +1600,8 @@ package body Sem_Ch13 is
-- Case 3a: The aspects listed below don't correspond to
-- pragmas/attributes but do require delayed analysis.
+ -- Default_Value, Default_Component_Value
+
when Aspect_Default_Value |
Aspect_Default_Component_Value =>
Aitem := Empty;
@@ -1569,6 +1609,8 @@ package body Sem_Ch13 is
-- Case 3b: The aspects listed below don't correspond to
-- pragmas/attributes and don't need delayed analysis.
+ -- Implicit_Dereference
+
-- For Implicit_Dereference, External_Name and Link_Name, only
-- the legality checks are done during the analysis, thus no
-- delay is required.
@@ -1577,15 +1619,21 @@ package body Sem_Ch13 is
Analyze_Aspect_Implicit_Dereference;
goto Continue;
+ -- External_Name, Link_Name
+
when Aspect_External_Name |
Aspect_Link_Name =>
Analyze_Aspect_External_Or_Link_Name;
goto Continue;
+ -- Dimension
+
when Aspect_Dimension =>
Analyze_Aspect_Dimension (N, Id, Expr);
goto Continue;
+ -- Dimension_System
+
when Aspect_Dimension_System =>
Analyze_Aspect_Dimension_System (N, Id, Expr);
goto Continue;
@@ -1595,6 +1643,8 @@ package body Sem_Ch13 is
-- Pre/Post/Test_Case/Contract_Cases whose corresponding
-- pragmas take care of the delay.
+ -- Pre/Post
+
-- Aspects Pre/Post generate Precondition/Postcondition pragmas
-- with a first argument that is the expression, and a second
-- argument that is an informative message if the test fails.
@@ -1648,16 +1698,12 @@ package body Sem_Ch13 is
-- Build the precondition/postcondition pragma
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Pname),
- Class_Present => Class_Present (Aspect),
- Split_PPC => Split_PPC (Aspect),
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Eloc,
- Chars => Name_Check,
- Expression => Relocate_Node (Expr))));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Eloc,
+ Chars => Name_Check,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Pname);
-- Add message unless exception messages are suppressed
@@ -1726,6 +1772,8 @@ package body Sem_Ch13 is
goto Continue;
end;
+ -- Test_Case
+
when Aspect_Test_Case => Test_Case : declare
Args : List_Id;
Comp_Expr : Node_Id;
@@ -1786,15 +1834,15 @@ package body Sem_Ch13 is
-- Build the test-case pragma
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Nam),
- Pragma_Argument_Associations => Args);
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => Args,
+ Pragma_Name => Nam);
Delay_Required := False;
end Test_Case;
+ -- Contract_Cases
+
when Aspect_Contract_Cases => Contract_Cases : declare
Case_Guard : Node_Id;
Extra : Node_Id;
@@ -1860,13 +1908,11 @@ package body Sem_Ch13 is
-- Transform the aspect into a pragma
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Loc, Nam),
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Loc,
- Expression => Relocate_Node (Expr))));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Nam);
Delay_Required := False;
end Contract_Cases;
@@ -1875,8 +1921,10 @@ package body Sem_Ch13 is
-- boolean argument.
-- In the general case, the corresponding pragma cannot be
- -- generated yet because the evaluation of the boolean needs to
- -- be delayed til the freeze point.
+ -- generated yet because the evaluation of the boolean needs
+ -- to be delayed till the freeze point.
+
+ -- Boolwn_Aspects
when Boolean_Aspects |
Library_Unit_Aspects =>
@@ -1954,13 +2002,11 @@ package body Sem_Ch13 is
-- simply insert the pragma, no delay is required.
if No (Expr) then
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Ent),
- Expression => Ent)),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent)),
+ Pragma_Name => Chars (Id));
Delay_Required := False;
@@ -1979,8 +2025,16 @@ package body Sem_Ch13 is
if Present (Aitem) then
Set_From_Aspect_Specification (Aitem, True);
+ -- For a pragma, keep pointer to aspect
+
if Nkind (Aitem) = N_Pragma then
Set_Corresponding_Aspect (Aitem, Aspect);
+
+ -- Also set Is_Ignored flag. No need to set Is_Disabled.
+ -- We checked that right away, and would not get here.
+
+ Set_Is_Ignored (Aitem, Is_Ignored (Aspect));
+ pragma Assert (not Is_Disabled (Aspect));
end if;
end if;
@@ -2000,9 +2054,9 @@ package body Sem_Ch13 is
goto Continue;
-- In the context of a compilation unit, we directly put the
- -- pragma in the Pragmas_After list of the
- -- N_Compilation_Unit_Aux node (no delay is required here)
- -- except for aspects on a subprogram body (see below).
+ -- pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
+ -- node (no delay is required here) except for aspects on a
+ -- subprogram body (see below).
elsif Nkind (Parent (N)) = N_Compilation_Unit
and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@@ -2018,13 +2072,11 @@ package body Sem_Ch13 is
if Is_Boolean_Aspect (Aspect) and then No (Aitem) then
if Is_True (Static_Boolean (Expr)) then
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Ent),
- Expression => Ent)),
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Chars (Id)));
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent)),
+ Pragma_Name => Chars (Id));
Set_From_Aspect_Specification (Aitem, True);
Set_Corresponding_Aspect (Aitem, Aspect);
@@ -2097,7 +2149,7 @@ package body Sem_Ch13 is
Insert_After (Ins_Node, Aitem);
Ins_Node := Aitem;
end if;
- end;
+ end Analyze_One_Aspect;
<<Continue>>
Next (Aspect);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 68f1d41..43f94e1 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -12082,16 +12082,12 @@ package body Sem_Ch6 is
declare
New_Expr : constant Node_Id :=
- Get_Pragma_Arg
- (Next
- (First
- (Pragma_Argument_Associations
- (Inherited_Precond))));
+ Get_Pragma_Arg
+ (Next (First (Pragma_Argument_Associations
+ (Inherited_Precond))));
Old_Expr : constant Node_Id :=
- Get_Pragma_Arg
- (Next
- (First
- (Pragma_Argument_Associations
+ Get_Pragma_Arg
+ (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
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 373828e..bacb340 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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,14 +6770,20 @@ package body Sem_Prag is
Pname := Chars (Identifier (Corresponding_Aspect (N)));
end if;
- Check_Applicable_Policy (N);
+ -- 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 pragma is disabled, rewrite as Null statement and skip analysis
+ if not From_Aspect_Specification (N) then
+ Check_Applicable_Policy (N);
- if Is_Disabled (N) then
- Rewrite (N, Make_Null_Statement (Loc));
- Analyze (N);
- raise Pragma_Exit;
+ -- 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,26 +8110,37 @@ package body Sem_Prag is
-- Set Check_On to indicate check status
- case Check_Kind (Cname) is
- when Name_Ignore =>
- Check_On := False;
+ -- 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.
- when Name_Check =>
- Check_On := True;
+ if From_Aspect_Specification (N) then
+ Check_On := not Is_Ignored (N);
- -- For disable, rewrite pragma as null statement and skip
- -- rest of the analysis of the pragma.
+ -- Otherwise check the status right now
- when Name_Disable =>
- Rewrite (N, Make_Null_Statement (Loc));
- Analyze (N);
- raise Pragma_Exit;
+ else
+ case Check_Kind (Cname) is
+ when Name_Ignore =>
+ Check_On := False;
- -- No other possibilities
+ when Name_Check =>
+ Check_On := True;
- when others =>
- raise Program_Error;
- end case;
+ -- For disable, rewrite pragma as null statement and skip
+ -- rest of the analysis of the pragma.
+
+ when Name_Disable =>
+ Rewrite (N, Make_Null_Statement (Loc));
+ Analyze (N);
+ raise Pragma_Exit;
+
+ -- No other possibilities
+
+ when others =>
+ raise Program_Error;
+ end case;
+ end if;
-- If check kind was not Disable, then continue pragma analysis