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