gdb-vla-intel-fortran-strides.patch

   1 From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
   2 From: Fedora GDB patches <invalid@email.com>
   3 Date: Fri, 27 Oct 2017 21:07:50 +0200
   4 Subject: gdb-vla-intel-fortran-strides.patch
   5
   6 ;; VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests.
   7 ;;=push
   8
   9 git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides
  10 dbfd7140bf4c0500d1f5d192be781f83f78f7922
  11
  12  gdb/dwarf2loc.c                             |  46 ++-
  13  gdb/dwarf2loc.h                             |   6 +
  14  gdb/dwarf2read.c                            |  13 +-
  15  gdb/eval.c                                  | 391 +++++++++++++++++++++-----
  16  gdb/expprint.c                              |  20 +-
  17  gdb/expression.h                            |  18 +-
  18  gdb/f-exp.y                                 |  42 ++-
  19  gdb/f-valprint.c                            |   8 +-
  20  gdb/gdbtypes.c                              |  34 ++-
  21  gdb/gdbtypes.h                              |  18 +-
  22  gdb/parse.c                                 |  24 +-
  23  gdb/rust-exp.y                              |  12 +-
  24  gdb/rust-lang.c                             |  17 +-
  25  gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++
  26  gdb/testsuite/gdb.fortran/static-arrays.f90 |  55 ++++
  27  gdb/testsuite/gdb.fortran/vla-ptype.exp     |   4 +
  28  gdb/testsuite/gdb.fortran/vla-sizeof.exp    |   4 +
  29  gdb/testsuite/gdb.fortran/vla-stride.exp    |  44 +++
  30  gdb/testsuite/gdb.fortran/vla-stride.f90    |  29 ++
  31  gdb/testsuite/gdb.fortran/vla.f90           |  10 +
  32  gdb/valarith.c                              |  10 +-
  33  gdb/valops.c                                | 197 +++++++++++--
  34  gdb/value.h                                 |   2 +
  35  23 files changed, 1242 insertions(+), 183 deletions(-)
  36
  37 diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
  38 --- a/gdb/dwarf2loc.c
  39 +++ b/gdb/dwarf2loc.c
  40 @@ -2429,11 +2429,14 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
  41  /* See dwarf2loc.h.  */
  42
  43  int
  44 -dwarf2_evaluate_property (const struct dynamic_prop *prop,
  45 +dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
  46                           struct frame_info *frame,
  47                           struct property_addr_info *addr_stack,
  48 -                         CORE_ADDR *value)
  49 +                         CORE_ADDR *value,
  50 +                         int is_signed)
  51  {
  52 +  int rc = 0;
  53 +
  54    if (prop == NULL)
  55      return 0;
  56
  57 @@ -2457,7 +2460,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
  58
  59                 *value = value_as_address (val);
  60               }
  61 -           return 1;
  62 +           rc = 1;
  63           }
  64        }
  65        break;
  66 @@ -2479,7 +2482,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
  67             if (!value_optimized_out (val))
  68               {
  69                 *value = value_as_address (val);
  70 -               return 1;
  71 +               rc = 1;
  72               }
  73           }
  74        }
  75 @@ -2487,8 +2490,8 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
  76
  77      case PROP_CONST:
  78        *value = prop->data.const_val;
  79 -      return 1;
  80 -
  81 +      rc = 1;
  82 +      break;
  83      case PROP_ADDR_OFFSET:
  84        {
  85         struct dwarf2_property_baton *baton
  86 @@ -2509,11 +2512,38 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
  87           val = value_at (baton->offset_info.type,
  88                           pinfo->addr + baton->offset_info.offset);
  89         *value = value_as_address (val);
  90 -       return 1;
  91 +       rc = 1;
  92        }
  93 +      break;
  94      }
  95
  96 -  return 0;
  97 +  if (rc == 1 && is_signed == 1)
  98 +    {
  99 +      /* If we have a valid return candidate and it's value is signed,
 100 +         we have to sign-extend the value because CORE_ADDR on 64bit machine has
 101 +         8 bytes but address size of an 32bit application is 4 bytes.  */
 102 +      struct gdbarch * gdbarch = target_gdbarch ();
 103 +      const int addr_bit = gdbarch_addr_bit (gdbarch);
 104 +      const CORE_ADDR neg_mask = ((~0) <<  (addr_bit - 1));
 105 +
 106 +      /* Check if signed bit is set and sign-extend values.  */
 107 +      if (*value & (neg_mask))
 108 +       *value |= (neg_mask );
 109 +    }
 110 +  return rc;
 111 +}
 112 +
 113 +int
 114 +dwarf2_evaluate_property (const struct dynamic_prop *prop,
 115 +                         struct frame_info *frame,
 116 +                         struct property_addr_info *addr_stack,
 117 +                         CORE_ADDR *value)
 118 +{
 119 +  return dwarf2_evaluate_property_signed (prop,
 120 +                                  frame,
 121 +                                  addr_stack,
 122 +                                  value,
 123 +                                  0);
 124  }
 125
 126  /* See dwarf2loc.h.  */
 127 diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
 128 --- a/gdb/dwarf2loc.h
 129 +++ b/gdb/dwarf2loc.h
 130 @@ -143,6 +143,12 @@ int dwarf2_evaluate_property (const struct dynamic_prop *prop,
 131                               struct property_addr_info *addr_stack,
 132                               CORE_ADDR *value);
 133
 134 +int dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
 135 +                             struct frame_info *frame,
 136 +                             struct property_addr_info *addr_stack,
 137 +                             CORE_ADDR *value,
 138 +                             int is_signed);
 139 +
 140  /* A helper for the compiler interface that compiles a single dynamic
 141     property to C code.
 142
 143 diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
 144 --- a/gdb/dwarf2read.c
 145 +++ b/gdb/dwarf2read.c
 146 @@ -17752,7 +17752,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
 147    struct type *base_type, *orig_base_type;
 148    struct type *range_type;
 149    struct attribute *attr;
 150 -  struct dynamic_prop low, high;
 151 +  struct dynamic_prop low, high, stride;
 152    int low_default_is_valid;
 153    int high_bound_is_count = 0;
 154    const char *name;
 155 @@ -17772,7 +17772,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
 156
 157    low.kind = PROP_CONST;
 158    high.kind = PROP_CONST;
 159 +  stride.kind = PROP_CONST;
 160    high.data.const_val = 0;
 161 +  stride.data.const_val = 0;
 162
 163    /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
 164       omitting DW_AT_lower_bound.  */
 165 @@ -17805,6 +17807,14 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
 166        break;
 167      }
 168
 169 +  attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
 170 +  if (attr)
 171 +    if (!attr_to_dynamic_prop (attr, die, cu, &stride))
 172 +        complaint (_("Missing DW_AT_byte_stride "
 173 +                    "- DIE at 0x%s [in module %s]"),
 174 +                  sect_offset_str (die->sect_off),
 175 +                  objfile_name (cu->per_cu->dwarf2_per_objfile->objfile));
 176 +
 177    attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
 178    if (attr)
 179      attr_to_dynamic_prop (attr, die, cu, &low);
 180 @@ -17897,7 +17907,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
 181        && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
 182      high.data.const_val |= negative_mask;
 183
 184 -  range_type = create_range_type (NULL, orig_base_type, &low, &high);
 185 +  range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
 186
 187    if (high_bound_is_count)
 188      TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
 189 diff --git a/gdb/eval.c b/gdb/eval.c
 190 --- a/gdb/eval.c
 191 +++ b/gdb/eval.c
 192 @@ -377,29 +377,324 @@ init_array_element (struct value *array, struct value *element,
 193    return index;
 194  }
 195
 196 +/* Evaluates any operation on Fortran arrays or strings with at least
 197 +   one user provided parameter.  Expects the input ARRAY to be either
 198 +   an array, or a string.  Evaluates EXP by incrementing POS, and
 199 +   writes the content from the elt stack into a local struct.  NARGS
 200 +   specifies number of literal or range arguments the user provided.
 201 +   NARGS must be the same number as ARRAY has dimensions.  */
 202 +
 203  static struct value *
 204 -value_f90_subarray (struct value *array,
 205 -                   struct expression *exp, int *pos, enum noside noside)
 206 +value_f90_subarray (struct value *array, struct expression *exp,
 207 +                   int *pos, int nargs, enum noside noside)
 208  {
 209 -  int pc = (*pos) + 1;
 210 -  LONGEST low_bound, high_bound;
 211 -  struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
 212 -  enum range_type range_type
 213 -    = (enum range_type) longest_to_int (exp->elts[pc].longconst);
 214 -
 215 -  *pos += 3;
 216 -
 217 -  if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
 218 -    low_bound = TYPE_LOW_BOUND (range);
 219 -  else
 220 -    low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 221 +  int i, dim_count = 0;
 222 +  struct value *new_array = array;
 223 +  struct type *array_type = check_typedef (value_type (new_array));
 224 +  struct type *elt_type;
 225 +
 226 +  typedef struct
 227 +  {
 228 +    enum range_type f90_range_type;
 229 +    LONGEST low, high, stride;
 230 +  } subscript_range;
 231 +
 232 +  typedef enum subscript_kind
 233 +  {
 234 +    SUBSCRIPT_RANGE,    /* e.g. "(lowbound:highbound)"  */
 235 +    SUBSCRIPT_INDEX    /* e.g. "(literal)"  */
 236 +  } kind;
 237 +
 238 +  /* Local struct to hold user data for Fortran subarray dimensions.  */
 239 +  struct subscript_store
 240 +  {
 241 +    /* For every dimension, we are either working on a range or an index
 242 +       expression, so we store this info separately for later.  */
 243 +    enum subscript_kind kind;
 244 +
 245 +    /* We also store either the lower and upper bound info, or the index
 246 +       number.  Before evaluation of the input values, we do not know if we are
 247 +       actually working on a range of ranges, or an index in a range.  So as a
 248 +       first step we store all input in a union.  The array calculation itself
 249 +       deals with this later on.  */
 250 +    union element_range
 251 +    {
 252 +      subscript_range range;
 253 +      LONGEST number;
 254 +    } U;
 255 +  } *subscript_array;
 256 +
 257 +  /* Check if the number of arguments provided by the user matches
 258 +     the number of dimension of the array.  A string has only one
 259 +     dimension.  */
 260 +  if (nargs != calc_f77_array_dims (value_type (new_array)))
 261 +    error (_("Wrong number of subscripts"));
 262 +
 263 +  subscript_array = (struct subscript_store*) alloca (sizeof (*subscript_array) * nargs);
 264 +
 265 +  /* Parse the user input into the SUBSCRIPT_ARRAY to store it.  We need
 266 +     to evaluate it first, as the input is from left-to-right.  The
 267 +     array is stored from right-to-left.  So we have to use the user
 268 +     input in reverse order.  Later on, we need the input information to
 269 +     re-calculate the output array.  For multi-dimensional arrays, we
 270 +     can be dealing with any possible combination of ranges and indices
 271 +     for every dimension.  */
 272 +  for (i = 0; i < nargs; i++)
 273 +    {
 274 +      struct subscript_store *index = &subscript_array[i];
 275 +
 276 +      /* The user input is a range, with or without lower and upper bound.
 277 +        E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc.  */
 278 +      if (exp->elts[*pos].opcode == OP_RANGE)
 279 +       {
 280 +         int pc = (*pos) + 1;
 281 +         subscript_range *range;
 282 +
 283 +         index->kind = SUBSCRIPT_RANGE;
 284 +         range = &index->U.range;
 285 +
 286 +         *pos += 3;
 287 +         range->f90_range_type = (enum range_type) exp->elts[pc].longconst;
 288 +
 289 +         /* If a lower bound was provided by the user, the bit has been
 290 +            set and we can assign the value from the elt stack.  Same for
 291 +            upper bound.  */
 292 +         if ((range->f90_range_type & SUBARRAY_LOW_BOUND)
 293 +             == SUBARRAY_LOW_BOUND)
 294 +           range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp,
 295 +                                                        pos, noside));
 296 +         if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)
 297 +             == SUBARRAY_HIGH_BOUND)
 298 +           range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
 299 +                                                         pos, noside));
 300 +
 301 +         /* Assign the user's stride value if provided.  */
 302 +         if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
 303 +           range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp,
 304 +                                                            pos, noside));
 305 +
 306 +         /* Assign the default stride value '1'.  */
 307 +         else
 308 +           range->stride = 1;
 309
 310 -  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
 311 -    high_bound = TYPE_HIGH_BOUND (range);
 312 -  else
 313 -    high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 314 +         /* Check the provided stride value is illegal, aka '0'.  */
 315 +         if (range->stride == 0)
 316 +           error (_("Stride must not be 0"));
 317 +       }
 318 +      /* User input is an index.  E.g.: "p arry(5)".  */
 319 +      else
 320 +       {
 321 +         struct value *val;
 322 +
 323 +         index->kind = SUBSCRIPT_INDEX;
 324 +
 325 +         /* Evaluate each subscript; it must be a legal integer in F77.  This
 326 +            ensures the validity of the provided index.  */
 327 +         val = evaluate_subexp_with_coercion (exp, pos, noside);
 328 +         index->U.number = value_as_long (val);
 329 +       }
 330 +
 331 +    }
 332 +
 333 +  /* Traverse the array from right to left and set the high and low bounds
 334 +     for later use.  */
 335 +  for (i = nargs - 1; i >= 0; i--)
 336 +    {
 337 +      struct subscript_store *index = &subscript_array[i];
 338 +      struct type *index_type = TYPE_INDEX_TYPE (array_type);
 339 +
 340 +      switch (index->kind)
 341 +       {
 342 +       case SUBSCRIPT_RANGE:
 343 +         {
 344 +
 345 +           /* When we hit the first range specified by the user, we must
 346 +              treat any subsequent user entry as a range.  We simply
 347 +              increment DIM_COUNT which tells us how many times we are
 348 +              calling VALUE_SLICE_1.  */
 349 +           subscript_range *range = &index->U.range;
 350 +
 351 +           /* If no lower bound was provided by the user, we take the
 352 +              default boundary.  Same for the high bound.  */
 353 +           if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0)
 354 +             range->low = TYPE_LOW_BOUND (index_type);
 355 +
 356 +           if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0)
 357 +             range->high = TYPE_HIGH_BOUND (index_type);
 358 +
 359 +           /* Both user provided low and high bound have to be inside the
 360 +              array bounds.  Throw an error if not.  */
 361 +           if (range->low < TYPE_LOW_BOUND (index_type)
 362 +               || range->low > TYPE_HIGH_BOUND (index_type)
 363 +               || range->high < TYPE_LOW_BOUND (index_type)
 364 +               || range->high > TYPE_HIGH_BOUND (index_type))
 365 +             error (_("provided bound(s) outside array bound(s)"));
 366 +
 367 +           /* For a negative stride the lower boundary must be larger than the
 368 +              upper boundary.
 369 +              For a positive stride the lower boundary must be smaller than the
 370 +              upper boundary.  */
 371 +           if ((range->stride < 0 && range->low < range->high)
 372 +               || (range->stride > 0 && range->low > range->high))
 373 +             error (_("Wrong value provided for stride and boundaries"));
 374 +
 375 +         }
 376 +         break;
 377 +
 378 +       case SUBSCRIPT_INDEX:
 379 +         break;
 380 +
 381 +       }
 382 +
 383 +       array_type = TYPE_TARGET_TYPE (array_type);
 384 +    }
 385 +
 386 +  /* Reset ARRAY_TYPE before slicing.*/
 387 +  array_type = check_typedef (value_type (new_array));
 388 +
 389 +  /* Traverse the array from right to left and evaluate each corresponding
 390 +     user input.  VALUE_SUBSCRIPT is called for every index, until a range
 391 +     expression is evaluated.  After a range expression has been evaluated,
 392 +     every subsequent expression is also treated as a range.  */
 393 +  for (i = nargs - 1; i >= 0; i--)
 394 +    {
 395 +      struct subscript_store *index = &subscript_array[i];
 396 +      struct type *index_type = TYPE_INDEX_TYPE (array_type);
 397 +
 398 +      switch (index->kind)
 399 +       {
 400 +       case SUBSCRIPT_RANGE:
 401 +         {
 402 +
 403 +           /* When we hit the first range specified by the user, we must
 404 +              treat any subsequent user entry as a range.  We simply
 405 +              increment DIM_COUNT which tells us how many times we are
 406 +              calling VALUE_SLICE_1.  */
 407 +           subscript_range *range = &index->U.range;
 408 +
 409 +           /* DIM_COUNT counts every user argument that is treated as a range.
 410 +              This is necessary for expressions like 'print array(7, 8:9).
 411 +              Here the first argument is a literal, but must be treated as a
 412 +              range argument to allow the correct output representation.  */
 413 +           dim_count++;
 414 +
 415 +           new_array
 416 +             = value_slice_1 (new_array, range->low,
 417 +                              range->high - range->low + 1,
 418 +                              range->stride, dim_count);
 419 +         }
 420 +         break;
 421 +
 422 +       case SUBSCRIPT_INDEX:
 423 +         {
 424 +           /* DIM_COUNT only stays '0' when no range argument was processed
 425 +              before, starting from the last dimension.  This way we can
 426 +              reduce the number of dimensions from the result array.
 427 +              However, if a range has been processed before an index, we
 428 +              treat the index like a range with equal low- and high bounds
 429 +              to get the value offset right.  */
 430 +           if (dim_count == 0)
 431 +             new_array
 432 +               = value_subscripted_rvalue (new_array, index->U.number,
 433 +                                           f77_get_lowerbound (value_type
 434 +                                                                 (new_array)));
 435 +           else
 436 +             {
 437 +               dim_count++;
 438 +
 439 +               /* We might end up here, because we have to treat the provided
 440 +                  index like a range. But now VALUE_SUBSCRIPTED_RVALUE
 441 +                  cannot do the range checks for us. So we have to make sure
 442 +                  ourselves that the user provided index is inside the
 443 +                  array bounds.  Throw an error if not.  */
 444 +               if (index->U.number < TYPE_LOW_BOUND (index_type)
 445 +                   && index->U.number > TYPE_HIGH_BOUND (index_type))
 446 +                 error (_("provided bound(s) outside array bound(s)"));
 447 +
 448 +               if (index->U.number > TYPE_LOW_BOUND (index_type)
 449 +                   && index->U.number > TYPE_HIGH_BOUND (index_type))
 450 +                 error (_("provided bound(s) outside array bound(s)"));
 451 +
 452 +               new_array = value_slice_1 (new_array,
 453 +                                          index->U.number,
 454 +                                          1, /* COUNT is '1' element  */
 455 +                                          1, /* STRIDE set to '1'  */
 456 +                                          dim_count);
 457 +             }
 458 +
 459 +         }
 460 +         break;
 461 +       }
 462 +      array_type = TYPE_TARGET_TYPE (array_type);
 463 +    }
 464 +
 465 +  /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect
 466 +     an array of arrays, depending on how many ranges have been provided by
 467 +     the user.  So we need to rebuild the array dimensions for printing it
 468 +     correctly.
 469 +     Starting from right to left in the user input, after we hit the first
 470 +     range argument every subsequent argument is also treated as a range.
 471 +     E.g.:
 472 +     "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3
 473 +     ranges.
 474 +     "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2
 475 +     ranges.
 476 +     "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1
 477 +     range.  */
 478 +  if (dim_count > 1)
 479 +    {
 480 +      struct value *v = NULL;
 481 +
 482 +      elt_type = TYPE_TARGET_TYPE (value_type (new_array));
 483
 484 -  return value_slice (array, low_bound, high_bound - low_bound + 1);
 485 +      /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in
 486 +        the output array.  So we traverse the SUBSCRIPT_ARRAY again, looking
 487 +        for a range entry.  When we find one, we use the range info to create
 488 +        an additional range_type to set the correct bounds and dimensions for
 489 +        the output array.  In addition, we may have a stride value that is not
 490 +        '1', forcing us to adjust the number of elements in a range, according
 491 +        to the stride value.  */
 492 +      for (i = 0; i < nargs; i++)
 493 +       {
 494 +         struct subscript_store *index = &subscript_array[i];
 495 +
 496 +         if (index->kind == SUBSCRIPT_RANGE)
 497 +           {
 498 +             struct type *range_type, *interim_array_type;
 499 +
 500 +             int new_length;
 501 +
 502 +             /* The length of a sub-dimension with all elements between the
 503 +                bounds plus the start element itself.  It may be modified by
 504 +                a user provided stride value.  */
 505 +             new_length = index->U.range.high - index->U.range.low;
 506 +
 507 +             new_length /= index->U.range.stride;
 508 +
 509 +             range_type
 510 +               = create_static_range_type (NULL,
 511 +                                           elt_type,
 512 +                                           index->U.range.low,
 513 +                                           index->U.range.low + new_length);
 514 +
 515 +             interim_array_type = create_array_type (NULL,
 516 +                                                     elt_type,
 517 +                                                     range_type);
 518 +
 519 +             TYPE_CODE (interim_array_type)
 520 +               = TYPE_CODE (value_type (new_array));
 521 +
 522 +             v = allocate_value (interim_array_type);
 523 +
 524 +             elt_type = value_type (v);
 525 +           }
 526 +
 527 +       }
 528 +      value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type));
 529 +      return v;
 530 +    }
 531 +
 532 +  return new_array;
 533  }
 534
 535
 536 @@ -1242,19 +1537,6 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
 537    return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
 538  }
 539
 540 -/* Helper for skipping all the arguments in an undetermined argument list.
 541 -   This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
 542 -   case of evaluate_subexp_standard as multiple, but not all, code paths
 543 -   require a generic skip.  */
 544 -
 545 -static void
 546 -skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
 547 -                          enum noside noside)
 548 -{
 549 -  for (int i = 0; i < nargs; ++i)
 550 -    evaluate_subexp (NULL_TYPE, exp, pos, noside);
 551 -}
 552 -
 553  struct value *
 554  evaluate_subexp_standard (struct type *expect_type,
 555                           struct expression *exp, int *pos,
 556 @@ -1949,33 +2231,8 @@ evaluate_subexp_standard (struct type *expect_type,
 557        switch (code)
 558         {
 559         case TYPE_CODE_ARRAY:
 560 -         if (exp->elts[*pos].opcode == OP_RANGE)
 561 -           return value_f90_subarray (arg1, exp, pos, noside);
 562 -         else
 563 -           {
 564 -             if (noside == EVAL_SKIP)
 565 -               {
 566 -                 skip_undetermined_arglist (nargs, exp, pos, noside);
 567 -                 /* Return the dummy value with the correct type.  */
 568 -                 return arg1;
 569 -               }
 570 -             goto multi_f77_subscript;
 571 -           }
 572 -
 573         case TYPE_CODE_STRING:
 574 -         if (exp->elts[*pos].opcode == OP_RANGE)
 575 -           return value_f90_subarray (arg1, exp, pos, noside);
 576 -         else
 577 -           {
 578 -             if (noside == EVAL_SKIP)
 579 -               {
 580 -                 skip_undetermined_arglist (nargs, exp, pos, noside);
 581 -                 /* Return the dummy value with the correct type.  */
 582 -                 return arg1;
 583 -               }
 584 -             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 585 -             return value_subscript (arg1, value_as_long (arg2));
 586 -           }
 587 +         return value_f90_subarray (arg1, exp, pos, nargs, noside);
 588
 589         case TYPE_CODE_PTR:
 590         case TYPE_CODE_FUNC:
 591 @@ -2372,49 +2629,6 @@ evaluate_subexp_standard (struct type *expect_type,
 592         }
 593        return (arg1);
 594
 595 -    multi_f77_subscript:
 596 -      {
 597 -       LONGEST subscript_array[MAX_FORTRAN_DIMS];
 598 -       int ndimensions = 1, i;
 599 -       struct value *array = arg1;
 600 -
 601 -       if (nargs > MAX_FORTRAN_DIMS)
 602 -         error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
 603 -
 604 -       ndimensions = calc_f77_array_dims (type);
 605 -
 606 -       if (nargs != ndimensions)
 607 -         error (_("Wrong number of subscripts"));
 608 -
 609 -       gdb_assert (nargs > 0);
 610 -
 611 -       /* Now that we know we have a legal array subscript expression
 612 -          let us actually find out where this element exists in the array.  */
 613 -
 614 -       /* Take array indices left to right.  */
 615 -       for (i = 0; i < nargs; i++)
 616 -         {
 617 -           /* Evaluate each subscript; it must be a legal integer in F77.  */
 618 -           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 619 -
 620 -           /* Fill in the subscript array.  */
 621 -
 622 -           subscript_array[i] = value_as_long (arg2);
 623 -         }
 624 -
 625 -       /* Internal type of array is arranged right to left.  */
 626 -       for (i = nargs; i > 0; i--)
 627 -         {
 628 -           struct type *array_type = check_typedef (value_type (array));
 629 -           LONGEST index = subscript_array[i - 1];
 630 -
 631 -           array = value_subscripted_rvalue (array, index,
 632 -                                             f77_get_lowerbound (array_type));
 633 -         }
 634 -
 635 -       return array;
 636 -      }
 637 -
 638      case BINOP_LOGICAL_AND:
 639        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 640        if (noside == EVAL_SKIP)
 641 @@ -3334,6 +3548,9 @@ calc_f77_array_dims (struct type *array_type)
 642    int ndimen = 1;
 643    struct type *tmp_type;
 644
 645 +  if (TYPE_CODE (array_type) == TYPE_CODE_STRING)
 646 +    return 1;
 647 +
 648    if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
 649      error (_("Can't get dimensions for a non-array type"));
 650
 651 diff --git a/gdb/expprint.c b/gdb/expprint.c
 652 --- a/gdb/expprint.c
 653 +++ b/gdb/expprint.c
 654 @@ -578,17 +578,14 @@ print_subexp_standard (struct expression *exp, int *pos,
 655           longest_to_int (exp->elts[pc + 1].longconst);
 656         *pos += 2;
 657
 658 -       if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
 659 -           || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
 660 +       if ((range_type & SUBARRAY_HIGH_BOUND_EXCLUSIVE)
 661 +           == SUBARRAY_HIGH_BOUND_EXCLUSIVE)
 662           fputs_filtered ("EXCLUSIVE_", stream);
 663         fputs_filtered ("RANGE(", stream);
 664 -       if (range_type == HIGH_BOUND_DEFAULT
 665 -           || range_type == NONE_BOUND_DEFAULT
 666 -           || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
 667 +       if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
 668           print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
 669         fputs_filtered ("..", stream);
 670 -       if (range_type == LOW_BOUND_DEFAULT
 671 -           || range_type == NONE_BOUND_DEFAULT)
 672 +       if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
 673           print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
 674         fputs_filtered (")", stream);
 675         return;
 676 @@ -1105,22 +1102,24 @@ dump_subexp_body_standard (struct expression *exp,
 677
 678         switch (range_type)
 679           {
 680 -         case BOTH_BOUND_DEFAULT:
 681 +         case SUBARRAY_NONE_BOUND:
 682             fputs_filtered ("Range '..'", stream);
 683             break;
 684 -         case LOW_BOUND_DEFAULT:
 685 +         case SUBARRAY_HIGH_BOUND:
 686             fputs_filtered ("Range '..EXP'", stream);
 687             break;
 688 -         case LOW_BOUND_DEFAULT_EXCLUSIVE:
 689 -           fputs_filtered ("ExclusiveRange '..EXP'", stream);
 690 -           break;
 691 -         case HIGH_BOUND_DEFAULT:
 692 +         case SUBARRAY_LOW_BOUND:
 693             fputs_filtered ("Range 'EXP..'", stream);
 694             break;
 695 -         case NONE_BOUND_DEFAULT:
 696 +         case (SUBARRAY_LOW_BOUND
 697 +               | SUBARRAY_HIGH_BOUND
 698 +               | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
 699 +           fputs_filtered ("ExclusiveRange '..EXP'", stream);
 700 +           break;
 701 +         case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
 702             fputs_filtered ("Range 'EXP..EXP'", stream);
 703             break;
 704 -         case NONE_BOUND_DEFAULT_EXCLUSIVE:
 705 +         case (SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE):
 706             fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
 707             break;
 708           default:
 709 @@ -1128,11 +1127,9 @@ dump_subexp_body_standard (struct expression *exp,
 710             break;
 711           }
 712
 713 -       if (range_type == HIGH_BOUND_DEFAULT
 714 -           || range_type == NONE_BOUND_DEFAULT)
 715 +       if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
 716           elt = dump_subexp (exp, stream, elt);
 717 -       if (range_type == LOW_BOUND_DEFAULT
 718 -           || range_type == NONE_BOUND_DEFAULT)
 719 +       if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
 720           elt = dump_subexp (exp, stream, elt);
 721        }
 722        break;
 723 diff --git a/gdb/expression.h b/gdb/expression.h
 724 --- a/gdb/expression.h
 725 +++ b/gdb/expression.h
 726 @@ -150,28 +150,27 @@ extern void dump_raw_expression (struct expression *,
 727                                  struct ui_file *, const char *);
 728  extern void dump_prefix_expression (struct expression *, struct ui_file *);
 729
 730 -/* In an OP_RANGE expression, either bound could be empty, indicating
 731 -   that its value is by default that of the corresponding bound of the
 732 -   array or string.  Also, the upper end of the range can be exclusive
 733 -   or inclusive.  So we have six sorts of subrange.  This enumeration
 734 -   type is to identify this.  */
 735 +/* In an OP_RANGE expression, either bound can be provided by the
 736 +   user, or not.  In addition to this, the user can also specify a
 737 +   stride value to indicated only certain elements of the array.
 738 +   Also, the upper end of the range can be exclusive or inclusive.
 739 +   This enumeration type is to identify this.  */
 740
 741  enum range_type
 742 -{
 743 -  /* Neither the low nor the high bound was given -- so this refers to
 744 -     the entire available range.  */
 745 -  BOTH_BOUND_DEFAULT,
 746 -  /* The low bound was not given and the high bound is inclusive.  */
 747 -  LOW_BOUND_DEFAULT,
 748 -  /* The high bound was not given and the low bound in inclusive.  */
 749 -  HIGH_BOUND_DEFAULT,
 750 -  /* Both bounds were given and both are inclusive.  */
 751 -  NONE_BOUND_DEFAULT,
 752 -  /* The low bound was not given and the high bound is exclusive.  */
 753 -  NONE_BOUND_DEFAULT_EXCLUSIVE,
 754 -  /* Both bounds were given.  The low bound is inclusive and the high
 755 -     bound is exclusive.  */
 756 -  LOW_BOUND_DEFAULT_EXCLUSIVE,
 757 -};
 758 +  {
 759 +    SUBARRAY_NONE_BOUND = 0x0,         /* "( : )"  */
 760 +    SUBARRAY_LOW_BOUND = 0x1,          /* "(low:)"  */
 761 +    SUBARRAY_HIGH_BOUND = 0x2,         /* "(:high)"  */
 762 +    SUBARRAY_STRIDE = 0x4,             /* "(::stride)"  */
 763 +    /* The low bound was not given and the high bound is exclusive.
 764 +       In this case we always use (SUBARRAY_HIGH_BOUND |
 765 +       SUBARRAY_HIGH_BOUND_EXCLUSIVE).  */
 766 +    SUBARRAY_HIGH_BOUND_EXCLUSIVE = 0x8,
 767 +    /* Both bounds were given.  The low bound is inclusive and the high
 768 +       bound is exclusive.  In this case, we use (SUBARRAY_LOW_BOUND |
 769 +       SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE).  */
 770 +    // SUBARRAY_LOW_BOUND_EXCLUSIVE = (SUBARRAY_LOW_BOUND
 771 +    //                                     | SUBARRAY_HIGH_BOUND_EXCLUSIVE),
 772 +  };
 773
 774  #endif /* !defined (EXPRESSION_H) */
 775 diff --git a/gdb/f-exp.y b/gdb/f-exp.y
 776 --- a/gdb/f-exp.y
 777 +++ b/gdb/f-exp.y
 778 @@ -257,31 +257,63 @@ arglist : subrange
 779
 780  arglist        :       arglist ',' exp   %prec ABOVE_COMMA
 781                         { arglist_len++; }
 782 +       |       arglist ',' subrange    %prec ABOVE_COMMA
 783 +                       { arglist_len++; }
 784         ;
 785
 786  /* There are four sorts of subrange types in F90.  */
 787
 788  subrange:      exp ':' exp     %prec ABOVE_COMMA
 789 -                       { write_exp_elt_opcode (pstate, OP_RANGE);
 790 -                         write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
 791 +                       { write_exp_elt_opcode (pstate, OP_RANGE);
 792 +                         write_exp_elt_longcst (pstate,
 793 +                                                SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND);
 794                           write_exp_elt_opcode (pstate, OP_RANGE); }
 795         ;
 796
 797  subrange:      exp ':' %prec ABOVE_COMMA
 798                         { write_exp_elt_opcode (pstate, OP_RANGE);
 799 -                         write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
 800 +                         write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND);
 801                           write_exp_elt_opcode (pstate, OP_RANGE); }
 802         ;
 803
 804  subrange:      ':' exp %prec ABOVE_COMMA
 805                         { write_exp_elt_opcode (pstate, OP_RANGE);
 806 -                         write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
 807 +                         write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND);
 808                           write_exp_elt_opcode (pstate, OP_RANGE); }
 809         ;
 810
 811  subrange:      ':'     %prec ABOVE_COMMA
 812                         { write_exp_elt_opcode (pstate, OP_RANGE);
 813 -                         write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
 814 +                         write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND);
 815 +                         write_exp_elt_opcode (pstate, OP_RANGE); }
 816 +       ;
 817 +
 818 +/* Each subrange type can have a stride argument.  */
 819 +subrange:      exp ':' exp ':' exp %prec ABOVE_COMMA
 820 +                       { write_exp_elt_opcode (pstate, OP_RANGE);
 821 +                         write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
 822 +                                                | SUBARRAY_HIGH_BOUND
 823 +                                                | SUBARRAY_STRIDE);
 824 +                         write_exp_elt_opcode (pstate, OP_RANGE); }
 825 +       ;
 826 +
 827 +subrange:      exp ':' ':' exp %prec ABOVE_COMMA
 828 +                       { write_exp_elt_opcode (pstate, OP_RANGE);
 829 +                         write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND
 830 +                                                | SUBARRAY_STRIDE);
 831 +                         write_exp_elt_opcode (pstate, OP_RANGE); }
 832 +       ;
 833 +
 834 +subrange:      ':' exp ':' exp %prec ABOVE_COMMA
 835 +                       { write_exp_elt_opcode (pstate, OP_RANGE);
 836 +                         write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND
 837 +                                                | SUBARRAY_STRIDE);
 838 +                         write_exp_elt_opcode (pstate, OP_RANGE); }
 839 +       ;
 840 +
 841 +subrange:      ':' ':' exp %prec ABOVE_COMMA
 842 +                       { write_exp_elt_opcode (pstate, OP_RANGE);
 843 +                         write_exp_elt_longcst (pstate, SUBARRAY_STRIDE);
 844                           write_exp_elt_opcode (pstate, OP_RANGE); }
 845         ;
 846
 847 diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
 848 --- a/gdb/f-valprint.c
 849 +++ b/gdb/f-valprint.c
 850 @@ -119,8 +119,14 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
 851
 852    if (nss != ndimensions)
 853      {
 854 -      size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
 855 +      size_t dim_size;
 856        size_t offs = 0;
 857 +      LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
 858 +
 859 +      if (byte_stride)
 860 +        dim_size = byte_stride;
 861 +      else
 862 +        dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
 863
 864        for (i = lowerbound;
 865            (i < upperbound + 1 && (*elts) < options->print_max);
 866 diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
 867 --- a/gdb/gdbtypes.c
 868 +++ b/gdb/gdbtypes.c
 869 @@ -911,7 +911,8 @@ operator== (const range_bounds &l, const range_bounds &r)
 870  struct type *
 871  create_range_type (struct type *result_type, struct type *index_type,
 872                    const struct dynamic_prop *low_bound,
 873 -                  const struct dynamic_prop *high_bound)
 874 +                  const struct dynamic_prop *high_bound,
 875 +                  const struct dynamic_prop *stride)
 876  {
 877    if (result_type == NULL)
 878      result_type = alloc_type_copy (index_type);
 879 @@ -926,6 +927,7 @@ create_range_type (struct type *result_type, struct type *index_type,
 880      TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
 881    TYPE_RANGE_DATA (result_type)->low = *low_bound;
 882    TYPE_RANGE_DATA (result_type)->high = *high_bound;
 883 +  TYPE_RANGE_DATA (result_type)->stride = *stride;
 884
 885    if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
 886      TYPE_UNSIGNED (result_type) = 1;
 887 @@ -954,7 +956,7 @@ struct type *
 888  create_static_range_type (struct type *result_type, struct type *index_type,
 889                           LONGEST low_bound, LONGEST high_bound)
 890  {
 891 -  struct dynamic_prop low, high;
 892 +  struct dynamic_prop low, high, stride;
 893
 894    low.kind = PROP_CONST;
 895    low.data.const_val = low_bound;
 896 @@ -962,7 +964,11 @@ create_static_range_type (struct type *result_type, struct type *index_type,
 897    high.kind = PROP_CONST;
 898    high.data.const_val = high_bound;
 899
 900 -  result_type = create_range_type (result_type, index_type, &low, &high);
 901 +  stride.kind = PROP_CONST;
 902 +  stride.data.const_val = 0;
 903 +
 904 +  result_type = create_range_type (result_type, index_type,
 905 +                                   &low, &high, &stride);
 906
 907    return result_type;
 908  }
 909 @@ -1180,16 +1186,20 @@ create_array_type_with_stride (struct type *result_type,
 910        && (!type_not_associated (result_type)
 911           && !type_not_allocated (result_type)))
 912      {
 913 -      LONGEST low_bound, high_bound;
 914 +      LONGEST low_bound, high_bound, byte_stride;
 915
 916        if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 917         low_bound = high_bound = 0;
 918        element_type = check_typedef (element_type);
 919 +      byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
 920 +
 921        /* Be careful when setting the array length.  Ada arrays can be
 922          empty arrays with the high_bound being smaller than the low_bound.
 923          In such cases, the array length should be zero.  */
 924        if (high_bound < low_bound)
 925         TYPE_LENGTH (result_type) = 0;
 926 +      else if (byte_stride > 0)
 927 +       TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
 928        else if (bit_stride > 0)
 929         TYPE_LENGTH (result_type) =
 930           (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
 931 @@ -1990,12 +2000,12 @@ resolve_dynamic_range (struct type *dyn_range_type,
 932    CORE_ADDR value;
 933    struct type *static_range_type, *static_target_type;
 934    const struct dynamic_prop *prop;
 935 -  struct dynamic_prop low_bound, high_bound;
 936 +  struct dynamic_prop low_bound, high_bound, stride;
 937
 938    gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
 939
 940    prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
 941 -  if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
 942 +  if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
 943      {
 944        low_bound.kind = PROP_CONST;
 945        low_bound.data.const_val = value;
 946 @@ -2007,7 +2017,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
 947      }
 948
 949    prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
 950 -  if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
 951 +  if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
 952      {
 953        high_bound.kind = PROP_CONST;
 954        high_bound.data.const_val = value;
 955 @@ -2022,12 +2032,20 @@ resolve_dynamic_range (struct type *dyn_range_type,
 956        high_bound.data.const_val = 0;
 957      }
 958
 959 +  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
 960 +  if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
 961 +    {
 962 +      stride.kind = PROP_CONST;
 963 +      stride.data.const_val = value;
 964 +    }
 965 +
 966    static_target_type
 967      = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
 968                                      addr_stack, 0);
 969    static_range_type = create_range_type (copy_type (dyn_range_type),
 970                                          static_target_type,
 971 -                                        &low_bound, &high_bound);
 972 +                                        &low_bound, &high_bound, &stride);
 973 +
 974    TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
 975    return static_range_type;
 976  }
 977 diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
 978 --- a/gdb/gdbtypes.h
 979 +++ b/gdb/gdbtypes.h
 980 @@ -614,6 +614,10 @@ struct range_bounds
 981
 982    struct dynamic_prop high;
 983
 984 +  /* * Stride of range.  */
 985 +
 986 +  struct dynamic_prop stride;
 987 +
 988    /* True if HIGH range bound contains the number of elements in the
 989       subrange. This affects how the final hight bound is computed.  */
 990
 991 @@ -778,7 +782,6 @@ struct main_type
 992      /* * Union member used for range types.  */
 993
 994      struct range_bounds *bounds;
 995 -
 996    } flds_bnds;
 997
 998    /* * Slot to point to additional language-specific fields of this
 999 @@ -1327,6 +1330,15 @@ extern bool set_type_align (struct type *, ULONGEST);
1000    TYPE_RANGE_DATA(range_type)->high.kind
1001  #define TYPE_LOW_BOUND_KIND(range_type) \
1002    TYPE_RANGE_DATA(range_type)->low.kind
1003 +#define TYPE_BYTE_STRIDE(range_type) \
1004 +  TYPE_RANGE_DATA(range_type)->stride.data.const_val
1005 +#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
1006 +  TYPE_RANGE_DATA(range_type)->stride.data.locexpr
1007 +#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
1008 +  TYPE_RANGE_DATA(range_type)->stride.data.loclist
1009 +#define TYPE_BYTE_STRIDE_KIND(range_type) \
1010 +  TYPE_RANGE_DATA(range_type)->stride.kind
1011 +
1012
1013  /* Property accessors for the type data location.  */
1014  #define TYPE_DATA_LOCATION(thistype) \
1015 @@ -1361,6 +1373,9 @@ extern bool set_type_align (struct type *, ULONGEST);
1016     TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
1017  #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
1018     TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
1019 +#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
1020 +   (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
1021 +
1022
1023  #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
1024     (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
1025 @@ -1896,6 +1911,7 @@ extern struct type *create_array_type_with_stride
1026     struct dynamic_prop *, unsigned int);
1027
1028  extern struct type *create_range_type (struct type *, struct type *,
1029 +                                      const struct dynamic_prop *,
1030                                        const struct dynamic_prop *,
1031                                        const struct dynamic_prop *);
1032
1033 diff --git a/gdb/parse.c b/gdb/parse.c
1034 --- a/gdb/parse.c
1035 +++ b/gdb/parse.c
1036 @@ -989,24 +989,20 @@ operator_length_standard (const struct expression *expr, int endpos,
1037
1038      case OP_RANGE:
1039        oplen = 3;
1040 +      args = 0;
1041        range_type = (enum range_type)
1042         longest_to_int (expr->elts[endpos - 2].longconst);
1043
1044 -      switch (range_type)
1045 -       {
1046 -       case LOW_BOUND_DEFAULT:
1047 -       case LOW_BOUND_DEFAULT_EXCLUSIVE:
1048 -       case HIGH_BOUND_DEFAULT:
1049 -         args = 1;
1050 -         break;
1051 -       case BOTH_BOUND_DEFAULT:
1052 -         args = 0;
1053 -         break;
1054 -       case NONE_BOUND_DEFAULT:
1055 -       case NONE_BOUND_DEFAULT_EXCLUSIVE:
1056 -         args = 2;
1057 -         break;
1058 -       }
1059 +      /* Increment the argument counter for each argument
1060 +        provided by the user.  */
1061 +      if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
1062 +       args++;
1063 +
1064 +      if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
1065 +       args++;
1066 +
1067 +      if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE)
1068 +       args++;
1069
1070        break;
1071
1072 diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y
1073 --- a/gdb/rust-exp.y
1074 +++ b/gdb/rust-exp.y
1075 @@ -2475,24 +2475,28 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation,
1076
1077      case OP_RANGE:
1078        {
1079 -       enum range_type kind = BOTH_BOUND_DEFAULT;
1080 +       enum range_type kind = SUBARRAY_NONE_BOUND;
1081
1082         if (operation->left.op != NULL)
1083           {
1084             convert_ast_to_expression (operation->left.op, top);
1085 -           kind = HIGH_BOUND_DEFAULT;
1086 +           kind = SUBARRAY_LOW_BOUND;
1087           }
1088         if (operation->right.op != NULL)
1089           {
1090             convert_ast_to_expression (operation->right.op, top);
1091 -           if (kind == BOTH_BOUND_DEFAULT)
1092 -             kind = (operation->inclusive
1093 -                     ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE);
1094 +           if (kind == SUBARRAY_NONE_BOUND)
1095 +             {
1096 +               kind = (range_type) SUBARRAY_HIGH_BOUND;
1097 +               if (!operation->inclusive)
1098 +                 kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
1099 +             }
1100             else
1101               {
1102 -               gdb_assert (kind == HIGH_BOUND_DEFAULT);
1103 -               kind = (operation->inclusive
1104 -                       ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE);
1105 +               gdb_assert (kind == SUBARRAY_LOW_BOUND);
1106 +               kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
1107 +               if (!operation->inclusive)
1108 +                 kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE);
1109               }
1110           }
1111         else
1112 diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c
1113 --- a/gdb/rust-lang.c
1114 +++ b/gdb/rust-lang.c
1115 @@ -1193,13 +1193,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside)
1116    kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
1117    *pos += 3;
1118
1119 -  if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT
1120 -      || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
1121 +  if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
1122      low = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1123 -  if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE
1124 -      || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE)
1125 +  if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
1126      high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1127 -  bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT);
1128 +  bool inclusive = (!((kind & SUBARRAY_HIGH_BOUND_EXCLUSIVE) == SUBARRAY_HIGH_BOUND_EXCLUSIVE));
1129
1130    if (noside == EVAL_SKIP)
1131      return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
1132 @@ -1288,7 +1286,7 @@ rust_compute_range (struct type *type, struct value *range,
1133
1134    *low = 0;
1135    *high = 0;
1136 -  *kind = BOTH_BOUND_DEFAULT;
1137 +  *kind = SUBARRAY_NONE_BOUND;
1138
1139    if (TYPE_NFIELDS (type) == 0)
1140      return;
1141 @@ -1296,15 +1294,14 @@ rust_compute_range (struct type *type, struct value *range,
1142    i = 0;
1143    if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0)
1144      {
1145 -      *kind = HIGH_BOUND_DEFAULT;
1146 +      *kind = SUBARRAY_LOW_BOUND;
1147        *low = value_as_long (value_field (range, 0));
1148        ++i;
1149      }
1150    if (TYPE_NFIELDS (type) > i
1151        && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0)
1152      {
1153 -      *kind = (*kind == BOTH_BOUND_DEFAULT
1154 -              ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT);
1155 +      *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND);
1156        *high = value_as_long (value_field (range, i));
1157
1158        if (rust_inclusive_range_type_p (type))
1159 @@ -1322,7 +1319,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
1160    struct type *rhstype;
1161    LONGEST low, high_bound;
1162    /* Initialized to appease the compiler.  */
1163 -  enum range_type kind = BOTH_BOUND_DEFAULT;
1164 +  enum range_type kind = SUBARRAY_NONE_BOUND;
1165    LONGEST high = 0;
1166    int want_slice = 0;
1167
1168 @@ -1420,7 +1417,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
1169         error (_("Cannot subscript non-array type"));
1170
1171        if (want_slice
1172 -         && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT))
1173 +         && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND))
1174         low = low_bound;
1175        if (low < 0)
1176         error (_("Index less than zero"));
1177 @@ -1438,7 +1435,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside,
1178           CORE_ADDR addr;
1179           struct value *addrval, *tem;
1180
1181 -         if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT)
1182 +         if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND)
1183             high = high_bound;
1184           if (high < 0)
1185             error (_("High index less than zero"));
1186 diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
1187 new file mode 100644
1188 --- /dev/null
1189 +++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
1190 @@ -0,0 +1,421 @@
1191 +# Copyright 2015 Free Software Foundation, Inc.
1192 +#
1193 +# Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
1194 +#
1195 +# This program is free software; you can redistribute it and/or modify
1196 +# it under the terms of the GNU General Public License as published by
1197 +# the Free Software Foundation; either version 3 of the License, or
1198 +# (at your option) any later version.
1199 +#
1200 +# This program is distributed in the hope that it will be useful,
1201 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1202 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1203 +# GNU General Public License for more details.
1204 +#
1205 +# You should have received a copy of the GNU General Public License
1206 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1207 +
1208 +standard_testfile static-arrays.f90
1209 +
1210 +if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } {
1211 +    return -1
1212 +}
1213 +
1214 +if ![runto MAIN__] then {
1215 +    perror "couldn't run to breakpoint MAIN__"
1216 +    continue
1217 +}
1218 +
1219 +gdb_breakpoint [gdb_get_line_number "BP1"]
1220 +gdb_continue_to_breakpoint "BP1" ".*BP1.*"
1221 +
1222 +# Tests subarrays of one dimensional arrays with subrange variations
1223 +gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
1224 +               "print ar1."
1225 +gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \
1226 +               "print ar1\(4:7\)"
1227 +gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \
1228 +               "print ar1\(8:\)"
1229 +gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \
1230 +               "print ar1\(:3\)"
1231 +gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
1232 +               "print ar1\(:\)"
1233 +
1234 +# Check assignment
1235 +gdb_test_no_output "set \$my_ary = ar1\(3:8\)"
1236 +gdb_test "print \$my_ary" \
1237 +               "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
1238 +               "Assignment of subarray to variable"
1239 +gdb_test_no_output "set ar1\(5\) = 42"
1240 +               gdb_test "print ar1\(3:8\)" \
1241 +               "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \
1242 +               "print ar1\(3:8\) after assignment"
1243 +gdb_test "print \$my_ary" \
1244 +               "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
1245 +               "Assignment of subarray to variable after original array changed"
1246 +
1247 +# Test for subarrays of one dimensional arrays with literals
1248 +               gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \
1249 +               "print ar1\(3\)"
1250 +
1251 +# Tests for subranges of 2 dimensional arrays with subrange variations
1252 +gdb_test "print ar2\(2:3, 3:4\)" \
1253 +               "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \
1254 +               "print ar2\(2:3, 3:4\)."
1255 +gdb_test "print ar2\(8:9,8:\)" \
1256 +               "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
1257 +               "print ar2\(8:9,8:\)"
1258 +gdb_test "print ar2\(8:9,:2\)" \
1259 +               "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
1260 +               "print ar2\(8:9,:2\)"
1261 +
1262 +gdb_test "print ar2\(8:,8:9\)" \
1263 +               "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
1264 +               "print ar2\(8:,8:9\)"
1265 +gdb_test "print ar2\(8:,8:\)" \
1266 +               "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
1267 +               "print ar2\(8:,8:\)"
1268 +gdb_test "print ar2\(8:,:2\)" \
1269 +               "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
1270 +               "print ar2\(8:,:2\)"
1271 +
1272 +gdb_test "print ar2\(:2,2:3\)" \
1273 +               "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \
1274 +               "print ar2\(:2,2:3\)"
1275 +gdb_test "print ar2\(:2,8:\)" \
1276 +               "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \
1277 +               "print ar2\(:2,8:\)"
1278 +gdb_test "print ar2\(:2,:2\)" \
1279 +               "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \
1280 +               "print ar2\(:2,:2\)"
1281 +
1282 +# Test subranges of 2 dimensional arrays with literals and subrange variations
1283 +gdb_test "print ar2\(7, 3:6\)" \
1284 +               "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \
1285 +               "print ar2\(7, 3:6\)"
1286 +gdb_test "print ar2\(7,8:\)" \
1287 +               "\\$\[0-9\]+ = \\(78, 79\\)" \
1288 +               "print ar2\(7,8:\)"
1289 +gdb_test "print ar2\(7,:2\)" \
1290 +               "\\$\[0-9\]+ = \\(71, 72\\)" \
1291 +               "print ar2\(7,:2\)"
1292 +
1293 +gdb_test "print ar2\(7:8,4\)" \
1294 +               "\\$\[0-9\]+ = \\(74, 84\\)" \
1295 +               "print ar2(7:8,4\)"
1296 +gdb_test "print ar2\(8:,4\)" \
1297 +               "\\$\[0-9\]+ = \\(84, 94\\)" \
1298 +               "print ar2\(8:,4\)"
1299 +gdb_test "print ar2\(:2,4\)" \
1300 +               "\\$\[0-9\]+ = \\(14, 24\\)" \
1301 +               "print ar2\(:2,4\)"
1302 +gdb_test "print ar2\(3,4\)" \
1303 +               "\\$\[0-9\]+ = 34" \
1304 +               "print ar2\(3,4\)"
1305 +
1306 +# Test subarrays of 3 dimensional arrays with literals and subrange variations
1307 +gdb_test "print ar3\(2:4,3:4,7:8\)" \
1308 +               "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\
1309 +                \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \
1310 +               "print ar3\(2:4,3:4,7:8\)"
1311 +gdb_test "print ar3\(2:3,4:5,8:\)" \
1312 +               "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\
1313 +                \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \
1314 +               "print ar3\(2:3,4:5,8:\)"
1315 +gdb_test "print ar3\(2:3,4:5,:2\)" \
1316 +               "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\
1317 +                \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \
1318 +               "print ar3\(2:3,4:5,:2\)"
1319 +
1320 +gdb_test "print ar3\(2:3,8:,7:8\)" \
1321 +               "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\
1322 +                \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \
1323 +               "print ar3\(2:3,8:,7:8\)"
1324 +gdb_test "print ar3\(2:3,8:,8:\)" \
1325 +               "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\
1326 +                \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \
1327 +               "print ar3\(2:3,8:,8:\)"
1328 +gdb_test "print ar3\(2:3,8:,:2\)" \
1329 +               "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\
1330 +                \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \
1331 +               "print ar3\(2:3,8:,:2\)"
1332 +
1333 +gdb_test "print ar3\(2:3,:2,7:8\)" \
1334 +               "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\
1335 +                \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \
1336 +               "print ar3\(2:3,:2,7:8\)"
1337 +gdb_test "print ar3\(2:3,:2,8:\)" \
1338 +               "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\
1339 +                \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \
1340 +               "print ar3\(2:3,:2,8:\)"
1341 +gdb_test "print ar3\(2:3,:2,:2\)" \
1342 +               "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\
1343 +                \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \
1344 +               "print ar3\(2:3,:2,:2\)"
1345 +
1346 +gdb_test "print ar3\(8:,3:4,7:8\)" \
1347 +               "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\
1348 +                \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \
1349 +               "print ar3\(8:,3:4,7:8\)"
1350 +gdb_test "print ar3\(8:,4:5,8:\)" \
1351 +               "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\
1352 +                \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \
1353 +               "print ar3\(8:,4:5,8:\)"
1354 +gdb_test "print ar3\(8:,4:5,:2\)" \
1355 +               "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\
1356 +                \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \
1357 +               "print ar3\(8:,4:5,:2\)"
1358 +
1359 +gdb_test "print ar3\(8:,8:,7:8\)" \
1360 +               "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\
1361 +                \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \
1362 +               "print ar3\(8:,8:,7:8\)"
1363 +gdb_test "print ar3\(8:,8:,8:\)" \
1364 +               "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\
1365 +                \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \
1366 +               "print ar3\(8:,8:,8:\)"
1367 +gdb_test "print ar3\(8:,8:,:2\)" \
1368 +               "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\
1369 +                \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \
1370 +               "print ar3\(8:,8:,:2\)"
1371 +
1372 +gdb_test "print ar3\(8:,:2,7:8\)" \
1373 +               "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\
1374 +                \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \
1375 +               "print ar3\(8:,:2,7:8\)"
1376 +gdb_test "print ar3\(8:,:2,8:\)" \
1377 +               "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\
1378 +                \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \
1379 +               "print ar3\(8:,:2,8:\)"
1380 +gdb_test "print ar3\(8:,:2,:2\)" \
1381 +               "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\
1382 +                \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \
1383 +               "print ar3\(8:,:2,:2\)"
1384 +
1385 +
1386 +gdb_test "print ar3\(:2,3:4,7:8\)" \
1387 +               "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\
1388 +                \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \
1389 +               "print ar3 \(:2,3:4,7:8\)."
1390 +gdb_test "print ar3\(:2,3:4,8:\)" \
1391 +               "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\
1392 +                \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \
1393 +               "print ar3\(:2,3:4,8:\)"
1394 +gdb_test "print ar3\(:2,3:4,:2\)" \
1395 +               "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\
1396 +                \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \
1397 +               "print ar3\(:2,3:4,:2\)"
1398 +
1399 +gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\
1400 +                197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \
1401 +               "print ar3\(:2,8:,7:8\)"
1402 +gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\
1403 +                298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \
1404 +               "print ar3\(:2,8:,8:\)"
1405 +gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\
1406 +                291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \
1407 +               "print ar3\(:2,8:,:2\)"
1408 +
1409 +gdb_test "print ar3\(:2,:2,7:8\)" \
1410 +               "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\
1411 +                \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \
1412 +               "print ar3\(:2,:2,7:8\)"
1413 +gdb_test "print ar3\(:2,:2,8:\)" \
1414 +               "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\
1415 +                \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \
1416 +               "print ar3\(:2,:2,8:\)"
1417 +gdb_test "print ar3\(:2,:2,:2\)" \
1418 +               "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\
1419 +                \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \
1420 +               "print ar3\(:2,:2,:2\)"
1421 +
1422 +#Tests for subarrays of 3 dimensional arrays with literals and subranges
1423 +gdb_test "print ar3\(3,3:4,7:8\)" \
1424 +               "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \
1425 +               "print ar3\(3,3:4,7:8\)"
1426 +gdb_test "print ar3\(3,4:5,8:\)" \
1427 +               "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \
1428 +               "print ar3\(3,4:5,8:\)"
1429 +gdb_test "print ar3\(3,4:5,:2\)" \
1430 +               "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \
1431 +               "print ar3\(3,4:5,:2\)"
1432 +gdb_test "print ar3\(3,4:5,3\)" \
1433 +               "\\$\[0-9\]+ = \\(343, 353\\)" \
1434 +               "print ar3\(3,4:5,3\)"
1435 +
1436 +gdb_test "print ar3\(2,8:,7:8\)" \
1437 +               "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \
1438 +               "print ar3\(2,8:,7:8\)"
1439 +gdb_test "print ar3\(2,8:,8:\)" \
1440 +               "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \
1441 +               "print ar3\(2,8:,8:\)"
1442 +gdb_test "print ar3\(2,8:,:2\)"\
1443 +               "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \
1444 +               "print ar3\(2,8:,:2\)"
1445 +gdb_test "print ar3\(2,8:,3\)" \
1446 +               "\\$\[0-9\]+ = \\(283, 293\\)" \
1447 +               "print ar3\(2,8:,3\)"
1448 +
1449 +gdb_test "print ar3\(2,:2,7:8\)" \
1450 +               "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \
1451 +               "print ar3\(2,:2,7:8\)"
1452 +gdb_test "print ar3\(2,:2,8:\)" \
1453 +               "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \
1454 +               "print ar3\(2,:2,8:\)"
1455 +gdb_test "print ar3\(2,:2,:2\)" \
1456 +               "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \
1457 +               "print ar3\(2,:2,:2\)"
1458 +gdb_test "print ar3\(2,:2,3\)" \
1459 +               "\\$\[0-9\]+ = \\(213, 223\\)" \
1460 +               "print ar3\(2,:2,3\)"
1461 +
1462 +gdb_test "print ar3\(3,4,7:8\)" \
1463 +               "\\$\[0-9\]+ = \\(347, 348\\)" \
1464 +               "print ar3\(3,4,7:8\)"
1465 +gdb_test "print ar3\(3,4,8:\)" \
1466 +               "\\$\[0-9\]+ = \\(348, 349\\)" \
1467 +i              "print ar3\(3,4,8:\)"
1468 +gdb_test "print ar3\(3,4,:2\)" \
1469 +               "\\$\[0-9\]+ = \\(341, 342\\)" \
1470 +               "print ar3\(3,4,:2\)"
1471 +gdb_test "print ar3\(5,6,7\)" \
1472 +               "\\$\[0-9\]+ = 567" \
1473 +               "print ar3\(5,6,7\)"
1474 +
1475 +gdb_test "print ar3\(3:4,6,7:8\)" \
1476 +               "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \
1477 +               "print ar3\(3:4,6,7:8\)"
1478 +gdb_test "print ar3\(3:4,6,8:\)" \
1479 +               "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \
1480 +               "print ar3\(3:4,6,8:\)"
1481 +gdb_test "print ar3\(3:4,6,:2\)" \
1482 +               "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \
1483 +               "print ar3\(3:4,6,:2\)"
1484 +gdb_test "print ar3\(3:4,6,5\)" \
1485 +               "\\$\[0-9\]+ = \\(365, 465\\)" \
1486 +               "print ar3\(3:4,6,5\)"
1487 +
1488 +gdb_test "print ar3\(8:,6,7:8\)" \
1489 +               "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \
1490 +               "print ar3\(8:,6,7:8\)"
1491 +gdb_test "print ar3\(8:,6,8:\)" \
1492 +               "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \
1493 +               "print ar3\(8:,6,8:\)"
1494 +gdb_test "print ar3\(8:,6,:2\)" \
1495 +               "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \
1496 +               "print ar3\(8:,6,:2\)"
1497 +gdb_test "print ar3\(8:,6,5\)" \
1498 +               "\\$\[0-9\]+ = \\(865, 965\\)" \
1499 +               "print ar3\(8:,6,5\)"
1500 +
1501 +gdb_test "print ar3\(:2,6,7:8\)" \
1502 +               "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \
1503 +               "print ar3\(:2,6,7:8\)"
1504 +gdb_test "print ar3\(:2,6,8:\)" \
1505 +               "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \
1506 +               "print ar3\(:2,6,8:\)"
1507 +gdb_test "print ar3\(:2,6,:2\)" \
1508 +               "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \
1509 +               "print ar3\(:2,6,:2\)"
1510 +gdb_test "print ar3\(:2,6,5\)" \
1511 +               "\\$\[0-9\]+ = \\(165, 265\\)" \
1512 +               "print ar3\(:2,6,5\)"
1513 +
1514 +gdb_test "print ar3\(3:4,5:6,4\)" \
1515 +               "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \
1516 +               "print ar2\(3:4,5:6,4\)"
1517 +gdb_test "print ar3\(8:,5:6,4\)" \
1518 +               "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \
1519 +               "print ar2\(8:,5:6,4\)"
1520 +gdb_test "print ar3\(:2,5:6,4\)" \
1521 +               "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \
1522 +               "print ar2\(:2,5:6,4\)"
1523 +
1524 +# Stride > 1
1525 +gdb_test "print ar1\(2:6:2\)" \
1526 +               "\\$\[0-9\]+ = \\(2, 4, 6\\)" \
1527 +               "print ar1\(2:6:2\)"
1528 +gdb_test "print ar2\(2:6:2,3:4\)" \
1529 +               "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \
1530 +               "print ar2\(2:6:2,3:4\)"
1531 +gdb_test "print ar2\(2:6:2,3\)" \
1532 +               "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
1533 +               "print ar2\(2:6:2,3\)"
1534 +gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \
1535 +               "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\
1536 +                \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \
1537 +               "print ar3\(2:6:2,3:5:2,4:7:3\)"
1538 +gdb_test "print ar3\(2:6:2,5,4:7:3\)" \
1539 +               "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\
1540 +                \\)" \
1541 +               "print ar3\(2:6:2,5,4:7:3\)"
1542 +
1543 +# Stride < 0
1544 +gdb_test "print ar1\(8:2:-2\)" \
1545 +               "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \
1546 +               "print ar1\(8:2:-2\)"
1547 +gdb_test "print ar2\(8:2:-2,3:4\)" \
1548 +               "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\
1549 +                \\)" \
1550 +               "print ar2\(8:2:-2,3:4\)"
1551 +gdb_test "print ar2\(2:6:2,3\)" \
1552 +               "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
1553 +               "print ar2\(2:6:2,3\)"
1554 +gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \
1555 +               "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\
1556 +                \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \
1557 +               "print ar3\(2:3,7:3:-4,4:7:3\)"
1558 +gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \
1559 +               "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\
1560 +                \\)" \
1561 +               "print ar3\(2:6:2,5,7:4:-3\)"
1562 +
1563 +# Tests with negative and mixed indices
1564 +gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \
1565 +               "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\
1566 +                \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\
1567 +                362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\
1568 +                392, 492\\) \\) \\)" \
1569 +               "print ar4(2:4, -2:1, -15:-14)"
1570 +
1571 +gdb_test "p ar4\(7,-6:2:3,-7\)" \
1572 +                "\\$\[0-9\]+ = \\(729, 759, 789\\)" \
1573 +                "print ar4(7,-6:2:3,-7)"
1574 +
1575 +gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \
1576 +                "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\
1577 +                560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\
1578 +                527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\
1579 +                387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\
1580 +                354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\
1581 +                321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\
1582 +                \\)" \
1583 +                "print ar4(9:2:-2, -6:2:3, -6:-15:-3)"
1584 +
1585 +gdb_test "p ar4\(:,:,:\)" \
1586 +                "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\
1587 +                811, .*" \
1588 +                "print ar4(:,:,:)"
1589 +
1590 +# Provoke error messages for bad user input
1591 +gdb_test "print ar1\(0:4\)" \
1592 +               "provided bound\\(s\\) outside array bound\\(s\\)" \
1593 +               "print ar1\(0:4\)"
1594 +gdb_test "print ar1\(8:12\)" \
1595 +               "provided bound\\(s\\) outside array bound\\(s\\)" \
1596 +               "print ar1\(8:12\)"
1597 +gdb_test "print ar1\(8:2:\)" \
1598 +               "A syntax error in expression, near `\\)'." \
1599 +               "print ar1\(8:2:\)"
1600 +gdb_test "print ar1\(8:2:2\)" \
1601 +               "Wrong value provided for stride and boundaries" \
1602 +               "print ar1\(8:2:2\)"
1603 +gdb_test "print ar1\(2:8:-2\)" \
1604 +               "Wrong value provided for stride and boundaries" \
1605 +               "print ar1\(2:8:-2\)"
1606 +gdb_test "print ar1\(2:7:0\)" \
1607 +               "Stride must not be 0" \
1608 +               "print ar1\(2:7:0\)"
1609 +gdb_test "print ar1\(3:7\) = 42" \
1610 +               "Invalid cast." \
1611 +               "Assignment of value to subarray"
1612 diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
1613 new file mode 100644
1614 --- /dev/null
1615 +++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
1616 @@ -0,0 +1,55 @@
1617 +! Copyright 2015 Free Software Foundation, Inc.
1618 +!
1619 +! Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
1620 +!
1621 +! This program is free software; you can redistribute it and/or modify
1622 +! it under the terms of the GNU General Public License as published by
1623 +! the Free Software Foundation; either version 3 of the License, or
1624 +! (at your option) any later version.
1625 +!
1626 +! This program is distributed in the hope that it will be useful,
1627 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1628 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1629 +! GNU General Public License for more details.
1630 +!
1631 +! You should have received a copy of the GNU General Public License
1632 +! along with this program.  If not, see <http://www.gnu.org/licenses/>.
1633 +
1634 +subroutine sub
1635 +  integer, dimension(9) :: ar1
1636 +  integer, dimension(9,9) :: ar2
1637 +  integer, dimension(9,9,9) :: ar3
1638 +  integer, dimension(10,-7:3, -15:-5) :: ar4
1639 +  integer :: i,j,k
1640 +
1641 +  ar1 = 1
1642 +  ar2 = 1
1643 +  ar3 = 1
1644 +  ar4 = 4
1645 +
1646 +  ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...)))
1647 +  do i = 1, 9, 1
1648 +    ar1(i) = i
1649 +    do j = 1, 9, 1
1650 +      ar2(i,j) = i*10 + j
1651 +      do k = 1, 9, 1
1652 +        ar3(i,j,k) = i*100 + j*10 + k
1653 +      end do
1654 +    end do
1655 +  end do
1656 +
1657 +  do i = 1, 10, 1
1658 +    do j = -7, 3, 1
1659 +      do k = -15, -5, 1
1660 +        ar4(i,j,k) = i*100 + (j+8)*10 + (k+16)
1661 +      end do
1662 +    end do
1663 +  end do
1664 +
1665 +  ar1(1) = 11  !BP1
1666 +  return
1667 +end
1668 +
1669 +program testprog
1670 +  call sub
1671 +end
1672 diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
1673 --- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
1674 +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
1675 @@ -98,3 +98,7 @@ gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
1676  gdb_test "ptype vla2(5, 45, 20)" \
1677    "no such vector element \\\(vector not allocated\\\)" \
1678    "ptype vla2(5, 45, 20) not allocated"
1679 +
1680 +gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
1681 +gdb_continue_to_breakpoint "vla1-neg-bounds"
1682 +gdb_test "ptype vla1" "type = $real \\(-2:1,-5:4,-3:-1\\)" "ptype vla1 negative bounds"
1683 diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1684 --- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1685 +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1686 @@ -44,3 +44,7 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
1687  gdb_breakpoint [gdb_get_line_number "pvla-associated"]
1688  gdb_continue_to_breakpoint "pvla-associated"
1689  gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
1690 +
1691 +gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
1692 +gdb_continue_to_breakpoint "vla1-neg-bounds"
1693 +gdb_test "print sizeof(vla1)" " = 480" "print sizeof vla1 negative bounds"
1694 diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
1695 new file mode 100644
1696 --- /dev/null
1697 +++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
1698 @@ -0,0 +1,44 @@
1699 +# Copyright 2016 Free Software Foundation, Inc.
1700 +
1701 +# This program is free software; you can redistribute it and/or modify
1702 +# it under the terms of the GNU General Public License as published by
1703 +# the Free Software Foundation; either version 3 of the License, or
1704 +# (at your option) any later version.
1705 +#
1706 +# This program is distributed in the hope that it will be useful,
1707 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1708 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1709 +# GNU General Public License for more details.
1710 +#
1711 +# You should have received a copy of the GNU General Public License
1712 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1713 +
1714 +standard_testfile ".f90"
1715 +
1716 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1717 +    {debug f90 quiet}] } {
1718 +    return -1
1719 +}
1720 +
1721 +if ![runto MAIN__] then {
1722 +    perror "couldn't run to breakpoint MAIN__"
1723 +    continue
1724 +}
1725 +
1726 +gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
1727 +gdb_continue_to_breakpoint "re-reverse-elements"
1728 +gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
1729 +  "print re-reverse-elements"
1730 +gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
1731 +gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
1732 +
1733 +gdb_breakpoint [gdb_get_line_number "odd-elements"]
1734 +gdb_continue_to_breakpoint "odd-elements"
1735 +gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
1736 +gdb_test "print pvla(1)" " = 1" "print first odd-element"
1737 +gdb_test "print pvla(5)" " = 9" "print last odd-element"
1738 +
1739 +gdb_breakpoint [gdb_get_line_number "single-element"]
1740 +gdb_continue_to_breakpoint "single-element"
1741 +gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
1742 +gdb_test "print pvla(1)" " = 5" "print one single-element"
1743 diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
1744 new file mode 100644
1745 --- /dev/null
1746 +++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
1747 @@ -0,0 +1,29 @@
1748 +! Copyright 2016 Free Software Foundation, Inc.
1749 +!
1750 +! This program is free software; you can redistribute it and/or modify
1751 +! it under the terms of the GNU General Public License as published by
1752 +! the Free Software Foundation; either version 3 of the License, or
1753 +! (at your option) any later version.
1754 +!
1755 +! This program is distributed in the hope that it will be useful,
1756 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1757 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1758 +! GNU General Public License for more details.
1759 +!
1760 +! You should have received a copy of the GNU General Public License
1761 +! along with this program.  If not, see <http://www.gnu.org/licenses/>.
1762 +
1763 +program vla_stride
1764 +  integer, target, allocatable :: vla (:)
1765 +  integer, pointer :: pvla (:)
1766 +
1767 +  allocate(vla(10))
1768 +  vla = (/ (I, I = 1,10) /)
1769 +
1770 +  pvla => vla(10:1:-1)
1771 +  pvla => pvla(10:1:-1)
1772 +  pvla => vla(1:10:2)   ! re-reverse-elements
1773 +  pvla => vla(5:4:-2)   ! odd-elements
1774 +
1775 +  pvla => null()        ! single-element
1776 +end program vla_stride
1777 diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
1778 --- a/gdb/testsuite/gdb.fortran/vla.f90
1779 +++ b/gdb/testsuite/gdb.fortran/vla.f90
1780 @@ -54,4 +54,14 @@ program vla
1781
1782    allocate (vla3 (2,2))               ! vla2-deallocated
1783    vla3(:,:) = 13
1784 +
1785 +  allocate (vla1 (-2:1, -5:4, -3:-1))
1786 +  l = allocated(vla1)
1787 +
1788 +  vla1(:, :, :) = 1
1789 +  vla1(-2, -3, -1) = -231
1790 +
1791 +  deallocate (vla1)                   ! vla1-neg-bounds
1792 +  l = allocated(vla1)
1793 +
1794  end program vla
1795 diff --git a/gdb/valarith.c b/gdb/valarith.c
1796 --- a/gdb/valarith.c
1797 +++ b/gdb/valarith.c
1798 @@ -187,11 +187,17 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
1799    struct type *array_type = check_typedef (value_type (array));
1800    struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
1801    ULONGEST elt_size = type_length_units (elt_type);
1802 -  ULONGEST elt_offs = elt_size * (index - lowerbound);
1803 +  LONGEST elt_offs = index - lowerbound;
1804 +  LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
1805 +
1806 +  if (elt_stride != 0)
1807 +    elt_offs *= elt_stride;
1808 +  else
1809 +    elt_offs *= elt_size;
1810
1811    if (index < lowerbound
1812        || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
1813 -          && elt_offs >= type_length_units (array_type))
1814 +          && abs (elt_offs) >= type_length_units (array_type))
1815        || (VALUE_LVAL (array) != lval_memory
1816            && TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)))
1817      {
1818 diff --git a/gdb/valops.c b/gdb/valops.c
1819 --- a/gdb/valops.c
1820 +++ b/gdb/valops.c
1821 @@ -3792,56 +3792,195 @@ value_of_this_silent (const struct language_defn *lang)
1822
1823  struct value *
1824  value_slice (struct value *array, int lowbound, int length)
1825 +{
1826 +  /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride
1827 +     value of '1', which returns every element between LOWBOUND and
1828 +     (LOWBOUND + LENGTH).  We also provide a default CALL_COUNT of '1'
1829 +     as we are only considering the highest dimension, or we are
1830 +     working on a one dimensional array.  So we call VALUE_SLICE_1
1831 +     exactly once.  */
1832 +  return value_slice_1 (array, lowbound, length, 1, 1);
1833 +}
1834 +
1835 +/* VALUE_SLICE_1 is called for each array dimension to calculate the number
1836 +   of elements as defined by the subscript expression.
1837 +   CALL_COUNT is used to determine if we are calling the function once, e.g.
1838 +   we are working on the current dimension of ARRAY, or if we are calling
1839 +   the function repeatedly.  In the later case we need to take elements
1840 +   from the TARGET_TYPE of ARRAY.
1841 +   With a CALL_COUNT greater than 1 we calculate the offsets for every element
1842 +   that should be in the result array.  Then we fetch the contents and then
1843 +   copy them into the result array.  The result array will have one dimension
1844 +   less than the input array, so later on we need to recreate the indices and
1845 +   ranges in the calling function.  */
1846 +
1847 +struct value *
1848 +value_slice_1 (struct value *array, int lowbound, int length,
1849 +              int stride_length, int call_count)
1850  {
1851    struct type *slice_range_type, *slice_type, *range_type;
1852 -  LONGEST lowerbound, upperbound;
1853 -  struct value *slice;
1854 -  struct type *array_type;
1855 +  struct type *array_type = check_typedef (value_type (array));
1856 +  struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
1857 +  unsigned int elt_size, elt_offs;
1858 +  LONGEST ary_high_bound, ary_low_bound;
1859 +  struct value *v;
1860 +  int slice_range_size, i = 0, row_count = 1, elem_count = 1;
1861
1862 -  array_type = check_typedef (value_type (array));
1863 +  /* Check for legacy code if we are actually dealing with an array or
1864 +     string.  */
1865    if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
1866        && TYPE_CODE (array_type) != TYPE_CODE_STRING)
1867      error (_("cannot take slice of non-array"));
1868
1869 -  range_type = TYPE_INDEX_TYPE (array_type);
1870 -  if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
1871 -    error (_("slice from bad array or bitstring"));
1872 +  ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type));
1873 +  ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type));
1874 +
1875 +  /* When we are working on a multi-dimensional array, we need to get the
1876 +     attributes of the underlying type.  */
1877 +  if (call_count > 1)
1878 +    {
1879 +      ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type));
1880 +      ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type));
1881 +      elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
1882 +      row_count = TYPE_LENGTH (array_type)
1883 +                   / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
1884 +    }
1885 +
1886 +  /* With a stride of '1', the number of elements per result row is equal to
1887 +     the LENGTH of the subarray.  With non-default stride values, we skip
1888 +     elements, but have to add the start element to the total number of
1889 +     elements per row.  */
1890 +  if (stride_length == 1)
1891 +    elem_count = length;
1892 +  else
1893 +    elem_count = ((length - 1) / stride_length) + 1;
1894 +
1895 +  elt_size = TYPE_LENGTH (elt_type);
1896 +  elt_offs = lowbound - ary_low_bound;
1897
1898 -  if (lowbound < lowerbound || length < 0
1899 -      || lowbound + length - 1 > upperbound)
1900 -    error (_("slice out of range"));
1901 +  elt_offs *= elt_size;
1902 +
1903 +  /* Check for valid user input.  In case of Fortran this was already done
1904 +     in the calling function.  */
1905 +  if (call_count == 1
1906 +       && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
1907 +             && elt_offs >= TYPE_LENGTH (array_type)))
1908 +    error (_("no such vector element"));
1909 +
1910 +  /* CALL_COUNT is 1 when we are dealing either with the highest dimension
1911 +     of the array, or a one dimensional array.  Set RANGE_TYPE accordingly.
1912 +     In both cases we calculate how many rows/elements will be in the output
1913 +     array by setting slice_range_size.  */
1914 +  if (call_count == 1)
1915 +    {
1916 +      range_type = TYPE_INDEX_TYPE (array_type);
1917 +      slice_range_size = ary_low_bound + elem_count - 1;
1918 +
1919 +      /* Check if the array bounds are valid.  */
1920 +      if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)
1921 +       error (_("slice from bad array or bitstring"));
1922 +    }
1923 +  /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays.
1924 +     So we need to get the type below the current one and set the RANGE_TYPE
1925 +     accordingly.  */
1926 +  else
1927 +    {
1928 +      range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
1929 +      slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
1930 +      ary_low_bound = TYPE_LOW_BOUND (range_type);
1931 +    }
1932
1933    /* FIXME-type-allocation: need a way to free this type when we are
1934 -     done with it.  */
1935 -  slice_range_type = create_static_range_type ((struct type *) NULL,
1936 -                                              TYPE_TARGET_TYPE (range_type),
1937 -                                              lowbound,
1938 -                                              lowbound + length - 1);
1939 +      done with it.  */
1940
1941 +  slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type),
1942 +                                              ary_low_bound, slice_range_size);
1943    {
1944 -    struct type *element_type = TYPE_TARGET_TYPE (array_type);
1945 -    LONGEST offset
1946 -      = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
1947 +    struct type *element_type;
1948 +
1949 +    /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy
1950 +       code for subarrays.  */
1951 +    if (call_count == 1 && stride_length == 1)
1952 +      {
1953 +       element_type = TYPE_TARGET_TYPE (array_type);
1954 +
1955 +       slice_type = create_array_type (NULL, element_type, slice_range_type);
1956
1957 -    slice_type = create_array_type ((struct type *) NULL,
1958 -                                   element_type,
1959 -                                   slice_range_type);
1960 -    TYPE_CODE (slice_type) = TYPE_CODE (array_type);
1961 +       TYPE_CODE (slice_type) = TYPE_CODE (array_type);
1962
1963 -    if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
1964 -      slice = allocate_value_lazy (slice_type);
1965 +       if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
1966 +         v = allocate_value_lazy (slice_type);
1967 +       else
1968 +         {
1969 +           v = allocate_value (slice_type);
1970 +           value_contents_copy (v,
1971 +                                value_embedded_offset (v),
1972 +                                array,
1973 +                                value_embedded_offset (array) + elt_offs,
1974 +                                elt_size * longest_to_int (length));
1975 +         }
1976 +
1977 +      }
1978 +    /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working
1979 +       on a range of ranges.  So we copy the relevant elements into the
1980 +       new array we return.  */
1981      else
1982        {
1983 -       slice = allocate_value (slice_type);
1984 -       value_contents_copy (slice, 0, array, offset,
1985 -                            type_length_units (slice_type));
1986 +       int j, offs_store = elt_offs;
1987 +       LONGEST dst_offset = 0;
1988 +       LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
1989 +
1990 +       if (call_count == 1)
1991 +         {
1992 +           /* When CALL_COUNT is equal to 1 we are working on the current range
1993 +              and use these elements directly.  */
1994 +           element_type = TYPE_TARGET_TYPE (array_type);
1995 +         }
1996 +       else
1997 +         {
1998 +           /* Working on an array of arrays, the type of the elements is the type
1999 +              of the subarrays' type.  */
2000 +           element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
2001 +         }
2002 +
2003 +       slice_type = create_array_type (NULL, element_type, slice_range_type);
2004 +
2005 +        /* If we have a one dimensional array, we copy its TYPE_CODE.  For a
2006 +           multi dimensional array we copy the embedded type's TYPE_CODE.  */
2007 +       if (call_count == 1)
2008 +         TYPE_CODE (slice_type) = TYPE_CODE (array_type);
2009 +       else
2010 +         TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
2011 +
2012 +       v = allocate_value (slice_type);
2013 +
2014 +       /* Iterate through the rows of the outer array and set the new offset
2015 +          for each row.  */
2016 +       for (i = 0; i < row_count; i++)
2017 +         {
2018 +           elt_offs = offs_store + i * src_row_length;
2019 +
2020 +           /* Iterate through the elements in each row to copy only those.  */
2021 +           for (j = 1; j <= elem_count; j++)
2022 +             {
2023 +               /* Fetches the contents of ARRAY and copies them into V.  */
2024 +               value_contents_copy (v, dst_offset, array, elt_offs, elt_size);
2025 +               elt_offs += elt_size * stride_length;
2026 +               dst_offset += elt_size;
2027 +             }
2028 +         }
2029        }
2030
2031 -    set_value_component_location (slice, array);
2032 -    set_value_offset (slice, value_offset (array) + offset);
2033 +    set_value_component_location (v, array);
2034 +    if (VALUE_LVAL (v) == lval_register)
2035 +      {
2036 +       VALUE_REGNUM (v) = VALUE_REGNUM (array);
2037 +       VALUE_NEXT_FRAME_ID (v) = VALUE_NEXT_FRAME_ID (array);
2038 +      }
2039 +    set_value_offset (v, value_offset (array) + elt_offs);
2040    }
2041
2042 -  return slice;
2043 +  return v;
2044  }
2045
2046  /* Create a value for a FORTRAN complex number.  Currently most of the
2047 diff --git a/gdb/value.h b/gdb/value.h
2048 --- a/gdb/value.h
2049 +++ b/gdb/value.h
2050 @@ -1139,6 +1139,8 @@ extern struct value *varying_to_slice (struct value *);
2051
2052  extern struct value *value_slice (struct value *, int, int);
2053
2054 +extern struct value *value_slice_1 (struct value *, int, int, int, int);
2055 +
2056  extern struct value *value_literal_complex (struct value *, struct value *,
2057                                             struct type *);
2058