Commit 95b89f1b by Arnaud Charlet

[multiple changes]

2009-04-09  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb (Check_Stream_Attribute): Check violation of
	restriction No_Streams

	* gnat_rm.texi: Clarify No_Streams restriction

	* g-socket.adb: Minor reformatting.

2009-04-09  Thomas Quinot  <quinot@adacore.com>

	* g-socket.ads: Mark Initialize and Finalize as obsolesent interfaces.

2009-04-09  Geert Bosch  <bosch@adacore.com>

	* exp_fixd.adb (Build_Conversion): Accept new optional Trunc argument.
	(Set_Result): Likewise.
	(Expand_Convert_Float_To_Fixed): Have Set_Result truncate the
	conversion, as required by RM 4.6(31).

From-SVN: r145801
parent 22a65a54
2009-04-09 Robert Dewar <dewar@adacore.com>
* sem_attr.adb (Check_Stream_Attribute): Check violation of
restriction No_Streams
* gnat_rm.texi: Clarify No_Streams restriction
* g-socket.adb: Minor reformatting.
2009-04-09 Thomas Quinot <quinot@adacore.com>
* g-socket.ads: Mark Initialize and Finalize as obsolesent interfaces.
2009-04-09 Geert Bosch <bosch@adacore.com>
* exp_fixd.adb (Build_Conversion): Accept new optional Trunc argument.
(Set_Result): Likewise.
(Expand_Convert_Float_To_Fixed): Have Set_Result truncate the
conversion, as required by RM 4.6(31).
2009-04-08 Robert Dewar <dewar@adacore.com>
* checks.adb (Enable_Overflow_Check): Do not enable if overflow checks
......@@ -57,16 +57,19 @@ package body Exp_Fixd is
-- still dealing with a normal fixed-point operation and mess it up).
function Build_Conversion
(N : Node_Id;
Typ : Entity_Id;
Expr : Node_Id;
Rchk : Boolean := False) return Node_Id;
(N : Node_Id;
Typ : Entity_Id;
Expr : Node_Id;
Rchk : Boolean := False;
Trunc : Boolean := False) return Node_Id;
-- Build an expression that converts the expression Expr to type Typ,
-- taking the source location from Sloc (N). If the conversions involve
-- fixed-point types, then the Conversion_OK flag will be set so that the
-- resulting conversions do not get re-expanded. On return the resulting
-- node has its Etype set. If Rchk is set, then Do_Range_Check is set
-- in the resulting conversion node.
-- in the resulting conversion node. If Trunc is set, then the
-- Float_Truncate flag is set on the conversion, which must be from
-- a floating-point type to an integer type.
function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
-- Builds an N_Op_Divide node from the given left and right operand
......@@ -203,7 +206,11 @@ package body Exp_Fixd is
-- Returns True if N is a node that contains the Rounded_Result flag
-- and if the flag is true or the target type is an integer type.
procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : Boolean := False);
procedure Set_Result
(N : Node_Id;
Expr : Node_Id;
Rchk : Boolean := False;
Trunc : Boolean := False);
-- N is the node for the current conversion, division or multiplication
-- operation, and Expr is an expression representing the result. Expr may
-- be of floating-point or integer type. If the operation result is fixed-
......@@ -211,18 +218,20 @@ package body Exp_Fixd is
-- (i.e. small's have already been dealt with). The result of the call is
-- to replace N by an appropriate conversion to the result type, dealing
-- with rounding for the decimal types case. The node is then analyzed and
-- resolved using the result type. If Rchk is True, then Do_Range_Check is
-- set in the resulting conversion.
-- resolved using the result type. If Rchk or Trunc are True, then
-- respectively Do_Range_Check and Float_Truncate are set in the
-- resulting conversion.
----------------------
-- Build_Conversion --
----------------------
function Build_Conversion
(N : Node_Id;
Typ : Entity_Id;
Expr : Node_Id;
Rchk : Boolean := False) return Node_Id
(N : Node_Id;
Typ : Entity_Id;
Expr : Node_Id;
Rchk : Boolean := False;
Trunc : Boolean := False) return Node_Id
is
Loc : constant Source_Ptr := Sloc (N);
Result : Node_Id;
......@@ -269,6 +278,8 @@ package body Exp_Fixd is
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Expression => Expr);
Set_Float_Truncate (Result, Trunc);
end if;
-- Set Conversion_OK if either result or expression type is a
......@@ -1687,7 +1698,7 @@ package body Exp_Fixd is
-- Optimize small = 1, where we can avoid the multiply completely
if Small = Ureal_1 then
Set_Result (N, Expr, Rng_Check);
Set_Result (N, Expr, Rng_Check, Trunc => True);
-- Normal case where multiply is required
......@@ -1696,7 +1707,7 @@ package body Exp_Fixd is
Build_Multiply (N,
Fpt_Value (Expr),
Real_Literal (N, Ureal_1 / Small)),
Rng_Check);
Rng_Check, Trunc => True);
end if;
end Expand_Convert_Float_To_Fixed;
......@@ -2349,9 +2360,10 @@ package body Exp_Fixd is
----------------
procedure Set_Result
(N : Node_Id;
Expr : Node_Id;
Rchk : Boolean := False)
(N : Node_Id;
Expr : Node_Id;
Rchk : Boolean := False;
Trunc : Boolean := False)
is
Cnode : Node_Id;
......@@ -2359,15 +2371,15 @@ package body Exp_Fixd is
Result_Type : constant Entity_Id := Etype (N);
begin
-- No conversion required if types match and no range check
-- No conversion required if types match and no range check or truncate
if Result_Type = Expr_Type and then not Rchk then
if Result_Type = Expr_Type and then not (Rchk or Trunc) then
Cnode := Expr;
-- Else perform required conversion
else
Cnode := Build_Conversion (N, Result_Type, Expr, Rchk);
Cnode := Build_Conversion (N, Result_Type, Expr, Rchk, Trunc);
end if;
Rewrite (N, Cnode);
......
......@@ -802,6 +802,7 @@ package body GNAT.Sockets is
procedure Finalize (X : in out Sockets_Library_Controller) is
pragma Unreferenced (X);
begin
-- Finalization operation for the GNAT.Sockets package
......@@ -817,6 +818,7 @@ package body GNAT.Sockets is
-- This is a dummy placeholder for an obsolete API.
-- The real finalization actions are in Initialize primitive operation
-- of Sockets_Library_Controller.
null;
end Finalize;
......@@ -1304,6 +1306,7 @@ package body GNAT.Sockets is
procedure Initialize (X : in out Sockets_Library_Controller) is
pragma Unreferenced (X);
begin
-- Initialization operation for the GNAT.Sockets package
......@@ -1325,7 +1328,8 @@ package body GNAT.Sockets is
"incorrect Process_Blocking_IO setting, expected " & Expected'Img;
end if;
-- This is a dummy placeholder for an obsolete API.
-- This is a dummy placeholder for an obsolete API
-- Real initialization actions are in Initialize primitive operation
-- of Sockets_Library_Controller.
......@@ -1338,9 +1342,11 @@ package body GNAT.Sockets is
procedure Initialize is
begin
-- This is a dummy placeholder for an obsolete API.
-- This is a dummy placeholder for an obsolete API
-- Real initialization actions are in Initialize primitive operation
-- of Sockets_Library_Controller.
null;
end Initialize;
......
......@@ -379,6 +379,9 @@ package GNAT.Sockets is
-- including through this renaming.
procedure Initialize;
pragma Obsolescent
(Entity => Initialize,
Message => "explicit initialization is no longer required");
-- Initialize must be called before using any other socket routines.
-- Note that this operation is a no-op on UNIX platforms, but applications
-- should make sure to call it if portability is expected: some platforms
......@@ -389,7 +392,7 @@ package GNAT.Sockets is
procedure Initialize (Process_Blocking_IO : Boolean);
pragma Obsolescent
(Entity => Initialize,
Message => "passing a parameter to Initialize is not supported anymore");
Message => "passing a parameter to Initialize is no longer supported");
-- Previous versions of GNAT.Sockets used to require the user to indicate
-- whether socket I/O was process- or thread-blocking on the platform.
-- This property is now determined automatically when the run-time library
......@@ -400,6 +403,9 @@ package GNAT.Sockets is
-- automatically).
procedure Finalize;
pragma Obsolescent
(Entity => Finalize,
Message => "explicit finalization is no longer required");
-- After Finalize is called it is not possible to use any routines
-- exported in by this package. This procedure is idempotent.
-- This is now a no-op (initialization and finalization are done
......
......@@ -8592,11 +8592,12 @@ user-defined storage pool.
@item No_Streams
@findex No_Streams
This restriction ensures at compile/bind time that there are no
stream objects created (and therefore no actual stream operations).
stream objects created and no use of stream attributes.
This restriction does not forbid dependences on the package
@code{Ada.Streams}. So it is permissible to with
@code{Ada.Streams} (or another package that does so itself)
as long as no actual stream objects are created.
as long as no actual stream objects are created and no
stream attributes are used.
@item No_Task_Attributes_Package
@findex No_Task_Attributes_Package
......
......@@ -1554,7 +1554,9 @@ package body Sem_Attr is
end if;
end if;
-- Check for violation of restriction No_Stream_Attributes
-- Check restriction violations
Check_Restriction (No_Streams, P);
if Is_RTE (P_Type, RE_Exception_Id)
or else
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment