From 95b89f1bf9d363aaa98b55caae4ce1ffd8d6fef6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 9 Apr 2009 10:15:14 +0200 Subject: [PATCH] [multiple changes] 2009-04-09 Robert Dewar * 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 * g-socket.ads: Mark Initialize and Finalize as obsolesent interfaces. 2009-04-09 Geert Bosch * 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 --- gcc/ada/ChangeLog | 20 ++++++++++++++++++++ gcc/ada/exp_fixd.adb | 52 ++++++++++++++++++++++++++++++++-------------------- gcc/ada/g-socket.adb | 10 ++++++++-- gcc/ada/g-socket.ads | 8 +++++++- gcc/ada/gnat_rm.texi | 5 +++-- gcc/ada/sem_attr.adb | 4 +++- 6 files changed, 73 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index baa8423..1756db0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2009-04-09 Robert Dewar + + * 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 + + * g-socket.ads: Mark Initialize and Finalize as obsolesent interfaces. + +2009-04-09 Geert Bosch + + * 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 * checks.adb (Enable_Overflow_Check): Do not enable if overflow checks diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index b2e05c3..afac7b0 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -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); diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 55629d2..92407cc 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -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; diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index 9ea9ecc..3910778 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -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 diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 5f344b0..ae93d01 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 014f0ca..0871ce8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 -- 2.7.4