Commit 6cbab959 by Arnaud Charlet

[multiple changes]

2012-01-23  Robert Dewar  <dewar@adacore.com>

	* sem_ch10.adb (Analyze_Subunit): Properly save/restore cunit
	restrictions.

2012-01-23  Ed Schonberg  <schonberg@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.

From-SVN: r183410
parent 67bdbf1e
2012-01-23 Robert Dewar <dewar@adacore.com> 2012-01-23 Robert Dewar <dewar@adacore.com>
* sem_ch10.adb (Analyze_Subunit): Properly save/restore cunit
restrictions.
2012-01-23 Ed Schonberg <schonberg@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.
2012-01-23 Robert Dewar <dewar@adacore.com>
* sem_ch10.adb, errout.adb: Minor reformatting. * sem_ch10.adb, errout.adb: Minor reformatting.
2012-01-23 Ed Schonberg <schonberg@adacore.com> 2012-01-23 Ed Schonberg <schonberg@adacore.com>
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -305,6 +305,7 @@ package body Aspects is ...@@ -305,6 +305,7 @@ package body Aspects is
Aspect_Stream_Size => Aspect_Stream_Size, Aspect_Stream_Size => Aspect_Stream_Size,
Aspect_Suppress => Aspect_Suppress, Aspect_Suppress => Aspect_Suppress,
Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info, Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info,
Aspect_Synchronization => Aspect_Synchronization,
Aspect_Test_Case => Aspect_Test_Case, Aspect_Test_Case => Aspect_Test_Case,
Aspect_Type_Invariant => Aspect_Invariant, Aspect_Type_Invariant => Aspect_Invariant,
Aspect_Unchecked_Union => Aspect_Unchecked_Union, Aspect_Unchecked_Union => Aspect_Unchecked_Union,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -81,6 +81,7 @@ package Aspects is ...@@ -81,6 +81,7 @@ package Aspects is
Aspect_Storage_Size, Aspect_Storage_Size,
Aspect_Stream_Size, Aspect_Stream_Size,
Aspect_Suppress, Aspect_Suppress,
Aspect_Synchronization,
Aspect_Test_Case, -- GNAT Aspect_Test_Case, -- GNAT
Aspect_Type_Invariant, Aspect_Type_Invariant,
Aspect_Unsuppress, Aspect_Unsuppress,
...@@ -281,6 +282,7 @@ package Aspects is ...@@ -281,6 +282,7 @@ package Aspects is
Aspect_Storage_Size => Expression, Aspect_Storage_Size => Expression,
Aspect_Stream_Size => Expression, Aspect_Stream_Size => Expression,
Aspect_Suppress => Name, Aspect_Suppress => Name,
Aspect_Synchronization => Name,
Aspect_Test_Case => Expression, Aspect_Test_Case => Expression,
Aspect_Type_Invariant => Expression, Aspect_Type_Invariant => Expression,
Aspect_Unsuppress => Name, Aspect_Unsuppress => Name,
...@@ -367,6 +369,7 @@ package Aspects is ...@@ -367,6 +369,7 @@ package Aspects is
Aspect_Stream_Size => Name_Stream_Size, Aspect_Stream_Size => Name_Stream_Size,
Aspect_Suppress => Name_Suppress, Aspect_Suppress => Name_Suppress,
Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info, Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info,
Aspect_Synchronization => Name_Synchronization,
Aspect_Test_Case => Name_Test_Case, Aspect_Test_Case => Name_Test_Case,
Aspect_Type_Invariant => Name_Type_Invariant, Aspect_Type_Invariant => Name_Type_Invariant,
Aspect_Unchecked_Union => Name_Unchecked_Union, Aspect_Unchecked_Union => Name_Unchecked_Union,
......
...@@ -1962,6 +1962,12 @@ package body Sem_Ch10 is ...@@ -1962,6 +1962,12 @@ package body Sem_Ch10 is
Enclosing_Child : Entity_Id := Empty; Enclosing_Child : Entity_Id := Empty;
Svg : constant Suppress_Array := Scope_Suppress; Svg : constant Suppress_Array := Scope_Suppress;
Save_Cunit_Restrictions : constant Save_Cunit_Boolean_Restrictions :=
Cunit_Boolean_Restrictions_Save;
-- Save non-partition wide restrictions before processing the subunit.
-- All subunits are analyzed with config restrictions reset and we need
-- to restore these saved values at the end.
procedure Analyze_Subunit_Context; procedure Analyze_Subunit_Context;
-- Capture names in use clauses of the subunit. This must be done before -- Capture names in use clauses of the subunit. This must be done before
-- re-installing parent declarations, because items in the context must -- re-installing parent declarations, because items in the context must
...@@ -2175,6 +2181,15 @@ package body Sem_Ch10 is ...@@ -2175,6 +2181,15 @@ package body Sem_Ch10 is
-- Start of processing for Analyze_Subunit -- Start of processing for Analyze_Subunit
begin begin
-- For subunit in main extended unit, we reset the configuration values
-- for the non-partition-wide restrictions. For other units reset them.
if In_Extended_Main_Source_Unit (N) then
Restore_Config_Cunit_Boolean_Restrictions;
else
Reset_Cunit_Boolean_Restrictions;
end if;
if Style_Check then if Style_Check then
declare declare
Nam : Node_Id := Name (Unit (N)); Nam : Node_Id := Name (Unit (N));
...@@ -2280,6 +2295,10 @@ package body Sem_Ch10 is ...@@ -2280,6 +2295,10 @@ package body Sem_Ch10 is
end loop; end loop;
end; end;
end if; end if;
-- Deal with restore of restrictions
Cunit_Boolean_Restrictions_Restore (Save_Cunit_Restrictions);
end Analyze_Subunit; end Analyze_Subunit;
---------------------------- ----------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1103,6 +1103,21 @@ package body Sem_Ch13 is ...@@ -1103,6 +1103,21 @@ package body Sem_Ch13 is
pragma Assert (not Delay_Required); 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 -- Aspects corresponding to pragmas with two arguments, where
-- the second argument is a local name referring to the entity, -- the second argument is a local name referring to the entity,
-- and the first argument is the aspect definition expression. -- and the first argument is the aspect definition expression.
...@@ -6115,11 +6130,12 @@ package body Sem_Ch13 is ...@@ -6115,11 +6130,12 @@ package body Sem_Ch13 is
Analyze (Expression (ASN)); Analyze (Expression (ASN));
return; return;
-- Suppress/Unsuppress/Warnings should never be delayed -- Suppress/Unsuppress/Synchronization/Warnings should not be delayed
when Aspect_Suppress | when Aspect_Suppress |
Aspect_Unsuppress | Aspect_Unsuppress |
Aspect_Warnings => Aspect_Synchronization |
Aspect_Warnings =>
raise Program_Error; raise Program_Error;
-- Pre/Post/Invariant/Predicate take boolean expressions -- Pre/Post/Invariant/Predicate take boolean expressions
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -6037,10 +6037,11 @@ package body Sem_Util is ...@@ -6037,10 +6037,11 @@ package body Sem_Util is
function Implementation_Kind (Subp : Entity_Id) return Name_Id is function Implementation_Kind (Subp : Entity_Id) return Name_Id is
Impl_Prag : constant Node_Id := Get_Rep_Pragma (Subp, Name_Implemented); Impl_Prag : constant Node_Id := Get_Rep_Pragma (Subp, Name_Implemented);
Arg : Node_Id;
begin begin
pragma Assert (Present (Impl_Prag)); pragma Assert (Present (Impl_Prag));
return Arg := Last (Pragma_Argument_Associations (Impl_Prag));
Chars (Expression (Last (Pragma_Argument_Associations (Impl_Prag)))); return Chars (Get_Pragma_Arg (Arg));
end Implementation_Kind; end Implementation_Kind;
-------------------------- --------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- T e m p l a t e -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1086,6 +1086,7 @@ package Snames is ...@@ -1086,6 +1086,7 @@ package Snames is
-- Additional reserved words and identifiers used in GNAT Project Files -- Additional reserved words and identifiers used in GNAT Project Files
-- Note that Name_External is already previously declared. -- Note that Name_External is already previously declared.
-- The names with the -- GB annotation are only used in gprbuild. -- The names with the -- GB annotation are only used in gprbuild.
Name_Aggregate : constant Name_Id := N + $; Name_Aggregate : constant Name_Id := N + $;
...@@ -1226,6 +1227,7 @@ package Snames is ...@@ -1226,6 +1227,7 @@ package Snames is
Name_Switches : constant Name_Id := N + $; Name_Switches : constant Name_Id := N + $;
Name_Symbolic_Link_Supported : constant Name_Id := N + $; Name_Symbolic_Link_Supported : constant Name_Id := N + $;
Name_Synchronize : 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_Description : constant Name_Id := N + $;
Name_Toolchain_Version : constant Name_Id := N + $; Name_Toolchain_Version : constant Name_Id := N + $;
Name_Trailing_Required_Switches : constant Name_Id := N + $; Name_Trailing_Required_Switches : constant Name_Id := N + $;
......
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