Aspect Synchronization was introduced in Ada 2012 (AI05-215), to provide
an aspect specification for the previously defined pragma Implemented,
introduced in AI05-030. These two equivalent forms control requeue on a
synchronized interface. This patch implements the aspect version.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-01-23 Ed Schonberg <schonb...@adacore.com>
* snames.ads-tmpl: Add Name_Synchronization.
* aspects.ads, aspects.adb: Add Aspect_Synchronization to
enumeration type and related maps.
* sem_ch13.adb (Analyze_Aspect_Specifications): Handle Aspect
Synchronization, build corresponding pragma Implemented.
* sem_util.adb (Implementation_Kind): Handle both explicit and
implicit pragma_argument association to retrieve the given
synchronization mode.
Index: aspects.adb
===================================================================
--- aspects.adb (revision 183406)
+++ aspects.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
@@ -305,6 +305,7 @@
Aspect_Stream_Size => Aspect_Stream_Size,
Aspect_Suppress => Aspect_Suppress,
Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info,
+ Aspect_Synchronization => Aspect_Synchronization,
Aspect_Test_Case => Aspect_Test_Case,
Aspect_Type_Invariant => Aspect_Invariant,
Aspect_Unchecked_Union => Aspect_Unchecked_Union,
Index: aspects.ads
===================================================================
--- aspects.ads (revision 183406)
+++ aspects.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
@@ -81,6 +81,7 @@
Aspect_Storage_Size,
Aspect_Stream_Size,
Aspect_Suppress,
+ Aspect_Synchronization,
Aspect_Test_Case, -- GNAT
Aspect_Type_Invariant,
Aspect_Unsuppress,
@@ -281,6 +282,7 @@
Aspect_Storage_Size => Expression,
Aspect_Stream_Size => Expression,
Aspect_Suppress => Name,
+ Aspect_Synchronization => Name,
Aspect_Test_Case => Expression,
Aspect_Type_Invariant => Expression,
Aspect_Unsuppress => Name,
@@ -367,6 +369,7 @@
Aspect_Stream_Size => Name_Stream_Size,
Aspect_Suppress => Name_Suppress,
Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info,
+ Aspect_Synchronization => Name_Synchronization,
Aspect_Test_Case => Name_Test_Case,
Aspect_Type_Invariant => Name_Type_Invariant,
Aspect_Unchecked_Union => Name_Unchecked_Union,
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 183406)
+++ sem_ch13.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -1103,6 +1103,21 @@
pragma Assert (not Delay_Required);
+ when Aspect_Synchronization =>
+
+ -- The aspect corresponds to pragma Implemented.
+ -- Construct the pragma
+
+ Aitem :=
+ Make_Pragma (Loc,
+ Pragma_Argument_Associations => New_List (
+ New_Occurrence_Of (E, Loc),
+ Relocate_Node (Expr)),
+ Pragma_Identifier =>
+ Make_Identifier (Sloc (Id), Name_Implemented));
+
+ pragma Assert (not Delay_Required);
+
-- Aspects corresponding to pragmas with two arguments, where
-- the second argument is a local name referring to the entity,
-- and the first argument is the aspect definition expression.
@@ -6115,11 +6130,12 @@
Analyze (Expression (ASN));
return;
- -- Suppress/Unsuppress/Warnings should never be delayed
+ -- Suppress/Unsuppress/Synchronization/Warnings should not be delayed
- when Aspect_Suppress |
- Aspect_Unsuppress |
- Aspect_Warnings =>
+ when Aspect_Suppress |
+ Aspect_Unsuppress |
+ Aspect_Synchronization |
+ Aspect_Warnings =>
raise Program_Error;
-- Pre/Post/Invariant/Predicate take boolean expressions
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 183406)
+++ sem_util.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -6037,10 +6037,11 @@
function Implementation_Kind (Subp : Entity_Id) return Name_Id is
Impl_Prag : constant Node_Id := Get_Rep_Pragma (Subp, Name_Implemented);
+ Arg : Node_Id;
begin
pragma Assert (Present (Impl_Prag));
- return
- Chars (Expression (Last (Pragma_Argument_Associations (Impl_Prag))));
+ Arg := Last (Pragma_Argument_Associations (Impl_Prag));
+ return Chars (Get_Pragma_Arg (Arg));
end Implementation_Kind;
--------------------------
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 183406)
+++ snames.ads-tmpl (working copy)
@@ -6,7 +6,7 @@
-- --
-- T e m p l a t e --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -1086,6 +1086,7 @@
-- Additional reserved words and identifiers used in GNAT Project Files
-- Note that Name_External is already previously declared.
+
-- The names with the -- GB annotation are only used in gprbuild.
Name_Aggregate : constant Name_Id := N + $;
@@ -1226,6 +1227,7 @@
Name_Switches : constant Name_Id := N + $;
Name_Symbolic_Link_Supported : constant Name_Id := N + $;
Name_Synchronize : constant Name_Id := N + $;
+ Name_Synchronization : constant Name_Id := N + $;
Name_Toolchain_Description : constant Name_Id := N + $;
Name_Toolchain_Version : constant Name_Id := N + $;
Name_Trailing_Required_Switches : constant Name_Id := N + $;
