* [Ada] Implement new Aspect control restrictions
@ 2011-09-19 8:51 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2011-09-19 8:51 UTC (permalink / raw)
To: gcc-patches; +Cc: Robert Dewar
[-- Attachment #1: Type: text/plain, Size: 3171 bytes --]
Ada 2012 AI-241. Restriction No_Implementation_Aspect_Specifications
disallows any implementation defined aspect specifications. It is
included in the profile No_Implementation_Extensions. Restriction
No_Implementation_Of_Aspects => Aspect_Identifier disallows a
specified aspect specification. The following test programs
show these new restrictions in action (they do not have to be
partition-wide consistent). They are all compiled with -gnatj60
-gnatld7.
1. pragma Ada_2012;
2. pragma Restrictions
3. (No_Implementation_Aspect_Specifications);
4. package noimpaspect is
5. type X is new Integer with
6. Object_Size => 32;
|
>>> violation of restriction
"no_implementation_aspect_specifications" at
line 2
7. Y : Integer with
8. Size => 32;
9. end noimpaspect;
1. pragma Ada_2012;
2. pragma Profile (No_Implementation_Extensions);
3. package noimpaspect2 is
4. type X is new Integer with
5. Object_Size => 32;
|
>>> violation of restriction
"no_implementation_aspect_specifications", from
profile "no_implementation_extensions" at line 2
6. Y : Integer with
7. Size => 32;
8. end noimpaspect2;
1. pragma Ada_2012;
2. pragma Restrictions
3. (No_Specification_Of_Aspect => Size);
4. pragma Restriction_Warnings
5. (No_Specification_Of_Aspect => Object_Size);
6. package NoSpecAsp is
7. type R is new Integer with
8. Size => 32;
|
>>> violation of restriction
"No_Specification_Of_Aspect => Size" at line 3
9. type S is new Integer with
10. Object_Size => 32;
|
>>> warning: violation of restriction
"No_Specification_Of_Aspect => Object_Size" at
line 5
11. end NoSpecAsp;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-19 Robert Dewar <dewar@adacore.com>
* aspects.ads (Impl_Defined_Aspects): New array
* lib-writ.adb (No_Dependences): New name for No_Dependence
* restrict.adb (No_Dependences): New name for No_Dependence
(Check_Restriction_No_Specification_Of_Aspect): New
procedure.
(Set_Restriction_No_Specification_Of_Aspect): New procedure
(Restricted_Profile_Result): New variable
(No_Specification_Of_Aspects): New variable
(No_Specification_Of_Aspect_Warning): New variable
* restrict.ads (No_Dependences): New name for No_Dependence
(Check_Restriction_No_Specification_Of_Aspect): New procedure
(Set_Restriction_No_Specification_Of_Aspect): New procedure
* s-rident.ads: Add restriction
No_Implementation_Aspect_Specifications, this is also added to
the No_Implementation_Extensions profile.
* sem_ch13.adb (Analyze_Aspect_Specifications): Check
No_Implementation_Defined_Aspects
(Analyze_Aspect_Specifications): Check No_Specification_Of_Aspect
* sem_prag.adb (Analyze_Aspect_Specifications): Check
No_Implementation_Aspects
(Analyze_Aspect_Specifications): Check No_Specification_Of_Aspect
* snames.ads-tmpl (Name_No_Specification_Of_Aspect): New name
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 15519 bytes --]
Index: lib-writ.adb
===================================================================
--- lib-writ.adb (revision 178955)
+++ lib-writ.adb (working copy)
@@ -1161,13 +1161,13 @@
-- Output R lines for No_Dependence entries
- for J in No_Dependence.First .. No_Dependence.Last loop
- if In_Extended_Main_Source_Unit (No_Dependence.Table (J).Unit)
- and then not No_Dependence.Table (J).Warn
+ for J in No_Dependences.First .. No_Dependences.Last loop
+ if In_Extended_Main_Source_Unit (No_Dependences.Table (J).Unit)
+ and then not No_Dependences.Table (J).Warn
then
Write_Info_Initiate ('R');
Write_Info_Char (' ');
- Write_Unit_Name (No_Dependence.Table (J).Unit);
+ Write_Unit_Name (No_Dependences.Table (J).Unit);
Write_Info_EOL;
end if;
end loop;
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 178955)
+++ sem_prag.adb (working copy)
@@ -29,6 +29,7 @@
-- to complete the syntax checks. Certain pragmas are handled partially or
-- completely by the parser (see Par.Prag for further details).
+with Aspects; use Aspects;
with Atree; use Atree;
with Casing; use Casing;
with Checks; use Checks;
@@ -5314,6 +5315,26 @@
elsif Id = Name_No_Dependence then
Check_Unit_Name (Expr);
+ -- Case of No_Specification_Of_Aspect => Identifier.
+
+ elsif Id = Name_No_Specification_Of_Aspect then
+ declare
+ A_Id : Aspect_Id;
+
+ begin
+ if Nkind (Expr) /= N_Identifier then
+ A_Id := No_Aspect;
+ else
+ A_Id := Get_Aspect_Id (Chars (Expr));
+ end if;
+
+ if A_Id = No_Aspect then
+ Error_Pragma_Arg ("invalid restriction name", Arg);
+ else
+ Set_Restriction_No_Specification_Of_Aspect (Expr, Warn);
+ end if;
+ end;
+
-- All other cases of restriction identifier present
else
Index: restrict.adb
===================================================================
--- restrict.adb (revision 178955)
+++ restrict.adb (working copy)
@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Casing; use Casing;
with Einfo; use Einfo;
@@ -41,15 +42,29 @@
package body Restrict is
Restricted_Profile_Result : Boolean := False;
- -- This switch memoizes the result of Restricted_Profile function
- -- calls for improved efficiency. Its setting is valid only if
- -- Restricted_Profile_Cached is True. Note that if this switch
- -- is ever set True, it need never be turned off again.
+ -- This switch memoizes the result of Restricted_Profile function calls for
+ -- improved efficiency. Valid only if Restricted_Profile_Cached is True.
+ -- Note: if this switch is ever set True, it is never turned off again.
Restricted_Profile_Cached : Boolean := False;
- -- This flag is set to True if the Restricted_Profile_Result
- -- contains the correct cached result of Restricted_Profile calls.
+ -- This flag is set to True if the Restricted_Profile_Result contains the
+ -- correct cached result of Restricted_Profile calls.
+ No_Specification_Of_Aspects : array (Aspect_Id) of Source_Ptr :=
+ (others => No_Location);
+ -- Entries in this array are set to point to a previously occuring pragma
+ -- that activates a No_Specification_Of_Aspect check.
+
+ No_Specification_Of_Aspect_Warning : array (Aspect_Id) of Boolean :=
+ (others => True);
+ -- An entry in this array is set False in reponse to a previous call to
+ -- Set_No_Speficiation_Of_Aspect for pragmas in the main unit that
+ -- specify Warning as False. Once set False, an entry is never reset.
+
+ No_Specification_Of_Aspect_Set : Boolean := False;
+ -- Set True if any entry of No_Specifcation_Of_Aspects has been set True.
+ -- Once set True, this is never turned off again.
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -461,14 +476,14 @@
-- Loop through entries in No_Dependence table to check each one in turn
- for J in No_Dependence.First .. No_Dependence.Last loop
- DU := No_Dependence.Table (J).Unit;
+ for J in No_Dependences.First .. No_Dependences.Last loop
+ DU := No_Dependences.Table (J).Unit;
if Same_Unit (U, DU) then
Error_Msg_Sloc := Sloc (DU);
Error_Msg_Node_1 := DU;
- if No_Dependence.Table (J).Warn then
+ if No_Dependences.Table (J).Warn then
Error_Msg
("?violation of restriction `No_Dependence '='> &`#",
Sloc (Err));
@@ -483,6 +498,44 @@
end loop;
end Check_Restriction_No_Dependence;
+ --------------------------------------------------
+ -- Check_Restriction_No_Specification_Of_Aspect --
+ --------------------------------------------------
+
+ procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id) is
+ A_Id : Aspect_Id;
+ Id : Node_Id;
+
+ begin
+ -- Ignore call if no instances of this restriction set
+
+ if not No_Specification_Of_Aspect_Set then
+ return;
+ end if;
+
+ -- Ignore call if node N is not in the main source unit, since we only
+ -- give messages for . This avoids giving messages for aspects that are
+ -- specified in withed units.
+
+ if not In_Extended_Main_Source_Unit (N) then
+ return;
+ end if;
+
+ Id := Identifier (N);
+ A_Id := Get_Aspect_Id (Chars (Id));
+ pragma Assert (A_Id /= No_Aspect);
+
+ Error_Msg_Sloc := No_Specification_Of_Aspects (A_Id);
+
+ if Error_Msg_Sloc /= No_Location then
+ Error_Msg_Node_1 := Id;
+ Error_Msg_Warn := No_Specification_Of_Aspect_Warning (A_Id);
+ Error_Msg_N
+ ("<violation of restriction `No_Specification_Of_Aspect '='> &`#",
+ Id);
+ end if;
+ end Check_Restriction_No_Specification_Of_Aspect;
+
--------------------------------------
-- Check_Wide_Character_Restriction --
--------------------------------------
@@ -1059,16 +1112,16 @@
begin
-- Loop to check for duplicate entry
- for J in No_Dependence.First .. No_Dependence.Last loop
+ for J in No_Dependences.First .. No_Dependences.Last loop
-- Case of entry already in table
- if Same_Unit (Unit, No_Dependence.Table (J).Unit) then
+ if Same_Unit (Unit, No_Dependences.Table (J).Unit) then
-- Error has precedence over warning
if not Warn then
- No_Dependence.Table (J).Warn := False;
+ No_Dependences.Table (J).Warn := False;
end if;
return;
@@ -1077,9 +1130,30 @@
-- Entry is not currently in table
- No_Dependence.Append ((Unit, Warn, Profile));
+ No_Dependences.Append ((Unit, Warn, Profile));
end Set_Restriction_No_Dependence;
+ ------------------------------------------------
+ -- Set_Restriction_No_Specification_Of_Aspect --
+ ------------------------------------------------
+
+ procedure Set_Restriction_No_Specification_Of_Aspect
+ (N : Node_Id;
+ Warning : Boolean)
+ is
+ A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (N));
+ pragma Assert (A_Id /= No_Aspect);
+
+ begin
+ No_Specification_Of_Aspects (A_Id) := Sloc (N);
+
+ if Warning = False then
+ No_Specification_Of_Aspect_Warning (A_Id) := False;
+ end if;
+
+ No_Specification_Of_Aspect_Set := True;
+ end Set_Restriction_No_Specification_Of_Aspect;
+
----------------------------------
-- Suppress_Restriction_Message --
----------------------------------
Index: restrict.ads
===================================================================
--- restrict.ads (revision 178955)
+++ restrict.ads (working copy)
@@ -166,13 +166,13 @@
-- No_Profile if a pragma Restriction set the No_Dependence entry.
end record;
- package No_Dependence is new Table.Table (
+ package No_Dependences is new Table.Table (
Table_Component_Type => ND_Entry,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 200,
Table_Increment => 200,
- Table_Name => "Name_No_Dependence");
+ Table_Name => "Name_No_Dependences");
-------------------------------
-- SPARK Restriction Control --
@@ -255,6 +255,11 @@
-- an explicit WITH clause). U is a node for the unit involved, and Err is
-- the node to which an error will be attached if necessary.
+ procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id);
+ -- N is the node id for an N_Aspect_Specification. An error message
+ -- (warning) will be issued if a restriction (warning) was previous set
+ -- for this aspect using Set_No_Specification_Of_Aspect.
+
procedure Check_Elaboration_Code_Allowed (N : Node_Id);
-- Tests to see if elaboration code is allowed by the current restrictions
-- settings. This function is called by Gigi when it needs to define an
@@ -409,6 +414,15 @@
-- this flag is not set. Profile is set to a non-default value if the
-- No_Dependence restriction comes from a Profile pragma.
+ procedure Set_Restriction_No_Specification_Of_Aspect
+ (N : Node_Id;
+ Warning : Boolean);
+ -- N is the node id for an identifier from a pragma Restrictions for the
+ -- No_Specification_Of_Aspect pragma. An error message will be issued if
+ -- the identifier is not a valid aspect name. Warning is set True for the
+ -- case of a Restriction_Warnings pragma specifying this restriction and
+ -- False for a Restrictions pragma specifying this restriction.
+
function Tasking_Allowed return Boolean;
pragma Inline (Tasking_Allowed);
-- Tests if tasking operations are allowed by the current restrictions
Index: aspects.ads
===================================================================
--- aspects.ads (revision 178955)
+++ aspects.ads (working copy)
@@ -144,6 +144,31 @@
Aspect_Post => True,
others => False);
+ -- The following array identifies all implementation defined aspects
+
+ Impl_Defined_Aspects : constant array (Aspect_Id) of Boolean :=
+ (Aspect_Object_Size => True,
+ Aspect_Predicate => True,
+ Aspect_Test_Case => True,
+ Aspect_Value_Size => True,
+ Aspect_Compiler_Unit => True,
+ Aspect_Preelaborate_05 => True,
+ Aspect_Pure_05 => True,
+ Aspect_Universal_Data => True,
+ Aspect_Ada_2005 => True,
+ Aspect_Ada_2012 => True,
+ Aspect_Favor_Top_Level => True,
+ Aspect_Inline_Always => True,
+ Aspect_Persistent_BSS => True,
+ Aspect_Pure_Function => True,
+ Aspect_Shared => True,
+ Aspect_Suppress_Debug_Info => True,
+ Aspect_Universal_Aliasing => True,
+ Aspect_Unmodified => True,
+ Aspect_Unreferenced => True,
+ Aspect_Unreferenced_Objects => True,
+ others => False);
+
-- The following array indicates aspects for which multiple occurrences of
-- the same aspect attached to the same declaration are allowed.
Index: s-rident.ads
===================================================================
--- s-rident.ads (revision 178955)
+++ s-rident.ads (working copy)
@@ -125,6 +125,7 @@
-- The following cases do not require consistency checking
Immediate_Reclamation, -- (RM H.4(10))
+ No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241
No_Implementation_Attributes, -- Ada 2005 AI-257
No_Implementation_Identifiers, -- Ada 2012 AI-246
No_Implementation_Pragmas, -- Ada 2005 AI-257
@@ -349,11 +350,12 @@
-- Restrictions for Restricted profile
(Set =>
- (No_Implementation_Attributes => True,
- No_Implementation_Identifiers => True,
- No_Implementation_Pragmas => True,
- No_Implementation_Units => True,
- others => False),
+ (No_Implementation_Aspect_Specifications => True,
+ No_Implementation_Attributes => True,
+ No_Implementation_Identifiers => True,
+ No_Implementation_Pragmas => True,
+ No_Implementation_Units => True,
+ others => False),
-- Value settings for Restricted profile (none
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 178955)
+++ sem_ch13.adb (working copy)
@@ -804,6 +804,19 @@
goto Continue;
end if;
+ -- Check restriction No_Implementation_Aspect_Specifications
+
+ if Impl_Defined_Aspects (A_Id) then
+ Check_Restriction
+ (No_Implementation_Aspect_Specifications, Aspect);
+ end if;
+
+ -- Check restriction No_Specification_Of_Aspect
+
+ Check_Restriction_No_Specification_Of_Aspect (Aspect);
+
+ -- Analyze this aspect
+
Set_Analyzed (Aspect);
Set_Entity (Aspect, E);
Ent := New_Occurrence_Of (E, Sloc (Id));
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 178955)
+++ snames.ads-tmpl (working copy)
@@ -663,6 +663,7 @@
Name_No_Implementation_Extensions : constant Name_Id := N + $;
Name_No_Requeue : constant Name_Id := N + $;
Name_No_Requeue_Statements : constant Name_Id := N + $;
+ Name_No_Specification_Of_Aspect : constant Name_Id := N + $;
Name_No_Task_Attributes : constant Name_Id := N + $;
Name_No_Task_Attributes_Package : constant Name_Id := N + $;
Name_Nominal : constant Name_Id := N + $;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2011-09-19 8:33 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-09-19 8:51 [Ada] Implement new Aspect control restrictions Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).