===================================================================
@@ -2779,7 +2779,7 @@ package body Sem_Ch3 is
-- Has_Stream just for efficiency reasons. There is no point in
-- spending time on a Has_Stream check if the restriction is not set.
- if Restrictions.Set (No_Streams) then
+ if Restriction_Check_Required (No_Streams) then
if Has_Stream (T) then
Check_Restriction (No_Streams, N);
end if;
@@ -13659,7 +13659,7 @@ package body Sem_Ch3 is
-- Check violation of No_Wide_Characters
- if Restriction_Active (No_Wide_Characters) then
+ if Restriction_Check_Required (No_Wide_Characters) then
Get_Name_String (Chars (L));
if Name_Len >= 3 and then Name_Buffer (1 .. 2) = "QW" then
===================================================================
@@ -290,7 +290,7 @@ begin
-- explicit switch turning off Warn_On_Non_Local_Exception, then turn on
-- this warning by default if we have encountered an exception handler.
- if Restriction_Active (No_Exception_Propagation)
+ if Restriction_Check_Required (No_Exception_Propagation)
and then not No_Warn_On_Non_Local_Exception
and then Exception_Handler_Encountered
then
===================================================================
@@ -1182,9 +1182,9 @@ package body Sem_Ch9 is
-- and the No_Local_Protected_Objects restriction applies, issue a
-- warning that objects of the type will violate the restriction.
- if not Is_Library_Level_Entity (T)
+ if Restriction_Check_Required (No_Local_Protected_Objects)
+ and then not Is_Library_Level_Entity (T)
and then Comes_From_Source (T)
- and then Restrictions.Set (No_Local_Protected_Objects)
then
Error_Msg_Sloc := Restrictions_Loc (No_Local_Protected_Objects);
@@ -1995,9 +1995,9 @@ package body Sem_Ch9 is
-- No_Task_Hierarchy restriction applies, issue a warning that objects
-- of the type will violate the restriction.
- if not Is_Library_Level_Entity (T)
+ if Restriction_Check_Required (No_Task_Hierarchy)
+ and then not Is_Library_Level_Entity (T)
and then Comes_From_Source (T)
- and then Restrictions.Set (No_Task_Hierarchy)
then
Error_Msg_Sloc := Restrictions_Loc (No_Task_Hierarchy);
@@ -2193,18 +2193,10 @@ package body Sem_Ch9 is
-- Entry family with non-static bounds
else
- -- If restriction is set, then this is an error
+ -- Record an unknown count restriction, and if the
+ -- restriction is active, post a message or warning.
- if Restrictions.Set (R) then
- Error_Msg_N
- ("static subtype required by Restriction pragma",
- DSD);
-
- -- Otherwise we record an unknown count restriction
-
- else
- Check_Restriction (R, D);
- end if;
+ Check_Restriction (R, D);
end if;
end;
end if;
===================================================================
@@ -2325,7 +2325,7 @@ package body Sem_Ch10 is
-- Note: this is not quite right if the user defines one of these units
-- himself, but that's a marginal case, and fixing it is hard ???
- if Restriction_Active (No_Obsolescent_Features) then
+ if Restriction_Check_Required (No_Obsolescent_Features) then
declare
F : constant File_Name_Type :=
Unit_File_Name (Get_Source_Unit (U));
===================================================================
@@ -4759,7 +4759,7 @@ package body Sem_Res is
-- violated if either operand can be negative for mod, or for rem
-- if both operands can be negative.
- if Restrictions.Set (No_Implicit_Conditionals)
+ if Restriction_Check_Required (No_Implicit_Conditionals)
and then Nkind_In (N, N_Op_Rem, N_Op_Mod)
then
declare
===================================================================
@@ -2549,7 +2549,7 @@ package body Sem_Attr is
-- 2005. Note that we can't test Is_Tagged_Type here on P_Type, since
-- this flag gets set by Find_Type in this situation.
- if Restriction_Active (No_Obsolescent_Features)
+ if Restriction_Check_Required (No_Obsolescent_Features)
and then Ada_Version >= Ada_2005
and then Ekind (P_Type) = E_Incomplete_Type
then
===================================================================
@@ -2006,7 +2006,7 @@ package body Exp_Ch11 is
procedure Warn_If_No_Propagation (N : Node_Id) is
begin
- if Restriction_Active (No_Exception_Propagation)
+ if Restriction_Check_Required (No_Exception_Propagation)
and then Warn_On_Non_Local_Exception
then
Warn_No_Exception_Propagation_Active (N);
===================================================================
@@ -617,7 +617,7 @@ package body Sem_Ch4 is
-- Has_Stream just for efficiency reasons. There is no point in
-- spending time on a Has_Stream check if the restriction is not set.
- if Restrictions.Set (No_Streams) then
+ if Restriction_Check_Required (No_Streams) then
if Has_Stream (Designated_Type (Acc_Type)) then
Check_Restriction (No_Streams, N);
end if;
===================================================================
@@ -144,8 +144,8 @@ package body Restrict is
-- Start of processing for Check_Obsolescent_2005_Entity
begin
- if Ada_Version >= Ada_2005
- and then Restriction_Active (No_Obsolescent_Features)
+ if Restriction_Check_Required (No_Obsolescent_Features)
+ and then Ada_Version >= Ada_2005
and then Chars_Is (Scope (E), "handling")
and then Chars_Is (Scope (Scope (E)), "characters")
and then Chars_Is (Scope (Scope (Scope (E))), "ada")
@@ -298,8 +298,8 @@ package body Restrict is
-- Start of processing for Check_Restriction
begin
- -- In CodePeer mode, we do not want to check for any restriction, or
- -- set additional restrictions than those already set in gnat1drv.adb
+ -- In CodePeer mode, we do not want to check for any restriction, or set
+ -- additional restrictions other than those already set in gnat1drv.adb
-- so that we have consistency between each compilation.
if CodePeer_Mode then
@@ -403,7 +403,7 @@ package body Restrict is
procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id) is
begin
- if Restriction_Active (No_Wide_Characters)
+ if Restriction_Check_Required (No_Wide_Characters)
and then Comes_From_Source (N)
then
declare
@@ -586,6 +586,15 @@ package body Restrict is
return Restrictions.Set (R) and then not Restriction_Warnings (R);
end Restriction_Active;
+ --------------------------------
+ -- Restriction_Check_Required --
+ --------------------------------
+
+ function Restriction_Check_Required (R : All_Restrictions) return Boolean is
+ begin
+ return Restrictions.Set (R);
+ end Restriction_Check_Required;
+
---------------------
-- Restriction_Msg --
---------------------
===================================================================
@@ -292,7 +292,19 @@ package Restrict is
-- used where the compiled code depends on whether the restriction is
-- active. Always use Check_Restriction to record a violation. Note that
-- this returns False if we only have a Restriction_Warnings set, since
- -- restriction warnings should never affect generated code.
+ -- restriction warnings should never affect generated code. If you want
+ -- to know if a call to Check_Restriction is needed then use the function
+ -- Restriction_Check_Required instead.
+
+ function Restriction_Check_Required (R : All_Restrictions) return Boolean;
+ pragma Inline (Restriction_Check_Required);
+ -- Determines if either a Restriction_Warnings or Restrictions pragma has
+ -- been given for the specified restriction. If true, then a subsequent
+ -- call to Check_Restriction is required if the restriction is violated.
+ -- This must not be used to guard code generation that depends on whether
+ -- a restriction is active (see Restriction_Active above). Typically it
+ -- is used to avoid complex code to determine if a restriction is violated,
+ -- executing this code only if needed.
function Restricted_Profile return Boolean;
-- Tests if set of restrictions corresponding to Profile (Restricted) is