cec9297
[PATCH 00/23] Fortran dynamic array support
cec9297
https://sourceware.org/ml/gdb-patches/2014-06/msg00108.html
cec9297
https://github.com/intel-gdb/vla/tree/vla-fortran
cec9297
cec9297
GIT snapshot:
a972d47
commit 511bff520372ffc10fa2ff569c176bdf1e6e475d
cec9297
cec9297
2f7f533
Index: gdb-7.8.50.20141228/gdb/c-valprint.c
b132e8a
===================================================================
2f7f533
--- gdb-7.8.50.20141228.orig/gdb/c-valprint.c	2015-01-06 22:51:17.663240907 +0100
2f7f533
+++ gdb-7.8.50.20141228/gdb/c-valprint.c	2015-01-06 23:03:07.424684753 +0100
2f7f533
@@ -537,7 +537,16 @@ c_value_print (struct value *val, struct
cec9297
 	{
cec9297
 	  /* normal case */
cec9297
 	  fprintf_filtered (stream, "(");
cec9297
-	  type_print (value_type (val), "", stream, -1);
cec9297
+	  if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
cec9297
+	    {
cec9297
+	      struct value *v;
cec9297
+
cec9297
+	      v = value_ind (val);
cec9297
+	      v = value_addr (v);
cec9297
+	      type_print (value_type (v), "", stream, -1);
cec9297
+	    }
cec9297
+	  else
cec9297
+	    type_print (value_type (val), "", stream, -1);
cec9297
 	  fprintf_filtered (stream, ") ");
cec9297
 	}
cec9297
     }
2f7f533
Index: gdb-7.8.50.20141228/gdb/dwarf2loc.h
b132e8a
===================================================================
2f7f533
--- gdb-7.8.50.20141228.orig/gdb/dwarf2loc.h	2015-01-06 22:51:17.663240907 +0100
2f7f533
+++ gdb-7.8.50.20141228/gdb/dwarf2loc.h	2015-01-06 23:03:07.424684753 +0100
2f7f533
@@ -111,6 +111,11 @@ int dwarf2_evaluate_property (const stru
2f7f533
 			      CORE_ADDR address,
cec9297
 			      CORE_ADDR *value);
cec9297
 
cec9297
+/* Checks if a dwarf location definition is valid.
cec9297
+   Returns 1 if valid; 0 otherwise.  */
cec9297
+
cec9297
+extern int dwarf2_address_data_valid (const struct type *type);
cec9297
+
2f7f533
 /* A helper for the compiler interface that compiles a single dynamic
2f7f533
    property to C code.
2f7f533
 
2f7f533
Index: gdb-7.8.50.20141228/gdb/dwarf2read.c
b132e8a
===================================================================
2f7f533
--- gdb-7.8.50.20141228.orig/gdb/dwarf2read.c	2015-01-06 22:51:17.663240907 +0100
2f7f533
+++ gdb-7.8.50.20141228/gdb/dwarf2read.c	2015-01-06 23:04:09.691986881 +0100
2f7f533
@@ -1844,6 +1844,12 @@ static void free_dwo_file_cleanup (void
cec9297
 static void process_cu_includes (void);
cec9297
 
cec9297
 static void check_producer (struct dwarf2_cu *cu);
cec9297
+
cec9297
+static int
cec9297
+attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
cec9297
+		      struct dwarf2_cu *cu, struct dynamic_prop *prop,
cec9297
+		      const gdb_byte *additional_data, int additional_data_size);
cec9297
+
cec9297
 
cec9297
 /* Various complaints about symbol reading that don't abort the process.  */
cec9297
 
2f7f533
@@ -14241,29 +14247,92 @@ read_tag_string_type (struct die_info *d
cec9297
   struct gdbarch *gdbarch = get_objfile_arch (objfile);
cec9297
   struct type *type, *range_type, *index_type, *char_type;
cec9297
   struct attribute *attr;
cec9297
-  unsigned int length;
cec9297
+  unsigned int length = UINT_MAX;
b132e8a
 
cec9297
+  index_type = objfile_type (objfile)->builtin_int;
cec9297
+  range_type = create_static_range_type (NULL, index_type, 1, length);
b132e8a
+
cec9297
+  /* If DW_AT_string_length is defined, the length is stored at some location
cec9297
+   * in memory. */
cec9297
   attr = dwarf2_attr (die, DW_AT_string_length, cu);
cec9297
   if (attr)
cec9297
     {
cec9297
-      length = DW_UNSND (attr);
cec9297
+      if (attr_form_is_block (attr))
cec9297
+        {
cec9297
+          struct attribute *byte_size, *bit_size;
cec9297
+          struct dynamic_prop high;
cec9297
+
cec9297
+          byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
cec9297
+          bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
cec9297
+
cec9297
+          /* DW_AT_byte_size should never occur together in combination with
cec9297
+             DW_AT_string_length.  */
cec9297
+          if ((byte_size == NULL && bit_size != NULL) ||
cec9297
+                  (byte_size != NULL && bit_size == NULL))
cec9297
+            complaint (&symfile_complaints, _("DW_AT_byte_size AND "
cec9297
+                      "DW_AT_bit_size found together at the same time."));
cec9297
+
cec9297
+          /* If DW_AT_string_length AND DW_AT_byte_size exist together, it
cec9297
+             describes the number of bytes that should be read from the length
cec9297
+             memory location.  */
cec9297
+          if (byte_size != NULL && bit_size == NULL)
cec9297
+            {
cec9297
+              /* Build new dwarf2_locexpr_baton structure with additions to the
cec9297
+                 data attribute, to reflect DWARF specialities to get address
cec9297
+                 sizes.  */
cec9297
+              const gdb_byte append_ops[] = {
cec9297
+                /* DW_OP_deref_size: size of an address on the target machine
cec9297
+                   (bytes), where the size will be specified by the next
cec9297
+                   operand.  */
cec9297
+                DW_OP_deref_size,
cec9297
+                /* Operand for DW_OP_deref_size.  */
cec9297
+                DW_UNSND (byte_size) };
cec9297
+
cec9297
+              if (!attr_to_dynamic_prop (attr, die, cu, &high,
cec9297
+                      append_ops, ARRAY_SIZE (append_ops)))
cec9297
+                complaint (&symfile_complaints,
cec9297
+                        _("Could not parse DW_AT_byte_size"));
cec9297
+            }
cec9297
+          else if (bit_size != NULL && byte_size == NULL)
cec9297
+            complaint (&symfile_complaints, _("DW_AT_string_length AND "
cec9297
+                      "DW_AT_bit_size found but not supported yet."));
cec9297
+          /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
cec9297
+             is the address size of the target machine.  */
cec9297
+          else
cec9297
+            {
a972d47
+              const gdb_byte append_ops[] = { DW_OP_deref };
a972d47
+
a972d47
+              if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
a972d47
+                      ARRAY_SIZE (append_ops)))
cec9297
+                complaint (&symfile_complaints,
cec9297
+                        _("Could not parse DW_AT_string_length"));
cec9297
+            }
cec9297
+
cec9297
+          TYPE_RANGE_DATA (range_type)->high = high;
cec9297
+        }
cec9297
+      else
cec9297
+        {
cec9297
+          TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
cec9297
+          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
cec9297
+        }
cec9297
     }
cec9297
   else
cec9297
     {
cec9297
-      /* Check for the DW_AT_byte_size attribute.  */
cec9297
+      /* Check for the DW_AT_byte_size attribute, which represents the length
cec9297
+         in this case.  */
cec9297
       attr = dwarf2_attr (die, DW_AT_byte_size, cu);
cec9297
       if (attr)
cec9297
         {
cec9297
-          length = DW_UNSND (attr);
cec9297
+          TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
cec9297
+          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
cec9297
         }
cec9297
       else
cec9297
         {
cec9297
-          length = 1;
cec9297
+          TYPE_HIGH_BOUND (range_type) = 1;
cec9297
+          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
cec9297
         }
cec9297
     }
cec9297
 
cec9297
-  index_type = objfile_type (objfile)->builtin_int;
cec9297
-  range_type = create_static_range_type (NULL, index_type, 1, length);
cec9297
   char_type = language_string_char_type (cu->language_defn, gdbarch);
cec9297
   type = create_string_type (NULL, char_type, range_type);
cec9297
 
2f7f533
@@ -14580,13 +14649,15 @@ read_base_type (struct die_info *die, st
cec9297
   return set_die_type (die, type, cu);
cec9297
 }
cec9297
 
cec9297
+
cec9297
 /* Parse dwarf attribute if it's a block, reference or constant and put the
cec9297
    resulting value of the attribute into struct bound_prop.
cec9297
    Returns 1 if ATTR could be resolved into PROP, 0 otherwise.  */
cec9297
 
cec9297
 static int
cec9297
 attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
cec9297
-		      struct dwarf2_cu *cu, struct dynamic_prop *prop)
cec9297
+		      struct dwarf2_cu *cu, struct dynamic_prop *prop,
cec9297
+		      const gdb_byte *additional_data, int additional_data_size)
cec9297
 {
cec9297
   struct dwarf2_property_baton *baton;
cec9297
   struct obstack *obstack = &cu->objfile->objfile_obstack;
2f7f533
@@ -14599,8 +14670,25 @@ attr_to_dynamic_prop (const struct attri
cec9297
       baton = obstack_alloc (obstack, sizeof (*baton));
cec9297
       baton->referenced_type = NULL;
cec9297
       baton->locexpr.per_cu = cu->per_cu;
cec9297
-      baton->locexpr.size = DW_BLOCK (attr)->size;
a972d47
-      baton->locexpr.data = DW_BLOCK (attr)->data;
a972d47
+
a972d47
+      if (additional_data != NULL && additional_data_size > 0)
a972d47
+        {
a972d47
+          gdb_byte *data;
a972d47
+
a972d47
+          data = obstack_alloc (&cu->objfile->objfile_obstack,
a972d47
+                  DW_BLOCK (attr)->size + additional_data_size);
a972d47
+          memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
a972d47
+          memcpy (data + DW_BLOCK (attr)->size,
a972d47
+                  additional_data, additional_data_size);
a972d47
+
a972d47
+          baton->locexpr.data = data;
a972d47
+          baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
a972d47
+        }
a972d47
+      else
a972d47
+        {
a972d47
+          baton->locexpr.data = DW_BLOCK (attr)->data;
a972d47
+          baton->locexpr.size = DW_BLOCK (attr)->size;
a972d47
+        }
cec9297
       prop->data.baton = baton;
cec9297
       prop->kind = PROP_LOCEXPR;
cec9297
       gdb_assert (prop->data.baton != NULL);
2f7f533
@@ -14630,8 +14718,28 @@ attr_to_dynamic_prop (const struct attri
cec9297
 	  baton = obstack_alloc (obstack, sizeof (*baton));
cec9297
 	  baton->referenced_type = die_type (target_die, target_cu);
cec9297
 	  baton->locexpr.per_cu = cu->per_cu;
a972d47
-	  baton->locexpr.size = DW_BLOCK (target_attr)->size;
a972d47
-	  baton->locexpr.data = DW_BLOCK (target_attr)->data;
a972d47
+
a972d47
+	  if (additional_data != NULL && additional_data_size > 0)
a972d47
+	    {
a972d47
+	      gdb_byte *data;
a972d47
+
a972d47
+	      data = obstack_alloc (&cu->objfile->objfile_obstack,
a972d47
+	              DW_BLOCK (target_attr)->size + additional_data_size);
a972d47
+	      memcpy (data, DW_BLOCK (target_attr)->data,
a972d47
+	              DW_BLOCK (target_attr)->size);
a972d47
+	      memcpy (data + DW_BLOCK (target_attr)->size,
a972d47
+	              additional_data, additional_data_size);
a972d47
+
a972d47
+	      baton->locexpr.data = data;
a972d47
+	      baton->locexpr.size = (DW_BLOCK (target_attr)->size
a972d47
+	                             + additional_data_size);
a972d47
+	    }
a972d47
+	  else
a972d47
+	    {
a972d47
+	      baton->locexpr.data = DW_BLOCK (target_attr)->data;
a972d47
+	      baton->locexpr.size = DW_BLOCK (target_attr)->size;
a972d47
+	    }
a972d47
+
cec9297
 	  prop->data.baton = baton;
cec9297
 	  prop->kind = PROP_LOCEXPR;
cec9297
 	  gdb_assert (prop->data.baton != NULL);
2f7f533
@@ -14666,7 +14774,7 @@ read_subrange_type (struct die_info *die
cec9297
   struct type *base_type, *orig_base_type;
cec9297
   struct type *range_type;
cec9297
   struct attribute *attr;
cec9297
-  struct dynamic_prop low, high;
cec9297
+  struct dynamic_prop low, high, stride;
cec9297
   int low_default_is_valid;
cec9297
   int high_bound_is_count = 0;
cec9297
   const char *name;
2f7f533
@@ -14686,7 +14794,9 @@ read_subrange_type (struct die_info *die
cec9297
 
cec9297
   low.kind = PROP_CONST;
cec9297
   high.kind = PROP_CONST;
cec9297
+  stride.kind = PROP_CONST;
cec9297
   high.data.const_val = 0;
cec9297
+  stride.data.const_val = 0;
cec9297
 
cec9297
   /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
cec9297
      omitting DW_AT_lower_bound.  */
2f7f533
@@ -14719,19 +14829,26 @@ read_subrange_type (struct die_info *die
cec9297
       break;
cec9297
     }
cec9297
 
cec9297
+  attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
cec9297
+  if (attr)
cec9297
+    if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0))
cec9297
+        complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
cec9297
+                  "- DIE at 0x%x [in module %s]"),
cec9297
+             die->offset.sect_off, objfile_name (cu->objfile));
cec9297
+
cec9297
   attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
cec9297
   if (attr)
cec9297
-    attr_to_dynamic_prop (attr, die, cu, &low);
cec9297
+    attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
cec9297
   else if (!low_default_is_valid)
cec9297
     complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
cec9297
 				      "- DIE at 0x%x [in module %s]"),
cec9297
 	       die->offset.sect_off, objfile_name (cu->objfile));
cec9297
 
cec9297
   attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
cec9297
-  if (!attr_to_dynamic_prop (attr, die, cu, &high))
cec9297
+  if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
cec9297
     {
cec9297
       attr = dwarf2_attr (die, DW_AT_count, cu);
cec9297
-      if (attr_to_dynamic_prop (attr, die, cu, &high))
cec9297
+      if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
cec9297
 	{
cec9297
 	  /* If bounds are constant do the final calculation here.  */
cec9297
 	  if (low.kind == PROP_CONST && high.kind == PROP_CONST)
2f7f533
@@ -14795,7 +14912,7 @@ read_subrange_type (struct die_info *die
cec9297
       && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
cec9297
     high.data.const_val |= negative_mask;
cec9297
 
cec9297
-  range_type = create_range_type (NULL, orig_base_type, &low, &high);
cec9297
+  range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
cec9297
 
cec9297
   if (high_bound_is_count)
cec9297
     TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
2f7f533
@@ -21860,7 +21977,44 @@ set_die_type (struct die_info *die, stru
cec9297
 
2f7f533
   /* Read DW_AT_data_location and set in type.  */
2f7f533
   attr = dwarf2_attr (die, DW_AT_data_location, cu);
2f7f533
-  if (attr_to_dynamic_prop (attr, die, cu, &prop))
2f7f533
+  if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
2f7f533
+    {
2f7f533
+      TYPE_DATA_LOCATION (type)
2f7f533
+        = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
2f7f533
+      *TYPE_DATA_LOCATION (type) = prop;
2f7f533
+    }
2f7f533
+
cec9297
+  /* Read DW_AT_allocated and set in type.  */
cec9297
+  attr = dwarf2_attr (die, DW_AT_allocated, cu);
cec9297
+  if (attr_form_is_block (attr))
cec9297
+    {
cec9297
+      struct dynamic_prop prop;
cec9297
+
cec9297
+      if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
cec9297
+        {
cec9297
+          TYPE_ALLOCATED_PROP (type)
cec9297
+            = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
cec9297
+          *TYPE_ALLOCATED_PROP (type) = prop;
cec9297
+        }
cec9297
+    }
cec9297
+
cec9297
+  /* Read DW_AT_associated and set in type.  */
cec9297
+  attr = dwarf2_attr (die, DW_AT_associated, cu);
cec9297
+  if (attr_form_is_block (attr))
cec9297
+    {
cec9297
+      struct dynamic_prop prop;
cec9297
+
cec9297
+      if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
cec9297
+        {
cec9297
+          TYPE_ASSOCIATED_PROP (type)
cec9297
+            = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
cec9297
+          *TYPE_ASSOCIATED_PROP (type) = prop;
cec9297
+        }
cec9297
+    }
cec9297
+
cec9297
+  /* Read DW_AT_data_location and set in type.  */
cec9297
+  attr = dwarf2_attr (die, DW_AT_data_location, cu);
cec9297
+  if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
cec9297
     {
2f7f533
       TYPE_DATA_LOCATION (type)
2f7f533
         = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
2f7f533
Index: gdb-7.8.50.20141228/gdb/f-typeprint.c
b132e8a
===================================================================
2f7f533
--- gdb-7.8.50.20141228.orig/gdb/f-typeprint.c	2015-01-06 22:51:17.663240907 +0100
2f7f533
+++ gdb-7.8.50.20141228/gdb/f-typeprint.c	2015-01-06 23:03:07.428684772 +0100
cec9297
@@ -30,6 +30,7 @@
cec9297
 #include "gdbcore.h"
cec9297
 #include "target.h"
cec9297
 #include "f-lang.h"
cec9297
+#include "valprint.h"
cec9297
 
2f7f533
 #if 0				/* Currently unused.  */
2f7f533
 static void f_type_print_args (struct type *, struct ui_file *);
2f7f533
@@ -53,6 +54,17 @@ f_print_type (struct type *type, const c
cec9297
   enum type_code code;
cec9297
   int demangled_args;
cec9297
 
cec9297
+  if (TYPE_NOT_ASSOCIATED (type))
cec9297
+    {
cec9297
+      val_print_not_associated (stream);
cec9297
+      return;
cec9297
+    }
cec9297
+  if (TYPE_NOT_ALLOCATED (type))
cec9297
+    {
cec9297
+      val_print_not_allocated (stream);
cec9297
+      return;
cec9297
+    }
cec9297
+
cec9297
   f_type_print_base (type, stream, show, level);
cec9297
   code = TYPE_CODE (type);
cec9297
   if ((varstring != NULL && *varstring != '\0')
2f7f533
@@ -167,28 +179,36 @@ f_type_print_varspec_suffix (struct type
cec9297
       if (arrayprint_recurse_level == 1)
cec9297
 	fprintf_filtered (stream, "(");
cec9297
 
cec9297
-      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
cec9297
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
cec9297
-				     arrayprint_recurse_level);
cec9297
-
cec9297
-      lower_bound = f77_get_lowerbound (type);
cec9297
-      if (lower_bound != 1)	/* Not the default.  */
cec9297
-	fprintf_filtered (stream, "%d:", lower_bound);
cec9297
-
cec9297
-      /* Make sure that, if we have an assumed size array, we
cec9297
-         print out a warning and print the upperbound as '*'.  */
cec9297
-
cec9297
-      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
cec9297
-	fprintf_filtered (stream, "*");
cec9297
+      if (TYPE_NOT_ASSOCIATED (type))
cec9297
+        val_print_not_associated (stream);
cec9297
+      else if (TYPE_NOT_ALLOCATED (type))
cec9297
+        val_print_not_allocated (stream);
cec9297
       else
cec9297
-	{
cec9297
-	  upper_bound = f77_get_upperbound (type);
cec9297
-	  fprintf_filtered (stream, "%d", upper_bound);
cec9297
-	}
cec9297
-
cec9297
-      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
cec9297
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
cec9297
-				     arrayprint_recurse_level);
cec9297
+        {
cec9297
+
cec9297
+          if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
cec9297
+            f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
cec9297
+                 arrayprint_recurse_level);
cec9297
+
cec9297
+          lower_bound = f77_get_lowerbound (type);
cec9297
+          if (lower_bound != 1)	/* Not the default.  */
cec9297
+            fprintf_filtered (stream, "%d:", lower_bound);
cec9297
+
cec9297
+          /* Make sure that, if we have an assumed size array, we
cec9297
+             print out a warning and print the upperbound as '*'.  */
cec9297
+
cec9297
+          if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
cec9297
+            fprintf_filtered (stream, "*");
cec9297
+          else
cec9297
+            {
cec9297
+              upper_bound = f77_get_upperbound (type);
cec9297
+              fprintf_filtered (stream, "%d", upper_bound);
cec9297
+            }
cec9297
+
cec9297
+          if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
cec9297
+            f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
cec9297
+                 arrayprint_recurse_level);
cec9297
+      }
cec9297
       if (arrayprint_recurse_level == 1)
cec9297
 	fprintf_filtered (stream, ")");
cec9297
       else
2f7f533
Index: gdb-7.8.50.20141228/gdb/f-valprint.c
b132e8a
===================================================================
2f7f533
--- gdb-7.8.50.20141228.orig/gdb/f-valprint.c	2015-01-06 22:51:17.663240907 +0100
2f7f533
+++ gdb-7.8.50.20141228/gdb/f-valprint.c	2015-01-06 23:03:07.428684772 +0100
2f7f533
@@ -36,8 +36,6 @@
cec9297
 
cec9297
 extern void _initialize_f_valprint (void);
cec9297
 static void info_common_command (char *, int);
cec9297
-static void f77_create_arrayprint_offset_tbl (struct type *,
cec9297
-					      struct ui_file *);
cec9297
 static void f77_get_dynamic_length_of_aggregate (struct type *);
cec9297
 
cec9297
 int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
2f7f533
@@ -45,15 +43,6 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM
cec9297
 /* Array which holds offsets to be applied to get a row's elements
cec9297
    for a given array.  Array also holds the size of each subarray.  */
cec9297
 
cec9297
-/* The following macro gives us the size of the nth dimension, Where 
cec9297
-   n is 1 based.  */
cec9297
-
cec9297
-#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
cec9297
-
cec9297
-/* The following gives us the offset for row n where n is 1-based.  */
cec9297
-
cec9297
-#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
cec9297
-
cec9297
 int
cec9297
 f77_get_lowerbound (struct type *type)
cec9297
 {
2f7f533
@@ -111,47 +100,6 @@ f77_get_dynamic_length_of_aggregate (str
cec9297
     * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
cec9297
 }
cec9297
 
cec9297
-/* Function that sets up the array offset,size table for the array 
cec9297
-   type "type".  */
cec9297
-
cec9297
-static void
cec9297
-f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
cec9297
-{
cec9297
-  struct type *tmp_type;
cec9297
-  int eltlen;
cec9297
-  int ndimen = 1;
cec9297
-  int upper, lower;
cec9297
-
cec9297
-  tmp_type = type;
cec9297
-
cec9297
-  while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
cec9297
-    {
cec9297
-      upper = f77_get_upperbound (tmp_type);
cec9297
-      lower = f77_get_lowerbound (tmp_type);
cec9297
-
cec9297
-      F77_DIM_SIZE (ndimen) = upper - lower + 1;
cec9297
-
cec9297
-      tmp_type = TYPE_TARGET_TYPE (tmp_type);
cec9297
-      ndimen++;
cec9297
-    }
cec9297
-
cec9297
-  /* Now we multiply eltlen by all the offsets, so that later we 
cec9297
-     can print out array elements correctly.  Up till now we 
cec9297
-     know an offset to apply to get the item but we also 
cec9297
-     have to know how much to add to get to the next item.  */
cec9297
-
cec9297
-  ndimen--;
cec9297
-  eltlen = TYPE_LENGTH (tmp_type);
cec9297
-  F77_DIM_OFFSET (ndimen) = eltlen;
cec9297
-  while (--ndimen > 0)
cec9297
-    {
cec9297
-      eltlen *= F77_DIM_SIZE (ndimen + 1);
cec9297
-      F77_DIM_OFFSET (ndimen) = eltlen;
cec9297
-    }
cec9297
-}
cec9297
-
cec9297
-
cec9297
-
cec9297
 /* Actual function which prints out F77 arrays, Valaddr == address in 
cec9297
    the superior.  Address == the address in the inferior.  */
cec9297
 
2f7f533
@@ -164,41 +112,62 @@ f77_print_array_1 (int nss, int ndimensi
cec9297
 		   const struct value_print_options *options,
cec9297
 		   int *elts)
cec9297
 {
cec9297
+  struct type *range_type = TYPE_INDEX_TYPE (check_typedef (type));
cec9297
+  CORE_ADDR addr = address + embedded_offset;
cec9297
+  LONGEST lowerbound, upperbound;
cec9297
   int i;
cec9297
 
cec9297
+  get_discrete_bounds (range_type, &lowerbound, &upperbound);
cec9297
+
cec9297
   if (nss != ndimensions)
cec9297
     {
cec9297
-      for (i = 0;
cec9297
-	   (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max);
cec9297
+      size_t dim_size;
cec9297
+      size_t offs = 0;
cec9297
+      LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
cec9297
+
cec9297
+      if (byte_stride)
cec9297
+        dim_size = byte_stride;
cec9297
+      else
cec9297
+        dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
cec9297
+
cec9297
+      for (i = lowerbound;
cec9297
+	   (i < upperbound + 1 && (*elts) < options->print_max);
cec9297
 	   i++)
cec9297
 	{
cec9297
+	  struct value *subarray = value_from_contents_and_address
cec9297
+	    (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
cec9297
+	     + offs, addr + offs);
cec9297
+
cec9297
 	  fprintf_filtered (stream, "( ");
cec9297
-	  f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
cec9297
-			     valaddr,
cec9297
-			     embedded_offset + i * F77_DIM_OFFSET (nss),
cec9297
-			     address,
cec9297
-			     stream, recurse, val, options, elts);
cec9297
+	  f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
cec9297
+			     value_contents_for_printing (subarray),
cec9297
+			     value_embedded_offset (subarray),
cec9297
+			     value_address (subarray),
cec9297
+			     stream, recurse, subarray, options, elts);
cec9297
+	  offs += dim_size;
cec9297
 	  fprintf_filtered (stream, ") ");
cec9297
 	}
cec9297
-      if (*elts >= options->print_max && i < F77_DIM_SIZE (nss)) 
cec9297
+      if (*elts >= options->print_max && i < upperbound)
cec9297
 	fprintf_filtered (stream, "...");
cec9297
     }
cec9297
   else
cec9297
     {
cec9297
-      for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max;
cec9297
+      for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
cec9297
 	   i++, (*elts)++)
cec9297
 	{
cec9297
-	  val_print (TYPE_TARGET_TYPE (type),
cec9297
-		     valaddr,
cec9297
-		     embedded_offset + i * F77_DIM_OFFSET (ndimensions),
cec9297
-		     address, stream, recurse,
cec9297
-		     val, options, current_language);
cec9297
+	  struct value *elt = value_subscript ((struct value *)val, i);
cec9297
+
cec9297
+	  val_print (value_type (elt),
cec9297
+		     value_contents_for_printing (elt),
cec9297
+		     value_embedded_offset (elt),
cec9297
+		     value_address (elt), stream, recurse,
cec9297
+		     elt, options, current_language);
cec9297
 
cec9297
-	  if (i != (F77_DIM_SIZE (nss) - 1))
cec9297
+	  if (i != upperbound)
cec9297
 	    fprintf_filtered (stream, ", ");
cec9297
 
cec9297
 	  if ((*elts == options->print_max - 1)
cec9297
-	      && (i != (F77_DIM_SIZE (nss) - 1)))
cec9297
+	      && (i != upperbound))
cec9297
 	    fprintf_filtered (stream, "...");
cec9297
 	}
cec9297
     }
2f7f533
@@ -225,12 +194,6 @@ f77_print_array (struct type *type, cons
cec9297
 Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
cec9297
 	   ndimensions, MAX_FORTRAN_DIMS);
cec9297
 
cec9297
-  /* Since F77 arrays are stored column-major, we set up an 
cec9297
-     offset table to get at the various row's elements.  The 
cec9297
-     offset table contains entries for both offset and subarray size.  */
cec9297
-
cec9297
-  f77_create_arrayprint_offset_tbl (type, stream);
cec9297
-
cec9297
   f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
cec9297
 		     address, stream, recurse, val, options, &elts);
cec9297
 }
2f7f533
@@ -375,12 +338,15 @@ f_val_print (struct type *type, const gd
cec9297
       fprintf_filtered (stream, "( ");
cec9297
       for (index = 0; index < TYPE_NFIELDS (type); index++)
cec9297
         {
cec9297
-          int offset = TYPE_FIELD_BITPOS (type, index) / 8;
cec9297
+	  struct value *field = value_field
cec9297
+	    ((struct value *)original_value, index);
cec9297
+
cec9297
+          val_print (value_type (field),
cec9297
+		     value_contents_for_printing (field),
cec9297
+		     value_embedded_offset (field),
cec9297
+		     value_address (field), stream, recurse + 1,
cec9297
+		     field, options, current_language);
cec9297
 
cec9297
-          val_print (TYPE_FIELD_TYPE (type, index), valaddr,
cec9297
-		     embedded_offset + offset,
cec9297
-		     address, stream, recurse + 1,
cec9297
-		     original_value, options, current_language);
cec9297
           if (index != TYPE_NFIELDS (type) - 1)
cec9297
             fputs_filtered (", ", stream);
cec9297
         }
2f7f533
Index: gdb-7.8.50.20141228/gdb/gdbtypes.c
b132e8a
===================================================================
2f7f533
--- gdb-7.8.50.20141228.orig/gdb/gdbtypes.c	2015-01-06 22:51:17.663240907 +0100
2f7f533
+++ gdb-7.8.50.20141228/gdb/gdbtypes.c	2015-01-06 23:03:07.429684777 +0100
2f7f533
@@ -815,7 +815,8 @@ allocate_stub_method (struct type *type)
cec9297
 struct type *
cec9297
 create_range_type (struct type *result_type, struct type *index_type,
cec9297
 		   const struct dynamic_prop *low_bound,
cec9297
-		   const struct dynamic_prop *high_bound)
cec9297
+		   const struct dynamic_prop *high_bound,
cec9297
+		   const struct dynamic_prop *stride)
cec9297
 {
cec9297
   if (result_type == NULL)
cec9297
     result_type = alloc_type_copy (index_type);
2f7f533
@@ -830,6 +831,7 @@ create_range_type (struct type *result_t
cec9297
     TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
cec9297
   TYPE_RANGE_DATA (result_type)->low = *low_bound;
cec9297
   TYPE_RANGE_DATA (result_type)->high = *high_bound;
cec9297
+  TYPE_RANGE_DATA (result_type)->stride = *stride;
cec9297
 
cec9297
   if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
cec9297
     TYPE_UNSIGNED (result_type) = 1;
2f7f533
@@ -858,7 +860,7 @@ struct type *
cec9297
 create_static_range_type (struct type *result_type, struct type *index_type,
cec9297
 			  LONGEST low_bound, LONGEST high_bound)
cec9297
 {
cec9297
-  struct dynamic_prop low, high;
cec9297
+  struct dynamic_prop low, high, stride;
cec9297
 
cec9297
   low.kind = PROP_CONST;
cec9297
   low.data.const_val = low_bound;
2f7f533
@@ -866,7 +868,11 @@ create_static_range_type (struct type *r
cec9297
   high.kind = PROP_CONST;
cec9297
   high.data.const_val = high_bound;
cec9297
 
cec9297
-  result_type = create_range_type (result_type, index_type, &low, &high);
cec9297
+  stride.kind = PROP_CONST;
cec9297
+  stride.data.const_val = 0;
cec9297
+
cec9297
+  result_type = create_range_type (result_type, index_type,
cec9297
+                                   &low, &high, &stride);
cec9297
 
cec9297
   return result_type;
cec9297
 }
2f7f533
@@ -1020,18 +1026,24 @@ create_array_type_with_stride (struct ty
cec9297
 
cec9297
   TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
cec9297
   TYPE_TARGET_TYPE (result_type) = element_type;
cec9297
-  if (has_static_range (TYPE_RANGE_DATA (range_type)))
cec9297
+  if (has_static_range (TYPE_RANGE_DATA (range_type))
cec9297
+      && dwarf2_address_data_valid (result_type))
cec9297
     {
cec9297
-      LONGEST low_bound, high_bound;
cec9297
+      LONGEST low_bound, high_bound, byte_stride;
cec9297
 
cec9297
       if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
cec9297
 	low_bound = high_bound = 0;
cec9297
       CHECK_TYPEDEF (element_type);
cec9297
+
cec9297
+      byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
cec9297
+
cec9297
       /* Be careful when setting the array length.  Ada arrays can be
cec9297
 	 empty arrays with the high_bound being smaller than the low_bound.
cec9297
 	 In such cases, the array length should be zero.  */
cec9297
       if (high_bound < low_bound)
cec9297
 	TYPE_LENGTH (result_type) = 0;
cec9297
+      else if (byte_stride > 0)
cec9297
+	TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
cec9297
       else if (bit_stride > 0)
cec9297
 	TYPE_LENGTH (result_type) =
cec9297
 	  (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
2f7f533
@@ -1630,12 +1642,31 @@ stub_noname_complaint (void)
a972d47
 static int
a972d47
 is_dynamic_type_internal (struct type *type, int top_level)
cec9297
 {
cec9297
+  int index;
cec9297
+
cec9297
+  if (!type)
cec9297
+    return 0;
cec9297
+
cec9297
   type = check_typedef (type);
cec9297
 
a972d47
   /* We only want to recognize references at the outermost level.  */
a972d47
   if (top_level && TYPE_CODE (type) == TYPE_CODE_REF)
cec9297
     type = check_typedef (TYPE_TARGET_TYPE (type));
cec9297
 
cec9297
+  if (TYPE_ASSOCIATED_PROP (type))
cec9297
+    return 1;
cec9297
+
cec9297
+  if (TYPE_ALLOCATED_PROP (type))
cec9297
+    return 1;
cec9297
+
cec9297
+  /* Scan field types in the Fortran case for nested dynamic types.
cec9297
+     This will be done only for Fortran as in the C++ case an endless recursion
cec9297
+     can occur in the area of classes.  */
cec9297
+  if (current_language->la_language == language_fortran)
cec9297
+    for (index = 0; index < TYPE_NFIELDS (type); index++)
cec9297
+      if (is_dynamic_type (TYPE_FIELD_TYPE (type, index)))
cec9297
+        return 1;
cec9297
+
2f7f533
   /* Types that have a dynamic TYPE_DATA_LOCATION are considered
2f7f533
      dynamic, even if the type itself is statically defined.
2f7f533
      From a user's point of view, this may appear counter-intuitive;
2f7f533
@@ -1656,11 +1687,19 @@ is_dynamic_type_internal (struct type *t
cec9297
       {
cec9297
 	gdb_assert (TYPE_NFIELDS (type) == 1);
cec9297
 
cec9297
-	/* The array is dynamic if either the bounds are dynamic,
cec9297
-	   or the elements it contains have a dynamic contents.  */
cec9297
+	/* The array is dynamic if either
cec9297
+     - the bounds are dynamic,
cec9297
+	   - the elements it contains have a dynamic contents
cec9297
+     - a data_locaton attribute was found.  */
a972d47
 	if (is_dynamic_type_internal (TYPE_INDEX_TYPE (type), 0))
cec9297
 	  return 1;
a972d47
-	return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
cec9297
+	else if (TYPE_DATA_LOCATION (type) != NULL
cec9297
+	         && (TYPE_DATA_LOCATION_KIND (type) == PROP_LOCEXPR
cec9297
+	             || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST))
cec9297
+    return 1;
cec9297
+  else
a972d47
+    return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
cec9297
+	break;
cec9297
       }
cec9297
 
cec9297
     case TYPE_CODE_STRUCT:
2f7f533
@@ -1673,6 +1712,17 @@ is_dynamic_type_internal (struct type *t
a972d47
 	      && is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0))
cec9297
 	    return 1;
cec9297
       }
cec9297
+    case TYPE_CODE_PTR:
cec9297
+      {
cec9297
+        if (TYPE_TARGET_TYPE (type)
cec9297
+            && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING)
cec9297
+          return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type)));
cec9297
+
cec9297
+        return 0;
cec9297
+        break;
cec9297
+      }
cec9297
+    default:
cec9297
+      return 0;
cec9297
       break;
cec9297
     }
cec9297
 
2f7f533
@@ -1701,7 +1751,8 @@ resolve_dynamic_range (struct type *dyn_
cec9297
   struct type *static_range_type;
cec9297
   const struct dynamic_prop *prop;
cec9297
   const struct dwarf2_locexpr_baton *baton;
cec9297
-  struct dynamic_prop low_bound, high_bound;
cec9297
+  struct dynamic_prop low_bound, high_bound, stride;
cec9297
+  struct type *range_copy = copy_type (dyn_range_type);
cec9297
 
cec9297
   gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
cec9297
 
2f7f533
@@ -1732,10 +1783,17 @@ resolve_dynamic_range (struct type *dyn_
cec9297
       high_bound.kind = PROP_UNDEFINED;
cec9297
       high_bound.data.const_val = 0;
cec9297
     }
cec9297
+  
cec9297
+  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
cec9297
+  if (dwarf2_evaluate_property (prop, addr, &value))
cec9297
+    {
cec9297
+      stride.kind = PROP_CONST;
cec9297
+      stride.data.const_val = value;
cec9297
+    }
cec9297
 
cec9297
-  static_range_type = create_range_type (copy_type (dyn_range_type),
cec9297
-					 TYPE_TARGET_TYPE (dyn_range_type),
cec9297
-					 &low_bound, &high_bound);
cec9297
+  static_range_type = create_range_type (range_copy,
cec9297
+					 TYPE_TARGET_TYPE (range_copy),
cec9297
+					 &low_bound, &high_bound, &stride);
cec9297
   TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
cec9297
   return static_range_type;
cec9297
 }
2f7f533
@@ -1751,23 +1809,46 @@ resolve_dynamic_array (struct type *type
cec9297
   struct type *elt_type;
cec9297
   struct type *range_type;
cec9297
   struct type *ary_dim;
cec9297
+  struct dynamic_prop *prop;
cec9297
+  struct type *copy = copy_type (type);
cec9297
 
cec9297
-  gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
cec9297
+  gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
2f7f533
+	      || TYPE_CODE (type) == TYPE_CODE_STRING);
cec9297
 
cec9297
   elt_type = type;
cec9297
   range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
2f7f533
   range_type = resolve_dynamic_range (range_type, addr);
2f7f533
 
cec9297
+  prop = TYPE_ALLOCATED_PROP (type);
cec9297
+  if (dwarf2_evaluate_property (prop, addr, &value))
cec9297
+    {
cec9297
+      TYPE_ALLOCATED_PROP (copy)->kind = PROP_CONST;
cec9297
+      TYPE_ALLOCATED_PROP (copy)->data.const_val = value;
cec9297
+    }
cec9297
+
cec9297
+  prop = TYPE_ASSOCIATED_PROP (type);
cec9297
+  if (dwarf2_evaluate_property (prop, addr, &value))
cec9297
+    {
cec9297
+      TYPE_ASSOCIATED_PROP (copy)->kind = PROP_CONST;
cec9297
+      TYPE_ASSOCIATED_PROP (copy)->data.const_val = value;
cec9297
+    }
2f7f533
+
cec9297
   ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
cec9297
 
cec9297
-  if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
2f7f533
-    elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr);
cec9297
+  if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
cec9297
+          || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
cec9297
+    elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr);
cec9297
   else
cec9297
     elt_type = TYPE_TARGET_TYPE (type);
cec9297
 
cec9297
-  return create_array_type (copy_type (type),
cec9297
-			    elt_type,
cec9297
-			    range_type);
cec9297
+  if (TYPE_CODE (type) == TYPE_CODE_STRING)
cec9297
+    return create_string_type (copy,
2f7f533
+	    elt_type,
2f7f533
+	    range_type);
cec9297
+  else
cec9297
+    return create_array_type (copy,
2f7f533
+	    elt_type,
2f7f533
+	    range_type);
cec9297
 }
cec9297
 
cec9297
 /* Resolve dynamic bounds of members of the union TYPE to static
2f7f533
@@ -1938,6 +2019,25 @@ resolve_dynamic_type_internal (struct ty
2f7f533
   else
2f7f533
     TYPE_DATA_LOCATION (resolved_type) = NULL;
cec9297
 
cec9297
+  /* Resolve data_location attribute.  */
cec9297
+  prop = TYPE_DATA_LOCATION (resolved_type);
cec9297
+  if (dwarf2_evaluate_property (prop, addr, &value))
cec9297
+    {
cec9297
+      struct type *range_type = TYPE_INDEX_TYPE (resolved_type);
cec9297
+
cec9297
+      /* Adjust the data location with the value of byte stride if set, which
cec9297
+         can describe the separation between successive elements along the
cec9297
+         dimension.  */
cec9297
+      if (TYPE_BYTE_STRIDE (range_type) < 0)
cec9297
+        value += (TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type))
cec9297
+                  * TYPE_BYTE_STRIDE (range_type);
cec9297
+
cec9297
+      TYPE_DATA_LOCATION_ADDR (resolved_type) = value;
cec9297
+      TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST;
cec9297
+    }
cec9297
+  else
cec9297
+    TYPE_DATA_LOCATION (resolved_type) = NULL;
cec9297
+
cec9297
   return resolved_type;
cec9297
 }
cec9297
 
2f7f533
@@ -4174,6 +4274,27 @@ copy_type_recursive (struct objfile *obj
2f7f533
 	      sizeof (struct dynamic_prop));
cec9297
     }
cec9297
 
cec9297
+  /* Copy the data location information.  */
cec9297
+  if (TYPE_DATA_LOCATION (type) != NULL)
cec9297
+    {
cec9297
+      TYPE_DATA_LOCATION (new_type) = xmalloc (sizeof (struct dynamic_prop));
cec9297
+      *TYPE_DATA_LOCATION (new_type) = *TYPE_DATA_LOCATION (type);
cec9297
+    }
cec9297
+
cec9297
+  /* Copy allocated information.  */
cec9297
+  if (TYPE_ALLOCATED_PROP (type) != NULL)
cec9297
+    {
cec9297
+      TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
cec9297
+      *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type);
cec9297
+    }
cec9297
+
cec9297
+  /* Copy associated information.  */
cec9297
+  if (TYPE_ASSOCIATED_PROP (type) != NULL)
cec9297
+    {
cec9297
+      TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
cec9297
+      *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type);
cec9297
+    }
cec9297
+
cec9297
   /* Copy pointers to other types.  */
cec9297
   if (TYPE_TARGET_TYPE (type))
cec9297
     TYPE_TARGET_TYPE (new_type) = 
2f7f533
@@ -4227,6 +4348,44 @@ copy_type (const struct type *type)
2f7f533
 	      sizeof (struct dynamic_prop));
2f7f533
     }
cec9297
 
cec9297
+  if (TYPE_ALLOCATED_PROP (type))
cec9297
+    {
cec9297
+      TYPE_ALLOCATED_PROP (new_type)
cec9297
+              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
cec9297
+                                struct dynamic_prop);
cec9297
+      memcpy (TYPE_ALLOCATED_PROP (new_type), TYPE_ALLOCATED_PROP (type),
cec9297
+        sizeof (struct dynamic_prop));
cec9297
+    }
cec9297
+
cec9297
+  if (TYPE_ASSOCIATED_PROP (type))
cec9297
+    {
cec9297
+      TYPE_ASSOCIATED_PROP (new_type)
cec9297
+              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
cec9297
+                                struct dynamic_prop);
cec9297
+      memcpy (TYPE_ASSOCIATED_PROP (new_type), TYPE_ASSOCIATED_PROP (type),
cec9297
+        sizeof (struct dynamic_prop));
cec9297
+    }
cec9297
+
cec9297
+  if (TYPE_DATA_LOCATION (type))
cec9297
+    {
cec9297
+      TYPE_DATA_LOCATION (new_type)
cec9297
+              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
cec9297
+                                struct dynamic_prop);
cec9297
+      memcpy (TYPE_DATA_LOCATION (new_type), TYPE_DATA_LOCATION (type),
cec9297
+        sizeof (struct dynamic_prop));
cec9297
+    }
cec9297
+
cec9297
+  if (TYPE_NFIELDS (type))
cec9297
+    {
cec9297
+      int nfields = TYPE_NFIELDS (type);
cec9297
+
cec9297
+      TYPE_FIELDS (new_type)
cec9297
+              = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
cec9297
+                                nfields, struct field);
cec9297
+      memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type),
cec9297
+        nfields * sizeof (struct field));
cec9297
+   }
cec9297
+
cec9297
   return new_type;
cec9297
 }
cec9297
 
2f7f533
Index: gdb-7.8.50.20141228/gdb/gdbtypes.h
b132e8a
===================================================================
2f7f533
--- gdb-7.8.50.20141228.orig/gdb/gdbtypes.h	2015-01-06 22:51:17.663240907 +0100
2f7f533
+++ gdb-7.8.50.20141228/gdb/gdbtypes.h	2015-01-06 23:03:07.429684777 +0100
2f7f533
@@ -660,6 +660,10 @@ struct main_type
cec9297
 
cec9297
       struct dynamic_prop high;
cec9297
 
cec9297
+      /* * Stride of range.  */
cec9297
+
cec9297
+      struct dynamic_prop stride;
cec9297
+
cec9297
       /* True if HIGH range bound contains the number of elements in the
cec9297
 	 subrange. This affects how the final hight bound is computed.  */
cec9297
 
2f7f533
@@ -720,6 +724,18 @@ struct main_type
2f7f533
      this field yields to the location of the data for an object.  */
cec9297
 
2f7f533
   struct dynamic_prop *data_location;
cec9297
+
cec9297
+  /* Structure for DW_AT_allocated.
cec9297
+     The presence of this attribute indicates that the object of the type
cec9297
+     can be allocated/deallocated.  The value can be a dwarf expression,
cec9297
+     reference, or a constant.  */
cec9297
+  struct dynamic_prop *allocated;
cec9297
+
cec9297
+  /* Structure for DW_AT_associated.
cec9297
+     The presence of this attribute indicated that the object of the type
cec9297
+     can be associated.  The value can be a dwarf expression,
cec9297
+     reference, or a constant.  */
cec9297
+  struct dynamic_prop *associated;
cec9297
 };
cec9297
 
cec9297
 /* * A ``struct type'' describes a particular instance of a type, with
2f7f533
@@ -1198,6 +1214,39 @@ extern void allocate_gnat_aux_type (stru
cec9297
   TYPE_RANGE_DATA(range_type)->high.kind
cec9297
 #define TYPE_LOW_BOUND_KIND(range_type) \
cec9297
   TYPE_RANGE_DATA(range_type)->low.kind
cec9297
+#define TYPE_BYTE_STRIDE(range_type) \
cec9297
+  TYPE_RANGE_DATA(range_type)->stride.data.const_val
cec9297
+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
cec9297
+  TYPE_RANGE_DATA(range_type)->stride.data.locexpr
cec9297
+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
cec9297
+  TYPE_RANGE_DATA(range_type)->stride.data.loclist
cec9297
+#define TYPE_BYTE_STRIDE_KIND(range_type) \
cec9297
+  TYPE_RANGE_DATA(range_type)->stride.kind
cec9297
+
cec9297
+
cec9297
+/* Attribute accessors for the type data location.  */
cec9297
+#define TYPE_DATA_LOCATION(thistype) \
cec9297
+  TYPE_MAIN_TYPE(thistype)->data_location
cec9297
+#define TYPE_DATA_LOCATION_BATON(thistype) \
cec9297
+  TYPE_DATA_LOCATION (thistype)->data.baton
cec9297
+#define TYPE_DATA_LOCATION_ADDR(thistype) \
cec9297
+  TYPE_DATA_LOCATION (thistype)->data.const_val
cec9297
+#define TYPE_DATA_LOCATION_KIND(thistype) \
cec9297
+  TYPE_DATA_LOCATION (thistype)->kind
cec9297
+#define TYPE_ALLOCATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->allocated
cec9297
+#define TYPE_ASSOCIATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->associated
cec9297
+
cec9297
+/* Allocated status of type object.  If set to non-zero it means the object
cec9297
+   is allocated. A zero value means it is not allocated.  */
cec9297
+#define TYPE_NOT_ALLOCATED(t)  (TYPE_ALLOCATED_PROP (t) \
cec9297
+  && TYPE_ALLOCATED_PROP (t)->kind == PROP_CONST \
cec9297
+  && !TYPE_ALLOCATED_PROP (t)->data.const_val)
cec9297
+
cec9297
+/* Associated status of type object.  If set to non-zero it means the object
cec9297
+   is associated. A zero value means it is not associated.  */
cec9297
+#define TYPE_NOT_ASSOCIATED(t)  (TYPE_ASSOCIATED_PROP (t) \
cec9297
+  && TYPE_ASSOCIATED_PROP (t)->kind == PROP_CONST \
cec9297
+  && !TYPE_ASSOCIATED_PROP (t)->data.const_val)
cec9297
 
2f7f533
 /* Attribute accessors for the type data location.  */
2f7f533
 #define TYPE_DATA_LOCATION(thistype) \
2f7f533
@@ -1215,6 +1264,9 @@ extern void allocate_gnat_aux_type (stru
cec9297
    TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
cec9297
 #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
cec9297
    TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
cec9297
+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
cec9297
+   (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
cec9297
+
cec9297
 
cec9297
 #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
cec9297
    (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
2f7f533
@@ -1685,6 +1737,7 @@ extern struct type *create_array_type_wi
cec9297
 
cec9297
 extern struct type *create_range_type (struct type *, struct type *,
cec9297
 				       const struct dynamic_prop *,
cec9297
+				       const struct dynamic_prop *,
cec9297
 				       const struct dynamic_prop *);
cec9297
 
cec9297
 extern struct type *create_array_type (struct type *, struct type *,
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp	2015-01-06 23:03:07.429684777 +0100
cec9297
@@ -0,0 +1,65 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile "vla.f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+# Check the association status of various types of VLA's
cec9297
+# and pointer to VLA's.
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
cec9297
+gdb_continue_to_breakpoint "vla1-allocated"
cec9297
+gdb_test "print l" " = \\.TRUE\\." \
cec9297
+  "print vla1 allocation status (allocated)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
cec9297
+gdb_continue_to_breakpoint "vla2-allocated"
cec9297
+gdb_test "print l" " = \\.TRUE\\." \
cec9297
+  "print vla2 allocation status (allocated)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
cec9297
+gdb_continue_to_breakpoint "pvla-associated"
cec9297
+gdb_test "print l" " = \\.TRUE\\." \
cec9297
+  "print pvla associated status (associated)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
cec9297
+gdb_continue_to_breakpoint "pvla-re-associated"
cec9297
+gdb_test "print l" " = \\.TRUE\\." \
cec9297
+  "print pvla associated status (re-associated)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
cec9297
+gdb_continue_to_breakpoint "pvla-deassociated"
cec9297
+gdb_test "print l" " = \\.FALSE\\." \
cec9297
+  "print pvla allocation status (deassociated)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
cec9297
+gdb_continue_to_breakpoint "vla1-deallocated"
cec9297
+gdb_test "print l" " = \\.FALSE\\." \
cec9297
+  "print vla1 allocation status (deallocated)"
cec9297
+gdb_test "print vla1" " = <not allocated>" \
cec9297
+  "print deallocated vla1"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
cec9297
+gdb_continue_to_breakpoint "vla2-deallocated"
cec9297
+gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated"
cec9297
+gdb_test "print vla2" " = <not allocated>" "print deallocated vla2"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-datatypes.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-datatypes.exp	2015-01-06 23:03:07.429684777 +0100
cec9297
@@ -0,0 +1,82 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile ".f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+# check that all fortran standard datatypes will be
cec9297
+# handled correctly when using as VLA's
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vlas-allocated"]
cec9297
+gdb_continue_to_breakpoint "vlas-allocated"
cec9297
+gdb_test "next" " = allocated\\\(realvla\\\)" \
cec9297
+  "next to allocation status of intvla"
cec9297
+gdb_test "print l" " = \\.TRUE\\." "intvla allocated"
cec9297
+gdb_test "next" " = allocated\\\(complexvla\\\)" \
cec9297
+  "next to allocation status of realvla"
cec9297
+gdb_test "print l" " = \\.TRUE\\." "realvla allocated"
cec9297
+gdb_test "next" " = allocated\\\(logicalvla\\\)" \
cec9297
+  "next to allocation status of complexvla"
cec9297
+gdb_test "print l" " = \\.TRUE\\." "complexvla allocated"
cec9297
+gdb_test "next" " = allocated\\\(charactervla\\\)" \
cec9297
+  "next to allocation status of logicalvla"
cec9297
+gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated"
cec9297
+gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \
cec9297
+  "next to allocation status of charactervla"
cec9297
+gdb_test "print l" " = \\.TRUE\\." "charactervla allocated"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vlas-initialized"]
cec9297
+gdb_continue_to_breakpoint "vlas-initialized"
cec9297
+gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \
cec9297
+  "ptype intvla"
cec9297
+gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \
cec9297
+  "ptype realvla"
cec9297
+gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \
cec9297
+  "ptype complexvla"
cec9297
+gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \
cec9297
+  "ptype logicalvla"
cec9297
+gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \
cec9297
+  "ptype charactervla"
cec9297
+
cec9297
+gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)"
cec9297
+gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \
cec9297
+  "print realvla(5,5,5) (1st)"
cec9297
+gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \
cec9297
+  "print complexvla(5,5,5) (1st)"
cec9297
+gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \
cec9297
+  "print logicalvla(5,5,5) (1st)"
cec9297
+gdb_test "print charactervla(5,5,5)" " = 'K'" \
cec9297
+  "print charactervla(5,5,5) (1st)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vlas-modified"]
cec9297
+gdb_continue_to_breakpoint "vlas-modified"
cec9297
+gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)"
cec9297
+gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \
cec9297
+  "print realvla(5,5,5) (2nd)"
cec9297
+gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \
cec9297
+  "print complexvla(5,5,5) (2nd)"
cec9297
+gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \
cec9297
+  "print logicalvla(5,5,5) (2nd)"
cec9297
+gdb_test "print charactervla(5,5,5)" " = 'X'" \
cec9297
+  "print charactervla(5,5,5) (2nd)"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-datatypes.f90
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-datatypes.f90	2015-01-06 23:03:07.429684777 +0100
cec9297
@@ -0,0 +1,51 @@
cec9297
+! Copyright 2014 Free Software Foundation, Inc.
cec9297
+!
cec9297
+! This program is free software; you can redistribute it and/or modify
cec9297
+! it under the terms of the GNU General Public License as published by
cec9297
+! the Free Software Foundation; either version 2 of the License, or
cec9297
+! (at your option) any later version.
cec9297
+!
cec9297
+! This program is distributed in the hope that it will be useful,
cec9297
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+! GNU General Public License for more details.
cec9297
+!
cec9297
+! You should have received a copy of the GNU General Public License
cec9297
+! along with this program; if not, write to the Free Software
cec9297
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
cec9297
+
cec9297
+program vla_primitives
cec9297
+  integer, allocatable    :: intvla(:, :, :)
cec9297
+  real, allocatable       :: realvla(:, :, :)
cec9297
+  complex, allocatable    :: complexvla(:, :, :)
cec9297
+  logical, allocatable    :: logicalvla(:, :, :)
cec9297
+  character, allocatable  :: charactervla(:, :, :)
cec9297
+  logical                 :: l
cec9297
+
cec9297
+  allocate (intvla (11,22,33))
cec9297
+  allocate (realvla (11,22,33))
cec9297
+  allocate (complexvla (11,22,33))
cec9297
+  allocate (logicalvla (11,22,33))
cec9297
+  allocate (charactervla (11,22,33))
cec9297
+
cec9297
+  l = allocated(intvla)                   ! vlas-allocated
cec9297
+  l = allocated(realvla)
cec9297
+  l = allocated(complexvla)
cec9297
+  l = allocated(logicalvla)
cec9297
+  l = allocated(charactervla)
cec9297
+
cec9297
+  intvla(:,:,:) = 1
cec9297
+  realvla(:,:,:) = 3.14
cec9297
+  complexvla(:,:,:) = cmplx(2.0,-3.0)
cec9297
+  logicalvla(:,:,:) = .TRUE.
cec9297
+  charactervla(:,:,:) = char(75)
cec9297
+
cec9297
+  intvla(5,5,5) = 42                      ! vlas-initialized
cec9297
+  realvla(5,5,5) = 4.13
cec9297
+  complexvla(5,5,5) = cmplx(-3.0,2.0)
cec9297
+  logicalvla(5,5,5) = .FALSE.
cec9297
+  charactervla(5,5,5) = 'X'
cec9297
+
cec9297
+  ! dummy statement for bp
cec9297
+  l = .FALSE.                             ! vlas-modified
cec9297
+end program vla_primitives
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-func.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-func.exp	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,61 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile ".f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+# Check VLA passed to first Fortran function.
cec9297
+gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]
cec9297
+gdb_continue_to_breakpoint "func1-vla-passed"
cec9297
+gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \
cec9297
+  "print vla (func1)"
cec9297
+gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \
cec9297
+  "ptype vla (func1)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]
cec9297
+gdb_continue_to_breakpoint "func1-vla-modified"
cec9297
+gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"
cec9297
+gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"
cec9297
+
cec9297
+# Check if the values are correct after returning from func1
cec9297
+gdb_breakpoint [gdb_get_line_number "func1-returned"]
cec9297
+gdb_continue_to_breakpoint "func1-returned"
cec9297
+gdb_test "print ret" " = .TRUE." "print ret after func1 returned"
cec9297
+
cec9297
+# Check VLA passed to second Fortran function
cec9297
+gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]
cec9297
+gdb_continue_to_breakpoint "func2-vla-passed"
cec9297
+gdb_test "print vla" \
cec9297
+  " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \
cec9297
+  "print vla (func2)"
cec9297
+gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
cec9297
+  "ptype vla (func2)"
cec9297
+
cec9297
+# Check if the returned VLA has the correct values and ptype.
cec9297
+gdb_breakpoint [gdb_get_line_number "func2-returned"]
cec9297
+gdb_continue_to_breakpoint "func2-returned"
cec9297
+gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \
cec9297
+  "print vla3 (after func2)"
cec9297
+gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
cec9297
+  "ptype vla3 (after func2)"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-func.f90
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-func.f90	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,71 @@
cec9297
+! Copyright 2014 Free Software Foundation, Inc.
cec9297
+!
cec9297
+! This program is free software; you can redistribute it and/or modify
cec9297
+! it under the terms of the GNU General Public License as published by
cec9297
+! the Free Software Foundation; either version 2 of the License, or
cec9297
+! (at your option) any later version.
cec9297
+!
cec9297
+! This program is distributed in the hope that it will be useful,
cec9297
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+! GNU General Public License for more details.
cec9297
+!
cec9297
+! You should have received a copy of the GNU General Public License
cec9297
+! along with this program; if not, write to the Free Software
cec9297
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
cec9297
+
cec9297
+logical function func1 (vla)
cec9297
+  implicit none
cec9297
+  integer, allocatable :: vla (:, :)
cec9297
+  func1 = allocated(vla)
cec9297
+  vla(5,5) = 55               ! func1-vla-passed
cec9297
+  vla(7,7) = 77
cec9297
+  return                      ! func1-vla-modified
cec9297
+end function func1
cec9297
+
cec9297
+function func2(vla)
cec9297
+  implicit none
cec9297
+  integer :: vla (:)
cec9297
+  integer :: func2(size(vla))
cec9297
+  integer :: k
cec9297
+
cec9297
+  vla(1) = 1                    ! func2-vla-passed
cec9297
+  vla(2) = 2
cec9297
+  vla(4) = 4
cec9297
+  vla(8) = 8
cec9297
+
cec9297
+  func2 = vla
cec9297
+end function func2
cec9297
+
cec9297
+program vla_func
cec9297
+  implicit none
cec9297
+  interface
cec9297
+    logical function func1 (vla)
cec9297
+      integer :: vla (:, :)
cec9297
+    end function
cec9297
+  end interface
cec9297
+  interface
cec9297
+    function func2 (vla)
cec9297
+      integer :: vla (:)
cec9297
+      integer func2(size(vla))
cec9297
+    end function
cec9297
+  end interface
cec9297
+
cec9297
+  logical :: ret
cec9297
+  integer, allocatable :: vla1 (:, :)
cec9297
+  integer, allocatable :: vla2 (:)
cec9297
+  integer, allocatable :: vla3 (:)
cec9297
+
cec9297
+  ret = .FALSE.
cec9297
+
cec9297
+  allocate (vla1 (10,10))
cec9297
+  vla1(:,:) = 22
cec9297
+
cec9297
+  allocate (vla2 (10))
cec9297
+  vla2(:) = 44
cec9297
+
cec9297
+  ret = func1(vla1)
cec9297
+  vla3 = func2(vla2)          ! func1-returned
cec9297
+
cec9297
+  ret = .TRUE.                ! func2-returned
cec9297
+end program vla_func
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-history.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-history.exp	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,62 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile "vla.f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+# Set some breakpoints and print complete vla.
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-init"]
cec9297
+gdb_continue_to_breakpoint "vla1-init"
cec9297
+gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
cec9297
+gdb_continue_to_breakpoint "vla2-allocated"
cec9297
+gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
cec9297
+  "print vla1 allocated"
cec9297
+gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
cec9297
+  "print vla2 allocated"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-filled"]
cec9297
+gdb_continue_to_breakpoint "vla1-filled"
cec9297
+gdb_test "print vla1" \
cec9297
+  " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \
cec9297
+  "print vla1 filled"
cec9297
+
cec9297
+# Try to access history values for full vla prints.
cec9297
+gdb_test "print \$1" " = <not allocated>" "print \$1"
cec9297
+gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
cec9297
+  "print \$2"
cec9297
+gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
cec9297
+  "print \$3"
cec9297
+gdb_test "print \$4" \
cec9297
+  " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-filled"]
cec9297
+gdb_continue_to_breakpoint "vla2-filled"
cec9297
+gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)"
cec9297
+gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)"
cec9297
+
cec9297
+# Try to access history values for vla values.
cec9297
+gdb_test "print \$9" " = 1311" "print \$9"
cec9297
+gdb_test "print \$10" " = 1001" "print \$10"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,87 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile "vla-sub.f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+# Pass fixed array to function and handle them as vla in function.
cec9297
+gdb_breakpoint [gdb_get_line_number "not-filled"]
cec9297
+gdb_continue_to_breakpoint "not-filled (1st)"
cec9297
+gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \
cec9297
+  "ptype array1 (passed fixed)"
cec9297
+gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \
cec9297
+  "ptype array2 (passed fixed)"
cec9297
+gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \
cec9297
+  "ptype array1(40, 10) (passed fixed)"
cec9297
+gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \
cec9297
+  "ptype array2(13, 11, 5) (passed fixed)"
cec9297
+
cec9297
+# Pass sub arrays to function and handle them as vla in function.
cec9297
+gdb_continue_to_breakpoint "not-filled (2nd)"
cec9297
+gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \
cec9297
+  "ptype array1 (passed sub-array)"
cec9297
+gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \
cec9297
+  "ptype array2 (passed sub-array)"
cec9297
+gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \
cec9297
+  "ptype array1(3, 3) (passed sub-array)"
cec9297
+gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \
cec9297
+  "ptype array2(4, 4, 4) (passed sub-array)"
cec9297
+
cec9297
+# Check ptype outside of bounds. This should not crash GDB.
cec9297
+gdb_test "ptype array1(100, 100)" "no such vector element" \
cec9297
+  "ptype array1(100, 100) subarray do not crash (passed sub-array)"
cec9297
+gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
cec9297
+  "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)"
cec9297
+
cec9297
+# Pass vla to function.
cec9297
+gdb_continue_to_breakpoint "not-filled (3rd)"
cec9297
+gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \
cec9297
+  "ptype array1 (passed vla)"
cec9297
+gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
cec9297
+  "ptype array2 (passed vla)"
cec9297
+gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \
cec9297
+  "ptype array1(3, 3) (passed vla)"
cec9297
+gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \
cec9297
+  "ptype array2(4, 4, 4) (passed vla)"
cec9297
+
cec9297
+# Check ptype outside of bounds. This should not crash GDB.
cec9297
+gdb_test "ptype array1(100, 100)" "no such vector element" \
cec9297
+  "ptype array1(100, 100) VLA do not crash (passed vla)"
cec9297
+gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
cec9297
+  "ptype array2(100, 100, 100) VLA do not crash (passed vla)"
cec9297
+
cec9297
+# Pass fixed array to function and handle it as VLA of arbitrary length in
cec9297
+# function.
cec9297
+gdb_breakpoint [gdb_get_line_number "end-of-bar"]
cec9297
+gdb_continue_to_breakpoint "end-of-bar"
cec9297
+gdb_test "ptype array1" \
cec9297
+  "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \
cec9297
+  "ptype array1 (arbitrary length)"
cec9297
+gdb_test "ptype array2" \
cec9297
+  "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \
cec9297
+  "ptype array2 (arbitrary length)"
cec9297
+gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \
cec9297
+  "ptype array1(100) (arbitrary length)"
cec9297
+gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \
cec9297
+  "ptype array2(4,100) (arbitrary length)"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-ptype.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-ptype.exp	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,96 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile "vla.f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+# Check the ptype of various VLA states and pointer to VLA's.
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-init"]
cec9297
+gdb_continue_to_breakpoint "vla1-init"
cec9297
+gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized"
cec9297
+gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
cec9297
+gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
cec9297
+gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
cec9297
+  "ptype vla1(3, 6, 9) not initialized"
cec9297
+gdb_test "ptype vla2(5, 45, 20)" \
cec9297
+  "no such vector element because not allocated" \
cec9297
+  "ptype vla1(5, 45, 20) not initialized"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
cec9297
+gdb_continue_to_breakpoint "vla1-allocated"
cec9297
+gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
cec9297
+  "ptype vla1 allocated"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
cec9297
+gdb_continue_to_breakpoint "vla2-allocated"
cec9297
+gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
cec9297
+  "ptype vla2 allocated"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-filled"]
cec9297
+gdb_continue_to_breakpoint "vla1-filled"
cec9297
+gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
cec9297
+  "ptype vla1 filled"
cec9297
+gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \
cec9297
+  "ptype vla1(3, 6, 9)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-filled"]
cec9297
+gdb_continue_to_breakpoint "vla2-filled"
cec9297
+gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
cec9297
+  "ptype vla2 filled"
cec9297
+gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \
cec9297
+  "ptype vla1(5, 45, 20) filled"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
cec9297
+gdb_continue_to_breakpoint "pvla-associated"
cec9297
+gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
cec9297
+  "ptype pvla associated"
cec9297
+gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \
cec9297
+  "ptype pvla(3, 6, 9)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
cec9297
+gdb_continue_to_breakpoint "pvla-re-associated"
cec9297
+gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
cec9297
+  "ptype pvla re-associated"
cec9297
+gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \
cec9297
+  "ptype vla1(5, 45, 20) re-associated"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
cec9297
+gdb_continue_to_breakpoint "pvla-deassociated"
cec9297
+gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
cec9297
+gdb_test "ptype pvla(5, 45, 20)" \
cec9297
+  "no such vector element because not associated" \
cec9297
+  "ptype pvla(5, 45, 20) not associated"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
cec9297
+gdb_continue_to_breakpoint "vla1-deallocated"
cec9297
+gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
cec9297
+gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
cec9297
+  "ptype vla1(3, 6, 9) not allocated"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
cec9297
+gdb_continue_to_breakpoint "vla2-deallocated"
cec9297
+gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
cec9297
+gdb_test "ptype vla2(5, 45, 20)" \
cec9297
+  "no such vector element because not allocated" \
cec9297
+  "ptype vla2(5, 45, 20) not allocated"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-sizeof.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-sizeof.exp	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,46 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile "vla.f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+# Try to access values in non allocated VLA
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-init"]
cec9297
+gdb_continue_to_breakpoint "vla1-init"
cec9297
+gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
cec9297
+
cec9297
+# Try to access value in allocated VLA
cec9297
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
cec9297
+gdb_continue_to_breakpoint "vla2-allocated"
cec9297
+gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
cec9297
+
cec9297
+# Try to access values in undefined pointer to VLA (dangling)
cec9297
+gdb_breakpoint [gdb_get_line_number "vla1-filled"]
cec9297
+gdb_continue_to_breakpoint "vla1-filled"
cec9297
+gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
cec9297
+
cec9297
+# Try to access values in pointer to VLA and compare them
cec9297
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
cec9297
+gdb_continue_to_breakpoint "pvla-associated"
cec9297
+gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-stride.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-stride.exp	2015-01-06 23:03:07.430684782 +0100
a972d47
@@ -0,0 +1,44 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile ".f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
cec9297
+gdb_continue_to_breakpoint "re-reverse-elements"
cec9297
+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
cec9297
+  "print re-reverse-elements"
cec9297
+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
cec9297
+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "odd-elements"]
cec9297
+gdb_continue_to_breakpoint "odd-elements"
cec9297
+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
cec9297
+gdb_test "print pvla(1)" " = 1" "print first odd-element"
cec9297
+gdb_test "print pvla(5)" " = 9" "print last odd-element"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "single-element"]
cec9297
+gdb_continue_to_breakpoint "single-element"
cec9297
+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
cec9297
+gdb_test "print pvla(1)" " = 5" "print one single-element"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-stride.f90
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-stride.f90	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,30 @@
cec9297
+! Copyright 2014 Free Software Foundation, Inc.
cec9297
+!
cec9297
+! This program is free software; you can redistribute it and/or modify
cec9297
+! it under the terms of the GNU General Public License as published by
cec9297
+! the Free Software Foundation; either version 2 of the License, or
cec9297
+! (at your option) any later version.
cec9297
+!
cec9297
+! This program is distributed in the hope that it will be useful,
cec9297
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+! GNU General Public License for more details.
cec9297
+!
cec9297
+! You should have received a copy of the GNU General Public License
cec9297
+! along with this program; if not, write to the Free Software
cec9297
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
cec9297
+
cec9297
+program vla_stride
cec9297
+  integer, target, allocatable :: vla (:)
cec9297
+  integer, pointer :: pvla (:)
cec9297
+
cec9297
+  allocate(vla(10))
cec9297
+  vla = (/ (I, I = 1,10) /)
cec9297
+
cec9297
+  pvla => vla(10:1:-1)
a972d47
+  pvla => pvla(10:1:-1)
cec9297
+  pvla => vla(1:10:2)   ! re-reverse-elements
cec9297
+  pvla => vla(5:4:-2)   ! odd-elements
cec9297
+
cec9297
+  pvla => null()        ! single-element
cec9297
+end program vla_stride
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-strings.exp
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-strings.exp	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,104 @@
cec9297
+# Copyright 2014 Free Software Foundation, Inc.
cec9297
+
cec9297
+# This program is free software; you can redistribute it and/or modify
cec9297
+# it under the terms of the GNU General Public License as published by
cec9297
+# the Free Software Foundation; either version 3 of the License, or
cec9297
+# (at your option) any later version.
cec9297
+#
cec9297
+# This program is distributed in the hope that it will be useful,
cec9297
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+# GNU General Public License for more details.
cec9297
+#
cec9297
+# You should have received a copy of the GNU General Public License
cec9297
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
cec9297
+
cec9297
+standard_testfile ".f90"
cec9297
+
cec9297
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
cec9297
+    {debug f90 quiet}] } {
cec9297
+    return -1
cec9297
+}
cec9297
+
cec9297
+# check that all fortran standard datatypes will be
cec9297
+# handled correctly when using as VLA's
cec9297
+
cec9297
+if ![runto MAIN__] then {
cec9297
+    perror "couldn't run to breakpoint MAIN__"
cec9297
+    continue
cec9297
+}
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
cec9297
+gdb_continue_to_breakpoint "var_char-allocated-1"
cec9297
+gdb_test "print var_char" \
cec9297
+  " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \
cec9297
+  "print var_char after allocated first time"
cec9297
+gdb_test "print *var_char" \
cec9297
+  " = '\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000'" \
cec9297
+  "print *var_char after allocated first time"
cec9297
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10 \\)" \
cec9297
+  "whatis var_char first time"
cec9297
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10 \\)" \
cec9297
+  "ptype var_char first time"
cec9297
+gdb_test "next" "\\d+.*var_char = 'foo'.*" \
cec9297
+  "next to allocation status of var_char"
cec9297
+gdb_test "print l" " = .TRUE." "print allocation status first time"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
cec9297
+gdb_continue_to_breakpoint "var_char-filled-1"
cec9297
+gdb_test "print var_char" \
cec9297
+  " = \\(PTR TO -> \\( character\\*3 \\)\\) ${hex}" \
cec9297
+  "print var_char after filled first time"
cec9297
+gdb_test "print *var_char" " = 'foo'" \
cec9297
+  "print *var_char after filled first time"
cec9297
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3 \\)" \
cec9297
+  "whatis var_char after filled first time"
cec9297
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3 \\)" \
cec9297
+  "ptype var_char after filled first time"
cec9297
+gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
cec9297
+gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
cec9297
+gdb_continue_to_breakpoint "var_char-filled-2"
cec9297
+gdb_test "print var_char" \
cec9297
+  " = \\(PTR TO -> \\( character\\*6 \\)\\) ${hex}" \
cec9297
+  "print var_char after allocated second time"
cec9297
+gdb_test "print *var_char" " = 'foobar'" \
cec9297
+  "print *var_char after allocated second time"
cec9297
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6 \\)" \
cec9297
+  "whatis var_char second time"
cec9297
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6 \\)" \
cec9297
+  "ptype var_char second time"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "var_char-empty"]
cec9297
+gdb_continue_to_breakpoint "var_char-empty"
cec9297
+gdb_test "print var_char" \
cec9297
+  " = \\(PTR TO -> \\( character\\*0 \\)\\) ${hex}" \
cec9297
+  "print var_char after set empty"
cec9297
+gdb_test "print *var_char" " = \"\"" "print *var_char after set empty"
cec9297
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0 \\)" \
cec9297
+  "whatis var_char after set empty"
cec9297
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0 \\)" \
cec9297
+  "ptype var_char after set empty"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"]
cec9297
+gdb_continue_to_breakpoint "var_char-allocated-3"
cec9297
+gdb_test "print var_char" \
cec9297
+  " = \\(PTR TO -> \\( character\\*21 \\)\\) ${hex}" \
cec9297
+  "print var_char after allocated third time"
cec9297
+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21 \\)" \
cec9297
+  "whatis var_char after allocated third time"
cec9297
+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21 \\)" \
cec9297
+  "ptype var_char after allocated third time"
cec9297
+
cec9297
+gdb_breakpoint [gdb_get_line_number "var_char_p-associated"]
cec9297
+gdb_continue_to_breakpoint "var_char_p-associated"
cec9297
+gdb_test "print var_char_p" \
cec9297
+  " = \\(PTR TO -> \\( character\\*7 \\)\\) ${hex}" \
cec9297
+  "print var_char_p after associated"
cec9297
+gdb_test "print *var_char_p" " = 'johndoe'" \
cec9297
+  "print *var_char_ after associated"
cec9297
+gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
cec9297
+  "whatis var_char_p after associated"
cec9297
+gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
cec9297
+  "ptype var_char_p after associated"
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-strings.f90
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-strings.f90	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,40 @@
cec9297
+! Copyright 2014 Free Software Foundation, Inc.
cec9297
+!
cec9297
+! This program is free software; you can redistribute it and/or modify
cec9297
+! it under the terms of the GNU General Public License as published by
cec9297
+! the Free Software Foundation; either version 2 of the License, or
cec9297
+! (at your option) any later version.
cec9297
+!
cec9297
+! This program is distributed in the hope that it will be useful,
cec9297
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+! GNU General Public License for more details.
cec9297
+!
cec9297
+! You should have received a copy of the GNU General Public License
cec9297
+! along with this program; if not, write to the Free Software
cec9297
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
cec9297
+
cec9297
+program vla_strings
cec9297
+  character(len=:), target, allocatable   :: var_char
cec9297
+  character(len=:), pointer               :: var_char_p
cec9297
+  logical                                 :: l
cec9297
+
cec9297
+  allocate(character(len=10) :: var_char)
cec9297
+  l = allocated(var_char)                 ! var_char-allocated-1
cec9297
+  var_char = 'foo'
cec9297
+  deallocate(var_char)                    ! var_char-filled-1
cec9297
+  l = allocated(var_char)                 ! var_char-deallocated
cec9297
+  allocate(character(len=42) :: var_char)
cec9297
+  l = allocated(var_char)
cec9297
+  var_char = 'foobar'
cec9297
+  var_char = ''                           ! var_char-filled-2
cec9297
+  var_char = 'bar'                        ! var_char-empty
cec9297
+  deallocate(var_char)
cec9297
+  allocate(character(len=21) :: var_char)
cec9297
+  l = allocated(var_char)                 ! var_char-allocated-3
cec9297
+  var_char = 'johndoe'
cec9297
+  var_char_p => var_char
cec9297
+  l = associated(var_char_p)              ! var_char_p-associated
cec9297
+  var_char_p => null()
cec9297
+  l = associated(var_char_p)              ! var_char_p-not-associated
cec9297
+end program vla_strings
2f7f533
Index: gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-sub.f90
b132e8a
===================================================================
b132e8a
--- /dev/null	1970-01-01 00:00:00.000000000 +0000
2f7f533
+++ gdb-7.8.50.20141228/gdb/testsuite/gdb.fortran/vla-sub.f90	2015-01-06 23:03:07.430684782 +0100
cec9297
@@ -0,0 +1,82 @@
cec9297
+! Copyright 2014 Free Software Foundation, Inc.
cec9297
+!
cec9297
+! This program is free software; you can redistribute it and/or modify
cec9297
+! it under the terms of the GNU General Public License as published by
cec9297
+! the Free Software Foundation; either version 2 of the License, or
cec9297
+! (at your option) any later version.
cec9297
+!
cec9297
+! This program is distributed in the hope that it will be useful,
cec9297
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
cec9297
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cec9297
+! GNU General Public License for more details.
cec9297
+!
cec9297
+! You should have received a copy of the GNU General Public License
cec9297
+! along with this program; if not, write to the Free Software
cec9297
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
cec9297
+!
cec9297
+! Original file written by Jakub Jelinek <jakub@redhat.com> and
cec9297
+! Jan Kratochvil <jan.kratochvil@redhat.com>.
cec9297
+! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>.
cec9297
+
cec9297
+subroutine foo (array1, array2)
cec9297
+  integer :: array1 (:, :)
cec9297
+  real    :: array2 (:, :, :)
cec9297
+
cec9297
+  array1(:,:) = 5                       ! not-filled
cec9297
+  array1(1, 1) = 30
cec9297
+
cec9297
+  array2(:,:,:) = 6                     ! array1-filled
cec9297
+  array2(:,:,:) = 3
cec9297
+  array2(1,1,1) = 30
cec9297
+  array2(3,3,3) = 90                    ! array2-almost-filled
cec9297
+end subroutine
cec9297
+
cec9297
+subroutine bar (array1, array2)
cec9297
+  integer :: array1 (*)
cec9297
+  integer :: array2 (4:9, 10:*)
cec9297
+
cec9297
+  array1(5:10) = 1311
cec9297
+  array1(7) = 1
cec9297
+  array1(100) = 100
cec9297
+  array2(4,10) = array1(7)
cec9297
+  array2(4,100) = array1(7)
cec9297
+  return