[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

6 files changed, 73 insertions, 26 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index baa8423ae8b..1756db017eb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+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
diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb
index b2e05c3c43d..afac7b0b298 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 55629d2c46a..92407cc188b 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 9ea9ecc56b6..39107783eb1 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 5f344b00e48..ae93d0173e0 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 014f0caf402..0871ce83d0b 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