From 575209b6a640ba87a8638ae65b8e327d80a49ecb Mon Sep 17 00:00:00 2001
From: brobecke <brobecke>
Date: Fri, 28 Dec 2007 06:25:56 +0000
Subject: [PATCH]         * ada-lang.c (ada_value_cast): New function,
 extracted out from         the code in ada_evaluate_subexp, case UNOP_CAST. 
 The code handling         the obscure case has been removed as we think that
 it is actually         unnecessary.         (ada_evaluate_subexp): Add type
 case when evaluating an OP_DOUBLE         or an OP_LONG with a non-null
 expect_type. Replace extracted-out         code with call to new
 ada_value_cast function.

---
 gdb/ChangeLog  | 10 ++++++++++
 gdb/ada-lang.c | 59 +++++++++++++++++++++++++++++++++-------------------------
 2 files changed, 44 insertions(+), 25 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 157745fe36..6dd38b8103 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,13 @@
+2007-12-27  Joel Brobecker  <brobecker@adacore.com>
+
+	* ada-lang.c (ada_value_cast): New function, extracted out from
+	the code in ada_evaluate_subexp, case UNOP_CAST.  The code handling
+	the obscure case has been removed as we think that it is actually
+	unnecessary.
+	(ada_evaluate_subexp): Add type case when evaluating an OP_DOUBLE
+	or an OP_LONG with a non-null expect_type. Replace extracted-out
+	code with call to new ada_value_cast function.
+
 2007-12-27  Paul Hilfinger  <hilfinger@adacore.com>
 
 	* ada-lang.c (ada_evaluate_subexp): Add cases for BINOP_LOGICAL_AND,
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 116839bee3..1a0422e7f8 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -7984,6 +7984,24 @@ add_component_interval (LONGEST low, LONGEST high,
   indices[i + 1] = high;
 }
 
+/* Perform and Ada cast of ARG2 to type TYPE if the type of ARG2
+   is different.  */
+
+static struct value *
+ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
+{
+  if (type == ada_check_typedef (value_type (arg2)))
+    return arg2;
+
+  if (ada_is_fixed_point_type (type))
+    return (cast_to_fixed (type, arg2));
+
+  if (ada_is_fixed_point_type (value_type (arg2)))
+    return value_cast (type, cast_from_fixed_to_double (arg2));
+
+  return value_cast (type, arg2);
+}
+
 static struct value *
 ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                      int *pos, enum noside noside)
@@ -8004,9 +8022,21 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
     {
     default:
       *pos -= 1;
-      return
-        unwrap_value (evaluate_subexp_standard
-                      (expect_type, exp, pos, noside));
+      arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+      arg1 = unwrap_value (arg1);
+
+      /* If evaluating an OP_DOUBLE and an EXPECT_TYPE was provided,
+         then we need to perform the conversion manually, because
+         evaluate_subexp_standard doesn't do it.  This conversion is
+         necessary in Ada because the different kinds of float/fixed
+         types in Ada have different representations.
+
+         Similarly, we need to perform the conversion from OP_LONG
+         ourselves.  */
+      if ((op == OP_DOUBLE || op == OP_LONG) && expect_type != NULL)
+        arg1 = ada_value_cast (expect_type, arg1, noside);
+
+      return arg1;
 
     case OP_STRING:
       {
@@ -8026,28 +8056,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       arg1 = evaluate_subexp (type, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
-      if (type != ada_check_typedef (value_type (arg1)))
-        {
-          if (ada_is_fixed_point_type (type))
-            arg1 = cast_to_fixed (type, arg1);
-          else if (ada_is_fixed_point_type (value_type (arg1)))
-            arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
-          else if (VALUE_LVAL (arg1) == lval_memory)
-            {
-              /* This is in case of the really obscure (and undocumented,
-                 but apparently expected) case of (Foo) Bar.all, where Bar
-                 is an integer constant and Foo is a dynamic-sized type.
-                 If we don't do this, ARG1 will simply be relabeled with
-                 TYPE.  */
-              if (noside == EVAL_AVOID_SIDE_EFFECTS)
-                return value_zero (to_static_fixed_type (type), not_lval);
-              arg1 =
-                ada_to_fixed_value_create
-                (type, VALUE_ADDRESS (arg1) + value_offset (arg1), 0);
-            }
-          else
-            arg1 = value_cast (type, arg1);
-        }
+      arg1 = ada_value_cast (type, arg1, noside);
       return arg1;
 
     case UNOP_QUAL:
-- 
2.11.0