exp_fixd.adb (Expand_Multiply_Fixed_By_Fixed_Giving_Fixed): handle properly the case...

	* exp_fixd.adb (Expand_Multiply_Fixed_By_Fixed_Giving_Fixed): handle
	properly the case where one universal operand in a non-static
	exponentiation of a real literal.

From-SVN: r46211

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7e563c5feb4ed7f704d0f4c4df23a0d3076f691d..929f093bef689be7f6da956cabd69aed9f1498f8 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2001-10-11  Ed Schonberg <schonber@gnat.com>
+
+       * exp_fixd.adb (Expand_Multiply_Fixed_By_Fixed_Giving_Fixed): handle 
+       properly the case where one universal operand in a non-static 
+       exponentiation of a real literal.
+
 2001-10-11  Ed Schonberg <schonber@gnat.com>
 
        * exp_ch7.adb (Find_Final_List): for a type appearing in a with_type 

diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb
index 656173f47f196319c0887a9d260efa5d8396c8eb..0eba7e2673efe8f1eb2f0f810542f070734941e4 100644 (file)
--- a/gcc/ada/exp_fixd.adb
+++ b/gcc/ada/exp_fixd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.54 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
 --                                                                          --
@@ -2082,12 +2082,41 @@ package body Exp_Fixd is
       Left  : constant Node_Id := Left_Opnd (N);
       Right : constant Node_Id := Right_Opnd (N);
 
+      procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
+      --  The operand may be a non-static universal value, such an
+      --  exponentiation with a non-static exponent. In that case, treat
+      --  as a fixed * fixed multiplication, and convert the argument to
+      --  the target fixed type.
+
+      procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
+         Loc   : constant Source_Ptr := Sloc (N);
+
+      begin
+         Rewrite (Opnd,
+           Make_Type_Conversion (Loc,
+             Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
+             Expression   => Expression (Opnd)));
+         Analyze_And_Resolve (Opnd, Etype (N));
+      end Rewrite_Non_Static_Universal;
+
    begin
       if Etype (Left) = Universal_Real then
-         Do_Multiply_Fixed_Universal (N, Right, Left);
+         if Nkind (Left) = N_Real_Literal then
+            Do_Multiply_Fixed_Universal (N, Right, Left);
+
+         elsif Nkind (Left) = N_Type_Conversion then
+            Rewrite_Non_Static_Universal (Left);
+            Do_Multiply_Fixed_Fixed (N);
+         end if;
 
       elsif Etype (Right) = Universal_Real then
-         Do_Multiply_Fixed_Universal (N, Left, Right);
+         if Nkind (Right) = N_Real_Literal then
+            Do_Multiply_Fixed_Universal (N, Left, Right);
+
+         elsif Nkind (Right) = N_Type_Conversion then
+            Rewrite_Non_Static_Universal (Right);
+            Do_Multiply_Fixed_Fixed (N);
+         end if;
 
       else
          Do_Multiply_Fixed_Fixed (N);