* [Ada] Fix missing warnings from Restriction_Warnings
@ 2010-09-09 10:16 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2010-09-09 10:16 UTC (permalink / raw)
To: gcc-patches; +Cc: Robert Dewar
[-- Attachment #1: Type: text/plain, Size: 4208 bytes --]
This patch fixes several cases in which pragma Restriction_Warnings
was not generating warnings when a restriction was violated. The
problem was calling Restriction_Active, when instead the required
action was simply to test Restrictions.Set. A new function provides
a convenient abstraction for this test Restriction_Check_Required.
The following, compiled with -gnatld7 -gnatj60 -gnatf shows all
the cases being caught (prior to this patch, most were missed)
1. --pragma Restrictions (No_Wide_Characters);
2. pragma Restriction_Warnings (No_Wide_Characters);
3. procedure No_Wide_Characters is
4. W_Char_1 : Wide_Character := 'a'; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
5. W_String_1 : Wide_String := "a"; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
6.
7. subtype My_Wide_Character is Wide_Character; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
8. subtype My_Wide_String is Wide_String (1 .. 5); -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
9.
10. W_Char_2 : My_Wide_Character := 'a'; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
11. W_String_2 : My_Wide_String := "12345"; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
12.
13. type My_Array_1
14. is array (Wide_Character'First .. -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
15. Wide_Character'Last) of Integer; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
16.
17. procedure Proc
18. (W_Ch : Standard.Wide_Character; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
19. W_Str : Wide_String) -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
20. is
21. begin
22. null;
23. end;
24.
25. function Fun_W_Ch
26. (Ch : Character)
27. return Standard.Wide_Character -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
28. is
29. begin
30. return '["1234"]'; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
31. end;
32.
33. function Fun_W_Str
34. (Str : String)
35. return Wide_String -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
36. is
37. begin
38. return "["1234"]"; -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
39. end;
40.
41. type R is ('a', '["1234"]'); -- FLAG
|
>>> warning: violation of restriction
"No_Wide_Characters" at line 2
42.
43. begin
44. null;
45. end No_Wide_Characters;
Tested on x86_64-pc-linux-gnu, committed on trunk
2010-09-09 Robert Dewar <dewar@adacore.com>
* exp_ch11.adb, frontend.adb, sem_attr.adb, sem_ch10.adb, sem_ch3.adb,
sem_ch4.adb, sem_ch9.adb, sem_res.adb: Use Restriction_Check_Needed
where appropriate.
* restrict.ads, restrict.adb: Ditto.
(Restriction_Check_Needed): New function
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 9807 bytes --]
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 164059)
+++ sem_ch3.adb (working copy)
@@ -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
Index: frontend.adb
===================================================================
--- frontend.adb (revision 164000)
+++ frontend.adb (working copy)
@@ -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
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb (revision 164000)
+++ sem_ch9.adb (working copy)
@@ -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;
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 164000)
+++ sem_ch10.adb (working copy)
@@ -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));
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 164058)
+++ sem_res.adb (working copy)
@@ -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
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 164000)
+++ sem_attr.adb (working copy)
@@ -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
Index: exp_ch11.adb
===================================================================
--- exp_ch11.adb (revision 164000)
+++ exp_ch11.adb (working copy)
@@ -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);
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 164000)
+++ sem_ch4.adb (working copy)
@@ -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;
Index: restrict.adb
===================================================================
--- restrict.adb (revision 164056)
+++ restrict.adb (working copy)
@@ -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 --
---------------------
Index: restrict.ads
===================================================================
--- restrict.ads (revision 164056)
+++ restrict.ads (working copy)
@@ -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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2010-09-09 9:57 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-09-09 10:16 [Ada] Fix missing warnings from Restriction_Warnings 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).