Fix typo in gdb.python/py-objfile.exp
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index d0340493b6bebd5f2b3b03fa8a00ad7264f822a3..06c72ee9c298ecc01f1df3f8b6a390c7a330a65f 100644 (file)
@@ -794,7 +794,7 @@ min_of_type (struct type *t)
 LONGEST
 ada_discrete_type_high_bound (struct type *type)
 {
-  type = resolve_dynamic_type (type, 0);
+  type = resolve_dynamic_type (type, NULL, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -815,7 +815,7 @@ ada_discrete_type_high_bound (struct type *type)
 LONGEST
 ada_discrete_type_low_bound (struct type *type)
 {
-  type = resolve_dynamic_type (type, 0);
+  type = resolve_dynamic_type (type, NULL, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -2238,7 +2238,7 @@ decode_constrained_packed_array_type (struct type *type)
       lim_warning (_("could not find bounds information on packed array"));
       return NULL;
     }
-  CHECK_TYPEDEF (shadow_type);
+  shadow_type = check_typedef (shadow_type);
 
   if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
     {
@@ -2417,10 +2417,21 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
     }
   else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
     {
-      v = value_at (type, value_address (obj));
+      v = value_at (type, value_address (obj) + offset);
       type = value_type (v);
+      if (TYPE_LENGTH (type) * HOST_CHAR_BIT < bit_size)
+       {
+         /* This can happen in the case of an array of dynamic objects,
+            where the size of each element changes from element to element.
+            In that case, we're initially given the array stride, but
+            after resolving the element type, we find that its size is
+            less than this stride.  In that case, adjust bit_size to
+            match TYPE's length, and recompute LEN accordingly.  */
+         bit_size = TYPE_LENGTH (type) * HOST_CHAR_BIT;
+         len = TYPE_LENGTH (type) + (bit_offset + HOST_CHAR_BIT - 1) / 8;
+       }
       bytes = (unsigned char *) alloca (len);
-      read_memory (value_address (v) + offset, bytes, len);
+      read_memory (value_address (v), bytes, len);
     }
   else
     {
@@ -2533,11 +2544,16 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
       accum |= sign << accumSize;
       unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT);
       accumSize -= HOST_CHAR_BIT;
+      if (accumSize < 0)
+       accumSize = 0;
       accum >>= HOST_CHAR_BIT;
       ntarg -= 1;
       targ += delta;
     }
 
+  if (is_dynamic_type (value_type (v)))
+    v = value_from_contents_and_address (value_type (v), value_contents (v),
+                                        0);
   return v;
 }
 
@@ -2668,21 +2684,27 @@ ada_value_assign (struct value *toval, struct value *fromval)
 }
 
 
-/* Given that COMPONENT is a memory lvalue that is part of the lvalue 
- * CONTAINER, assign the contents of VAL to COMPONENTS's place in 
- * CONTAINER.  Modifies the VALUE_CONTENTS of CONTAINER only, not 
- * COMPONENT, and not the inferior's memory.  The current contents 
- * of COMPONENT are ignored.  */
+/* Given that COMPONENT is a memory lvalue that is part of the lvalue
+   CONTAINER, assign the contents of VAL to COMPONENTS's place in
+   CONTAINER.  Modifies the VALUE_CONTENTS of CONTAINER only, not
+   COMPONENT, and not the inferior's memory.  The current contents
+   of COMPONENT are ignored.
+
+   Although not part of the initial design, this function also works
+   when CONTAINER and COMPONENT are not_lval's: it works as if CONTAINER
+   had a null address, and COMPONENT had an address which is equal to
+   its offset inside CONTAINER.  */
+
 static void
 value_assign_to_component (struct value *container, struct value *component,
                           struct value *val)
 {
   LONGEST offset_in_container =
     (LONGEST)  (value_address (component) - value_address (container));
-  int bit_offset_in_container = 
+  int bit_offset_in_container =
     value_bitpos (component) - value_bitpos (container);
   int bits;
-  
+
   val = value_cast (value_type (component), val);
 
   if (value_bitsize (component) == 0)
@@ -2691,17 +2713,17 @@ value_assign_to_component (struct value *container, struct value *component,
     bits = value_bitsize (component);
 
   if (gdbarch_bits_big_endian (get_type_arch (value_type (container))))
-    move_bits (value_contents_writeable (container) + offset_in_container, 
+    move_bits (value_contents_writeable (container) + offset_in_container,
               value_bitpos (container) + bit_offset_in_container,
               value_contents (val),
               TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits,
               bits, 1);
   else
-    move_bits (value_contents_writeable (container) + offset_in_container, 
+    move_bits (value_contents_writeable (container) + offset_in_container,
               value_bitpos (container) + bit_offset_in_container,
               value_contents (val), 0, bits, 0);
-}             
-                       
+}
+
 /* The value of the element of array ARR at the ARITY indices given in IND.
    ARR may be either a simple array, GNAT array descriptor, or pointer
    thereto.  */
@@ -2743,13 +2765,15 @@ ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
   for (k = 0; k < arity; k += 1)
     {
       LONGEST lwb, upb;
+      struct value *lwb_value;
 
       if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
         error (_("too many subscripts (%d expected)"), k);
       arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
                         value_copy (arr));
       get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
-      arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
+      lwb_value = value_from_longest (value_type(ind[k]), lwb);
+      arr = value_ptradd (arr, pos_atr (ind[k]) - pos_atr (lwb_value));
       type = TYPE_TARGET_TYPE (type);
     }
 
@@ -2757,24 +2781,34 @@ ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
 }
 
 /* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the
-   actual type of ARRAY_PTR is ignored), returns the Ada slice of HIGH-LOW+1
-   elements starting at index LOW.  The lower bound of this array is LOW, as
-   per Ada rules.  */
+   actual type of ARRAY_PTR is ignored), returns the Ada slice of
+   HIGH'Pos-LOW'Pos+1 elements starting at index LOW.  The lower bound of
+   this array is LOW, as per Ada rules.  */
 static struct value *
 ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
                           int low, int high)
 {
   struct type *type0 = ada_check_typedef (type);
-  CORE_ADDR base = value_as_address (array_ptr)
-    + ((low - ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0)))
-       * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
+  struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0));
   struct type *index_type
-    = create_static_range_type (NULL,
-                               TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0)),
-                               low, high);
+    = create_static_range_type (NULL, base_index_type, low, high);
   struct type *slice_type =
     create_array_type (NULL, TYPE_TARGET_TYPE (type0), index_type);
+  int base_low =  ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0));
+  LONGEST base_low_pos, low_pos;
+  CORE_ADDR base;
 
+  if (!discrete_position (base_index_type, low, &low_pos)
+      || !discrete_position (base_index_type, base_low, &base_low_pos))
+    {
+      warning (_("unable to get positions in slice, use bounds instead"));
+      low_pos = low;
+      base_low_pos = base_low;
+    }
+
+  base = value_as_address (array_ptr)
+    + ((low_pos - base_low_pos)
+       * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
   return value_at_lazy (slice_type, base);
 }
 
@@ -2783,12 +2817,23 @@ static struct value *
 ada_value_slice (struct value *array, int low, int high)
 {
   struct type *type = ada_check_typedef (value_type (array));
+  struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
   struct type *index_type
     = create_static_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
   struct type *slice_type =
     create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+  LONGEST low_pos, high_pos;
+
+  if (!discrete_position (base_index_type, low, &low_pos)
+      || !discrete_position (base_index_type, high, &high_pos))
+    {
+      warning (_("unable to get positions in slice, use bounds instead"));
+      low_pos = low;
+      high_pos = high;
+    }
 
-  return value_cast (slice_type, value_slice (array, low, high - low + 1));
+  return value_cast (slice_type,
+                    value_slice (array, low, high_pos - low_pos + 1));
 }
 
 /* If type is a record type in the form of a standard GNAT array
@@ -2990,7 +3035,8 @@ ada_array_bound (struct value *arr, int n, int which)
 static LONGEST
 ada_array_length (struct value *arr, int n)
 {
-  struct type *arr_type;
+  struct type *arr_type, *index_type;
+  int low, high;
 
   if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
     arr = value_ind (arr);
@@ -3000,11 +3046,30 @@ ada_array_length (struct value *arr, int n)
     return ada_array_length (decode_constrained_packed_array (arr), n);
 
   if (ada_is_simple_array_type (arr_type))
-    return (ada_array_bound_from_type (arr_type, n, 1)
-           - ada_array_bound_from_type (arr_type, n, 0) + 1);
+    {
+      low = ada_array_bound_from_type (arr_type, n, 0);
+      high = ada_array_bound_from_type (arr_type, n, 1);
+    }
   else
-    return (value_as_long (desc_one_bound (desc_bounds (arr), n, 1))
-           - value_as_long (desc_one_bound (desc_bounds (arr), n, 0)) + 1);
+    {
+      low = value_as_long (desc_one_bound (desc_bounds (arr), n, 0));
+      high = value_as_long (desc_one_bound (desc_bounds (arr), n, 1));
+    }
+
+  arr_type = check_typedef (arr_type);
+  index_type = TYPE_INDEX_TYPE (arr_type);
+  if (index_type != NULL)
+    {
+      struct type *base_type;
+      if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
+       base_type = TYPE_TARGET_TYPE (index_type);
+      else
+       base_type = index_type;
+
+      low = pos_atr (value_from_longest (base_type, low));
+      high = pos_atr (value_from_longest (base_type, high));
+    }
+  return high - low + 1;
 }
 
 /* An empty array whose type is that of ARR_TYPE (an array type),
@@ -4290,6 +4355,16 @@ ada_convert_actual (struct value *actual, struct type *formal_type0)
     }
   else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR)
     return ada_value_ind (actual);
+  else if (ada_is_aligner_type (formal_type))
+    {
+      /* We need to turn this parameter into an aligner type
+        as well.  */
+      struct value *aligner = allocate_value (formal_type);
+      struct value *component = ada_value_struct_elt (aligner, "F", 0);
+
+      value_assign_to_component (aligner, component, actual);
+      return aligner;
+    }
 
   return actual;
 }
@@ -7730,7 +7805,7 @@ ada_type_name (struct type *type)
 static struct type *
 find_parallel_type_by_descriptive_type (struct type *type, const char *name)
 {
-  struct type *result;
+  struct type *result, *tmp;
 
   if (ada_ignore_descriptive_types_p)
     return NULL;
@@ -7757,9 +7832,21 @@ find_parallel_type_by_descriptive_type (struct type *type, const char *name)
 
       /* Otherwise, look at the next item on the list, if any.  */
       if (HAVE_GNAT_AUX_INFO (result))
-       result = TYPE_DESCRIPTIVE_TYPE (result);
+       tmp = TYPE_DESCRIPTIVE_TYPE (result);
       else
-       result = NULL;
+       tmp = NULL;
+
+      /* If not found either, try after having resolved the typedef.  */
+      if (tmp != NULL)
+       result = tmp;
+      else
+       {
+         result = check_typedef (result);
+         if (HAVE_GNAT_AUX_INFO (result))
+           result = TYPE_DESCRIPTIVE_TYPE (result);
+         else
+           result = NULL;
+       }
     }
 
   /* If we didn't find a match, see whether this is a packed array.  With
@@ -8477,6 +8564,7 @@ to_fixed_array_type (struct type *type0, struct value *dval,
   struct type *index_type_desc;
   struct type *result;
   int constrained_packed_array_p;
+  static const char *xa_suffix = "___XA";
 
   type0 = ada_check_typedef (type0);
   if (TYPE_FIXED_INSTANCE (type0))
@@ -8486,7 +8574,30 @@ to_fixed_array_type (struct type *type0, struct value *dval,
   if (constrained_packed_array_p)
     type0 = decode_constrained_packed_array_type (type0);
 
-  index_type_desc = ada_find_parallel_type (type0, "___XA");
+  index_type_desc = ada_find_parallel_type (type0, xa_suffix);
+
+  /* As mentioned in exp_dbug.ads, for non bit-packed arrays an
+     encoding suffixed with 'P' may still be generated.  If so,
+     it should be used to find the XA type.  */
+
+  if (index_type_desc == NULL)
+    {
+      const char *type_name = ada_type_name (type0);
+
+      if (type_name != NULL)
+       {
+         const int len = strlen (type_name);
+         char *name = (char *) alloca (len + strlen (xa_suffix));
+
+         if (type_name[len - 1] == 'P')
+           {
+             strcpy (name, type_name);
+             strcpy (name + len - 1, xa_suffix);
+             index_type_desc = ada_find_parallel_type_with_name (type0, name);
+           }
+       }
+    }
+
   ada_fixup_array_indexes_type (index_type_desc);
   if (index_type_desc != NULL
       && ada_is_redundant_index_type_desc (type0, index_type_desc))
@@ -8832,7 +8943,7 @@ ada_check_typedef (struct type *type)
       && is_thick_pntr (ada_typedef_target_type (type)))
     return type;
 
-  CHECK_TYPEDEF (type);
+  type = check_typedef (type);
   if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM
       || !TYPE_STUB (type)
       || TYPE_TAG_NAME (type) == NULL)
@@ -8927,24 +9038,15 @@ pos_atr (struct value *arg)
 {
   struct value *val = coerce_ref (arg);
   struct type *type = value_type (val);
+  LONGEST result;
 
   if (!discrete_type_p (type))
     error (_("'POS only defined on discrete types"));
 
-  if (TYPE_CODE (type) == TYPE_CODE_ENUM)
-    {
-      int i;
-      LONGEST v = value_as_long (val);
+  if (!discrete_position (type, value_as_long (val), &result))
+    error (_("enumeration value is invalid: can't find 'POS"));
 
-      for (i = 0; i < TYPE_NFIELDS (type); i += 1)
-        {
-          if (v == TYPE_FIELD_ENUMVAL (type, i))
-            return i;
-        }
-      error (_("enumeration value is invalid: can't find 'POS"));
-    }
-  else
-    return value_as_long (val);
+  return result;
 }
 
 static struct value *
@@ -10545,8 +10647,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
 
         low_bound_val = coerce_ref (low_bound_val);
         high_bound_val = coerce_ref (high_bound_val);
-        low_bound = pos_atr (low_bound_val);
-        high_bound = pos_atr (high_bound_val);
+        low_bound = value_as_long (low_bound_val);
+        high_bound = value_as_long (high_bound_val);
 
         if (noside == EVAL_SKIP)
           goto nosideret;
This page took 0.044063 seconds and 4 git commands to generate.