A new restriction No_Fixed_IO, which requires partition-wide consistent
use, forbids fixed I/O operations which may end up using floating-point
at run-time. These include any refernce to Fixed_IO or Decimal_IO in
packages Ada.Text_IO, Ada.Wide_Text_IO, and Ada.Wide_Wide_Text_IO, and
any use of the attributes Img, Image, Value, Wide_Image, Wide_Value,
Wide_Wide_Image, Wide_Wide_Value with ordinary or decimal fixed-point.
The following is compiled with -gnatws -gnatl:
1. pragma Restrictions (No_Fixed_IO);
2. with Text_IO;
3. with Ada.Wide_Text_IO;
4. with Ada.Wide_Wide_Text_IO;
5. use Ada.Wide_Wide_Text_IO;
6. package NoFixedIO is
7. pragma Inspection_Point;
8. type F is delta 0.25 range 0.0 .. 10.0;
9. type D is delta 0.1 digits 3 range 0.0 .. 99.9;
10. package MyFIO is new Text_IO.Fixed_IO (F);
|
>>> violation of restriction "No_Fixed_Io" at line 1
11. package MyDIO is new Text_IO.Decimal_IO (D);
|
>>> violation of restriction "No_Fixed_Io" at line 1
12. package MyFIOW is new Ada.Wide_Text_IO.Fixed_IO (F);
|
>>> violation of restriction "No_Fixed_Io" at line 1
13. package MyDIOW is new Ada.Wide_Text_IO.Decimal_IO (D);
|
>>> violation of restriction "No_Fixed_Io" at line 1
14. package MyFIOWW is new Ada.Wide_Wide_Text_IO.Fixed_IO (F);
|
>>> violation of restriction "No_Fixed_Io" at line 1
15. package MyDIOWW is new Ada.Wide_Wide_Text_IO.Decimal_IO (D);
|
>>> violation of restriction "No_Fixed_Io" at line 1
16. FV : F;
17. DV : D;
18. S1 : String := FV'Img;
|
>>> violation of restriction "No_Fixed_Io" at line 1
19. S2 : String := F'Image (FV);
|
>>> violation of restriction "No_Fixed_Io" at line 1
20. S3 : String := D'Image (DV);
|
>>> violation of restriction "No_Fixed_Io" at line 1
21. S4 : Wide_String := F'Wide_Image (FV);
|
>>> violation of restriction "No_Fixed_Io" at line 1
22. S5 : Wide_String := D'Wide_Image (DV);
|
>>> violation of restriction "No_Fixed_Io" at line 1
23. S6 : Wide_Wide_String := F'Wide_Wide_Image (FV);
|
>>> violation of restriction "No_Fixed_Io" at line 1
24. S7 : Wide_Wide_String := D'Wide_Wide_Image (DV);
|
>>> violation of restriction "No_Fixed_Io" at line 1
25. F1 : F := F'Value (S2);
|
>>> violation of restriction "No_Fixed_Io" at line 1
26. D1 : D := D'Value (S3);
|
>>> violation of restriction "No_Fixed_Io" at line 1
27. F2 : F := F'Wide_Value (S4);
|
>>> violation of restriction "No_Fixed_Io" at line 1
28. D2 : D := D'Wide_Value (S5);
|
>>> violation of restriction "No_Fixed_Io" at line 1
29. F3 : F := F'Wide_Wide_Value (S6);
|
>>> violation of restriction "No_Fixed_Io" at line 1
30. D3 : D := D'Wide_Wide_Value (S7);
|
>>> violation of restriction "No_Fixed_Io" at line 1
31. end NoFixedIO;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-05-21 Robert Dewar <de...@adacore.com>
* restrict.ads (Implementation_Restriction): Add entry for
No_Fixed_IO.
* rtsfind.ads: Add entries for Fixed_IO and Decimal_IO in
Ada.[Wide_[Wide_]Text_IO.
* s-rident.ads (Restriction_Id): Add entry for No_Fixed_IO.
* sem_attr.adb (Analyze_Attribute): Disallow fixed point types
for Img, Image, Value, Wide_Image, Wide_Value, Wide_Wide_Image,
Wide_Wide_Value if restriction No_Fixed_IO is set.
* sem_util.adb (Set_Entity_Checks): Check restriction No_Fixed_IO.
Index: rtsfind.ads
===================================================================
--- rtsfind.ads (revision 210697)
+++ rtsfind.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
@@ -108,9 +108,10 @@
-- ambiguities).
type RTU_Id is (
- -- Runtime packages, for list of accessible entities in each
- -- package see declarations in the runtime entity table below.
+ -- Runtime packages, for list of accessible entities in each package,
+ -- see declarations in the runtime entity table below.
+
RTU_Null,
-- Used as a null entry (will cause an error if referenced)
@@ -132,6 +133,9 @@
Ada_Tags,
Ada_Task_Identification,
Ada_Task_Termination,
+ Ada_Text_IO,
+ Ada_Wide_Text_IO,
+ Ada_Wide_Wide_Text_IO,
-- Children of Ada.Calendar
@@ -701,6 +705,15 @@
RE_Current_Task, -- Ada.Task_Identification
RO_AT_Task_Id, -- Ada.Task_Identification
+ RE_Decimal_IO, -- Ada.Text_IO
+ RE_Fixed_IO, -- Ada.Text_IO
+
+ RO_WT_Decimal_IO, -- Ada.Wide_Text_IO
+ RO_WT_Fixed_IO, -- Ada.Wide_Text_IO
+
+ RO_WW_Decimal_IO, -- Ada.Wide_Wide_Text_IO
+ RO_WW_Fixed_IO, -- Ada.Wide_Wide_Text_IO
+
RE_Integer_8, -- Interfaces
RE_Integer_16, -- Interfaces
RE_Integer_32, -- Interfaces
@@ -1973,6 +1986,15 @@
RE_Current_Task => Ada_Task_Identification,
RO_AT_Task_Id => Ada_Task_Identification,
+ RE_Decimal_IO => Ada_Text_IO,
+ RE_Fixed_IO => Ada_Text_IO,
+
+ RO_WT_Decimal_IO => Ada_Wide_Text_IO,
+ RO_WT_Fixed_IO => Ada_Wide_Text_IO,
+
+ RO_WW_Decimal_IO => Ada_Wide_Wide_Text_IO,
+ RO_WW_Fixed_IO => Ada_Wide_Wide_Text_IO,
+
RE_Integer_8 => Interfaces,
RE_Integer_16 => Interfaces,
RE_Integer_32 => Interfaces,
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 210709)
+++ sem_util.adb (working copy)
@@ -15867,12 +15867,6 @@
Set_Entity (N, Val);
- -- Remaining checks are only done on source nodes
-
- if not Comes_From_Source (N) then
- return;
- end if;
-
-- The node to post on is the selector in the case of an expanded name,
-- and otherwise the node itself.
@@ -15882,6 +15876,44 @@
Post_Node := N;
end if;
+ -- Check for violation of No_Fixed_IO
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then
+ ((RTU_Loaded (Ada_Text_IO)
+ and then (Is_RTE (Val, RE_Decimal_IO)
+ or else
+ Is_RTE (Val, RE_Fixed_IO)))
+
+ or else
+ (RTU_Loaded (Ada_Wide_Text_IO)
+ and then (Is_RTE (Val, RO_WT_Decimal_IO)
+ or else
+ Is_RTE (Val, RO_WT_Fixed_IO)))
+
+ or else
+ (RTU_Loaded (Ada_Wide_Wide_Text_IO)
+ and then (Is_RTE (Val, RO_WW_Decimal_IO)
+ or else
+ Is_RTE (Val, RO_WW_Fixed_IO))))
+
+ -- A special extra check, don't complain about a reference from within
+ -- the Ada.Interrupts package itself!
+
+ and then not In_Same_Extended_Unit (N, Val)
+ then
+ Check_Restriction (No_Fixed_IO, Post_Node);
+ end if;
+
+ -- Remaining checks are only done on source nodes. Note that we test
+ -- for violation of No_Fixed_IO even on non-source nodes, because the
+ -- cases for checking violations of this restriction are instantiations
+ -- where the refernece in the instance has Comes_From_Source False.
+
+ if not Comes_From_Source (N) then
+ return;
+ end if;
+
-- Check for violation of No_Abort_Statements, which is triggered by
-- call to Ada.Task_Identification.Abort_Task.
@@ -15907,6 +15939,7 @@
Is_RTE (Val, RE_Exchange_Handler) or else
Is_RTE (Val, RE_Detach_Handler) or else
Is_RTE (Val, RE_Reference))
+
-- A special extra check, don't complain about a reference from within
-- the Ada.Interrupts package itself!
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 210697)
+++ sem_attr.adb (working copy)
@@ -3627,6 +3627,16 @@
Resolve (E1, P_Base_Type);
Check_Enum_Image;
Validate_Non_Static_Attribute_Function_Call;
+
+ -- Check restriction No_Fixed_IO. Note the check of Comes_From_Source
+ -- to avoid giving a duplicate message for Img expanded into Image.
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Comes_From_Source (N)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
end Image;
---------
@@ -3646,6 +3656,14 @@
end if;
Check_Enum_Image;
+
+ -- Check restriction No_Fixed_IO
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
end Img;
-----------
@@ -6458,6 +6476,14 @@
Set_Etype (N, P_Base_Type);
Validate_Non_Static_Attribute_Function_Call;
+
+ -- Check restriction No_Fixed_IO
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
end Value;
----------------
@@ -6498,6 +6524,14 @@
Check_E1;
Resolve (E1, P_Base_Type);
Validate_Non_Static_Attribute_Function_Call;
+
+ -- Check restriction No_Fixed_IO
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
end Wide_Image;
---------------------
@@ -6511,6 +6545,14 @@
Check_E1;
Resolve (E1, P_Base_Type);
Validate_Non_Static_Attribute_Function_Call;
+
+ -- Check restriction No_Fixed_IO
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
end Wide_Wide_Image;
----------------
@@ -6528,6 +6570,14 @@
Set_Etype (N, P_Type);
Validate_Non_Static_Attribute_Function_Call;
+
+ -- Check restriction No_Fixed_IO
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
end Wide_Value;
---------------------
@@ -6544,6 +6594,14 @@
Set_Etype (N, P_Type);
Validate_Non_Static_Attribute_Function_Call;
+
+ -- Check restriction No_Fixed_IO
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
end Wide_Wide_Value;
---------------------
Index: restrict.ads
===================================================================
--- restrict.ads (revision 210697)
+++ restrict.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
@@ -120,6 +120,7 @@
No_Exception_Propagation => True,
No_Exception_Registration => True,
No_Finalization => True,
+ No_Fixed_IO => True,
No_Implementation_Attributes => True,
No_Implementation_Pragmas => True,
No_Implicit_Conditionals => True,
Index: s-rident.ads
===================================================================
--- s-rident.ads (revision 210697)
+++ s-rident.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
@@ -112,6 +112,7 @@
No_Exception_Registration, -- GNAT
No_Exceptions, -- (RM H.4(12))
No_Finalization, -- GNAT
+ No_Fixed_IO, -- GNAT
No_Fixed_Point, -- (RM H.4(15))
No_Floating_Point, -- (RM H.4(14))
No_IO, -- (RM H.4(20))
