public inbox for archer-commits@sourceware.org
help / color / mirror / Atom feed
* [SCM]  archer-jankratochvil-vla: Merge branch 'new' into archer-jankratochvil-vla
@ 2011-01-15 14:40 jkratoch
  0 siblings, 0 replies; only message in thread
From: jkratoch @ 2011-01-15 14:40 UTC (permalink / raw)
  To: archer-commits

The branch, archer-jankratochvil-vla has been updated
       via  eb6132fc212249096d1a4e66decba99bd7c04bcd (commit)
       via  82122d8690dd5612dffb8ac6a6550fbe5d927985 (commit)
       via  73efc74c0aabcfae449945aa2ad5178fece7fa7e (commit)
       via  ab9bbd880572932c99c89a4febdcff51f9673018 (commit)
       via  6bfdbeb2e2ee8d003f74a265b5393d33ce6d318b (commit)
       via  9eb7173dc4280b2d723f8cb9deb08e0f42a249ff (commit)
       via  8711fcd89621ac83b3fd32f500e1eaefaaa8f0ae (commit)
       via  f3dc825d88ea933b2e869aff05086a538b370f97 (commit)
       via  4eed3b2fa1b3eef5947b1fc6827024ae571e831f (commit)
       via  c932a09669a165316cb3e7539a91bd10c1e803c2 (commit)
       via  75f49300927370fa332c1ce4dfef5d3ecf21ec54 (commit)
       via  632131fea4924bba706e3291280d504409a90da3 (commit)
       via  c11cdcc46c6496635ac313b64b28c84c893605f3 (commit)
       via  0e95366df26d41effec9ceffa49a17654ef52040 (commit)
       via  54ba622319da1562fd38f6ce9bbad8df170738c4 (commit)
       via  6f708229f79c32e5d21f1516d5706f85e12cc583 (commit)
      from  58c26171909be5fc6f487d575fe9c1100a486439 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email.

- Log -----------------------------------------------------------------
commit eb6132fc212249096d1a4e66decba99bd7c04bcd
Merge: 58c2617 82122d8
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Sat Jan 15 15:40:12 2011 +0100

    Merge branch 'new' into archer-jankratochvil-vla
    
    Conflicts:
    	gdb/eval.c
    	gdb/valarith.c

commit 82122d8690dd5612dffb8ac6a6550fbe5d927985
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Sat Jan 15 15:33:23 2011 +0100

    Fix gdb.fortran/exprs.exp regression

commit 73efc74c0aabcfae449945aa2ad5178fece7fa7e
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Sat Jan 15 15:26:11 2011 +0100

    newly allocating subranges

commit ab9bbd880572932c99c89a4febdcff51f9673018
Merge: f3dc825 6bfdbeb
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Sat Jan 15 13:21:16 2011 +0100

    Merge branch 'burge-vla' into burge-vla-subrange

commit 6bfdbeb2e2ee8d003f74a265b5393d33ce6d318b
Merge: c11cdcc 9eb7173
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Sat Jan 15 13:21:10 2011 +0100

    Merge branch 'burge' into burge-vla
    
    Conflicts:
    	gdb/dwarf2loc.c
    	gdb/findvar.c

commit 9eb7173dc4280b2d723f8cb9deb08e0f42a249ff
Merge: 8711fcd dc2d67f
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Sat Jan 15 13:09:42 2011 +0100

    Merge branch 'master' into burge

commit 8711fcd89621ac83b3fd32f500e1eaefaaa8f0ae
Merge: 6f70822 c382ea4
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Fri Jan 14 09:12:48 2011 +0100

    Merge branch 'master' into burge

commit f3dc825d88ea933b2e869aff05086a538b370f97
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Wed Jan 12 09:44:36 2011 +0100

    ubranges work now!

commit 4eed3b2fa1b3eef5947b1fc6827024ae571e831f
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Tue Jan 11 20:03:53 2011 +0100

    fix

commit c932a09669a165316cb3e7539a91bd10c1e803c2
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Tue Jan 11 19:24:40 2011 +0100

    Regression fixes.

commit 75f49300927370fa332c1ce4dfef5d3ecf21ec54
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Tue Jan 11 11:08:59 2011 +0100

    Fix this branch's regression on create_array_type.

commit 632131fea4924bba706e3291280d504409a90da3
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Tue Jan 11 10:39:18 2011 +0100

    subrange

commit c11cdcc46c6496635ac313b64b28c84c893605f3
Merge: 0e95366 79092f2
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Mon Jan 10 22:13:57 2011 +0100

    Merge branch 'archer-jankratochvil-vla' into burge-vla

commit 0e95366df26d41effec9ceffa49a17654ef52040
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Mon Jan 10 15:33:07 2011 +0100

    Fix strides

commit 54ba622319da1562fd38f6ce9bbad8df170738c4
Merge: 6f70822 3ebce94
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Mon Jan 10 11:27:30 2011 +0100

    Merge branch 'archer-jankratochvil-vla' into burge-vla
    
    Conflicts:
    	gdb/dwarf2read.c
    	gdb/eval.c

commit 6f708229f79c32e5d21f1516d5706f85e12cc583
Author: Jan Kratochvil <jan.kratochvil@redhat.com>
Date:   Mon Jan 10 10:47:20 2011 +0100

    burge only

-----------------------------------------------------------------------

Summary of changes:
 gdb/eval.c                             |  343 +++++++++++++++++++-------------
 gdb/f-exp.y                            |    4 +-
 gdb/gdbtypes.c                         |   34 ++--
 gdb/testsuite/gdb.fortran/subrange.exp |   51 +++++
 gdb/testsuite/gdb.fortran/subrange.f90 |   23 ++
 gdb/testsuite/lib/gdb.exp              |    5 +
 gdb/valarith.c                         |   45 ++---
 gdb/valops.c                           |    2 +
 gdb/value.h                            |    2 +-
 9 files changed, 324 insertions(+), 185 deletions(-)
 create mode 100644 gdb/testsuite/gdb.fortran/subrange.exp
 create mode 100644 gdb/testsuite/gdb.fortran/subrange.f90

First 500 lines of diff:
diff --git a/gdb/eval.c b/gdb/eval.c
index afa7b43..3d5dfe7 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -506,27 +506,201 @@ init_array_element (struct value *array, struct value *element,
 }
 
 static struct value *
-value_f90_subarray (struct value *array,
-		    struct expression *exp, int *pos, enum noside noside)
+value_f90_subarray (struct value *array, struct expression *exp, int *pos,
+		    int nargs, enum noside noside)
 {
-  int pc = (*pos) + 1;
-  LONGEST low_bound, high_bound;
-  struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
-  enum f90_range_type range_type = longest_to_int (exp->elts[pc].longconst);
- 
-  *pos += 3;
-
-  if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
-    low_bound = TYPE_LOW_BOUND (range);
+  /* Type to use for the newly allocated value ARRAY.  */
+  struct type *new_array_type;
+
+  /* Type being iterated for each dimension.  */
+  struct type *type;
+
+  /* Pointer in the last holder to the type of current dimension.  */
+  struct type **typep = &new_array_type;
+
+  struct subscript_index
+    {
+      int pos;
+      enum { SUBSCRIPT_RANGE, SUBSCRIPT_NUMBER } kind;
+      union
+	{
+	  struct subscript_range
+	    {
+	      enum f90_range_type f90_range_type;
+	      LONGEST low_bound, high_bound;
+	    }
+	  range;
+	  LONGEST number;
+	};
+    }
+  *subscript_array;
+  int i;
+  struct cleanup *old_chain;
+  CORE_ADDR value_byte_address, value_byte_offset = 0;
+  htab_t copied_types;
+  struct value *saved_array;
+
+  old_chain = make_cleanup (null_cleanup, 0);
+  object_address_set (value_raw_address (array));
+
+  if (value_optimized_out (array)
+      || (VALUE_LVAL (array) != not_lval
+          && VALUE_LVAL (array) != lval_memory
+	  && VALUE_LVAL (array) != lval_internalvar_component
+	  && VALUE_LVAL (array) != lval_internalvar))
+    error (_("value being subranged must be in memory"));
+  type = check_typedef (value_type (array));
+  f_object_address_data_valid_or_error (type);
+
+  copied_types = create_copied_types_hash (NULL);
+  type = copy_type_recursive (type, copied_types);
+  htab_delete (copied_types);
+
+  if (nargs != calc_f77_array_dims (type))
+    error (_("Wrong number of subscripts"));
+
+  if (TYPE_DATA_LOCATION_IS_ADDR (type))
+    {
+      value_byte_address = (TYPE_DATA_LOCATION_ADDR (type)
+			    + value_offset (array));
+      TYPE_DATA_LOCATION_IS_ADDR (type) = 0;
+    }
   else
-    low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+    value_byte_address = value_address (array);
+
+  new_array_type = type;
+
+  subscript_array = alloca (sizeof (*subscript_array) * nargs);
+
+  gdb_assert (nargs > 0);
+
+  /* Now that we know we have a legal array subscript expression 
+     let us actually find out where this element exists in the array.  */
+
+  /* Take array indices left to right.  */
+  for (i = 0; i < nargs; i++)
+    {
+      struct subscript_index *index = &subscript_array[i];
+
+      index->pos = *pos;
+      
+      if (exp->elts[*pos].opcode == OP_F90_RANGE)
+	{
+	  int pc = (*pos) + 1;
+	  struct subscript_range *range;
+
+	  index->kind = SUBSCRIPT_RANGE;
+	  range = &index->range;
+
+	  *pos += 3;
+	  range->f90_range_type = longest_to_int (exp->elts[pc].longconst);
+
+	  if (range->f90_range_type == HIGH_BOUND_DEFAULT
+	      || range->f90_range_type == NONE_BOUND_DEFAULT)
+	    range->low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp,
+							       pos, noside));
+
+	  if (range->f90_range_type == LOW_BOUND_DEFAULT
+	      || range->f90_range_type == NONE_BOUND_DEFAULT)
+	    range->high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp,
+								pos, noside));
+	}
+      else
+	{
+	  struct value *val;
+
+	  index->kind = SUBSCRIPT_NUMBER;
+
+	  /* Evaluate each subscript; it must be a legal integer in F77.  */
+	  val = evaluate_subexp_with_coercion (exp, pos, noside);
+	  index->number = value_as_long (val);
+	}
+    }
+
+  /* Internal type of array is arranged right to left.  */
+  for (i = nargs - 1; i >= 0; i--)
+    {
+      struct subscript_index *index = &subscript_array[i];
+      struct type *range_type = TYPE_INDEX_TYPE (type);
+
+      switch (index->kind)
+	{
+	case SUBSCRIPT_RANGE:
+	  {
+	    struct subscript_range *range = &index->range;
+	    CORE_ADDR byte_offset;
+
+	    if (range->f90_range_type == LOW_BOUND_DEFAULT
+		|| range->f90_range_type == BOTH_BOUND_DEFAULT)
+	      range->low_bound = TYPE_LOW_BOUND (range_type);
+
+	    if (range->f90_range_type == HIGH_BOUND_DEFAULT
+		|| range->f90_range_type == BOTH_BOUND_DEFAULT)
+	      range->high_bound = TYPE_HIGH_BOUND (range_type);
+
+	    if (range->low_bound < TYPE_LOW_BOUND (range_type)
+		|| (!TYPE_HIGH_BOUND_UNDEFINED (range_type)
+		    && range->high_bound > TYPE_HIGH_BOUND (range_type)))
+	      error (_("slice out of range"));
+
+	    byte_offset = ((range->low_bound - TYPE_LOW_BOUND (range_type))
+			   * TYPE_ARRAY_BYTE_STRIDE_VALUE (type));
+	    TYPE_LOW_BOUND (range_type) = range->low_bound;
+	    TYPE_HIGH_BOUND (range_type) = range->high_bound;
+	    if (range->f90_range_type == LOW_BOUND_DEFAULT
+		|| range->f90_range_type == NONE_BOUND_DEFAULT)
+	      TYPE_HIGH_BOUND_UNDEFINED (range_type) = 0;
+
+	    typep = &TYPE_TARGET_TYPE (type);
+	    value_byte_offset += byte_offset;
+	    type = TYPE_TARGET_TYPE (type);
+	  }
+	  break;
+
+	case SUBSCRIPT_NUMBER:
+	  {
+	    CORE_ADDR byte_offset;
+
+	    if (index->number < TYPE_LOW_BOUND (range_type)
+		|| (!TYPE_HIGH_BOUND_UNDEFINED (range_type)
+		    && index->number > TYPE_HIGH_BOUND (range_type)))
+	      error (_("no such vector element"));
 
-  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
-    high_bound = TYPE_HIGH_BOUND (range);
+	    byte_offset = ((index->number - TYPE_LOW_BOUND (range_type))
+			   * TYPE_ARRAY_BYTE_STRIDE_VALUE (type));
+
+	    type = TYPE_TARGET_TYPE (type);
+	    *typep = type;
+	    value_byte_offset += byte_offset;
+	  }
+	  break;
+	}
+    }
+
+  check_typedef (new_array_type);
+  saved_array = array;
+  array = allocate_value_lazy (new_array_type);
+  VALUE_LVAL (array) = VALUE_LVAL (saved_array);
+  if (VALUE_LVAL (saved_array) == lval_internalvar_component)
+    VALUE_LVAL (array) = lval_internalvar;
   else
-    high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+    VALUE_LVAL (array) = VALUE_LVAL (saved_array);
+  VALUE_FRAME_ID (array) = VALUE_FRAME_ID (saved_array);
+  if (VALUE_LVAL (array) != lval_internalvar)
+    set_value_address (array, value_byte_address + value_byte_offset);
+
+  if (!value_lazy (saved_array))
+    {
+      allocate_value_contents (array);
+      set_value_lazy (array, 0);
 
-  return value_slice (array, low_bound, high_bound - low_bound + 1);
+      memcpy (value_contents_writeable (array),
+	      value_contents (saved_array) + value_byte_offset,
+	      TYPE_LENGTH (new_array_type));
+    }
+
+  do_cleanups (old_chain);
+  return array;
 }
 
 
@@ -1906,19 +2080,8 @@ evaluate_subexp_standard (struct type *expect_type,
       switch (code)
 	{
 	case TYPE_CODE_ARRAY:
-	  if (exp->elts[*pos].opcode == OP_F90_RANGE)
-	    return value_f90_subarray (arg1, exp, pos, noside);
-	  else
-	    goto multi_f77_subscript;
-
 	case TYPE_CODE_STRING:
-	  if (exp->elts[*pos].opcode == OP_F90_RANGE)
-	    return value_f90_subarray (arg1, exp, pos, noside);
-	  else
-	    {
-	      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-	      return value_subscript (arg1, value_as_long (arg2));
-	    }
+	  return value_f90_subarray (arg1, exp, pos, nargs, noside);
 
 	case TYPE_CODE_PTR:
 	case TYPE_CODE_FUNC:
@@ -2357,103 +2520,6 @@ evaluate_subexp_standard (struct type *expect_type,
 	}
       return (arg1);
 
-    multi_f77_subscript:
-      {
-	int subscript_array[MAX_FORTRAN_DIMS];
-	int array_size_array[MAX_FORTRAN_DIMS];
-	int byte_stride_array[MAX_FORTRAN_DIMS];
-	int ndimensions = 1, i;
-	struct type *tmp_type;
-	int offset_item;	/* The array offset where the item lives.  */
-	CORE_ADDR offset_byte;	/* byte_stride based offset  */
-	unsigned element_size;
-
-	if (nargs > MAX_FORTRAN_DIMS)
-	  error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
-	old_chain = make_cleanup (null_cleanup, 0);
-	object_address_set (value_raw_address (arg1));
-
-	tmp_type = check_typedef (value_type (arg1));
-	ndimensions = calc_f77_array_dims (type);
-
-	if (nargs != ndimensions)
-	  error (_("Wrong number of subscripts"));
-
-	gdb_assert (nargs > 0);
-
-	/* Now that we know we have a legal array subscript expression 
-	   let us actually find out where this element exists in the array.  */
-
-	/* Take array indices left to right.  */
-	for (i = 0; i < nargs; i++)
-	  {
-	    /* Evaluate each subscript; it must be a legal integer in F77.  */
-	    arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-
-	    /* Fill in the subscript array.  */
-
-	    subscript_array[i] = value_as_long (arg2);
-	  }
-
-	/* Internal type of array is arranged right to left.  */
-	for (i = 0; i < nargs; i++)
-	  {
-	    upper = f77_get_upperbound (tmp_type);
-	    lower = f77_get_lowerbound (tmp_type);
-
-	    byte_stride_array[nargs - i - 1] =
-					TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type);
-
-	    array_size_array[nargs - i - 1] = upper - lower + 1;
-
-	    /* Zero-normalize subscripts so that offsetting will work.  */
-
-	    subscript_array[nargs - i - 1] -= lower;
-
-	    /* If we are at the bottom of a multidimensional 
-	       array type then keep a ptr to the last ARRAY
-	       type around for use when calling value_subscript()
-	       below.  This is done because we pretend to value_subscript
-	       that we actually have a one-dimensional array 
-	       of base element type that we apply a simple 
-	       offset to.  */
-
-	    if (i < nargs - 1)
-	      tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
-	  }
-
-	/* Kept for the f77_get_upperbound / f77_get_lowerbound calls above.  */
-	do_cleanups (old_chain);
-
-	/* Now let us calculate the offset for this item.  */
-
-	offset_item = 0;
-	offset_byte = 0;
-
-	for (i = ndimensions - 1; i >= 0; --i)
-	  {
-	    offset_item *= array_size_array[i];
-	    if (byte_stride_array[i] == 0)
-	      offset_item += subscript_array[i];
-	    else
-	      offset_byte += subscript_array[i] * byte_stride_array[i];
-	  }
-
-	element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tmp_type));
-	offset_byte += offset_item * element_size;
-
-	/* Let us now play a dirty trick: we will take arg1 
-	   which is a value node pointing to the topmost level
-	   of the multidimensional array-set and pretend
-	   that it is actually a array of the final element 
-	   type, this will ensure that value_subscript()
-	   returns the correct type value.  */
-
-	deprecated_set_value_type (arg1, tmp_type);
-	return value_subscripted_rvalue (arg1, offset_byte);
-      }
-
     case BINOP_LOGICAL_AND:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
@@ -3195,18 +3261,25 @@ parse_and_eval_type (char *p, int length)
 int
 calc_f77_array_dims (struct type *array_type)
 {
-  int ndimen = 1;
-  struct type *tmp_type;
+  switch (TYPE_CODE (array_type))
+    {
+    case TYPE_CODE_STRING:
+      return 1;
 
-  if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
-    error (_("Can't get dimensions for a non-array type"));
+    case TYPE_CODE_ARRAY:
+      {
+	int ndimen = 1;
 
-  tmp_type = array_type;
+	while ((array_type = TYPE_TARGET_TYPE (array_type)))
+	  {
+	    if (TYPE_CODE (array_type) == TYPE_CODE_ARRAY)
+	      ++ndimen;
+	  }
+	return ndimen;
+      }
 
-  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
-    {
-      if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
-	++ndimen;
+    default:
+      error (_("Can't get dimensions for a non-array/non-string type"));
     }
-  return ndimen;
+
 }
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 02745c8..3a730e7 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -293,7 +293,9 @@ arglist :	subrange
 			{ arglist_len = 1; }
 	;
    
-arglist	:	arglist ',' exp   %prec ABOVE_COMMA
+arglist	:	arglist ',' exp       %prec ABOVE_COMMA
+			{ arglist_len++; }
+	|	arglist ',' subrange  %prec ABOVE_COMMA
 			{ arglist_len++; }
 	;
 
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 2963e39..b353f9d 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -147,6 +147,8 @@ static void print_bit_vector (B_TYPE *, int);
 static void print_arg_types (struct field *, int, int);
 static void dump_fn_fieldlists (struct type *, int);
 static void print_cplus_stuff (struct type *, int);
+static LONGEST type_length_get (struct type *type, struct type *target_type,
+				int full_span);
 
 /* The hash table holding all discardable `struct type *' references.  */
 static htab_t type_discardable_table;
@@ -943,29 +945,14 @@ create_array_type (struct type *result_type,
      DW_OP_PUSH_OBJECT_ADDRESS not being available during the
      CREATE_ARRAY_TYPE time.  */
   if (TYPE_RANGE_DATA (range_type)->low.kind != RANGE_BOUND_KIND_CONSTANT
-      || TYPE_RANGE_DATA (range_type)->high.kind != RANGE_BOUND_KIND_CONSTANT
-      || TYPE_LOW_BOUND_UNDEFINED (range_type) 
-      || TYPE_HIGH_BOUND_UNDEFINED (range_type) 
-      || get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
-    {
-      low_bound = 0;
-      high_bound = -1;
-    }
-
-  /* Be careful when setting the array length.  Ada arrays can be
-     empty arrays with the high_bound being smaller than the low_bound.
-     In such cases, the array length should be zero.  TYPE_TARGET_STUB needs to
-     be checked as it may have dependencies on DWARF blocks depending on
-     runtime information not available during the CREATE_ARRAY_TYPE time.  */
-  if (high_bound < low_bound || TYPE_TARGET_STUB (element_type))
+      || TYPE_RANGE_DATA (range_type)->high.kind != RANGE_BOUND_KIND_CONSTANT)
     TYPE_LENGTH (result_type) = 0;
   else
     {
       CHECK_TYPEDEF (element_type);
-      TYPE_LENGTH (result_type) =
-	TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
+      TYPE_LENGTH (result_type) = type_length_get (result_type, element_type,
+						   0);
     }
-
   if (TYPE_LENGTH (result_type) == 0)
     {
       /* The real size will be computed for specific instances by
@@ -1740,7 +1727,6 @@ check_typedef (struct type *type)
   if (TYPE_DYNAMIC (type))
     {
       htab_t copied_types;
-      struct type *type_old = type;
 
       copied_types = create_copied_types_hash (NULL);
       type = copy_type_recursive (type, copied_types);
@@ -3735,6 +3721,16 @@ copy_type_recursive_1 (struct objfile *objfile,
       copy_type_recursive_1 (objfile,
 			     TYPE_VPTR_BASETYPE (type),
 			     copied_types);
+
+  if (TYPE_CODE (new_type) == TYPE_CODE_ARRAY)
+    {
+      struct type *new_index_type = TYPE_INDEX_TYPE (new_type);
+
+      if (TYPE_BYTE_STRIDE (new_index_type) == 0)
+	TYPE_BYTE_STRIDE (new_index_type)
+	  = TYPE_LENGTH (TYPE_TARGET_TYPE (new_type));
+    }
+
   /* Maybe copy the type_specific bits.
 
      NOTE drow/2005-12-09: We do not copy the C++-specific bits like
diff --git a/gdb/testsuite/gdb.fortran/subrange.exp b/gdb/testsuite/gdb.fortran/subrange.exp
new file mode 100644
index 0000000..55598f9
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/subrange.exp
@@ -0,0 +1,51 @@
+# Copyright 2011 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+if { [skip_fortran_tests] } { return -1 }
+
+set testfile "subrange"
+set srcfile ${testfile}.f90
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug f77}] } {
+    return -1
+}
+
+if ![runto MAIN__] {
+    perror "Couldn't run to MAIN__"


hooks/post-receive
--
Repository for Project Archer.


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2011-01-15 14:40 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-01-15 14:40 [SCM] archer-jankratochvil-vla: Merge branch 'new' into archer-jankratochvil-vla jkratoch

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).