gdb-vla-intel-fortran-strides.patch

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