-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
-- Set True if any entry of No_Specifcation_Of_Aspects has been set True.
-- Once set True, this is never turned off again.
+ No_Use_Of_Attribute : array (Attribute_Id) of Source_Ptr :=
+ (others => No_Location);
+
+ No_Use_Of_Attribute_Warning : array (Attribute_Id) of Boolean :=
+ (others => False);
+
+ No_Use_Of_Attribute_Set : Boolean := False;
+ -- Indicates that No_Use_Of_Attribute was set at least once.
+
+ No_Use_Of_Pragma : array (Pragma_Id) of Source_Ptr :=
+ (others => No_Location);
+
+ No_Use_Of_Pragma_Warning : array (Pragma_Id) of Boolean :=
+ (others => False);
+
+ No_Use_Of_Pragma_Set : Boolean := False;
+ -- Indicates that No_Use_Of_Pragma was set at least once.
+
-----------------------
-- Local Subprograms --
-----------------------
Check_Restriction (No_Implicit_Heap_Allocations, N);
end Check_No_Implicit_Heap_Alloc;
+ -------------------------------------------
+ -- Check_Restriction_No_Use_Of_Attribute --
+ --------------------------------------------
+
+ procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id) is
+ Id : constant Name_Id := Chars (N);
+ A_Id : constant Attribute_Id := Get_Attribute_Id (Id);
+
+ begin
+ -- Ignore call if node N is not in the main source unit, since we only
+ -- give messages for the main unit. This avoids giving messages for
+ -- aspects that are specified in withed units.
+
+ if not In_Extended_Main_Source_Unit (N) then
+ return;
+ end if;
+
+ -- If nothing set, nothing to check.
+
+ if not No_Use_Of_Attribute_Set then
+ return;
+ end if;
+
+ Error_Msg_Sloc := No_Use_Of_Attribute (A_Id);
+
+ if Error_Msg_Sloc /= No_Location then
+ Error_Msg_Node_1 := N;
+ Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
+ Error_Msg_N
+ ("<violation of restriction `No_Use_Of_Attribute '='> &`#",
+ N);
+ end if;
+ end Check_Restriction_No_Use_Of_Attribute;
+
+ ----------------------------------------
+ -- Check_Restriction_No_Use_Of_Pragma --
+ ----------------------------------------
+
+ procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id) is
+ Id : constant Node_Id := Pragma_Identifier (N);
+ P_Id : constant Pragma_Id := Get_Pragma_Id (Chars (Id));
+
+ begin
+ -- Ignore call if node N is not in the main source unit, since we only
+ -- give messages for the main unit. This avoids giving messages for
+ -- aspects that are specified in withed units.
+
+ if not In_Extended_Main_Source_Unit (N) then
+ return;
+ end if;
+
+ -- If nothing set, nothing to check.
+
+ if not No_Use_Of_Pragma_Set then
+ return;
+ end if;
+
+ Error_Msg_Sloc := No_Use_Of_Pragma (P_Id);
+
+ if Error_Msg_Sloc /= No_Location then
+ Error_Msg_Node_1 := Id;
+ Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
+ Error_Msg_N
+ ("<violation of restriction `No_Use_Of_Pragma '='> &`#",
+ Id);
+ end if;
+ end Check_Restriction_No_Use_Of_Pragma;
+
-----------------------------------
-- Check_Obsolescent_2005_Entity --
-----------------------------------
No_Specification_Of_Aspect_Set := True;
end Set_Restriction_No_Specification_Of_Aspect;
+ -----------------------------------------
+ -- Set_Restriction_No_Use_Of_Attribute --
+ -----------------------------------------
+
+ procedure Set_Restriction_No_Use_Of_Attribute
+ (N : Node_Id;
+ Warning : Boolean)
+ is
+ A_Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
+
+ begin
+ No_Use_Of_Attribute_Set := True;
+ No_Use_Of_Attribute (A_Id) := Sloc (N);
+
+ if Warning = False then
+ No_Use_Of_Attribute_Warning (A_Id) := False;
+ end if;
+ end Set_Restriction_No_Use_Of_Attribute;
+
+ --------------------------------------
+ -- Set_Restriction_No_Use_Of_Pragma --
+ --------------------------------------
+
+ procedure Set_Restriction_No_Use_Of_Pragma
+ (N : Node_Id;
+ Warning : Boolean)
+ is
+ A_Id : constant Pragma_Id := Get_Pragma_Id (Chars (N));
+
+ begin
+ No_Use_Of_Pragma_Set := True;
+ No_Use_Of_Pragma (A_Id) := Sloc (N);
+
+ if Warning = False then
+ No_Use_Of_Pragma_Warning (A_Id) := False;
+ end if;
+ end Set_Restriction_No_Use_Of_Pragma;
+
----------------------------------
-- Suppress_Restriction_Message --
----------------------------------
-- binder will check that every unit either has the restriction set, or
-- does not violate the restriction.
- (Simple_Barriers, -- GNAT (Ravenscar)
- No_Abort_Statements, -- (RM D.7(5), H.4(3))
- No_Access_Subprograms, -- (RM H.4(17))
- No_Allocators, -- (RM H.4(7))
- No_Allocators_After_Elaboration, -- Ada 2012 (RM D.7(19.1/2))
- No_Anonymous_Allocators, -- Ada 2012 (RM H.4(8/1))
- No_Asynchronous_Control, -- (RM J.13(3/2)
- No_Calendar, -- GNAT
- No_Default_Stream_Attributes, -- Ada 2012 (RM 13.12.1(4/2))
- No_Delay, -- (RM H.4(21))
- No_Direct_Boolean_Operators, -- GNAT
- No_Dispatch, -- (RM H.4(19))
- No_Dispatching_Calls, -- GNAT
- No_Dynamic_Attachment, -- GNAT
- No_Dynamic_Priorities, -- (RM D.9(9))
- No_Enumeration_Maps, -- GNAT
- No_Entry_Calls_In_Elaboration_Code, -- GNAT
- No_Entry_Queue, -- GNAT (Ravenscar)
- No_Exception_Handlers, -- GNAT
- No_Exception_Propagation, -- GNAT
- No_Exception_Registration, -- GNAT
- No_Exceptions, -- (RM H.4(12))
- No_Finalization, -- GNAT
- No_Fixed_Point, -- (RM H.4(15))
- No_Floating_Point, -- (RM H.4(14))
- No_IO, -- (RM H.4(20))
- No_Implicit_Conditionals, -- GNAT
- No_Implicit_Dynamic_Code, -- GNAT
- No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3))
- No_Implicit_Loops, -- GNAT
- No_Initialize_Scalars, -- GNAT
- No_Local_Allocators, -- (RM H.4(8))
- No_Local_Timing_Events, -- (RM D.7(10.2/2))
- No_Local_Protected_Objects, -- GNAT
- No_Nested_Finalization, -- (RM D.7(4))
- No_Protected_Type_Allocators, -- GNAT
- No_Protected_Types, -- (RM H.4(5))
- No_Recursion, -- (RM H.4(22))
- No_Reentrancy, -- (RM H.4(23))
- No_Relative_Delay, -- GNAT (Ravenscar)
- No_Requeue_Statements, -- GNAT
- No_Secondary_Stack, -- GNAT
- No_Select_Statements, -- GNAT (Ravenscar)
- No_Specific_Termination_Handlers, -- (RM D.7(10.7/2))
- No_Standard_Storage_Pools, -- GNAT
- No_Stream_Optimizations, -- GNAT
- No_Streams, -- GNAT
- No_Task_Allocators, -- (RM D.7(7))
- No_Task_Attributes_Package, -- GNAT
- No_Task_Hierarchy, -- (RM D.7(3), H.4(3))
- No_Task_Termination, -- GNAT (Ravenscar)
- No_Tasking, -- GNAT
- No_Terminate_Alternatives, -- (RM D.7(6))
- No_Unchecked_Access, -- (RM H.4(18))
- No_Unchecked_Conversion, -- (RM J.13(4/2))
- No_Unchecked_Deallocation, -- (RM J.13(5/2))
- Static_Priorities, -- GNAT
- Static_Storage_Size, -- GNAT
+ (Simple_Barriers, -- Ada 2012 (D.7 (10.9/3))
+ No_Abort_Statements, -- (RM D.7(5), H.4(3))
+ No_Access_Parameter_Allocators, -- Ada 2012 (RM H.4 (8.3/3))
+ No_Access_Subprograms, -- (RM H.4(17))
+ No_Allocators, -- (RM H.4(7))
+ No_Anonymous_Allocators, -- Ada 2012 (RM H.4(8/1))
+ No_Asynchronous_Control, -- (RM J.13(3/2)
+ No_Calendar, -- GNAT
+ No_Coextensions, -- Ada 2012 (RM H.4(8.2/3))
+ No_Default_Stream_Attributes, -- Ada 2012 (RM 13.12.1(4/2))
+ No_Delay, -- (RM H.4(21))
+ No_Direct_Boolean_Operators, -- GNAT
+ No_Dispatch, -- (RM H.4(19))
+ No_Dispatching_Calls, -- GNAT
+ No_Dynamic_Attachment, -- Ada 2012 (RM E.7(10/3))
+ No_Dynamic_Priorities, -- (RM D.9(9))
+ No_Enumeration_Maps, -- GNAT
+ No_Entry_Calls_In_Elaboration_Code, -- GNAT
+ No_Entry_Queue, -- GNAT (Ravenscar)
+ No_Exception_Handlers, -- GNAT
+ No_Exception_Propagation, -- GNAT
+ No_Exception_Registration, -- GNAT
+ No_Exceptions, -- (RM H.4(12))
+ No_Finalization, -- GNAT
+ No_Fixed_Point, -- (RM H.4(15))
+ No_Floating_Point, -- (RM H.4(14))
+ No_IO, -- (RM H.4(20))
+ No_Implicit_Conditionals, -- GNAT
+ No_Implicit_Dynamic_Code, -- GNAT
+ No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3))
+ No_Implicit_Loops, -- GNAT
+ No_Initialize_Scalars, -- GNAT
+ No_Local_Allocators, -- (RM H.4(8))
+ No_Local_Timing_Events, -- (RM D.7(10.2/2))
+ No_Local_Protected_Objects, -- Ada 2012 (D.7(10/1.3))
+ No_Nested_Finalization, -- (RM D.7(4))
+ No_Protected_Type_Allocators, -- Ada 2012 (D.7 (10.3/2))
+ No_Protected_Types, -- (RM H.4(5))
+ No_Recursion, -- (RM H.4(22))
+ No_Reentrancy, -- (RM H.4(23))
+ No_Relative_Delay, -- Ada 2012 (D.7 (10.5/3))
+ No_Requeue_Statements, -- Ada 2012 (D.7 (10.6/3))
+ No_Secondary_Stack, -- GNAT
+ No_Select_Statements, -- Ada 2012 (D.7 (10.7/4))
+ No_Specific_Termination_Handlers, -- (RM D.7(10.7/2))
+ No_Standard_Allocators_After_Elaboration, -- Ada 2012 (RM D.7(19.1/2))
+ No_Standard_Storage_Pools, -- GNAT
+ No_Stream_Optimizations, -- GNAT
+ No_Streams, -- GNAT
+ No_Task_Allocators, -- (RM D.7(7))
+ No_Task_Attributes_Package, -- GNAT
+ No_Task_Hierarchy, -- (RM D.7(3), H.4(3))
+ No_Task_Termination, -- GNAT (Ravenscar)
+ No_Tasking, -- GNAT
+ No_Terminate_Alternatives, -- (RM D.7(6))
+ No_Unchecked_Access, -- (RM H.4(18))
+ No_Unchecked_Conversion, -- (RM J.13(4/2))
+ No_Unchecked_Deallocation, -- (RM J.13(5/2))
+ Static_Priorities, -- GNAT
+ Static_Storage_Size, -- GNAT
-- The following require consistency checking with special rules. See
-- individual routines in unit Bcheck for details of what is required.
- No_Default_Initialization, -- GNAT
+ No_Default_Initialization, -- GNAT
-- The following cases do not require consistency checking and if used
-- as a configuration pragma within a specific unit, apply only to that
-- it is sticky, in that if it is found anywhere within any of these
-- units, it applies to all units in this extended main source.
- 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
- No_Implementation_Restrictions, -- GNAT
- No_Implementation_Units, -- Ada 2012 AI-242
- No_Implicit_Aliasing, -- GNAT
- No_Elaboration_Code, -- GNAT
- No_Obsolescent_Features, -- Ada 2005 AI-368
- No_Wide_Characters, -- GNAT
- SPARK, -- GNAT
+ 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
+ No_Implementation_Restrictions, -- GNAT
+ No_Implementation_Units, -- Ada 2012 AI-242
+ No_Implicit_Aliasing, -- GNAT
+ No_Elaboration_Code, -- GNAT
+ No_Obsolescent_Features, -- Ada 2005 AI-368
+ No_Wide_Characters, -- GNAT
+ SPARK, -- GNAT
-- The following cases require a parameter value
+ No_Specification_Of_Aspect, -- 2012 (RM 13.12.1 (6.1/3))
+ No_Use_Of_Attribute, -- 2012 (RM 13.12.1 (6.2/3))
+ No_Use_Of_Pragma, -- 2012 (RM 13.12.1 (6.3/3))
+
-- The following entries are fully checked at compile/bind time, which
-- means that the compiler can in general tell the minimum value which
-- could be used with a restrictions pragma. The binder can deduce the
-- appropriate minimum value for the partition by taking the maximum
-- value required by any unit.
- Max_Protected_Entries, -- (RM D.7(14))
- Max_Select_Alternatives, -- (RM D.7(12))
- Max_Task_Entries, -- (RM D.7(13), H.4(3))
+ Max_Protected_Entries, -- (RM D.7(14))
+ Max_Select_Alternatives, -- (RM D.7(12))
+ Max_Task_Entries, -- (RM D.7(13), H.4(3))
-- The following entries are also fully checked at compile/bind time,
-- and the compiler can also at least in some cases tell the minimum
-- is that the contributions are additive, so the binder deduces this
-- value by adding the unit contributions.
- Max_Tasks, -- (RM D.7(19), H.4(3))
+ Max_Tasks, -- (RM D.7(19), H.4(3))
-- The following entries are checked at compile time only for zero/
-- nonzero entries. This means that the compiler can tell at compile
-- time if a restriction value of zero is (would be) violated, but that
-- the compiler cannot distinguish between different non-zero values.
- Max_Asynchronous_Select_Nesting, -- (RM D.7(18), H.4(3))
- Max_Entry_Queue_Length, -- GNAT
+ Max_Asynchronous_Select_Nesting, -- (RM D.7(18), H.4(3))
+ Max_Entry_Queue_Length, -- Ada 2012 (RM D.7 (19.1/2))
-- The remaining entries are not checked at compile/bind time
- Max_Storage_At_Blocking, -- (RM D.7(17))
+ Max_Storage_At_Blocking, -- (RM D.7(17))
Not_A_Restriction_Id);
subtype All_Parameter_Restrictions is
Restriction_Id range
- Max_Protected_Entries .. Max_Storage_At_Blocking;
+ No_Specification_Of_Aspect .. Max_Storage_At_Blocking;
-- All restrictions that take a parameter
subtype Checked_Parameter_Restrictions is
OSDN Git Service
