gdb-vla-intel.patch

   1 [PATCH 00/23] Fortran dynamic array support
   2 https://sourceware.org/ml/gdb-patches/2014-06/msg00108.html
   3 https://github.com/intel-gdb/vla/tree/vla-fortran
   4
   5 GIT snapshot:
   6 commit 511bff520372ffc10fa2ff569c176bdf1e6e475d
   7
   8
   9 Index: gdb-7.9.50.20150520/gdb/c-valprint.c
  10 ===================================================================
  11 --- gdb-7.9.50.20150520.orig/gdb/c-valprint.c   2015-05-29 08:27:02.657717326 +0200
  12 +++ gdb-7.9.50.20150520/gdb/c-valprint.c        2015-05-29 08:27:06.253740209 +0200
  13 @@ -537,7 +537,16 @@ c_value_print (struct value *val, struct
  14         {
  15           /* normal case */
  16           fprintf_filtered (stream, "(");
  17 -         type_print (value_type (val), "", stream, -1);
  18 +         if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
  19 +           {
  20 +             struct value *v;
  21 +
  22 +             v = value_ind (val);
  23 +             v = value_addr (v);
  24 +             type_print (value_type (v), "", stream, -1);
  25 +           }
  26 +         else
  27 +           type_print (value_type (val), "", stream, -1);
  28           fprintf_filtered (stream, ") ");
  29         }
  30      }
  31 Index: gdb-7.9.50.20150520/gdb/dwarf2loc.h
  32 ===================================================================
  33 --- gdb-7.9.50.20150520.orig/gdb/dwarf2loc.h    2015-05-29 08:27:02.658717333 +0200
  34 +++ gdb-7.9.50.20150520/gdb/dwarf2loc.h 2015-05-29 08:27:06.253740209 +0200
  35 @@ -131,6 +131,11 @@ int dwarf2_evaluate_property (const stru
  36                               struct property_addr_info *addr_stack,
  37                               CORE_ADDR *value);
  38
  39 +/* Checks if a dwarf location definition is valid.
  40 +   Returns 1 if valid; 0 otherwise.  */
  41 +
  42 +extern int dwarf2_address_data_valid (const struct type *type);
  43 +
  44  /* A helper for the compiler interface that compiles a single dynamic
  45     property to C code.
  46
  47 Index: gdb-7.9.50.20150520/gdb/dwarf2read.c
  48 ===================================================================
  49 --- gdb-7.9.50.20150520.orig/gdb/dwarf2read.c   2015-05-29 08:27:02.676717447 +0200
  50 +++ gdb-7.9.50.20150520/gdb/dwarf2read.c        2015-05-29 10:04:52.272600212 +0200
  51 @@ -1868,6 +1868,12 @@ static void process_cu_includes (void);
  52  static void check_producer (struct dwarf2_cu *cu);
  53
  54  static void free_line_header_voidp (void *arg);
  55 +
  56 +static int
  57 +attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
  58 +                     struct dwarf2_cu *cu, struct dynamic_prop *prop,
  59 +                     const gdb_byte *additional_data, int additional_data_size);
  60 +
  61  \f
  62  /* Various complaints about symbol reading that don't abort the process.  */
  63
  64 @@ -14431,29 +14437,92 @@ read_tag_string_type (struct die_info *d
  65    struct gdbarch *gdbarch = get_objfile_arch (objfile);
  66    struct type *type, *range_type, *index_type, *char_type;
  67    struct attribute *attr;
  68 -  unsigned int length;
  69 +  unsigned int length = UINT_MAX;
  70
  71 +  index_type = objfile_type (objfile)->builtin_int;
  72 +  range_type = create_static_range_type (NULL, index_type, 1, length);
  73 +
  74 +  /* If DW_AT_string_length is defined, the length is stored at some location
  75 +   * in memory. */
  76    attr = dwarf2_attr (die, DW_AT_string_length, cu);
  77    if (attr)
  78      {
  79 -      length = DW_UNSND (attr);
  80 +      if (attr_form_is_block (attr))
  81 +        {
  82 +          struct attribute *byte_size, *bit_size;
  83 +          struct dynamic_prop high;
  84 +
  85 +          byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
  86 +          bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
  87 +
  88 +          /* DW_AT_byte_size should never occur together in combination with
  89 +             DW_AT_string_length.  */
  90 +          if ((byte_size == NULL && bit_size != NULL) ||
  91 +                  (byte_size != NULL && bit_size == NULL))
  92 +            complaint (&symfile_complaints, _("DW_AT_byte_size AND "
  93 +                      "DW_AT_bit_size found together at the same time."));
  94 +
  95 +          /* If DW_AT_string_length AND DW_AT_byte_size exist together, it
  96 +             describes the number of bytes that should be read from the length
  97 +             memory location.  */
  98 +          if (byte_size != NULL && bit_size == NULL)
  99 +            {
 100 +              /* Build new dwarf2_locexpr_baton structure with additions to the
 101 +                 data attribute, to reflect DWARF specialities to get address
 102 +                 sizes.  */
 103 +              const gdb_byte append_ops[] = {
 104 +                /* DW_OP_deref_size: size of an address on the target machine
 105 +                   (bytes), where the size will be specified by the next
 106 +                   operand.  */
 107 +                DW_OP_deref_size,
 108 +                /* Operand for DW_OP_deref_size.  */
 109 +                DW_UNSND (byte_size) };
 110 +
 111 +              if (!attr_to_dynamic_prop (attr, die, cu, &high,
 112 +                      append_ops, ARRAY_SIZE (append_ops)))
 113 +                complaint (&symfile_complaints,
 114 +                        _("Could not parse DW_AT_byte_size"));
 115 +            }
 116 +          else if (bit_size != NULL && byte_size == NULL)
 117 +            complaint (&symfile_complaints, _("DW_AT_string_length AND "
 118 +                      "DW_AT_bit_size found but not supported yet."));
 119 +          /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
 120 +             is the address size of the target machine.  */
 121 +          else
 122 +            {
 123 +              const gdb_byte append_ops[] = { DW_OP_deref };
 124 +
 125 +              if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
 126 +                      ARRAY_SIZE (append_ops)))
 127 +                complaint (&symfile_complaints,
 128 +                        _("Could not parse DW_AT_string_length"));
 129 +            }
 130 +
 131 +          TYPE_RANGE_DATA (range_type)->high = high;
 132 +        }
 133 +      else
 134 +        {
 135 +          TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
 136 +          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
 137 +        }
 138      }
 139    else
 140      {
 141 -      /* Check for the DW_AT_byte_size attribute.  */
 142 +      /* Check for the DW_AT_byte_size attribute, which represents the length
 143 +         in this case.  */
 144        attr = dwarf2_attr (die, DW_AT_byte_size, cu);
 145        if (attr)
 146          {
 147 -          length = DW_UNSND (attr);
 148 +          TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
 149 +          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
 150          }
 151        else
 152          {
 153 -          length = 1;
 154 +          TYPE_HIGH_BOUND (range_type) = 1;
 155 +          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
 156          }
 157      }
 158
 159 -  index_type = objfile_type (objfile)->builtin_int;
 160 -  range_type = create_static_range_type (NULL, index_type, 1, length);
 161    char_type = language_string_char_type (cu->language_defn, gdbarch);
 162    type = create_string_type (NULL, char_type, range_type);
 163
 164 @@ -14776,13 +14845,15 @@ read_base_type (struct die_info *die, st
 165    return set_die_type (die, type, cu);
 166  }
 167
 168 +
 169  /* Parse dwarf attribute if it's a block, reference or constant and put the
 170     resulting value of the attribute into struct bound_prop.
 171     Returns 1 if ATTR could be resolved into PROP, 0 otherwise.  */
 172
 173  static int
 174  attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
 175 -                     struct dwarf2_cu *cu, struct dynamic_prop *prop)
 176 +                     struct dwarf2_cu *cu, struct dynamic_prop *prop,
 177 +                     const gdb_byte *additional_data, int additional_data_size)
 178  {
 179    struct dwarf2_property_baton *baton;
 180    struct obstack *obstack = &cu->objfile->objfile_obstack;
 181 @@ -14795,8 +14866,25 @@ attr_to_dynamic_prop (const struct attri
 182        baton = obstack_alloc (obstack, sizeof (*baton));
 183        baton->referenced_type = NULL;
 184        baton->locexpr.per_cu = cu->per_cu;
 185 -      baton->locexpr.size = DW_BLOCK (attr)->size;
 186 -      baton->locexpr.data = DW_BLOCK (attr)->data;
 187 +
 188 +      if (additional_data != NULL && additional_data_size > 0)
 189 +        {
 190 +          gdb_byte *data;
 191 +
 192 +          data = obstack_alloc (&cu->objfile->objfile_obstack,
 193 +                  DW_BLOCK (attr)->size + additional_data_size);
 194 +          memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
 195 +          memcpy (data + DW_BLOCK (attr)->size,
 196 +                  additional_data, additional_data_size);
 197 +
 198 +          baton->locexpr.data = data;
 199 +          baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
 200 +        }
 201 +      else
 202 +        {
 203 +          baton->locexpr.data = DW_BLOCK (attr)->data;
 204 +          baton->locexpr.size = DW_BLOCK (attr)->size;
 205 +        }
 206        prop->data.baton = baton;
 207        prop->kind = PROP_LOCEXPR;
 208        gdb_assert (prop->data.baton != NULL);
 209 @@ -14832,8 +14920,28 @@ attr_to_dynamic_prop (const struct attri
 210                 baton = obstack_alloc (obstack, sizeof (*baton));
 211                 baton->referenced_type = die_type (target_die, target_cu);
 212                 baton->locexpr.per_cu = cu->per_cu;
 213 -               baton->locexpr.size = DW_BLOCK (target_attr)->size;
 214 -               baton->locexpr.data = DW_BLOCK (target_attr)->data;
 215 +
 216 +               if (additional_data != NULL && additional_data_size > 0)
 217 +                 {
 218 +                   gdb_byte *data;
 219 +
 220 +                   data = obstack_alloc (&cu->objfile->objfile_obstack,
 221 +                           DW_BLOCK (target_attr)->size + additional_data_size);
 222 +                   memcpy (data, DW_BLOCK (target_attr)->data,
 223 +                           DW_BLOCK (target_attr)->size);
 224 +                   memcpy (data + DW_BLOCK (target_attr)->size,
 225 +                           additional_data, additional_data_size);
 226 +
 227 +                   baton->locexpr.data = data;
 228 +                   baton->locexpr.size = (DW_BLOCK (target_attr)->size
 229 +                                          + additional_data_size);
 230 +                 }
 231 +               else
 232 +                 {
 233 +                   baton->locexpr.data = DW_BLOCK (target_attr)->data;
 234 +                   baton->locexpr.size = DW_BLOCK (target_attr)->size;
 235 +                 }
 236 +
 237                 prop->data.baton = baton;
 238                 prop->kind = PROP_LOCEXPR;
 239                 gdb_assert (prop->data.baton != NULL);
 240 @@ -14887,7 +14995,7 @@ read_subrange_type (struct die_info *die
 241    struct type *base_type, *orig_base_type;
 242    struct type *range_type;
 243    struct attribute *attr;
 244 -  struct dynamic_prop low, high;
 245 +  struct dynamic_prop low, high, stride;
 246    int low_default_is_valid;
 247    int high_bound_is_count = 0;
 248    const char *name;
 249 @@ -14907,7 +15015,9 @@ read_subrange_type (struct die_info *die
 250
 251    low.kind = PROP_CONST;
 252    high.kind = PROP_CONST;
 253 +  stride.kind = PROP_CONST;
 254    high.data.const_val = 0;
 255 +  stride.data.const_val = 0;
 256
 257    /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
 258       omitting DW_AT_lower_bound.  */
 259 @@ -14940,19 +15050,26 @@ read_subrange_type (struct die_info *die
 260        break;
 261      }
 262
 263 +  attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
 264 +  if (attr)
 265 +    if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0))
 266 +        complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
 267 +                  "- DIE at 0x%x [in module %s]"),
 268 +             die->offset.sect_off, objfile_name (cu->objfile));
 269 +
 270    attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
 271    if (attr)
 272 -    attr_to_dynamic_prop (attr, die, cu, &low);
 273 +    attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
 274    else if (!low_default_is_valid)
 275      complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
 276                                       "- DIE at 0x%x [in module %s]"),
 277                die->offset.sect_off, objfile_name (cu->objfile));
 278
 279    attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
 280 -  if (!attr_to_dynamic_prop (attr, die, cu, &high))
 281 +  if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
 282      {
 283        attr = dwarf2_attr (die, DW_AT_count, cu);
 284 -      if (attr_to_dynamic_prop (attr, die, cu, &high))
 285 +      if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
 286         {
 287           /* If bounds are constant do the final calculation here.  */
 288           if (low.kind == PROP_CONST && high.kind == PROP_CONST)
 289 @@ -15016,7 +15133,7 @@ read_subrange_type (struct die_info *die
 290        && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
 291      high.data.const_val |= negative_mask;
 292
 293 -  range_type = create_range_type (NULL, orig_base_type, &low, &high);
 294 +  range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
 295
 296    if (high_bound_is_count)
 297      TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
 298 @@ -22128,9 +22245,37 @@ set_die_type (struct die_info *die, stru
 299        && !HAVE_GNAT_AUX_INFO (type))
 300      INIT_GNAT_SPECIFIC (type);
 301
 302 +  /* Read DW_AT_allocated and set in type.  */
 303 +  attr = dwarf2_attr (die, DW_AT_allocated, cu);
 304 +  if (attr_form_is_block (attr))
 305 +    {
 306 +      struct dynamic_prop prop;
 307 +
 308 +      if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
 309 +        {
 310 +          TYPE_ALLOCATED_PROP (type)
 311 +            = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
 312 +          *TYPE_ALLOCATED_PROP (type) = prop;
 313 +        }
 314 +    }
 315 +
 316 +  /* Read DW_AT_associated and set in type.  */
 317 +  attr = dwarf2_attr (die, DW_AT_associated, cu);
 318 +  if (attr_form_is_block (attr))
 319 +    {
 320 +      struct dynamic_prop prop;
 321 +
 322 +      if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
 323 +        {
 324 +          TYPE_ASSOCIATED_PROP (type)
 325 +            = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
 326 +          *TYPE_ASSOCIATED_PROP (type) = prop;
 327 +        }
 328 +    }
 329 +
 330    /* Read DW_AT_data_location and set in type.  */
 331    attr = dwarf2_attr (die, DW_AT_data_location, cu);
 332 -  if (attr_to_dynamic_prop (attr, die, cu, &prop))
 333 +  if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
 334      add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile);
 335
 336    if (dwarf2_per_objfile->die_type_hash == NULL)
 337 Index: gdb-7.9.50.20150520/gdb/f-typeprint.c
 338 ===================================================================
 339 --- gdb-7.9.50.20150520.orig/gdb/f-typeprint.c  2015-05-29 08:27:02.678717460 +0200
 340 +++ gdb-7.9.50.20150520/gdb/f-typeprint.c       2015-05-29 08:27:06.261740260 +0200
 341 @@ -30,6 +30,7 @@
 342  #include "gdbcore.h"
 343  #include "target.h"
 344  #include "f-lang.h"
 345 +#include "valprint.h"
 346
 347  #if 0                          /* Currently unused.  */
 348  static void f_type_print_args (struct type *, struct ui_file *);
 349 @@ -53,6 +54,17 @@ f_print_type (struct type *type, const c
 350    enum type_code code;
 351    int demangled_args;
 352
 353 +  if (TYPE_NOT_ASSOCIATED (type))
 354 +    {
 355 +      val_print_not_associated (stream);
 356 +      return;
 357 +    }
 358 +  if (TYPE_NOT_ALLOCATED (type))
 359 +    {
 360 +      val_print_not_allocated (stream);
 361 +      return;
 362 +    }
 363 +
 364    f_type_print_base (type, stream, show, level);
 365    code = TYPE_CODE (type);
 366    if ((varstring != NULL && *varstring != '\0')
 367 @@ -167,28 +179,36 @@ f_type_print_varspec_suffix (struct type
 368        if (arrayprint_recurse_level == 1)
 369         fprintf_filtered (stream, "(");
 370
 371 -      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
 372 -       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
 373 -                                    arrayprint_recurse_level);
 374 -
 375 -      lower_bound = f77_get_lowerbound (type);
 376 -      if (lower_bound != 1)    /* Not the default.  */
 377 -       fprintf_filtered (stream, "%d:", lower_bound);
 378 -
 379 -      /* Make sure that, if we have an assumed size array, we
 380 -         print out a warning and print the upperbound as '*'.  */
 381 -
 382 -      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 383 -       fprintf_filtered (stream, "*");
 384 +      if (TYPE_NOT_ASSOCIATED (type))
 385 +        val_print_not_associated (stream);
 386 +      else if (TYPE_NOT_ALLOCATED (type))
 387 +        val_print_not_allocated (stream);
 388        else
 389 -       {
 390 -         upper_bound = f77_get_upperbound (type);
 391 -         fprintf_filtered (stream, "%d", upper_bound);
 392 -       }
 393 -
 394 -      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
 395 -       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
 396 -                                    arrayprint_recurse_level);
 397 +        {
 398 +
 399 +          if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
 400 +            f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
 401 +                 arrayprint_recurse_level);
 402 +
 403 +          lower_bound = f77_get_lowerbound (type);
 404 +          if (lower_bound != 1)        /* Not the default.  */
 405 +            fprintf_filtered (stream, "%d:", lower_bound);
 406 +
 407 +          /* Make sure that, if we have an assumed size array, we
 408 +             print out a warning and print the upperbound as '*'.  */
 409 +
 410 +          if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 411 +            fprintf_filtered (stream, "*");
 412 +          else
 413 +            {
 414 +              upper_bound = f77_get_upperbound (type);
 415 +              fprintf_filtered (stream, "%d", upper_bound);
 416 +            }
 417 +
 418 +          if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
 419 +            f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
 420 +                 arrayprint_recurse_level);
 421 +      }
 422        if (arrayprint_recurse_level == 1)
 423         fprintf_filtered (stream, ")");
 424        else
 425 Index: gdb-7.9.50.20150520/gdb/f-valprint.c
 426 ===================================================================
 427 --- gdb-7.9.50.20150520.orig/gdb/f-valprint.c   2015-05-29 08:26:49.567634019 +0200
 428 +++ gdb-7.9.50.20150520/gdb/f-valprint.c        2015-05-29 08:27:06.262740266 +0200
 429 @@ -36,8 +36,6 @@
 430
 431  extern void _initialize_f_valprint (void);
 432  static void info_common_command (char *, int);
 433 -static void f77_create_arrayprint_offset_tbl (struct type *,
 434 -                                             struct ui_file *);
 435  static void f77_get_dynamic_length_of_aggregate (struct type *);
 436
 437  int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
 438 @@ -45,15 +43,6 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM
 439  /* Array which holds offsets to be applied to get a row's elements
 440     for a given array.  Array also holds the size of each subarray.  */
 441
 442 -/* The following macro gives us the size of the nth dimension, Where
 443 -   n is 1 based.  */
 444 -
 445 -#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
 446 -
 447 -/* The following gives us the offset for row n where n is 1-based.  */
 448 -
 449 -#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
 450 -
 451  int
 452  f77_get_lowerbound (struct type *type)
 453  {
 454 @@ -111,47 +100,6 @@ f77_get_dynamic_length_of_aggregate (str
 455      * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
 456  }
 457
 458 -/* Function that sets up the array offset,size table for the array
 459 -   type "type".  */
 460 -
 461 -static void
 462 -f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
 463 -{
 464 -  struct type *tmp_type;
 465 -  int eltlen;
 466 -  int ndimen = 1;
 467 -  int upper, lower;
 468 -
 469 -  tmp_type = type;
 470 -
 471 -  while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
 472 -    {
 473 -      upper = f77_get_upperbound (tmp_type);
 474 -      lower = f77_get_lowerbound (tmp_type);
 475 -
 476 -      F77_DIM_SIZE (ndimen) = upper - lower + 1;
 477 -
 478 -      tmp_type = TYPE_TARGET_TYPE (tmp_type);
 479 -      ndimen++;
 480 -    }
 481 -
 482 -  /* Now we multiply eltlen by all the offsets, so that later we
 483 -     can print out array elements correctly.  Up till now we
 484 -     know an offset to apply to get the item but we also
 485 -     have to know how much to add to get to the next item.  */
 486 -
 487 -  ndimen--;
 488 -  eltlen = TYPE_LENGTH (tmp_type);
 489 -  F77_DIM_OFFSET (ndimen) = eltlen;
 490 -  while (--ndimen > 0)
 491 -    {
 492 -      eltlen *= F77_DIM_SIZE (ndimen + 1);
 493 -      F77_DIM_OFFSET (ndimen) = eltlen;
 494 -    }
 495 -}
 496 -
 497 -
 498 -
 499  /* Actual function which prints out F77 arrays, Valaddr == address in
 500     the superior.  Address == the address in the inferior.  */
 501
 502 @@ -164,41 +112,62 @@ f77_print_array_1 (int nss, int ndimensi
 503                    const struct value_print_options *options,
 504                    int *elts)
 505  {
 506 +  struct type *range_type = TYPE_INDEX_TYPE (check_typedef (type));
 507 +  CORE_ADDR addr = address + embedded_offset;
 508 +  LONGEST lowerbound, upperbound;
 509    int i;
 510
 511 +  get_discrete_bounds (range_type, &lowerbound, &upperbound);
 512 +
 513    if (nss != ndimensions)
 514      {
 515 -      for (i = 0;
 516 -          (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max);
 517 +      size_t dim_size;
 518 +      size_t offs = 0;
 519 +      LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
 520 +
 521 +      if (byte_stride)
 522 +        dim_size = byte_stride;
 523 +      else
 524 +        dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
 525 +
 526 +      for (i = lowerbound;
 527 +          (i < upperbound + 1 && (*elts) < options->print_max);
 528            i++)
 529         {
 530 +         struct value *subarray = value_from_contents_and_address
 531 +           (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
 532 +            + offs, addr + offs);
 533 +
 534           fprintf_filtered (stream, "( ");
 535 -         f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
 536 -                            valaddr,
 537 -                            embedded_offset + i * F77_DIM_OFFSET (nss),
 538 -                            address,
 539 -                            stream, recurse, val, options, elts);
 540 +         f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
 541 +                            value_contents_for_printing (subarray),
 542 +                            value_embedded_offset (subarray),
 543 +                            value_address (subarray),
 544 +                            stream, recurse, subarray, options, elts);
 545 +         offs += dim_size;
 546           fprintf_filtered (stream, ") ");
 547         }
 548 -      if (*elts >= options->print_max && i < F77_DIM_SIZE (nss))
 549 +      if (*elts >= options->print_max && i < upperbound)
 550         fprintf_filtered (stream, "...");
 551      }
 552    else
 553      {
 554 -      for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max;
 555 +      for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
 556            i++, (*elts)++)
 557         {
 558 -         val_print (TYPE_TARGET_TYPE (type),
 559 -                    valaddr,
 560 -                    embedded_offset + i * F77_DIM_OFFSET (ndimensions),
 561 -                    address, stream, recurse,
 562 -                    val, options, current_language);
 563 +         struct value *elt = value_subscript ((struct value *)val, i);
 564 +
 565 +         val_print (value_type (elt),
 566 +                    value_contents_for_printing (elt),
 567 +                    value_embedded_offset (elt),
 568 +                    value_address (elt), stream, recurse,
 569 +                    elt, options, current_language);
 570
 571 -         if (i != (F77_DIM_SIZE (nss) - 1))
 572 +         if (i != upperbound)
 573             fprintf_filtered (stream, ", ");
 574
 575           if ((*elts == options->print_max - 1)
 576 -             && (i != (F77_DIM_SIZE (nss) - 1)))
 577 +             && (i != upperbound))
 578             fprintf_filtered (stream, "...");
 579         }
 580      }
 581 @@ -225,12 +194,6 @@ f77_print_array (struct type *type, cons
 582  Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
 583            ndimensions, MAX_FORTRAN_DIMS);
 584
 585 -  /* Since F77 arrays are stored column-major, we set up an
 586 -     offset table to get at the various row's elements.  The
 587 -     offset table contains entries for both offset and subarray size.  */
 588 -
 589 -  f77_create_arrayprint_offset_tbl (type, stream);
 590 -
 591    f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
 592                      address, stream, recurse, val, options, &elts);
 593  }
 594 @@ -375,12 +338,15 @@ f_val_print (struct type *type, const gd
 595        fprintf_filtered (stream, "( ");
 596        for (index = 0; index < TYPE_NFIELDS (type); index++)
 597          {
 598 -          int offset = TYPE_FIELD_BITPOS (type, index) / 8;
 599 +         struct value *field = value_field
 600 +           ((struct value *)original_value, index);
 601 +
 602 +          val_print (value_type (field),
 603 +                    value_contents_for_printing (field),
 604 +                    value_embedded_offset (field),
 605 +                    value_address (field), stream, recurse + 1,
 606 +                    field, options, current_language);
 607
 608 -          val_print (TYPE_FIELD_TYPE (type, index), valaddr,
 609 -                    embedded_offset + offset,
 610 -                    address, stream, recurse + 1,
 611 -                    original_value, options, current_language);
 612            if (index != TYPE_NFIELDS (type) - 1)
 613              fputs_filtered (", ", stream);
 614          }
 615 Index: gdb-7.9.50.20150520/gdb/gdbtypes.c
 616 ===================================================================
 617 --- gdb-7.9.50.20150520.orig/gdb/gdbtypes.c     2015-05-29 08:27:02.683717492 +0200
 618 +++ gdb-7.9.50.20150520/gdb/gdbtypes.c  2015-05-29 10:54:36.236498749 +0200
 619 @@ -824,7 +824,8 @@ allocate_stub_method (struct type *type)
 620  struct type *
 621  create_range_type (struct type *result_type, struct type *index_type,
 622                    const struct dynamic_prop *low_bound,
 623 -                  const struct dynamic_prop *high_bound)
 624 +                  const struct dynamic_prop *high_bound,
 625 +                  const struct dynamic_prop *stride)
 626  {
 627    if (result_type == NULL)
 628      result_type = alloc_type_copy (index_type);
 629 @@ -839,6 +840,7 @@ create_range_type (struct type *result_t
 630      TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
 631    TYPE_RANGE_DATA (result_type)->low = *low_bound;
 632    TYPE_RANGE_DATA (result_type)->high = *high_bound;
 633 +  TYPE_RANGE_DATA (result_type)->stride = *stride;
 634
 635    if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
 636      TYPE_UNSIGNED (result_type) = 1;
 637 @@ -867,7 +869,7 @@ struct type *
 638  create_static_range_type (struct type *result_type, struct type *index_type,
 639                           LONGEST low_bound, LONGEST high_bound)
 640  {
 641 -  struct dynamic_prop low, high;
 642 +  struct dynamic_prop low, high, stride;
 643
 644    low.kind = PROP_CONST;
 645    low.data.const_val = low_bound;
 646 @@ -875,7 +877,11 @@ create_static_range_type (struct type *r
 647    high.kind = PROP_CONST;
 648    high.data.const_val = high_bound;
 649
 650 -  result_type = create_range_type (result_type, index_type, &low, &high);
 651 +  stride.kind = PROP_CONST;
 652 +  stride.data.const_val = 0;
 653 +
 654 +  result_type = create_range_type (result_type, index_type,
 655 +                                   &low, &high, &stride);
 656
 657    return result_type;
 658  }
 659 @@ -1068,18 +1074,24 @@ create_array_type_with_stride (struct ty
 660
 661    TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
 662    TYPE_TARGET_TYPE (result_type) = element_type;
 663 -  if (has_static_range (TYPE_RANGE_DATA (range_type)))
 664 +  if (has_static_range (TYPE_RANGE_DATA (range_type))
 665 +      && dwarf2_address_data_valid (result_type))
 666      {
 667 -      LONGEST low_bound, high_bound;
 668 +      LONGEST low_bound, high_bound, byte_stride;
 669
 670        if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 671         low_bound = high_bound = 0;
 672        CHECK_TYPEDEF (element_type);
 673 +
 674 +      byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
 675 +
 676        /* Be careful when setting the array length.  Ada arrays can be
 677          empty arrays with the high_bound being smaller than the low_bound.
 678          In such cases, the array length should be zero.  */
 679        if (high_bound < low_bound)
 680         TYPE_LENGTH (result_type) = 0;
 681 +      else if (byte_stride > 0)
 682 +       TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
 683        else if (bit_stride > 0)
 684         TYPE_LENGTH (result_type) =
 685           (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
 686 @@ -1789,12 +1801,31 @@ stub_noname_complaint (void)
 687  static int
 688  is_dynamic_type_internal (struct type *type, int top_level)
 689  {
 690 +  int index;
 691 +
 692 +  if (!type)
 693 +    return 0;
 694 +
 695    type = check_typedef (type);
 696
 697    /* We only want to recognize references at the outermost level.  */
 698    if (top_level && TYPE_CODE (type) == TYPE_CODE_REF)
 699      type = check_typedef (TYPE_TARGET_TYPE (type));
 700
 701 +  if (TYPE_ASSOCIATED_PROP (type))
 702 +    return 1;
 703 +
 704 +  if (TYPE_ALLOCATED_PROP (type))
 705 +    return 1;
 706 +
 707 +  /* Scan field types in the Fortran case for nested dynamic types.
 708 +     This will be done only for Fortran as in the C++ case an endless recursion
 709 +     can occur in the area of classes.  */
 710 +  if (current_language->la_language == language_fortran)
 711 +    for (index = 0; index < TYPE_NFIELDS (type); index++)
 712 +      if (is_dynamic_type (TYPE_FIELD_TYPE (type, index)))
 713 +        return 1;
 714 +
 715    /* Types that have a dynamic TYPE_DATA_LOCATION are considered
 716       dynamic, even if the type itself is statically defined.
 717       From a user's point of view, this may appear counter-intuitive;
 718 @@ -1823,11 +1854,19 @@ is_dynamic_type_internal (struct type *t
 719        {
 720         gdb_assert (TYPE_NFIELDS (type) == 1);
 721
 722 -       /* The array is dynamic if either the bounds are dynamic,
 723 -          or the elements it contains have a dynamic contents.  */
 724 +       /* The array is dynamic if either
 725 +     - the bounds are dynamic,
 726 +          - the elements it contains have a dynamic contents
 727 +     - a data_locaton attribute was found.  */
 728         if (is_dynamic_type_internal (TYPE_INDEX_TYPE (type), 0))
 729           return 1;
 730 -       return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
 731 +       else if (TYPE_DATA_LOCATION (type) != NULL
 732 +                && (TYPE_DATA_LOCATION_KIND (type) == PROP_LOCEXPR
 733 +                    || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST))
 734 +    return 1;
 735 +  else
 736 +    return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
 737 +       break;
 738        }
 739
 740      case TYPE_CODE_STRUCT:
 741 @@ -1840,6 +1879,18 @@ is_dynamic_type_internal (struct type *t
 742               && is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0))
 743             return 1;
 744        }
 745 +    case TYPE_CODE_PTR:
 746 +      {
 747 +        if (TYPE_TARGET_TYPE (type)
 748 +            && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING
 749 +                || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY))
 750 +          return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type)));
 751 +
 752 +        return 0;
 753 +        break;
 754 +      }
 755 +    default:
 756 +      return 0;
 757        break;
 758      }
 759
 760 @@ -1869,7 +1920,8 @@ resolve_dynamic_range (struct type *dyn_
 761    struct type *static_range_type, *static_target_type;
 762    const struct dynamic_prop *prop;
 763    const struct dwarf2_locexpr_baton *baton;
 764 -  struct dynamic_prop low_bound, high_bound;
 765 +  struct dynamic_prop low_bound, high_bound, stride;
 766 +  struct type *range_copy = copy_type (dyn_range_type);
 767
 768    gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
 769
 770 @@ -1901,12 +1953,19 @@ resolve_dynamic_range (struct type *dyn_
 771        high_bound.data.const_val = 0;
 772      }
 773
 774 +  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
 775 +  if (dwarf2_evaluate_property (prop, addr_stack, &value))
 776 +    {
 777 +      stride.kind = PROP_CONST;
 778 +      stride.data.const_val = value;
 779 +    }
 780 +
 781    static_target_type
 782 -    = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
 783 +    = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (range_copy),
 784                                      addr_stack, 0);
 785 -  static_range_type = create_range_type (copy_type (dyn_range_type),
 786 +  static_range_type = create_range_type (range_copy,
 787                                          static_target_type,
 788 -                                        &low_bound, &high_bound);
 789 +                                        &low_bound, &high_bound, &stride);
 790    TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
 791    return static_range_type;
 792  }
 793 @@ -1923,23 +1982,47 @@ resolve_dynamic_array (struct type *type
 794    struct type *elt_type;
 795    struct type *range_type;
 796    struct type *ary_dim;
 797 +  struct dynamic_prop *prop;
 798 +  struct type *copy = copy_type (type);
 799
 800 -  gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
 801 +  gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
 802 +             || TYPE_CODE (type) == TYPE_CODE_STRING);
 803
 804    elt_type = type;
 805    range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
 806    range_type = resolve_dynamic_range (range_type, addr_stack);
 807
 808 +  prop = TYPE_ALLOCATED_PROP (type);
 809 +  if (dwarf2_evaluate_property (prop, addr_stack, &value))
 810 +    {
 811 +      TYPE_ALLOCATED_PROP (copy)->kind = PROP_CONST;
 812 +      TYPE_ALLOCATED_PROP (copy)->data.const_val = value;
 813 +    }
 814 +
 815 +  prop = TYPE_ASSOCIATED_PROP (type);
 816 +  if (dwarf2_evaluate_property (prop, addr_stack, &value))
 817 +    {
 818 +      TYPE_ASSOCIATED_PROP (copy)->kind = PROP_CONST;
 819 +      TYPE_ASSOCIATED_PROP (copy)->data.const_val = value;
 820 +    }
 821 +
 822    ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
 823
 824 -  if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
 825 -    elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack);
 826 +  if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
 827 +          || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
 828 +    elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr_stack);
 829    else
 830      elt_type = TYPE_TARGET_TYPE (type);
 831
 832 -  return create_array_type_with_stride (copy_type (type),
 833 -                                       elt_type, range_type,
 834 -                                       TYPE_FIELD_BITSIZE (type, 0));
 835 +  if (TYPE_CODE (type) == TYPE_CODE_STRING
 836 +      && TYPE_FIELD_BITSIZE (type, 0) == 0)
 837 +    return create_string_type (copy,
 838 +           elt_type,
 839 +           range_type);
 840 +  else
 841 +    return create_array_type_with_stride (copy,
 842 +           elt_type,
 843 +           range_type, TYPE_FIELD_BITSIZE (type, 0));
 844  }
 845
 846  /* Resolve dynamic bounds of members of the union TYPE to static
 847 @@ -4453,6 +4536,20 @@ copy_type_recursive (struct objfile *obj
 848                                 TYPE_DYN_PROP_LIST (type));
 849
 850
 851 +  /* Copy allocated information.  */
 852 +  if (TYPE_ALLOCATED_PROP (type) != NULL)
 853 +    {
 854 +      TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
 855 +      *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type);
 856 +    }
 857 +
 858 +  /* Copy associated information.  */
 859 +  if (TYPE_ASSOCIATED_PROP (type) != NULL)
 860 +    {
 861 +      TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
 862 +      *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type);
 863 +    }
 864 +
 865    /* Copy pointers to other types.  */
 866    if (TYPE_TARGET_TYPE (type))
 867      TYPE_TARGET_TYPE (new_type) =
 868 @@ -4494,6 +4591,35 @@ copy_type_recursive (struct objfile *obj
 869        gdb_assert_not_reached ("bad type_specific_kind");
 870      }
 871
 872 +  if (TYPE_ALLOCATED_PROP (type))
 873 +    {
 874 +      TYPE_ALLOCATED_PROP (new_type)
 875 +              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
 876 +                                struct dynamic_prop);
 877 +      memcpy (TYPE_ALLOCATED_PROP (new_type), TYPE_ALLOCATED_PROP (type),
 878 +        sizeof (struct dynamic_prop));
 879 +    }
 880 +
 881 +  if (TYPE_ASSOCIATED_PROP (type))
 882 +    {
 883 +      TYPE_ASSOCIATED_PROP (new_type)
 884 +              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
 885 +                                struct dynamic_prop);
 886 +      memcpy (TYPE_ASSOCIATED_PROP (new_type), TYPE_ASSOCIATED_PROP (type),
 887 +        sizeof (struct dynamic_prop));
 888 +    }
 889 +
 890 +  if (TYPE_NFIELDS (type))
 891 +    {
 892 +      int nfields = TYPE_NFIELDS (type);
 893 +
 894 +      TYPE_FIELDS (new_type)
 895 +              = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
 896 +                                nfields, struct field);
 897 +      memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type),
 898 +        nfields * sizeof (struct field));
 899 +   }
 900 +
 901    return new_type;
 902  }
 903
 904 @@ -4519,6 +4645,14 @@ copy_type (const struct type *type)
 905      TYPE_DYN_PROP_LIST (new_type)
 906        = copy_dynamic_prop_list (&TYPE_OBJFILE (type) -> objfile_obstack,
 907                                 TYPE_DYN_PROP_LIST (type));
 908 +  if (TYPE_ALLOCATED_PROP (type) != NULL)
 909 +    TYPE_ALLOCATED_PROP (new_type) = obstack_copy
 910 +      (&TYPE_OBJFILE (type)->objfile_obstack, TYPE_ALLOCATED_PROP (type),
 911 +       sizeof (*TYPE_ALLOCATED_PROP (type)));
 912 +  if (TYPE_ASSOCIATED_PROP (type) != NULL)
 913 +    TYPE_ASSOCIATED_PROP (new_type) = obstack_copy
 914 +      (&TYPE_OBJFILE (type)->objfile_obstack, TYPE_ASSOCIATED_PROP (type),
 915 +       sizeof (*TYPE_ASSOCIATED_PROP (type)));
 916
 917    return new_type;
 918  }
 919 Index: gdb-7.9.50.20150520/gdb/gdbtypes.h
 920 ===================================================================
 921 --- gdb-7.9.50.20150520.orig/gdb/gdbtypes.h     2015-05-29 08:27:02.685717504 +0200
 922 +++ gdb-7.9.50.20150520/gdb/gdbtypes.h  2015-05-29 08:46:08.862924052 +0200
 923 @@ -569,6 +569,10 @@ struct range_bounds
 924
 925    struct dynamic_prop high;
 926
 927 +  /* * Stride of range.  */
 928 +
 929 +  struct dynamic_prop stride;
 930 +
 931    /* True if HIGH range bound contains the number of elements in the
 932       subrange. This affects how the final hight bound is computed.  */
 933
 934 @@ -741,6 +745,18 @@ struct main_type
 935
 936    /* * Contains all dynamic type properties.  */
 937    struct dynamic_prop_list *dyn_prop_list;
 938 +
 939 +  /* Structure for DW_AT_allocated.
 940 +     The presence of this attribute indicates that the object of the type
 941 +     can be allocated/deallocated.  The value can be a dwarf expression,
 942 +     reference, or a constant.  */
 943 +  struct dynamic_prop *allocated;
 944 +
 945 +  /* Structure for DW_AT_associated.
 946 +     The presence of this attribute indicated that the object of the type
 947 +     can be associated.  The value can be a dwarf expression,
 948 +     reference, or a constant.  */
 949 +  struct dynamic_prop *associated;
 950  };
 951
 952  /* * A ``struct type'' describes a particular instance of a type, with
 953 @@ -1255,6 +1271,15 @@ extern void allocate_gnat_aux_type (stru
 954    TYPE_RANGE_DATA(range_type)->high.kind
 955  #define TYPE_LOW_BOUND_KIND(range_type) \
 956    TYPE_RANGE_DATA(range_type)->low.kind
 957 +#define TYPE_BYTE_STRIDE(range_type) \
 958 +  TYPE_RANGE_DATA(range_type)->stride.data.const_val
 959 +#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
 960 +  TYPE_RANGE_DATA(range_type)->stride.data.locexpr
 961 +#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
 962 +  TYPE_RANGE_DATA(range_type)->stride.data.loclist
 963 +#define TYPE_BYTE_STRIDE_KIND(range_type) \
 964 +  TYPE_RANGE_DATA(range_type)->stride.kind
 965 +
 966
 967  /* Property accessors for the type data location.  */
 968  #define TYPE_DATA_LOCATION(thistype) \
 969 @@ -1265,6 +1290,20 @@ extern void allocate_gnat_aux_type (stru
 970    TYPE_DATA_LOCATION (thistype)->data.const_val
 971  #define TYPE_DATA_LOCATION_KIND(thistype) \
 972    TYPE_DATA_LOCATION (thistype)->kind
 973 +#define TYPE_ALLOCATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->allocated
 974 +#define TYPE_ASSOCIATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->associated
 975 +
 976 +/* Allocated status of type object.  If set to non-zero it means the object
 977 +   is allocated. A zero value means it is not allocated.  */
 978 +#define TYPE_NOT_ALLOCATED(t)  (TYPE_ALLOCATED_PROP (t) \
 979 +  && TYPE_ALLOCATED_PROP (t)->kind == PROP_CONST \
 980 +  && !TYPE_ALLOCATED_PROP (t)->data.const_val)
 981 +
 982 +/* Associated status of type object.  If set to non-zero it means the object
 983 +   is associated. A zero value means it is not associated.  */
 984 +#define TYPE_NOT_ASSOCIATED(t)  (TYPE_ASSOCIATED_PROP (t) \
 985 +  && TYPE_ASSOCIATED_PROP (t)->kind == PROP_CONST \
 986 +  && !TYPE_ASSOCIATED_PROP (t)->data.const_val)
 987
 988  /* Attribute accessors for dynamic properties.  */
 989  #define TYPE_DYN_PROP_LIST(thistype) \
 990 @@ -1283,6 +1322,9 @@ extern void allocate_gnat_aux_type (stru
 991     TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
 992  #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
 993     TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
 994 +#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
 995 +   (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
 996 +
 997
 998  #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
 999     (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
1000 @@ -1764,6 +1806,7 @@ extern struct type *create_array_type_wi
1001
1002  extern struct type *create_range_type (struct type *, struct type *,
1003                                        const struct dynamic_prop *,
1004 +                                      const struct dynamic_prop *,
1005                                        const struct dynamic_prop *);
1006
1007  extern struct type *create_array_type (struct type *, struct type *,
1008 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp
1009 ===================================================================
1010 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1011 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp   2015-05-29 08:27:06.266740292 +0200
1012 @@ -0,0 +1,65 @@
1013 +# Copyright 2014 Free Software Foundation, Inc.
1014 +
1015 +# This program is free software; you can redistribute it and/or modify
1016 +# it under the terms of the GNU General Public License as published by
1017 +# the Free Software Foundation; either version 3 of the License, or
1018 +# (at your option) any later version.
1019 +#
1020 +# This program is distributed in the hope that it will be useful,
1021 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1022 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1023 +# GNU General Public License for more details.
1024 +#
1025 +# You should have received a copy of the GNU General Public License
1026 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1027 +
1028 +standard_testfile "vla.f90"
1029 +
1030 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1031 +    {debug f90 quiet}] } {
1032 +    return -1
1033 +}
1034 +
1035 +if ![runto MAIN__] then {
1036 +    perror "couldn't run to breakpoint MAIN__"
1037 +    continue
1038 +}
1039 +
1040 +# Check the association status of various types of VLA's
1041 +# and pointer to VLA's.
1042 +gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
1043 +gdb_continue_to_breakpoint "vla1-allocated"
1044 +gdb_test "print l" " = \\.TRUE\\." \
1045 +  "print vla1 allocation status (allocated)"
1046 +
1047 +gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
1048 +gdb_continue_to_breakpoint "vla2-allocated"
1049 +gdb_test "print l" " = \\.TRUE\\." \
1050 +  "print vla2 allocation status (allocated)"
1051 +
1052 +gdb_breakpoint [gdb_get_line_number "pvla-associated"]
1053 +gdb_continue_to_breakpoint "pvla-associated"
1054 +gdb_test "print l" " = \\.TRUE\\." \
1055 +  "print pvla associated status (associated)"
1056 +
1057 +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
1058 +gdb_continue_to_breakpoint "pvla-re-associated"
1059 +gdb_test "print l" " = \\.TRUE\\." \
1060 +  "print pvla associated status (re-associated)"
1061 +
1062 +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
1063 +gdb_continue_to_breakpoint "pvla-deassociated"
1064 +gdb_test "print l" " = \\.FALSE\\." \
1065 +  "print pvla allocation status (deassociated)"
1066 +
1067 +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
1068 +gdb_continue_to_breakpoint "vla1-deallocated"
1069 +gdb_test "print l" " = \\.FALSE\\." \
1070 +  "print vla1 allocation status (deallocated)"
1071 +gdb_test "print vla1" " = <not allocated>" \
1072 +  "print deallocated vla1"
1073 +
1074 +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
1075 +gdb_continue_to_breakpoint "vla2-deallocated"
1076 +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated"
1077 +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2"
1078 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-datatypes.exp
1079 ===================================================================
1080 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1081 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-datatypes.exp     2015-05-29 08:27:06.266740292 +0200
1082 @@ -0,0 +1,82 @@
1083 +# Copyright 2014 Free Software Foundation, Inc.
1084 +
1085 +# This program is free software; you can redistribute it and/or modify
1086 +# it under the terms of the GNU General Public License as published by
1087 +# the Free Software Foundation; either version 3 of the License, or
1088 +# (at your option) any later version.
1089 +#
1090 +# This program is distributed in the hope that it will be useful,
1091 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1092 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1093 +# GNU General Public License for more details.
1094 +#
1095 +# You should have received a copy of the GNU General Public License
1096 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1097 +
1098 +standard_testfile ".f90"
1099 +
1100 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1101 +    {debug f90 quiet}] } {
1102 +    return -1
1103 +}
1104 +
1105 +# check that all fortran standard datatypes will be
1106 +# handled correctly when using as VLA's
1107 +
1108 +if ![runto MAIN__] then {
1109 +    perror "couldn't run to breakpoint MAIN__"
1110 +    continue
1111 +}
1112 +
1113 +gdb_breakpoint [gdb_get_line_number "vlas-allocated"]
1114 +gdb_continue_to_breakpoint "vlas-allocated"
1115 +gdb_test "next" " = allocated\\\(realvla\\\)" \
1116 +  "next to allocation status of intvla"
1117 +gdb_test "print l" " = \\.TRUE\\." "intvla allocated"
1118 +gdb_test "next" " = allocated\\\(complexvla\\\)" \
1119 +  "next to allocation status of realvla"
1120 +gdb_test "print l" " = \\.TRUE\\." "realvla allocated"
1121 +gdb_test "next" " = allocated\\\(logicalvla\\\)" \
1122 +  "next to allocation status of complexvla"
1123 +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated"
1124 +gdb_test "next" " = allocated\\\(charactervla\\\)" \
1125 +  "next to allocation status of logicalvla"
1126 +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated"
1127 +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \
1128 +  "next to allocation status of charactervla"
1129 +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated"
1130 +
1131 +gdb_breakpoint [gdb_get_line_number "vlas-initialized"]
1132 +gdb_continue_to_breakpoint "vlas-initialized"
1133 +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \
1134 +  "ptype intvla"
1135 +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \
1136 +  "ptype realvla"
1137 +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \
1138 +  "ptype complexvla"
1139 +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \
1140 +  "ptype logicalvla"
1141 +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \
1142 +  "ptype charactervla"
1143 +
1144 +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)"
1145 +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \
1146 +  "print realvla(5,5,5) (1st)"
1147 +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \
1148 +  "print complexvla(5,5,5) (1st)"
1149 +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \
1150 +  "print logicalvla(5,5,5) (1st)"
1151 +gdb_test "print charactervla(5,5,5)" " = 'K'" \
1152 +  "print charactervla(5,5,5) (1st)"
1153 +
1154 +gdb_breakpoint [gdb_get_line_number "vlas-modified"]
1155 +gdb_continue_to_breakpoint "vlas-modified"
1156 +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)"
1157 +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \
1158 +  "print realvla(5,5,5) (2nd)"
1159 +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \
1160 +  "print complexvla(5,5,5) (2nd)"
1161 +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \
1162 +  "print logicalvla(5,5,5) (2nd)"
1163 +gdb_test "print charactervla(5,5,5)" " = 'X'" \
1164 +  "print charactervla(5,5,5) (2nd)"
1165 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-datatypes.f90
1166 ===================================================================
1167 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1168 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-datatypes.f90     2015-05-29 08:27:06.266740292 +0200
1169 @@ -0,0 +1,51 @@
1170 +! Copyright 2014 Free Software Foundation, Inc.
1171 +!
1172 +! This program is free software; you can redistribute it and/or modify
1173 +! it under the terms of the GNU General Public License as published by
1174 +! the Free Software Foundation; either version 2 of the License, or
1175 +! (at your option) any later version.
1176 +!
1177 +! This program is distributed in the hope that it will be useful,
1178 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1179 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1180 +! GNU General Public License for more details.
1181 +!
1182 +! You should have received a copy of the GNU General Public License
1183 +! along with this program; if not, write to the Free Software
1184 +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1185 +
1186 +program vla_primitives
1187 +  integer, allocatable    :: intvla(:, :, :)
1188 +  real, allocatable       :: realvla(:, :, :)
1189 +  complex, allocatable    :: complexvla(:, :, :)
1190 +  logical, allocatable    :: logicalvla(:, :, :)
1191 +  character, allocatable  :: charactervla(:, :, :)
1192 +  logical                 :: l
1193 +
1194 +  allocate (intvla (11,22,33))
1195 +  allocate (realvla (11,22,33))
1196 +  allocate (complexvla (11,22,33))
1197 +  allocate (logicalvla (11,22,33))
1198 +  allocate (charactervla (11,22,33))
1199 +
1200 +  l = allocated(intvla)                   ! vlas-allocated
1201 +  l = allocated(realvla)
1202 +  l = allocated(complexvla)
1203 +  l = allocated(logicalvla)
1204 +  l = allocated(charactervla)
1205 +
1206 +  intvla(:,:,:) = 1
1207 +  realvla(:,:,:) = 3.14
1208 +  complexvla(:,:,:) = cmplx(2.0,-3.0)
1209 +  logicalvla(:,:,:) = .TRUE.
1210 +  charactervla(:,:,:) = char(75)
1211 +
1212 +  intvla(5,5,5) = 42                      ! vlas-initialized
1213 +  realvla(5,5,5) = 4.13
1214 +  complexvla(5,5,5) = cmplx(-3.0,2.0)
1215 +  logicalvla(5,5,5) = .FALSE.
1216 +  charactervla(5,5,5) = 'X'
1217 +
1218 +  ! dummy statement for bp
1219 +  l = .FALSE.                             ! vlas-modified
1220 +end program vla_primitives
1221 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-func.exp
1222 ===================================================================
1223 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1224 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-func.exp  2015-05-29 08:27:06.266740292 +0200
1225 @@ -0,0 +1,61 @@
1226 +# Copyright 2014 Free Software Foundation, Inc.
1227 +
1228 +# This program is free software; you can redistribute it and/or modify
1229 +# it under the terms of the GNU General Public License as published by
1230 +# the Free Software Foundation; either version 3 of the License, or
1231 +# (at your option) any later version.
1232 +#
1233 +# This program is distributed in the hope that it will be useful,
1234 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1235 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1236 +# GNU General Public License for more details.
1237 +#
1238 +# You should have received a copy of the GNU General Public License
1239 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1240 +
1241 +standard_testfile ".f90"
1242 +
1243 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1244 +    {debug f90 quiet}] } {
1245 +    return -1
1246 +}
1247 +
1248 +if ![runto MAIN__] then {
1249 +    perror "couldn't run to breakpoint MAIN__"
1250 +    continue
1251 +}
1252 +
1253 +# Check VLA passed to first Fortran function.
1254 +gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]
1255 +gdb_continue_to_breakpoint "func1-vla-passed"
1256 +gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \
1257 +  "print vla (func1)"
1258 +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \
1259 +  "ptype vla (func1)"
1260 +
1261 +gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]
1262 +gdb_continue_to_breakpoint "func1-vla-modified"
1263 +gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"
1264 +gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"
1265 +
1266 +# Check if the values are correct after returning from func1
1267 +gdb_breakpoint [gdb_get_line_number "func1-returned"]
1268 +gdb_continue_to_breakpoint "func1-returned"
1269 +gdb_test "print ret" " = .TRUE." "print ret after func1 returned"
1270 +
1271 +# Check VLA passed to second Fortran function
1272 +gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]
1273 +gdb_continue_to_breakpoint "func2-vla-passed"
1274 +gdb_test "print vla" \
1275 +  " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \
1276 +  "print vla (func2)"
1277 +gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
1278 +  "ptype vla (func2)"
1279 +
1280 +# Check if the returned VLA has the correct values and ptype.
1281 +gdb_breakpoint [gdb_get_line_number "func2-returned"]
1282 +gdb_continue_to_breakpoint "func2-returned"
1283 +gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \
1284 +  "print vla3 (after func2)"
1285 +gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
1286 +  "ptype vla3 (after func2)"
1287 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-func.f90
1288 ===================================================================
1289 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1290 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-func.f90  2015-05-29 08:27:06.267740298 +0200
1291 @@ -0,0 +1,71 @@
1292 +! Copyright 2014 Free Software Foundation, Inc.
1293 +!
1294 +! This program is free software; you can redistribute it and/or modify
1295 +! it under the terms of the GNU General Public License as published by
1296 +! the Free Software Foundation; either version 2 of the License, or
1297 +! (at your option) any later version.
1298 +!
1299 +! This program is distributed in the hope that it will be useful,
1300 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1301 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1302 +! GNU General Public License for more details.
1303 +!
1304 +! You should have received a copy of the GNU General Public License
1305 +! along with this program; if not, write to the Free Software
1306 +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1307 +
1308 +logical function func1 (vla)
1309 +  implicit none
1310 +  integer, allocatable :: vla (:, :)
1311 +  func1 = allocated(vla)
1312 +  vla(5,5) = 55               ! func1-vla-passed
1313 +  vla(7,7) = 77
1314 +  return                      ! func1-vla-modified
1315 +end function func1
1316 +
1317 +function func2(vla)
1318 +  implicit none
1319 +  integer :: vla (:)
1320 +  integer :: func2(size(vla))
1321 +  integer :: k
1322 +
1323 +  vla(1) = 1                    ! func2-vla-passed
1324 +  vla(2) = 2
1325 +  vla(4) = 4
1326 +  vla(8) = 8
1327 +
1328 +  func2 = vla
1329 +end function func2
1330 +
1331 +program vla_func
1332 +  implicit none
1333 +  interface
1334 +    logical function func1 (vla)
1335 +      integer :: vla (:, :)
1336 +    end function
1337 +  end interface
1338 +  interface
1339 +    function func2 (vla)
1340 +      integer :: vla (:)
1341 +      integer func2(size(vla))
1342 +    end function
1343 +  end interface
1344 +
1345 +  logical :: ret
1346 +  integer, allocatable :: vla1 (:, :)
1347 +  integer, allocatable :: vla2 (:)
1348 +  integer, allocatable :: vla3 (:)
1349 +
1350 +  ret = .FALSE.
1351 +
1352 +  allocate (vla1 (10,10))
1353 +  vla1(:,:) = 22
1354 +
1355 +  allocate (vla2 (10))
1356 +  vla2(:) = 44
1357 +
1358 +  ret = func1(vla1)
1359 +  vla3 = func2(vla2)          ! func1-returned
1360 +
1361 +  ret = .TRUE.                ! func2-returned
1362 +end program vla_func
1363 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-history.exp
1364 ===================================================================
1365 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1366 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-history.exp       2015-05-29 08:27:06.267740298 +0200
1367 @@ -0,0 +1,62 @@
1368 +# Copyright 2014 Free Software Foundation, Inc.
1369 +
1370 +# This program is free software; you can redistribute it and/or modify
1371 +# it under the terms of the GNU General Public License as published by
1372 +# the Free Software Foundation; either version 3 of the License, or
1373 +# (at your option) any later version.
1374 +#
1375 +# This program is distributed in the hope that it will be useful,
1376 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1377 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1378 +# GNU General Public License for more details.
1379 +#
1380 +# You should have received a copy of the GNU General Public License
1381 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1382 +
1383 +standard_testfile "vla.f90"
1384 +
1385 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1386 +    {debug f90 quiet}] } {
1387 +    return -1
1388 +}
1389 +
1390 +if ![runto MAIN__] then {
1391 +    perror "couldn't run to breakpoint MAIN__"
1392 +    continue
1393 +}
1394 +
1395 +# Set some breakpoints and print complete vla.
1396 +gdb_breakpoint [gdb_get_line_number "vla1-init"]
1397 +gdb_continue_to_breakpoint "vla1-init"
1398 +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
1399 +
1400 +gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
1401 +gdb_continue_to_breakpoint "vla2-allocated"
1402 +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
1403 +  "print vla1 allocated"
1404 +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
1405 +  "print vla2 allocated"
1406 +
1407 +gdb_breakpoint [gdb_get_line_number "vla1-filled"]
1408 +gdb_continue_to_breakpoint "vla1-filled"
1409 +gdb_test "print vla1" \
1410 +  " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \
1411 +  "print vla1 filled"
1412 +
1413 +# Try to access history values for full vla prints.
1414 +gdb_test "print \$1" " = <not allocated>" "print \$1"
1415 +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
1416 +  "print \$2"
1417 +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
1418 +  "print \$3"
1419 +gdb_test "print \$4" \
1420 +  " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4"
1421 +
1422 +gdb_breakpoint [gdb_get_line_number "vla2-filled"]
1423 +gdb_continue_to_breakpoint "vla2-filled"
1424 +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)"
1425 +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)"
1426 +
1427 +# Try to access history values for vla values.
1428 +gdb_test "print \$9" " = 1311" "print \$9"
1429 +gdb_test "print \$10" " = 1001" "print \$10"
1430 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp
1431 ===================================================================
1432 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1433 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp     2015-05-29 08:27:06.267740298 +0200
1434 @@ -0,0 +1,87 @@
1435 +# Copyright 2014 Free Software Foundation, Inc.
1436 +
1437 +# This program is free software; you can redistribute it and/or modify
1438 +# it under the terms of the GNU General Public License as published by
1439 +# the Free Software Foundation; either version 3 of the License, or
1440 +# (at your option) any later version.
1441 +#
1442 +# This program is distributed in the hope that it will be useful,
1443 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1444 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1445 +# GNU General Public License for more details.
1446 +#
1447 +# You should have received a copy of the GNU General Public License
1448 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1449 +
1450 +standard_testfile "vla-sub.f90"
1451 +
1452 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1453 +    {debug f90 quiet}] } {
1454 +    return -1
1455 +}
1456 +
1457 +if ![runto MAIN__] then {
1458 +    perror "couldn't run to breakpoint MAIN__"
1459 +    continue
1460 +}
1461 +
1462 +# Pass fixed array to function and handle them as vla in function.
1463 +gdb_breakpoint [gdb_get_line_number "not-filled"]
1464 +gdb_continue_to_breakpoint "not-filled (1st)"
1465 +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \
1466 +  "ptype array1 (passed fixed)"
1467 +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \
1468 +  "ptype array2 (passed fixed)"
1469 +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \
1470 +  "ptype array1(40, 10) (passed fixed)"
1471 +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \
1472 +  "ptype array2(13, 11, 5) (passed fixed)"
1473 +
1474 +# Pass sub arrays to function and handle them as vla in function.
1475 +gdb_continue_to_breakpoint "not-filled (2nd)"
1476 +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \
1477 +  "ptype array1 (passed sub-array)"
1478 +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \
1479 +  "ptype array2 (passed sub-array)"
1480 +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \
1481 +  "ptype array1(3, 3) (passed sub-array)"
1482 +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \
1483 +  "ptype array2(4, 4, 4) (passed sub-array)"
1484 +
1485 +# Check ptype outside of bounds. This should not crash GDB.
1486 +gdb_test "ptype array1(100, 100)" "no such vector element" \
1487 +  "ptype array1(100, 100) subarray do not crash (passed sub-array)"
1488 +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
1489 +  "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)"
1490 +
1491 +# Pass vla to function.
1492 +gdb_continue_to_breakpoint "not-filled (3rd)"
1493 +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \
1494 +  "ptype array1 (passed vla)"
1495 +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
1496 +  "ptype array2 (passed vla)"
1497 +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \
1498 +  "ptype array1(3, 3) (passed vla)"
1499 +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \
1500 +  "ptype array2(4, 4, 4) (passed vla)"
1501 +
1502 +# Check ptype outside of bounds. This should not crash GDB.
1503 +gdb_test "ptype array1(100, 100)" "no such vector element" \
1504 +  "ptype array1(100, 100) VLA do not crash (passed vla)"
1505 +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
1506 +  "ptype array2(100, 100, 100) VLA do not crash (passed vla)"
1507 +
1508 +# Pass fixed array to function and handle it as VLA of arbitrary length in
1509 +# function.
1510 +gdb_breakpoint [gdb_get_line_number "end-of-bar"]
1511 +gdb_continue_to_breakpoint "end-of-bar"
1512 +gdb_test "ptype array1" \
1513 +  "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \
1514 +  "ptype array1 (arbitrary length)"
1515 +gdb_test "ptype array2" \
1516 +  "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \
1517 +  "ptype array2 (arbitrary length)"
1518 +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \
1519 +  "ptype array1(100) (arbitrary length)"
1520 +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \
1521 +  "ptype array2(4,100) (arbitrary length)"
1522 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-ptype.exp
1523 ===================================================================
1524 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1525 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-ptype.exp 2015-05-29 08:27:06.267740298 +0200
1526 @@ -0,0 +1,96 @@
1527 +# Copyright 2014 Free Software Foundation, Inc.
1528 +
1529 +# This program is free software; you can redistribute it and/or modify
1530 +# it under the terms of the GNU General Public License as published by
1531 +# the Free Software Foundation; either version 3 of the License, or
1532 +# (at your option) any later version.
1533 +#
1534 +# This program is distributed in the hope that it will be useful,
1535 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1536 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1537 +# GNU General Public License for more details.
1538 +#
1539 +# You should have received a copy of the GNU General Public License
1540 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1541 +
1542 +standard_testfile "vla.f90"
1543 +
1544 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1545 +    {debug f90 quiet}] } {
1546 +    return -1
1547 +}
1548 +
1549 +if ![runto MAIN__] then {
1550 +    perror "couldn't run to breakpoint MAIN__"
1551 +    continue
1552 +}
1553 +
1554 +# Check the ptype of various VLA states and pointer to VLA's.
1555 +gdb_breakpoint [gdb_get_line_number "vla1-init"]
1556 +gdb_continue_to_breakpoint "vla1-init"
1557 +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized"
1558 +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
1559 +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
1560 +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
1561 +  "ptype vla1(3, 6, 9) not initialized"
1562 +gdb_test "ptype vla2(5, 45, 20)" \
1563 +  "no such vector element because not allocated" \
1564 +  "ptype vla1(5, 45, 20) not initialized"
1565 +
1566 +gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
1567 +gdb_continue_to_breakpoint "vla1-allocated"
1568 +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
1569 +  "ptype vla1 allocated"
1570 +
1571 +gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
1572 +gdb_continue_to_breakpoint "vla2-allocated"
1573 +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
1574 +  "ptype vla2 allocated"
1575 +
1576 +gdb_breakpoint [gdb_get_line_number "vla1-filled"]
1577 +gdb_continue_to_breakpoint "vla1-filled"
1578 +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
1579 +  "ptype vla1 filled"
1580 +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \
1581 +  "ptype vla1(3, 6, 9)"
1582 +
1583 +gdb_breakpoint [gdb_get_line_number "vla2-filled"]
1584 +gdb_continue_to_breakpoint "vla2-filled"
1585 +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
1586 +  "ptype vla2 filled"
1587 +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \
1588 +  "ptype vla1(5, 45, 20) filled"
1589 +
1590 +gdb_breakpoint [gdb_get_line_number "pvla-associated"]
1591 +gdb_continue_to_breakpoint "pvla-associated"
1592 +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
1593 +  "ptype pvla associated"
1594 +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \
1595 +  "ptype pvla(3, 6, 9)"
1596 +
1597 +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
1598 +gdb_continue_to_breakpoint "pvla-re-associated"
1599 +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
1600 +  "ptype pvla re-associated"
1601 +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \
1602 +  "ptype vla1(5, 45, 20) re-associated"
1603 +
1604 +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
1605 +gdb_continue_to_breakpoint "pvla-deassociated"
1606 +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
1607 +gdb_test "ptype pvla(5, 45, 20)" \
1608 +  "no such vector element because not associated" \
1609 +  "ptype pvla(5, 45, 20) not associated"
1610 +
1611 +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
1612 +gdb_continue_to_breakpoint "vla1-deallocated"
1613 +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
1614 +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
1615 +  "ptype vla1(3, 6, 9) not allocated"
1616 +
1617 +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
1618 +gdb_continue_to_breakpoint "vla2-deallocated"
1619 +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
1620 +gdb_test "ptype vla2(5, 45, 20)" \
1621 +  "no such vector element because not allocated" \
1622 +  "ptype vla2(5, 45, 20) not allocated"
1623 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-sizeof.exp
1624 ===================================================================
1625 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1626 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-sizeof.exp        2015-05-29 08:27:06.267740298 +0200
1627 @@ -0,0 +1,46 @@
1628 +# Copyright 2014 Free Software Foundation, Inc.
1629 +
1630 +# This program is free software; you can redistribute it and/or modify
1631 +# it under the terms of the GNU General Public License as published by
1632 +# the Free Software Foundation; either version 3 of the License, or
1633 +# (at your option) any later version.
1634 +#
1635 +# This program is distributed in the hope that it will be useful,
1636 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1637 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1638 +# GNU General Public License for more details.
1639 +#
1640 +# You should have received a copy of the GNU General Public License
1641 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1642 +
1643 +standard_testfile "vla.f90"
1644 +
1645 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1646 +    {debug f90 quiet}] } {
1647 +    return -1
1648 +}
1649 +
1650 +if ![runto MAIN__] then {
1651 +    perror "couldn't run to breakpoint MAIN__"
1652 +    continue
1653 +}
1654 +
1655 +# Try to access values in non allocated VLA
1656 +gdb_breakpoint [gdb_get_line_number "vla1-init"]
1657 +gdb_continue_to_breakpoint "vla1-init"
1658 +gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
1659 +
1660 +# Try to access value in allocated VLA
1661 +gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
1662 +gdb_continue_to_breakpoint "vla2-allocated"
1663 +gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
1664 +
1665 +# Try to access values in undefined pointer to VLA (dangling)
1666 +gdb_breakpoint [gdb_get_line_number "vla1-filled"]
1667 +gdb_continue_to_breakpoint "vla1-filled"
1668 +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
1669 +
1670 +# Try to access values in pointer to VLA and compare them
1671 +gdb_breakpoint [gdb_get_line_number "pvla-associated"]
1672 +gdb_continue_to_breakpoint "pvla-associated"
1673 +gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
1674 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-stride.exp
1675 ===================================================================
1676 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1677 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-stride.exp        2015-05-29 08:27:06.267740298 +0200
1678 @@ -0,0 +1,44 @@
1679 +# Copyright 2014 Free Software Foundation, Inc.
1680 +
1681 +# This program is free software; you can redistribute it and/or modify
1682 +# it under the terms of the GNU General Public License as published by
1683 +# the Free Software Foundation; either version 3 of the License, or
1684 +# (at your option) any later version.
1685 +#
1686 +# This program is distributed in the hope that it will be useful,
1687 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1688 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1689 +# GNU General Public License for more details.
1690 +#
1691 +# You should have received a copy of the GNU General Public License
1692 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1693 +
1694 +standard_testfile ".f90"
1695 +
1696 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1697 +    {debug f90 quiet}] } {
1698 +    return -1
1699 +}
1700 +
1701 +if ![runto MAIN__] then {
1702 +    perror "couldn't run to breakpoint MAIN__"
1703 +    continue
1704 +}
1705 +
1706 +gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
1707 +gdb_continue_to_breakpoint "re-reverse-elements"
1708 +gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
1709 +  "print re-reverse-elements"
1710 +gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
1711 +gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
1712 +
1713 +gdb_breakpoint [gdb_get_line_number "odd-elements"]
1714 +gdb_continue_to_breakpoint "odd-elements"
1715 +gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
1716 +gdb_test "print pvla(1)" " = 1" "print first odd-element"
1717 +gdb_test "print pvla(5)" " = 9" "print last odd-element"
1718 +
1719 +gdb_breakpoint [gdb_get_line_number "single-element"]
1720 +gdb_continue_to_breakpoint "single-element"
1721 +gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
1722 +gdb_test "print pvla(1)" " = 5" "print one single-element"
1723 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-stride.f90
1724 ===================================================================
1725 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1726 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-stride.f90        2015-05-29 08:27:06.268740305 +0200
1727 @@ -0,0 +1,30 @@
1728 +! Copyright 2014 Free Software Foundation, Inc.
1729 +!
1730 +! This program is free software; you can redistribute it and/or modify
1731 +! it under the terms of the GNU General Public License as published by
1732 +! the Free Software Foundation; either version 2 of the License, or
1733 +! (at your option) any later version.
1734 +!
1735 +! This program is distributed in the hope that it will be useful,
1736 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1737 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1738 +! GNU General Public License for more details.
1739 +!
1740 +! You should have received a copy of the GNU General Public License
1741 +! along with this program; if not, write to the Free Software
1742 +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1743 +
1744 +program vla_stride
1745 +  integer, target, allocatable :: vla (:)
1746 +  integer, pointer :: pvla (:)
1747 +
1748 +  allocate(vla(10))
1749 +  vla = (/ (I, I = 1,10) /)
1750 +
1751 +  pvla => vla(10:1:-1)
1752 +  pvla => pvla(10:1:-1)
1753 +  pvla => vla(1:10:2)   ! re-reverse-elements
1754 +  pvla => vla(5:4:-2)   ! odd-elements
1755 +
1756 +  pvla => null()        ! single-element
1757 +end program vla_stride
1758 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-strings.exp
1759 ===================================================================
1760 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1761 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-strings.exp       2015-05-29 08:27:06.268740305 +0200
1762 @@ -0,0 +1,104 @@
1763 +# Copyright 2014 Free Software Foundation, Inc.
1764 +
1765 +# This program is free software; you can redistribute it and/or modify
1766 +# it under the terms of the GNU General Public License as published by
1767 +# the Free Software Foundation; either version 3 of the License, or
1768 +# (at your option) any later version.
1769 +#
1770 +# This program is distributed in the hope that it will be useful,
1771 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
1772 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1773 +# GNU General Public License for more details.
1774 +#
1775 +# You should have received a copy of the GNU General Public License
1776 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
1777 +
1778 +standard_testfile ".f90"
1779 +
1780 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
1781 +    {debug f90 quiet}] } {
1782 +    return -1
1783 +}
1784 +
1785 +# check that all fortran standard datatypes will be
1786 +# handled correctly when using as VLA's
1787 +
1788 +if ![runto MAIN__] then {
1789 +    perror "couldn't run to breakpoint MAIN__"
1790 +    continue
1791 +}
1792 +
1793 +gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
1794 +gdb_continue_to_breakpoint "var_char-allocated-1"
1795 +gdb_test "print var_char" \
1796 +  " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \
1797 +  "print var_char after allocated first time"
1798 +gdb_test "print *var_char" \
1799 +  " = '\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000'" \
1800 +  "print *var_char after allocated first time"
1801 +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10 \\)" \
1802 +  "whatis var_char first time"
1803 +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10 \\)" \
1804 +  "ptype var_char first time"
1805 +gdb_test "next" "\\d+.*var_char = 'foo'.*" \
1806 +  "next to allocation status of var_char"
1807 +gdb_test "print l" " = .TRUE." "print allocation status first time"
1808 +
1809 +gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
1810 +gdb_continue_to_breakpoint "var_char-filled-1"
1811 +gdb_test "print var_char" \
1812 +  " = \\(PTR TO -> \\( character\\*3 \\)\\) ${hex}" \
1813 +  "print var_char after filled first time"
1814 +gdb_test "print *var_char" " = 'foo'" \
1815 +  "print *var_char after filled first time"
1816 +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3 \\)" \
1817 +  "whatis var_char after filled first time"
1818 +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3 \\)" \
1819 +  "ptype var_char after filled first time"
1820 +gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
1821 +gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
1822 +
1823 +gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
1824 +gdb_continue_to_breakpoint "var_char-filled-2"
1825 +gdb_test "print var_char" \
1826 +  " = \\(PTR TO -> \\( character\\*6 \\)\\) ${hex}" \
1827 +  "print var_char after allocated second time"
1828 +gdb_test "print *var_char" " = 'foobar'" \
1829 +  "print *var_char after allocated second time"
1830 +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6 \\)" \
1831 +  "whatis var_char second time"
1832 +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6 \\)" \
1833 +  "ptype var_char second time"
1834 +
1835 +gdb_breakpoint [gdb_get_line_number "var_char-empty"]
1836 +gdb_continue_to_breakpoint "var_char-empty"
1837 +gdb_test "print var_char" \
1838 +  " = \\(PTR TO -> \\( character\\*0 \\)\\) ${hex}" \
1839 +  "print var_char after set empty"
1840 +gdb_test "print *var_char" " = \"\"" "print *var_char after set empty"
1841 +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0 \\)" \
1842 +  "whatis var_char after set empty"
1843 +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0 \\)" \
1844 +  "ptype var_char after set empty"
1845 +
1846 +gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"]
1847 +gdb_continue_to_breakpoint "var_char-allocated-3"
1848 +gdb_test "print var_char" \
1849 +  " = \\(PTR TO -> \\( character\\*21 \\)\\) ${hex}" \
1850 +  "print var_char after allocated third time"
1851 +gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21 \\)" \
1852 +  "whatis var_char after allocated third time"
1853 +gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21 \\)" \
1854 +  "ptype var_char after allocated third time"
1855 +
1856 +gdb_breakpoint [gdb_get_line_number "var_char_p-associated"]
1857 +gdb_continue_to_breakpoint "var_char_p-associated"
1858 +gdb_test "print var_char_p" \
1859 +  " = \\(PTR TO -> \\( character\\*7 \\)\\) ${hex}" \
1860 +  "print var_char_p after associated"
1861 +gdb_test "print *var_char_p" " = 'johndoe'" \
1862 +  "print *var_char_ after associated"
1863 +gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
1864 +  "whatis var_char_p after associated"
1865 +gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
1866 +  "ptype var_char_p after associated"
1867 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-strings.f90
1868 ===================================================================
1869 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1870 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-strings.f90       2015-05-31 15:25:01.305615755 +0200
1871 @@ -0,0 +1,40 @@
1872 +! Copyright 2014 Free Software Foundation, Inc.
1873 +!
1874 +! This program is free software; you can redistribute it and/or modify
1875 +! it under the terms of the GNU General Public License as published by
1876 +! the Free Software Foundation; either version 2 of the License, or
1877 +! (at your option) any later version.
1878 +!
1879 +! This program is distributed in the hope that it will be useful,
1880 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1881 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1882 +! GNU General Public License for more details.
1883 +!
1884 +! You should have received a copy of the GNU General Public License
1885 +! along with this program; if not, write to the Free Software
1886 +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1887 +
1888 +program vla_strings
1889 +  character(len=:), target, allocatable   :: var_char
1890 +  character(len=:), pointer               :: var_char_p
1891 +  logical                                 :: l
1892 +
1893 +  allocate(character(len=10) :: var_char)
1894 +  l = allocated(var_char)                 ! var_char-allocated-1
1895 +  var_char = 'foo'
1896 +  deallocate(var_char)                    ! var_char-filled-1
1897 +  l = allocated(var_char)                 ! var_char-deallocated
1898 +  allocate(character(len=42) :: var_char)
1899 +  l = allocated(var_char)
1900 +  var_char = 'foobar'
1901 +  var_char = ''                           ! var_char-filled-2
1902 +  var_char = 'bar'                        ! var_char-empty
1903 +  deallocate(var_char)
1904 +  allocate(character(len=21) :: var_char)
1905 +  l = allocated(var_char)                 ! var_char-allocated-3
1906 +  var_char = 'johndoe'
1907 +  var_char_p => var_char
1908 +  l = associated(var_char_p)              ! var_char_p-associated
1909 +  var_char_p => null()
1910 +  l = associated(var_char_p)              ! var_char_p-not-associated
1911 +end program vla_strings
1912 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-sub.f90
1913 ===================================================================
1914 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
1915 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-sub.f90   2015-05-29 08:27:06.268740305 +0200
1916 @@ -0,0 +1,82 @@
1917 +! Copyright 2014 Free Software Foundation, Inc.
1918 +!
1919 +! This program is free software; you can redistribute it and/or modify
1920 +! it under the terms of the GNU General Public License as published by
1921 +! the Free Software Foundation; either version 2 of the License, or
1922 +! (at your option) any later version.
1923 +!
1924 +! This program is distributed in the hope that it will be useful,
1925 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
1926 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1927 +! GNU General Public License for more details.
1928 +!
1929 +! You should have received a copy of the GNU General Public License
1930 +! along with this program; if not, write to the Free Software
1931 +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1932 +!
1933 +! Original file written by Jakub Jelinek <jakub@redhat.com> and
1934 +! Jan Kratochvil <jan.kratochvil@redhat.com>.
1935 +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>.
1936 +
1937 +subroutine foo (array1, array2)
1938 +  integer :: array1 (:, :)
1939 +  real    :: array2 (:, :, :)
1940 +
1941 +  array1(:,:) = 5                       ! not-filled
1942 +  array1(1, 1) = 30
1943 +
1944 +  array2(:,:,:) = 6                     ! array1-filled
1945 +  array2(:,:,:) = 3
1946 +  array2(1,1,1) = 30
1947 +  array2(3,3,3) = 90                    ! array2-almost-filled
1948 +end subroutine
1949 +
1950 +subroutine bar (array1, array2)
1951 +  integer :: array1 (*)
1952 +  integer :: array2 (4:9, 10:*)
1953 +
1954 +  array1(5:10) = 1311
1955 +  array1(7) = 1
1956 +  array1(100) = 100
1957 +  array2(4,10) = array1(7)
1958 +  array2(4,100) = array1(7)
1959 +  return                                ! end-of-bar
1960 +end subroutine
1961 +
1962 +program vla_sub
1963 +  interface
1964 +    subroutine foo (array1, array2)
1965 +      integer :: array1 (:, :)
1966 +      real :: array2 (:, :, :)
1967 +    end subroutine
1968 +  end interface
1969 +  interface
1970 +    subroutine bar (array1, array2)
1971 +      integer :: array1 (*)
1972 +      integer :: array2 (4:9, 10:*)
1973 +    end subroutine
1974 +  end interface
1975 +
1976 +  real, allocatable :: vla1 (:, :, :)
1977 +  integer, allocatable :: vla2 (:, :)
1978 +
1979 +  ! used for subroutine
1980 +  integer :: sub_arr1(42, 42)
1981 +  real    :: sub_arr2(42, 42, 42)
1982 +  integer :: sub_arr3(42)
1983 +
1984 +  sub_arr1(:,:) = 1                   ! vla2-deallocated
1985 +  sub_arr2(:,:,:) = 2
1986 +  sub_arr3(:) = 3
1987 +
1988 +  call foo(sub_arr1, sub_arr2)
1989 +  call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15))
1990 +
1991 +  allocate (vla1 (10,10,10))
1992 +  allocate (vla2 (20,20))
1993 +  vla1(:,:,:) = 1311
1994 +  vla2(:,:) = 42
1995 +  call foo(vla2, vla1)
1996 +
1997 +  call bar(sub_arr3, sub_arr1)
1998 +end program vla_sub
1999 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp
2000 ===================================================================
2001 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
2002 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp   2015-05-29 08:27:06.268740305 +0200
2003 @@ -0,0 +1,35 @@
2004 +# Copyright 2014 Free Software Foundation, Inc.
2005 +
2006 +# This program is free software; you can redistribute it and/or modify
2007 +# it under the terms of the GNU General Public License as published by
2008 +# the Free Software Foundation; either version 3 of the License, or
2009 +# (at your option) any later version.
2010 +#
2011 +# This program is distributed in the hope that it will be useful,
2012 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
2013 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2014 +# GNU General Public License for more details.
2015 +#
2016 +# You should have received a copy of the GNU General Public License
2017 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
2018 +
2019 +standard_testfile "vla-sub.f90"
2020 +
2021 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
2022 +    {debug f90 quiet}] } {
2023 +    return -1
2024 +}
2025 +
2026 +if ![runto MAIN__] then {
2027 +    perror "couldn't run to breakpoint MAIN__"
2028 +    continue
2029 +}
2030 +
2031 +# Check VLA with arbitary length and check that elements outside of
2032 +# bounds of the passed VLA can be accessed correctly.
2033 +gdb_breakpoint [gdb_get_line_number "end-of-bar"]
2034 +gdb_continue_to_breakpoint "end-of-bar"
2035 +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)"
2036 +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)"
2037 +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)"
2038 +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)"
2039 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp
2040 ===================================================================
2041 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
2042 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp      2015-05-29 08:27:06.268740305 +0200
2043 @@ -0,0 +1,49 @@
2044 +# Copyright 2014 Free Software Foundation, Inc.
2045 +
2046 +# This program is free software; you can redistribute it and/or modify
2047 +# it under the terms of the GNU General Public License as published by
2048 +# the Free Software Foundation; either version 3 of the License, or
2049 +# (at your option) any later version.
2050 +#
2051 +# This program is distributed in the hope that it will be useful,
2052 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
2053 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2054 +# GNU General Public License for more details.
2055 +#
2056 +# You should have received a copy of the GNU General Public License
2057 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
2058 +
2059 +standard_testfile "vla-sub.f90"
2060 +
2061 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
2062 +    {debug f90 quiet}] } {
2063 +    return -1
2064 +}
2065 +
2066 +if ![runto MAIN__] then {
2067 +    perror "couldn't run to breakpoint MAIN__"
2068 +    continue
2069 +}
2070 +
2071 +# "up" works with GCC but other Fortran compilers may copy the values into the
2072 +# outer function only on the exit of the inner function.
2073 +# We need both variants as depending on the arch we optionally may still be
2074 +# executing the caller line or not after `finish'.
2075 +
2076 +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"]
2077 +gdb_continue_to_breakpoint "array2-almost-filled"
2078 +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
2079 +  "print array2 in foo after it was filled"
2080 +gdb_test "print array2(2,1,1)=20" " = 20" \
2081 +  "set array(2,2,2) to 20 in subroutine"
2082 +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
2083 +  "print array2 in foo after it was mofified in debugger"
2084 +
2085 +gdb_test "finish" \
2086 +  ".*foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)" \
2087 +  "finish function"
2088 +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish"
2089 +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish"
2090 +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish"
2091 +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish"
2092 +
2093 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value-sub.exp
2094 ===================================================================
2095 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
2096 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value-sub.exp     2015-05-29 08:27:06.269740311 +0200
2097 @@ -0,0 +1,90 @@
2098 +# Copyright 2014 Free Software Foundation, Inc.
2099 +
2100 +# This program is free software; you can redistribute it and/or modify
2101 +# it under the terms of the GNU General Public License as published by
2102 +# the Free Software Foundation; either version 3 of the License, or
2103 +# (at your option) any later version.
2104 +#
2105 +# This program is distributed in the hope that it will be useful,
2106 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
2107 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2108 +# GNU General Public License for more details.
2109 +#
2110 +# You should have received a copy of the GNU General Public License
2111 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
2112 +
2113 +standard_testfile "vla-sub.f90"
2114 +
2115 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
2116 +    {debug f90 quiet}] } {
2117 +    return -1
2118 +}
2119 +
2120 +if ![runto MAIN__] then {
2121 +    perror "couldn't run to breakpoint MAIN__"
2122 +    continue
2123 +}
2124 +
2125 +# Check the values of VLA's in subroutine can be evaluated correctly
2126 +
2127 +# Try to access values from a fixed array handled as VLA in subroutine.
2128 +gdb_breakpoint [gdb_get_line_number "not-filled"]
2129 +gdb_continue_to_breakpoint "not-filled (1st)"
2130 +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \
2131 +  "print passed array1 in foo (passed fixed array)"
2132 +
2133 +gdb_breakpoint [gdb_get_line_number "array1-filled"]
2134 +gdb_continue_to_breakpoint "array1-filled (1st)"
2135 +gdb_test "print array1(5, 7)" " = 5" \
2136 +  "print array1(5, 7) after filled in foo (passed fixed array)"
2137 +gdb_test "print array1(1, 1)" " = 30" \
2138 +  "print array1(1, 1) after filled in foo (passed fixed array)"
2139 +
2140 +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"]
2141 +gdb_continue_to_breakpoint "array2-almost-filled (1st)"
2142 +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
2143 +  "print array2 in foo after it was filled (passed fixed array)"
2144 +gdb_test "print array2(2,1,1)=20" " = 20" \
2145 +  "set array(2,2,2) to 20 in subroutine (passed fixed array)"
2146 +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
2147 +  "print array2 in foo after it was mofified in debugger (passed fixed array)"
2148 +
2149 +
2150 +# Try to access values from a fixed sub-array handled as VLA in subroutine.
2151 +gdb_continue_to_breakpoint "not-filled (2nd)"
2152 +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \
2153 +  "print passed array1 in foo (passed sub-array)"
2154 +
2155 +gdb_continue_to_breakpoint "array1-filled (2nd)"
2156 +gdb_test "print array1(5, 5)" " = 5" \
2157 +  "print array1(5, 5) after filled in foo (passed sub-array)"
2158 +gdb_test "print array1(1, 1)" " = 30" \
2159 +  "print array1(1, 1) after filled in foo (passed sub-array)"
2160 +
2161 +gdb_continue_to_breakpoint "array2-almost-filled (2nd)"
2162 +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
2163 +  "print array2 in foo after it was filled (passed sub-array)"
2164 +gdb_test "print array2(2,1,1)=20" " = 20" \
2165 +  "set array(2,2,2) to 20 in subroutine (passed sub-array)"
2166 +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
2167 +  "print array2 in foo after it was mofified in debugger (passed sub-array)"
2168 +
2169 +
2170 +# Try to access values from a VLA passed to subroutine.
2171 +gdb_continue_to_breakpoint "not-filled (3rd)"
2172 +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \
2173 +  "print passed array1 in foo (passed vla)"
2174 +
2175 +gdb_continue_to_breakpoint "array1-filled (3rd)"
2176 +gdb_test "print array1(5, 5)" " = 5" \
2177 +  "print array1(5, 5) after filled in foo (passed vla)"
2178 +gdb_test "print array1(1, 1)" " = 30" \
2179 +  "print array1(1, 1) after filled in foo (passed vla)"
2180 +
2181 +gdb_continue_to_breakpoint "array2-almost-filled (3rd)"
2182 +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
2183 +  "print array2 in foo after it was filled (passed vla)"
2184 +gdb_test "print array2(2,1,1)=20" " = 20" \
2185 +  "set array(2,2,2) to 20 in subroutine (passed vla)"
2186 +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
2187 +  "print array2 in foo after it was mofified in debugger (passed vla)"
2188 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value.exp
2189 ===================================================================
2190 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
2191 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla-value.exp 2015-05-29 08:27:06.269740311 +0200
2192 @@ -0,0 +1,148 @@
2193 +# Copyright 2014 Free Software Foundation, Inc.
2194 +
2195 +# This program is free software; you can redistribute it and/or modify
2196 +# it under the terms of the GNU General Public License as published by
2197 +# the Free Software Foundation; either version 3 of the License, or
2198 +# (at your option) any later version.
2199 +#
2200 +# This program is distributed in the hope that it will be useful,
2201 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
2202 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2203 +# GNU General Public License for more details.
2204 +#
2205 +# You should have received a copy of the GNU General Public License
2206 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
2207 +
2208 +standard_testfile "vla.f90"
2209 +
2210 +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
2211 +     {debug f90 quiet}] } {
2212 +    return -1
2213 +}
2214 +
2215 +if ![runto MAIN__] then {
2216 +    perror "couldn't run to breakpoint MAIN__"
2217 +    continue
2218 +}
2219 +
2220 +# Try to access values in non allocated VLA
2221 +gdb_breakpoint [gdb_get_line_number "vla1-init"]
2222 +gdb_continue_to_breakpoint "vla1-init"
2223 +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
2224 +gdb_test "print &vla1" \
2225 +  " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \
2226 +  "print non-allocated &vla1"
2227 +gdb_test "print vla1(1,1,1)" "no such vector element because not allocated" \
2228 +  "print member in non-allocated vla1 (1)"
2229 +gdb_test "print vla1(101,202,303)" \
2230 +  "no such vector element because not allocated" \
2231 +  "print member in non-allocated vla1 (2)"
2232 +gdb_test "print vla1(5,2,18)=1" "no such vector element because not allocated" \
2233 +  "set member in non-allocated vla1"
2234 +
2235 +# Try to access value in allocated VLA
2236 +gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
2237 +gdb_continue_to_breakpoint "vla2-allocated"
2238 +gdb_test "next" "\\d+(\\t|\\s)+vla1\\\(3, 6, 9\\\) = 42" \
2239 +  "step over value assignment of vla1"
2240 +gdb_test "print &vla1" \
2241 +  " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
2242 +  "print allocated &vla1"
2243 +gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)"
2244 +gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)"
2245 +gdb_test "print vla1(9, 9, 9) = 999" " = 999" \
2246 +  "print allocated vla1(9,9,9)=1"
2247 +
2248 +# Try to access values in allocated VLA after specific assignment
2249 +gdb_breakpoint [gdb_get_line_number "vla1-filled"]
2250 +gdb_continue_to_breakpoint "vla1-filled"
2251 +gdb_test "print vla1(3, 6, 9)" " = 42" \
2252 +  "print allocated vla1(3,6,9) after specific assignment (filled)"
2253 +gdb_test "print vla1(1, 3, 8)" " = 1001" \
2254 +  "print allocated vla1(1,3,8) after specific assignment (filled)"
2255 +gdb_test "print vla1(9, 9, 9)" " = 999" \
2256 +  "print allocated vla1(9,9,9) after assignment in debugger (filled)"
2257 +
2258 +# Try to access values in undefined pointer to VLA (dangling)
2259 +gdb_test "print pvla" " = <not associated>" "print undefined pvla"
2260 +gdb_test "print &pvla" \
2261 +  " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \
2262 +  "print non-associated &pvla"
2263 +gdb_test "print pvla(1, 3, 8)" "no such vector element because not associated" \
2264 +  "print undefined pvla(1,3,8)"
2265 +
2266 +# Try to access values in pointer to VLA and compare them
2267 +gdb_breakpoint [gdb_get_line_number "pvla-associated"]
2268 +gdb_continue_to_breakpoint "pvla-associated"
2269 +gdb_test "print &pvla" \
2270 +  " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
2271 +  "print associated &pvla"
2272 +gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)"
2273 +gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)"
2274 +gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)"
2275 +
2276 +# Fill values to VLA using pointer and check
2277 +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
2278 +gdb_continue_to_breakpoint "pvla-re-associated"
2279 +gdb_test "print pvla(5, 45, 20)" \
2280 +  " = 1" "print pvla(5, 45, 20) after filled using pointer"
2281 +gdb_test "print vla2(5, 45, 20)" \
2282 +  " = 1" "print vla2(5, 45, 20) after filled using pointer"
2283 +gdb_test "print pvla(7, 45, 14)" " = 2" \
2284 +  "print pvla(7, 45, 14) after filled using pointer"
2285 +gdb_test "print vla2(7, 45, 14)" " = 2" \
2286 +  "print vla2(7, 45, 14) after filled using pointer"
2287 +
2288 +# Try to access values of deassociated VLA pointer
2289 +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
2290 +gdb_continue_to_breakpoint "pvla-deassociated"
2291 +gdb_test "print pvla(5, 45, 20)" \
2292 +  "no such vector element because not associated" \
2293 +  "print pvla(5, 45, 20) after deassociated"
2294 +gdb_test "print pvla(7, 45, 14)" \
2295 +  "no such vector element because not associated" \
2296 +  "print pvla(7, 45, 14) after dissasociated"
2297 +gdb_test "print pvla" " = <not associated>" \
2298 +  "print vla1 after deassociated"
2299 +
2300 +# Try to access values of deallocated VLA
2301 +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
2302 +gdb_continue_to_breakpoint "vla1-deallocated"
2303 +gdb_test "print vla1(3, 6, 9)" "no such vector element because not allocated" \
2304 +  "print allocated vla1(3,6,9) after specific assignment (deallocated)"
2305 +gdb_test "print vla1(1, 3, 8)" "no such vector element because not allocated" \
2306 +  "print allocated vla1(1,3,8) after specific assignment (deallocated)"
2307 +gdb_test "print vla1(9, 9, 9)" "no such vector element because not allocated" \
2308 +  "print allocated vla1(9,9,9) after assignment in debugger (deallocated)"
2309 +
2310 +
2311 +# Try to assign VLA to user variable
2312 +clean_restart ${testfile}
2313 +
2314 +if ![runto MAIN__] then {
2315 +    perror "couldn't run to breakpoint MAIN__"
2316 +    continue
2317 +}
2318 +gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
2319 +gdb_continue_to_breakpoint "vla2-allocated"
2320 +gdb_test "next" "\\d+.*vla1\\(3, 6, 9\\) = 42" "next (1)"
2321 +
2322 +gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1"
2323 +gdb_test "print \$myvar" \
2324 +  " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \
2325 +  "print \$myvar set to vla1"
2326 +
2327 +gdb_test "next" "\\d+.*vla1\\(1, 3, 8\\) = 1001" "next (2)"
2328 +gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)"
2329 +
2330 +gdb_breakpoint [gdb_get_line_number "pvla-associated"]
2331 +gdb_continue_to_breakpoint "pvla-associated"
2332 +gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla"
2333 +gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)"
2334 +
2335 +# deallocate pointer and make sure user defined variable still has the
2336 +# right value.
2337 +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
2338 +gdb_continue_to_breakpoint "pvla-deassociated"
2339 +gdb_test "print \$mypvar(1,3,8)" " = 1001" \
2340 +  "print \$mypvar(1,3,8) after deallocated"
2341 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla.f90
2342 ===================================================================
2343 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
2344 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/vla.f90       2015-05-29 08:27:06.269740311 +0200
2345 @@ -0,0 +1,56 @@
2346 +! Copyright 2014 Free Software Foundation, Inc.
2347 +!
2348 +! This program is free software; you can redistribute it and/or modify
2349 +! it under the terms of the GNU General Public License as published by
2350 +! the Free Software Foundation; either version 3 of the License, or
2351 +! (at your option) any later version.
2352 +!
2353 +! This program is distributed in the hope that it will be useful,
2354 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
2355 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2356 +! GNU General Public License for more details.
2357 +!
2358 +! You should have received a copy of the GNU General Public License
2359 +! along with this program.  If not, see <http://www.gnu.org/licenses/>.
2360 +
2361 +program vla
2362 +  real, target, allocatable :: vla1 (:, :, :)
2363 +  real, target, allocatable :: vla2 (:, :, :)
2364 +  real, target, allocatable :: vla3 (:, :)
2365 +  real, pointer :: pvla (:, :, :)
2366 +  logical :: l
2367 +
2368 +  allocate (vla1 (10,10,10))          ! vla1-init
2369 +  l = allocated(vla1)
2370 +
2371 +  allocate (vla2 (1:7,42:50,13:35))   ! vla1-allocated
2372 +  l = allocated(vla2)
2373 +
2374 +  vla1(:, :, :) = 1311                ! vla2-allocated
2375 +  vla1(3, 6, 9) = 42
2376 +  vla1(1, 3, 8) = 1001
2377 +  vla1(6, 2, 7) = 13
2378 +
2379 +  vla2(:, :, :) = 1311                ! vla1-filled
2380 +  vla2(5, 45, 20) = 42
2381 +
2382 +  pvla => vla1                        ! vla2-filled
2383 +  l = associated(pvla)
2384 +
2385 +  pvla => vla2                        ! pvla-associated
2386 +  l = associated(pvla)
2387 +  pvla(5, 45, 20) = 1
2388 +  pvla(7, 45, 14) = 2
2389 +
2390 +  pvla => null()                      ! pvla-re-associated
2391 +  l = associated(pvla)
2392 +
2393 +  deallocate (vla1)                   ! pvla-deassociated
2394 +  l = allocated(vla1)
2395 +
2396 +  deallocate (vla2)                   ! vla1-deallocated
2397 +  l = allocated(vla2)
2398 +
2399 +  allocate (vla3 (2,2))               ! vla2-deallocated
2400 +  vla3(:,:) = 13
2401 +end program vla
2402 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
2403 ===================================================================
2404 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
2405 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2015-05-29 11:13:53.951656591 +0200
2406 @@ -0,0 +1,181 @@
2407 +# Copyright 2014 Free Software Foundation, Inc.
2408 +
2409 +# This program is free software; you can redistribute it and/or modify
2410 +# it under the terms of the GNU General Public License as published by
2411 +# the Free Software Foundation; either version 3 of the License, or
2412 +# (at your option) any later version.
2413 +#
2414 +# This program is distributed in the hope that it will be useful,
2415 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
2416 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2417 +# GNU General Public License for more details.
2418 +#
2419 +# You should have received a copy of the GNU General Public License
2420 +# along with this program.  If not, see <http://www.gnu.org/licenses/>.
2421 +
2422 +# Verify that, using the MI, we can evaluate a simple C Variable Length
2423 +# Array (VLA).
2424 +
2425 +load_lib mi-support.exp
2426 +set MIFLAGS "-i=mi"
2427 +
2428 +gdb_exit
2429 +if [mi_gdb_start] {
2430 +    continue
2431 +}
2432 +
2433 +standard_testfile vla.f90
2434 +
2435 +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \
2436 +     {debug f90}] != "" } {
2437 +     untested mi-vla-fortran.exp
2438 +     return -1
2439 +}
2440 +
2441 +mi_delete_breakpoints
2442 +mi_gdb_reinitialize_dir $srcdir/$subdir
2443 +mi_gdb_load ${binfile}
2444 +
2445 +set bp_lineno [gdb_get_line_number "vla1-not-allocated"]
2446 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \
2447 +  ".*vla.f90" $bp_lineno $hex \
2448 +  "insert breakpoint at line $bp_lineno (vla not allocated)"
2449 +mi_run_cmd
2450 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2451 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2452 +mi_gdb_test "500-data-evaluate-expression vla1" \
2453 +  "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
2454 +
2455 +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
2456 +  "create local variable vla1_not_allocated"
2457 +mi_gdb_test "501-var-info-type vla1_not_allocated" \
2458 +  "501\\^done,type=\"<not allocated>\"" \
2459 +  "info type variable vla1_not_allocated"
2460 +mi_gdb_test "502-var-show-format vla1_not_allocated" \
2461 +  "502\\^done,format=\"natural\"" \
2462 +  "show format variable vla1_not_allocated"
2463 +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \
2464 +  "503\\^done,value=\"\\\[0\\\]\"" \
2465 +  "eval variable vla1_not_allocated"
2466 +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
2467 +    "real\\\(kind=4\\\)" "get children of vla1_not_allocated"
2468 +
2469 +
2470 +
2471 +set bp_lineno [gdb_get_line_number "vla1-allocated"]
2472 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \
2473 +  $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)"
2474 +mi_run_cmd
2475 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2476 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2477 +# Content of 'vla1' is uninitialized here.
2478 +
2479 +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \
2480 +  "create local variable vla1_allocated"
2481 +mi_gdb_test "511-var-info-type vla1_allocated" \
2482 +  "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \
2483 +  "info type variable vla1_allocated"
2484 +mi_gdb_test "512-var-show-format vla1_allocated" \
2485 +  "512\\^done,format=\"natural\"" \
2486 +  "show format variable vla1_allocated"
2487 +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \
2488 +  "513\\^done,value=\"\\\[5\\\]\"" \
2489 +  "eval variable vla1_allocated"
2490 +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
2491 +    "real\\\(kind=4\\\)" "get children of vla1_allocated"
2492 +
2493 +
2494 +set bp_lineno [gdb_get_line_number "vla1-filled"]
2495 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \
2496 +  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
2497 +mi_run_cmd
2498 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2499 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2500 +mi_gdb_test "520-data-evaluate-expression vla1" \
2501 +  "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla"
2502 +
2503 +
2504 +set bp_lineno [gdb_get_line_number "vla1-modified"]
2505 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \
2506 +  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
2507 +mi_run_cmd
2508 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2509 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2510 +mi_gdb_test "530-data-evaluate-expression vla1" \
2511 +  "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla"
2512 +mi_gdb_test "540-data-evaluate-expression vla1(1)" \
2513 +  "540\\^done,value=\"1\"" "evaluate filled vla"
2514 +mi_gdb_test "550-data-evaluate-expression vla1(2)" \
2515 +  "550\\^done,value=\"42\"" "evaluate filled vla"
2516 +mi_gdb_test "560-data-evaluate-expression vla1(4)" \
2517 +  "560\\^done,value=\"24\"" "evaluate filled vla"
2518 +
2519 +
2520 +set bp_lineno [gdb_get_line_number "vla1-deallocated"]
2521 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \
2522 +  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
2523 +mi_run_cmd
2524 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2525 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2526 +mi_gdb_test "570-data-evaluate-expression vla1" \
2527 +  "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
2528 +
2529 +
2530 +set bp_lineno [gdb_get_line_number "pvla2-not-associated"]
2531 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \
2532 +  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
2533 +mi_run_cmd
2534 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2535 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2536 +mi_gdb_test "580-data-evaluate-expression pvla2" \
2537 +  "580\\^done,value=\"<not associated>\"" "evaluate not associated vla"
2538 +
2539 +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
2540 +  "create local variable pvla2_not_associated"
2541 +mi_gdb_test "581-var-info-type pvla2_not_associated" \
2542 +  "581\\^done,type=\"<not associated>\"" \
2543 +  "info type variable pvla2_not_associated"
2544 +mi_gdb_test "582-var-show-format pvla2_not_associated" \
2545 +  "582\\^done,format=\"natural\"" \
2546 +  "show format variable pvla2_not_associated"
2547 +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \
2548 +  "583\\^done,value=\"\\\[0\\\]\"" \
2549 +  "eval variable pvla2_not_associated"
2550 +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
2551 +    "real\\\(kind=4\\\)" "get children of pvla2_not_associated"
2552 +
2553 +
2554 +set bp_lineno [gdb_get_line_number "pvla2-associated"]
2555 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \
2556 +  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
2557 +mi_run_cmd
2558 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2559 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2560 +mi_gdb_test "590-data-evaluate-expression pvla2" \
2561 +  "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \
2562 +  "evaluate associated vla"
2563 +
2564 +mi_create_varobj_checked pvla2_associated pvla2 \
2565 +  "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated"
2566 +mi_gdb_test "591-var-info-type pvla2_associated" \
2567 +  "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \
2568 +  "info type variable pvla2_associated"
2569 +mi_gdb_test "592-var-show-format pvla2_associated" \
2570 +  "592\\^done,format=\"natural\"" \
2571 +  "show format variable pvla2_associated"
2572 +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \
2573 +  "593\\^done,value=\"\\\[2\\\]\"" \
2574 +  "eval variable pvla2_associated"
2575 +
2576 +
2577 +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"]
2578 +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \
2579 +  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
2580 +mi_run_cmd
2581 +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
2582 +  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
2583 +mi_gdb_test "600-data-evaluate-expression pvla2" \
2584 +  "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null"
2585 +
2586 +mi_gdb_exit
2587 +return 0
2588 Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.mi/vla.f90
2589 ===================================================================
2590 --- /dev/null   1970-01-01 00:00:00.000000000 +0000
2591 +++ gdb-7.9.50.20150520/gdb/testsuite/gdb.mi/vla.f90    2015-05-29 08:27:06.270740317 +0200
2592 @@ -0,0 +1,42 @@
2593 +! Copyright 2014 Free Software Foundation, Inc.
2594 +!
2595 +! This program is free software; you can redistribute it and/or modify
2596 +! it under the terms of the GNU General Public License as published by
2597 +! the Free Software Foundation; either version 3 of the License, or
2598 +! (at your option) any later version.
2599 +!
2600 +! This program is distributed in the hope that it will be useful,
2601 +! but WITHOUT ANY WARRANTY; without even the implied warranty of
2602 +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2603 +! GNU General Public License for more details.
2604 +!
2605 +! You should have received a copy of the GNU General Public License
2606 +! along with this program.  If not, see <http://www.gnu.org/licenses/>.
2607 +
2608 +program vla
2609 +  real, allocatable :: vla1 (:)
2610 +  real, target, allocatable :: vla2(:, :)
2611 +  real, pointer :: pvla2 (:, :)
2612 +  logical :: l
2613 +
2614 +  allocate (vla1 (5))         ! vla1-not-allocated
2615 +  l = allocated(vla1)         ! vla1-allocated
2616 +
2617 +  vla1(:) = 1
2618 +  vla1(2) = 42                ! vla1-filled
2619 +  vla1(4) = 24
2620 +
2621 +  deallocate (vla1)           ! vla1-modified
2622 +  l = allocated(vla1)         ! vla1-deallocated
2623 +
2624 +  allocate (vla2 (5, 2))
2625 +  vla2(:, :) = 2
2626 +
2627 +  pvla2 => vla2               ! pvla2-not-associated
2628 +  l = associated(pvla2)       ! pvla2-associated
2629 +
2630 +  pvla2(2, 1) = 42
2631 +
2632 +  pvla2 => null()
2633 +  l = associated(pvla2)       ! pvla2-set-to-null
2634 +end program vla
2635 Index: gdb-7.9.50.20150520/gdb/typeprint.c
2636 ===================================================================
2637 --- gdb-7.9.50.20150520.orig/gdb/typeprint.c    2015-05-29 08:27:02.688717523 +0200
2638 +++ gdb-7.9.50.20150520/gdb/typeprint.c 2015-05-29 08:27:06.270740317 +0200
2639 @@ -458,6 +458,13 @@ whatis_exp (char *exp, int show)
2640
2641    type = value_type (val);
2642
2643 +  if (TYPE_CODE (type) == TYPE_CODE_PTR)
2644 +    if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
2645 +      {
2646 +       val = value_addr (value_ind (val));
2647 +       type = value_type (val);
2648 +      }
2649 +
2650    get_user_print_options (&opts);
2651    if (opts.objectprint)
2652      {
2653 Index: gdb-7.9.50.20150520/gdb/valarith.c
2654 ===================================================================
2655 --- gdb-7.9.50.20150520.orig/gdb/valarith.c     2015-05-29 08:27:02.689717530 +0200
2656 +++ gdb-7.9.50.20150520/gdb/valarith.c  2015-05-29 08:27:06.271740324 +0200
2657 @@ -193,12 +193,31 @@ value_subscripted_rvalue (struct value *
2658    struct type *array_type = check_typedef (value_type (array));
2659    struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
2660    unsigned int elt_size = TYPE_LENGTH (elt_type);
2661 -  unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound);
2662 +  unsigned int elt_offs = longest_to_int (index - lowerbound);
2663 +  LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
2664    struct value *v;
2665
2666 +  if (elt_stride > 0)
2667 +    elt_offs *= elt_stride;
2668 +  else if (elt_stride < 0)
2669 +    {
2670 +      int offs = (elt_offs + 1) * elt_stride;
2671 +
2672 +      elt_offs = TYPE_LENGTH (array_type) + offs;
2673 +    }
2674 +  else
2675 +    elt_offs *= elt_size;
2676 +
2677    if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
2678                              && elt_offs >= TYPE_LENGTH (array_type)))
2679 -    error (_("no such vector element"));
2680 +    {
2681 +      if (TYPE_NOT_ASSOCIATED (array_type))
2682 +        error (_("no such vector element because not associated"));
2683 +      else if (TYPE_NOT_ALLOCATED (array_type))
2684 +        error (_("no such vector element because not allocated"));
2685 +      else
2686 +        error (_("no such vector element"));
2687 +    }
2688
2689    if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
2690      v = allocate_value_lazy (elt_type);
2691 Index: gdb-7.9.50.20150520/gdb/valprint.c
2692 ===================================================================
2693 --- gdb-7.9.50.20150520.orig/gdb/valprint.c     2015-05-29 08:27:02.690717536 +0200
2694 +++ gdb-7.9.50.20150520/gdb/valprint.c  2015-05-29 08:27:06.271740324 +0200
2695 @@ -303,6 +303,18 @@ valprint_check_validity (struct ui_file
2696  {
2697    CHECK_TYPEDEF (type);
2698
2699 +  if (TYPE_NOT_ASSOCIATED (type))
2700 +    {
2701 +      val_print_not_associated (stream);
2702 +      return 0;
2703 +    }
2704 +
2705 +  if (TYPE_NOT_ALLOCATED (type))
2706 +    {
2707 +      val_print_not_allocated (stream);
2708 +      return 0;
2709 +    }
2710 +
2711    if (TYPE_CODE (type) != TYPE_CODE_UNION
2712        && TYPE_CODE (type) != TYPE_CODE_STRUCT
2713        && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2714 @@ -359,6 +371,18 @@ val_print_invalid_address (struct ui_fil
2715    fprintf_filtered (stream, _("<invalid address>"));
2716  }
2717
2718 +void
2719 +val_print_not_allocated (struct ui_file *stream)
2720 +{
2721 +  fprintf_filtered (stream, _("<not allocated>"));
2722 +}
2723 +
2724 +void
2725 +val_print_not_associated (struct ui_file *stream)
2726 +{
2727 +  fprintf_filtered (stream, _("<not associated>"));
2728 +}
2729 +
2730  /* A generic val_print that is suitable for use by language
2731     implementations of the la_val_print method.  This function can
2732     handle most type codes, though not all, notably exception
2733 @@ -802,12 +826,16 @@ static int
2734  value_check_printable (struct value *val, struct ui_file *stream,
2735                        const struct value_print_options *options)
2736  {
2737 +  const struct type *type;
2738 +
2739    if (val == 0)
2740      {
2741        fprintf_filtered (stream, _("<address of value unknown>"));
2742        return 0;
2743      }
2744
2745 +  type = value_type (val);
2746 +
2747    if (value_entirely_optimized_out (val))
2748      {
2749        if (options->summary && !val_print_scalar_type_p (value_type (val)))
2750 @@ -833,6 +861,18 @@ value_check_printable (struct value *val
2751        return 0;
2752      }
2753
2754 +  if (TYPE_NOT_ASSOCIATED (type))
2755 +    {
2756 +      val_print_not_associated (stream);
2757 +      return 0;
2758 +    }
2759 +
2760 +  if (TYPE_NOT_ALLOCATED (type))
2761 +    {
2762 +      val_print_not_allocated (stream);
2763 +      return 0;
2764 +    }
2765 +
2766    return 1;
2767  }
2768
2769 Index: gdb-7.9.50.20150520/gdb/valprint.h
2770 ===================================================================
2771 --- gdb-7.9.50.20150520.orig/gdb/valprint.h     2015-05-29 08:27:02.691717543 +0200
2772 +++ gdb-7.9.50.20150520/gdb/valprint.h  2015-05-29 08:27:06.272740330 +0200
2773 @@ -232,4 +232,8 @@ extern void print_command_parse_format (
2774                                         struct format_data *fmtp);
2775  extern void print_value (struct value *val, const struct format_data *fmtp);
2776
2777 +extern void val_print_not_allocated (struct ui_file *stream);
2778 +
2779 +extern void val_print_not_associated (struct ui_file *stream);
2780 +
2781  #endif
2782 Index: gdb-7.9.50.20150520/gdb/value.c
2783 ===================================================================
2784 --- gdb-7.9.50.20150520.orig/gdb/value.c        2015-05-29 08:27:02.693717555 +0200
2785 +++ gdb-7.9.50.20150520/gdb/value.c     2015-05-29 08:27:06.273740337 +0200
2786 @@ -40,6 +40,7 @@
2787  #include "tracepoint.h"
2788  #include "cp-abi.h"
2789  #include "user-regs.h"
2790 +#include "dwarf2loc.h"
2791
2792  /* Prototypes for exported functions.  */
2793
2794 @@ -1776,6 +1777,25 @@ set_value_component_location (struct val
2795        if (funcs->copy_closure)
2796          component->location.computed.closure = funcs->copy_closure (whole);
2797      }
2798 +
2799 +  /* For dynamic types compute the address of the component value location in
2800 +     sub range types based on the location of the sub range type, if not being
2801 +     an internal GDB variable or parts of it.  */
2802 +  if (VALUE_LVAL (component) != lval_internalvar
2803 +      && VALUE_LVAL (component) != lval_internalvar_component)
2804 +    {
2805 +      CORE_ADDR addr;
2806 +      struct type *type = value_type (whole);
2807 +
2808 +      addr = value_raw_address (component);
2809 +
2810 +      if (TYPE_DATA_LOCATION (type)
2811 +          && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
2812 +        {
2813 +          addr = TYPE_DATA_LOCATION_ADDR (type);
2814 +          set_value_address (component, addr);
2815 +        }
2816 +    }
2817  }
2818
2819  \f
2820 @@ -3080,13 +3100,22 @@ value_primitive_field (struct value *arg
2821         v = allocate_value_lazy (type);
2822        else
2823         {
2824 -         v = allocate_value (type);
2825 -         value_contents_copy_raw (v, value_embedded_offset (v),
2826 -                                  arg1, value_embedded_offset (arg1) + offset,
2827 -                                  TYPE_LENGTH (type));
2828 +         if (TYPE_DATA_LOCATION (type)
2829 +             && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
2830 +           v = value_at_lazy (type, value_address (arg1) + offset);
2831 +         else
2832 +           {
2833 +             v = allocate_value (type);
2834 +             value_contents_copy_raw (v, value_embedded_offset (v),
2835 +                                      arg1, value_embedded_offset (arg1) + offset,
2836 +                                      TYPE_LENGTH (type));
2837 +           }
2838         }
2839 -      v->offset = (value_offset (arg1) + offset
2840 -                  + value_embedded_offset (arg1));
2841 +
2842 +      if (!TYPE_DATA_LOCATION (type)
2843 +          || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
2844 +       v->offset = (value_offset (arg1) + offset
2845 +                    + value_embedded_offset (arg1));
2846      }
2847    set_value_component_location (v, arg1);
2848    VALUE_REGNUM (v) = VALUE_REGNUM (arg1);
2849 @@ -3674,7 +3703,8 @@ readjust_indirect_value_type (struct val
2850                               struct value *original_value)
2851  {
2852    /* Re-adjust type.  */
2853 -  deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
2854 +  if (!is_dynamic_type (TYPE_TARGET_TYPE (original_type)))
2855 +    deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
2856
2857    /* Add embedding info.  */
2858    set_value_enclosing_type (value, enc_type);
2859 @@ -3691,6 +3721,12 @@ coerce_ref (struct value *arg)
2860    struct value *retval;
2861    struct type *enc_type;
2862
2863 +  if (current_language->la_language != language_fortran
2864 +      && TYPE_DATA_LOCATION (value_type_arg_tmp) != NULL
2865 +      && TYPE_DATA_LOCATION_KIND (value_type_arg_tmp) == PROP_CONST)
2866 +    arg = value_at_lazy (value_type_arg_tmp,
2867 +                         TYPE_DATA_LOCATION_ADDR (value_type_arg_tmp));
2868 +
2869    retval = coerce_ref_if_computed (arg);
2870    if (retval)
2871      return retval;
2872 @@ -3825,8 +3861,14 @@ value_fetch_lazy (struct value *val)
2873      }
2874    else if (VALUE_LVAL (val) == lval_memory)
2875      {
2876 -      CORE_ADDR addr = value_address (val);
2877        struct type *type = check_typedef (value_enclosing_type (val));
2878 +      CORE_ADDR addr;
2879 +
2880 +      if (TYPE_DATA_LOCATION (type) != NULL
2881 +         && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
2882 +       addr = TYPE_DATA_LOCATION_ADDR (type);
2883 +      else
2884 +       addr = value_address (val);
2885
2886        if (TYPE_LENGTH (type))
2887         read_value_memory (val, 0, value_stack (val),
2888 Index: gdb-7.9.50.20150520/gdb/dwarf2loc.c
2889 ===================================================================
2890 --- gdb-7.9.50.20150520.orig/gdb/dwarf2loc.c    2015-05-29 08:27:02.694717562 +0200
2891 +++ gdb-7.9.50.20150520/gdb/dwarf2loc.c 2015-05-29 08:27:06.274740343 +0200
2892 @@ -2294,6 +2294,11 @@ dwarf2_evaluate_loc_desc_full (struct ty
2893             int in_stack_memory = dwarf_expr_fetch_in_stack_memory (ctx, 0);
2894
2895             do_cleanups (value_chain);
2896 +
2897 +           /* Select right frame to correctly evaluate VLA's during a backtrace.  */
2898 +           if (is_dynamic_type (type))
2899 +             select_frame (frame);
2900 +
2901             retval = value_at_lazy (type, address + byte_offset);
2902             if (in_stack_memory)
2903               set_value_stack (retval, 1);
2904 @@ -2577,6 +2582,19 @@ dwarf2_compile_property_to_c (struct ui_
2905                              data, data + size, per_cu);
2906  }
2907
2908 +/* See dwarf2loc.h.  */
2909 +
2910 +int
2911 +dwarf2_address_data_valid (const struct type *type)
2912 +{
2913 +  if (TYPE_NOT_ASSOCIATED (type))
2914 +    return 0;
2915 +
2916 +  if (TYPE_NOT_ALLOCATED (type))
2917 +    return 0;
2918 +
2919 +  return 1;
2920 +}
2921  \f
2922  /* Helper functions and baton for dwarf2_loc_desc_needs_frame.  */
2923