File gdb-vla-intel.patch of Package gdb

Overview Repositories Revisions Requests Users Attributes Meta

File gdb-vla-intel.patch of Package gdb

[PATCH 00/23] Fortran dynamic array support
https://sourceware.org/ml/gdb-patches/2014-06/msg00108.html
https://github.com/intel-gdb/vla/tree/vla-fortran

GIT snapshot:
commit 511bff520372ffc10fa2ff569c176bdf1e6e475d

diff --git a/gdb/NEWS b/gdb/NEWS
index d9a19ae..e6885d2 100644
### a/gdb/NEWS
### b/gdb/NEWS
## -3,6 +3,9 @@
 
 *** Changes since GDB 7.8
 
+* Fortran dynamic array support: It allows the user to evaluate
+  dynamic arrays like an ordinary static array.
+
 *** Changes in GDB 7.8
 
 * New command line options
diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c
index f4694b0..8c45276 100644
--- a/gdb/c-valprint.c
+++ b/gdb/c-valprint.c
@@ -538,7 +538,16 @@ c_value_print (struct value *val, struct ui_file *stream,
 	{
 	  /* normal case */
 	  fprintf_filtered (stream, "(");
-	  type_print (value_type (val), "", stream, -1);
+	  if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
+	    {
+	      struct value *v;
+
+	      v = value_ind (val);
+	      v = value_addr (v);
+	      type_print (value_type (v), "", stream, -1);
+	    }
+	  else
+	    type_print (value_type (val), "", stream, -1);
 	  fprintf_filtered (stream, ") ");
 	}
     }
diff --git a/gdb/dwarf2expr.c b/gdb/dwarf2expr.c
index 36c9f66..274ba62 100644
--- a/gdb/dwarf2expr.c
+++ b/gdb/dwarf2expr.c
@@ -1478,6 +1478,12 @@ execute_stack_op (struct dwarf_expr_context *ctx,
 	  }
 	  break;
 
+        case DW_OP_push_object_address:
+	  /* Return the address of the object we are currently observing.  */
+	  result = (ctx->funcs->get_object_address) (ctx->baton);
+	  result_val = value_from_ulongest (address_type, result);
+	  break;
+
 	default:
 	  error (_("Unhandled dwarf expression opcode 0x%x"), op);
 	}
diff --git a/gdb/dwarf2expr.h b/gdb/dwarf2expr.h
index 39dadf3..8cebbe8 100644
--- a/gdb/dwarf2expr.h
+++ b/gdb/dwarf2expr.h
@@ -84,12 +84,8 @@ struct dwarf_expr_context_funcs
      This can throw an exception if the index is out of range.  */
   CORE_ADDR (*get_addr_index) (void *baton, unsigned int index);
 
-#if 0
-  /* Not yet implemented.  */
-
   /* Return the `object address' for DW_OP_push_object_address.  */
   CORE_ADDR (*get_object_address) (void *baton);
-#endif
 };
 
 /* The location of a value.  */
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index fcab9b9..a624dac 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -306,6 +306,7 @@ struct dwarf_expr_baton
 {
   struct frame_info *frame;
   struct dwarf2_per_cu_data *per_cu;
+  CORE_ADDR obj_address;
 };
 
 /* Helper functions for dwarf2_evaluate_loc_desc.  */
@@ -1209,6 +1210,7 @@ dwarf_expr_push_dwarf_reg_entry_value (struct dwarf_expr_context *ctx,
 
   baton_local.frame = caller_frame;
   baton_local.per_cu = caller_per_cu;
+  baton_local.obj_address = 0;
 
   saved_ctx.gdbarch = ctx->gdbarch;
   saved_ctx.addr_size = ctx->addr_size;
@@ -1238,6 +1240,22 @@ dwarf_expr_get_addr_index (void *baton, unsigned int index)
   return dwarf2_read_addr_index (debaton->per_cu, index);
 }
 
+/* Callback function for get_object_address. Return the address of the VLA
+   object.  */
+
+static CORE_ADDR
+dwarf_expr_get_obj_addr (void *baton)
+{
+  struct dwarf_expr_baton *debaton = baton;
+
+  gdb_assert (debaton != NULL);
+
+  if (debaton->obj_address == 0)
+    error (_("Location address is not set."));
+
+  return debaton->obj_address;
+}
+
 /* VALUE must be of type lval_computed with entry_data_value_funcs.  Perform
    the indirect method on it, that is use its stored target value, the sole
    purpose of entry_data_value_funcs..  */
@@ -2202,7 +2220,8 @@ static const struct dwarf_expr_context_funcs dwarf_expr_ctx_funcs =
   dwarf_expr_dwarf_call,
   dwarf_expr_get_base_type,
   dwarf_expr_push_dwarf_reg_entry_value,
-  dwarf_expr_get_addr_index
+  dwarf_expr_get_addr_index,
+  dwarf_expr_get_obj_addr
 };
 
 /* Evaluate a location description, starting at DATA and with length
@@ -2231,6 +2250,7 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame,
 
   baton.frame = frame;
   baton.per_cu = per_cu;
+  baton.obj_address = 0;
 
   ctx = new_dwarf_expr_context ();
   old_chain = make_cleanup_free_dwarf_expr_context (ctx);
@@ -2326,6 +2346,11 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame,
 	    int in_stack_memory = dwarf_expr_fetch_in_stack_memory (ctx, 0);
 
 	    do_cleanups (value_chain);
+
+	    /* Select right frame to correctly evaluate VLA's during a backtrace.  */
+	    if (is_dynamic_type (type))
+	      select_frame (frame);
+
 	    retval = value_at_lazy (type, address + byte_offset);
 	    if (in_stack_memory)
 	      set_value_stack (retval, 1);
@@ -2436,6 +2461,7 @@ dwarf2_evaluate_loc_desc (struct type *type, struct frame_info *frame,
 
 static int
 dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
+         CORE_ADDR addr,
 			   CORE_ADDR *valp)
 {
   struct dwarf_expr_context *ctx;
@@ -2451,6 +2477,7 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
 
   baton.frame = get_selected_frame (NULL);
   baton.per_cu = dlbaton->per_cu;
+  baton.obj_address = addr;
 
   objfile = dwarf2_per_cu_objfile (dlbaton->per_cu);
 
@@ -2491,7 +2518,8 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
 /* See dwarf2loc.h.  */
 
 int
-dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
+dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR address,
+        CORE_ADDR *value)
 {
   if (prop == NULL)
     return 0;
@@ -2502,7 +2530,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
       {
 	const struct dwarf2_property_baton *baton = prop->data.baton;
 
-	if (dwarf2_locexpr_baton_eval (&baton->locexpr, value))
+	if (dwarf2_locexpr_baton_eval (&baton->locexpr, address, value))
 	  {
 	    if (baton->referenced_type)
 	      {
@@ -2546,6 +2574,20 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
   return 0;
 }
 
+/* See dwarf2loc.h.  */
+
+int
+dwarf2_address_data_valid (const struct type *type)
+{
+  if (TYPE_NOT_ASSOCIATED (type))
+    return 0;
+
+  if (TYPE_NOT_ALLOCATED (type))
+    return 0;
+
+  return 1;
+}
+
 
 /* Helper functions and baton for dwarf2_loc_desc_needs_frame.  */
 
@@ -2653,6 +2695,15 @@ needs_get_addr_index (void *baton, unsigned int index)
   return 1;
 }
 
+/* DW_OP_push_object_address has a frame already passed through.  */
+
+static CORE_ADDR
+needs_get_obj_addr (void *baton)
+{
+  /* Nothing to do.  */
+  return 1;
+}
+
 /* Virtual method table for dwarf2_loc_desc_needs_frame below.  */
 
 static const struct dwarf_expr_context_funcs needs_frame_ctx_funcs =
@@ -2667,7 +2718,8 @@ static const struct dwarf_expr_context_funcs needs_frame_ctx_funcs =
   needs_frame_dwarf_call,
   NULL,				/* get_base_type */
   needs_dwarf_reg_entry_value,
-  needs_get_addr_index
+  needs_get_addr_index,
+  needs_get_obj_addr
 };
 
 /* Return non-zero iff the location expression at DATA (length SIZE)
@@ -3316,6 +3368,10 @@ dwarf2_compile_expr_to_ax (struct agent_expr *expr, struct axs_value *loc,
 	  unimplemented (op);
 	  break;
 
+  case DW_OP_push_object_address:
+    unimplemented (op);
+    break;
+
 	case DW_OP_skip:
 	  offset = extract_signed_integer (op_ptr, 2, byte_order);
 	  op_ptr += 2;
diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
index 8ad5fa9..fb65c5c 100644
--- a/gdb/dwarf2loc.h
+++ b/gdb/dwarf2loc.h
@@ -96,11 +96,18 @@ struct value *dwarf2_evaluate_loc_desc (struct type *type,
    into VALUE, otherwise returns 0.  */
 
 int dwarf2_evaluate_property (const struct dynamic_prop *prop,
+			      CORE_ADDR address,
 			      CORE_ADDR *value);
 
 CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu,
 				  unsigned int addr_index);
 
+/* Checks if a dwarf location definition is valid.
+   Returns 1 if valid; 0 otherwise.  */
+
+extern int dwarf2_address_data_valid (const struct type *type);
+
+
 /* The symbol location baton types used by the DWARF-2 reader (i.e.
    SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol).  "struct
    dwarf2_locexpr_baton" is for a symbol with a single location
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 276d2f1..fbf13ce 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -1847,6 +1847,12 @@ static void free_dwo_file_cleanup (void *);
 static void process_cu_includes (void);
 
 static void check_producer (struct dwarf2_cu *cu);
+
+static int
+attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
+		      struct dwarf2_cu *cu, struct dynamic_prop *prop,
+		      const gdb_byte *additional_data, int additional_data_size);
+
 
 /* Various complaints about symbol reading that don't abort the process.  */
 
@@ -14201,29 +14207,92 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
   struct gdbarch *gdbarch = get_objfile_arch (objfile);
   struct type *type, *range_type, *index_type, *char_type;
   struct attribute *attr;
-  unsigned int length;
+  unsigned int length = UINT_MAX;
+
+  index_type = objfile_type (objfile)->builtin_int;
+  range_type = create_static_range_type (NULL, index_type, 1, length);
 
+  /* If DW_AT_string_length is defined, the length is stored at some location
+   * in memory. */
   attr = dwarf2_attr (die, DW_AT_string_length, cu);
   if (attr)
     {
-      length = DW_UNSND (attr);
+      if (attr_form_is_block (attr))
+        {
+          struct attribute *byte_size, *bit_size;
+          struct dynamic_prop high;
+
+          byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
+          bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
+
+          /* DW_AT_byte_size should never occur together in combination with
+             DW_AT_string_length.  */
+          if ((byte_size == NULL && bit_size != NULL) ||
+                  (byte_size != NULL && bit_size == NULL))
+            complaint (&symfile_complaints, _("DW_AT_byte_size AND "
+                      "DW_AT_bit_size found together at the same time."));
+
+          /* If DW_AT_string_length AND DW_AT_byte_size exist together, it
+             describes the number of bytes that should be read from the length
+             memory location.  */
+          if (byte_size != NULL && bit_size == NULL)
+            {
+              /* Build new dwarf2_locexpr_baton structure with additions to the
+                 data attribute, to reflect DWARF specialities to get address
+                 sizes.  */
+              const gdb_byte append_ops[] = {
+                /* DW_OP_deref_size: size of an address on the target machine
+                   (bytes), where the size will be specified by the next
+                   operand.  */
+                DW_OP_deref_size,
+                /* Operand for DW_OP_deref_size.  */
+                DW_UNSND (byte_size) };
+
+              if (!attr_to_dynamic_prop (attr, die, cu, &high,
+                      append_ops, ARRAY_SIZE (append_ops)))
+                complaint (&symfile_complaints,
+                        _("Could not parse DW_AT_byte_size"));
+            }
+          else if (bit_size != NULL && byte_size == NULL)
+            complaint (&symfile_complaints, _("DW_AT_string_length AND "
+                      "DW_AT_bit_size found but not supported yet."));
+          /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
+             is the address size of the target machine.  */
+          else
+            {
+              const gdb_byte append_ops[] = { DW_OP_deref };
+
+              if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
+                      ARRAY_SIZE (append_ops)))
+                complaint (&symfile_complaints,
+                        _("Could not parse DW_AT_string_length"));
+            }
+
+          TYPE_RANGE_DATA (range_type)->high = high;
+        }
+      else
+        {
+          TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
+          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
+        }
     }
   else
     {
-      /* Check for the DW_AT_byte_size attribute.  */
+      /* Check for the DW_AT_byte_size attribute, which represents the length
+         in this case.  */
       attr = dwarf2_attr (die, DW_AT_byte_size, cu);
       if (attr)
         {
-          length = DW_UNSND (attr);
+          TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
+          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
         }
       else
         {
-          length = 1;
+          TYPE_HIGH_BOUND (range_type) = 1;
+          TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
         }
     }
 
-  index_type = objfile_type (objfile)->builtin_int;
-  range_type = create_static_range_type (NULL, index_type, 1, length);
   char_type = language_string_char_type (cu->language_defn, gdbarch);
   type = create_string_type (NULL, char_type, range_type);
 
@@ -14540,13 +14609,15 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
   return set_die_type (die, type, cu);
 }
 
+
 /* Parse dwarf attribute if it's a block, reference or constant and put the
    resulting value of the attribute into struct bound_prop.
    Returns 1 if ATTR could be resolved into PROP, 0 otherwise.  */
 
 static int
 attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
-		      struct dwarf2_cu *cu, struct dynamic_prop *prop)
+		      struct dwarf2_cu *cu, struct dynamic_prop *prop,
+		      const gdb_byte *additional_data, int additional_data_size)
 {
   struct dwarf2_property_baton *baton;
   struct obstack *obstack = &cu->objfile->objfile_obstack;
@@ -14559,8 +14630,25 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
       baton = obstack_alloc (obstack, sizeof (*baton));
       baton->referenced_type = NULL;
       baton->locexpr.per_cu = cu->per_cu;
-      baton->locexpr.size = DW_BLOCK (attr)->size;
-      baton->locexpr.data = DW_BLOCK (attr)->data;
+
+      if (additional_data != NULL && additional_data_size > 0)
+        {
+          gdb_byte *data;
+
+          data = obstack_alloc (&cu->objfile->objfile_obstack,
+                  DW_BLOCK (attr)->size + additional_data_size);
+          memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
+          memcpy (data + DW_BLOCK (attr)->size,
+                  additional_data, additional_data_size);
+
+          baton->locexpr.data = data;
+          baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
+        }
+      else
+        {
+          baton->locexpr.data = DW_BLOCK (attr)->data;
+          baton->locexpr.size = DW_BLOCK (attr)->size;
+        }
       prop->data.baton = baton;
       prop->kind = PROP_LOCEXPR;
       gdb_assert (prop->data.baton != NULL);
@@ -14590,8 +14678,28 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
 	  baton = obstack_alloc (obstack, sizeof (*baton));
 	  baton->referenced_type = die_type (target_die, target_cu);
 	  baton->locexpr.per_cu = cu->per_cu;
-	  baton->locexpr.size = DW_BLOCK (target_attr)->size;
-	  baton->locexpr.data = DW_BLOCK (target_attr)->data;
+
+	  if (additional_data != NULL && additional_data_size > 0)
+	    {
+	      gdb_byte *data;
+
+	      data = obstack_alloc (&cu->objfile->objfile_obstack,
+	              DW_BLOCK (target_attr)->size + additional_data_size);
+	      memcpy (data, DW_BLOCK (target_attr)->data,
+	              DW_BLOCK (target_attr)->size);
+	      memcpy (data + DW_BLOCK (target_attr)->size,
+	              additional_data, additional_data_size);
+
+	      baton->locexpr.data = data;
+	      baton->locexpr.size = (DW_BLOCK (target_attr)->size
+	                             + additional_data_size);
+	    }
+	  else
+	    {
+	      baton->locexpr.data = DW_BLOCK (target_attr)->data;
+	      baton->locexpr.size = DW_BLOCK (target_attr)->size;
+	    }
+
 	  prop->data.baton = baton;
 	  prop->kind = PROP_LOCEXPR;
 	  gdb_assert (prop->data.baton != NULL);
@@ -14626,7 +14734,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
   struct type *base_type, *orig_base_type;
   struct type *range_type;
   struct attribute *attr;
-  struct dynamic_prop low, high;
+  struct dynamic_prop low, high, stride;
   int low_default_is_valid;
   int high_bound_is_count = 0;
   const char *name;
@@ -14646,7 +14754,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
 
   low.kind = PROP_CONST;
   high.kind = PROP_CONST;
+  stride.kind = PROP_CONST;
   high.data.const_val = 0;
+  stride.data.const_val = 0;
 
   /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
      omitting DW_AT_lower_bound.  */
@@ -14679,19 +14789,26 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
       break;
     }
 
+  attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
+  if (attr)
+    if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0))
+        complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
+                  "- DIE at 0x%x [in module %s]"),
+             die->offset.sect_off, objfile_name (cu->objfile));
+
   attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
   if (attr)
-    attr_to_dynamic_prop (attr, die, cu, &low);
+    attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
   else if (!low_default_is_valid)
     complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
 				      "- DIE at 0x%x [in module %s]"),
 	       die->offset.sect_off, objfile_name (cu->objfile));
 
   attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
-  if (!attr_to_dynamic_prop (attr, die, cu, &high))
+  if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
     {
       attr = dwarf2_attr (die, DW_AT_count, cu);
-      if (attr_to_dynamic_prop (attr, die, cu, &high))
+      if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
 	{
 	  /* If bounds are constant do the final calculation here.  */
 	  if (low.kind == PROP_CONST && high.kind == PROP_CONST)
@@ -14755,7 +14872,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
       && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
     high.data.const_val |= negative_mask;
 
-  range_type = create_range_type (NULL, orig_base_type, &low, &high);
+  range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
 
   if (high_bound_is_count)
     TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
@@ -21673,6 +21790,8 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
 {
   struct dwarf2_per_cu_offset_and_type **slot, ofs;
   struct objfile *objfile = cu->objfile;
+  struct attribute *attr;
+  struct dynamic_prop prop;
 
   /* For Ada types, make sure that the gnat-specific data is always
      initialized (if not already set).  There are a few types where
@@ -21687,6 +21806,43 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
       && !HAVE_GNAT_AUX_INFO (type))
     INIT_GNAT_SPECIFIC (type);
 
+  /* Read DW_AT_allocated and set in type.  */
+  attr = dwarf2_attr (die, DW_AT_allocated, cu);
+  if (attr_form_is_block (attr))
+    {
+      struct dynamic_prop prop;
+
+      if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
+        {
+          TYPE_ALLOCATED_PROP (type)
+            = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
+          *TYPE_ALLOCATED_PROP (type) = prop;
+        }
+    }
+
+  /* Read DW_AT_associated and set in type.  */
+  attr = dwarf2_attr (die, DW_AT_associated, cu);
+  if (attr_form_is_block (attr))
+    {
+      struct dynamic_prop prop;
+
+      if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
+        {
+          TYPE_ASSOCIATED_PROP (type)
+            = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
+          *TYPE_ASSOCIATED_PROP (type) = prop;
+        }
+    }
+
+  /* Read DW_AT_data_location and set in type.  */
+  attr = dwarf2_attr (die, DW_AT_data_location, cu);
+  if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
+    {
+      TYPE_DATA_LOCATION (type)
+        = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
+      *TYPE_DATA_LOCATION (type) = prop;
+    }
+
   if (dwarf2_per_objfile->die_type_hash == NULL)
     {
       dwarf2_per_objfile->die_type_hash =
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 8356aab..69e67f4 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -30,6 +30,7 @@
 #include "gdbcore.h"
 #include "target.h"
 #include "f-lang.h"
+#include "valprint.h"
 
 #include <string.h>
 #include <errno.h>
@@ -56,6 +57,17 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
   enum type_code code;
   int demangled_args;
 
+  if (TYPE_NOT_ASSOCIATED (type))
+    {
+      val_print_not_associated (stream);
+      return;
+    }
+  if (TYPE_NOT_ALLOCATED (type))
+    {
+      val_print_not_allocated (stream);
+      return;
+    }
+
   f_type_print_base (type, stream, show, level);
   code = TYPE_CODE (type);
   if ((varstring != NULL && *varstring != '\0')
@@ -170,28 +182,36 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
       if (arrayprint_recurse_level == 1)
 	fprintf_filtered (stream, "(");
 
-      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
-				     arrayprint_recurse_level);
-
-      lower_bound = f77_get_lowerbound (type);
-      if (lower_bound != 1)	/* Not the default.  */
-	fprintf_filtered (stream, "%d:", lower_bound);
-
-      /* Make sure that, if we have an assumed size array, we
-         print out a warning and print the upperbound as '*'.  */
-
-      if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
-	fprintf_filtered (stream, "*");
+      if (TYPE_NOT_ASSOCIATED (type))
+        val_print_not_associated (stream);
+      else if (TYPE_NOT_ALLOCATED (type))
+        val_print_not_allocated (stream);
       else
-	{
-	  upper_bound = f77_get_upperbound (type);
-	  fprintf_filtered (stream, "%d", upper_bound);
-	}
-
-      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
-				     arrayprint_recurse_level);
+        {
+
+          if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
+            f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+                 arrayprint_recurse_level);
+
+          lower_bound = f77_get_lowerbound (type);
+          if (lower_bound != 1)	/* Not the default.  */
+            fprintf_filtered (stream, "%d:", lower_bound);
+
+          /* Make sure that, if we have an assumed size array, we
+             print out a warning and print the upperbound as '*'.  */
+
+          if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+            fprintf_filtered (stream, "*");
+          else
+            {
+              upper_bound = f77_get_upperbound (type);
+              fprintf_filtered (stream, "%d", upper_bound);
+            }
+
+          if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
+            f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+                 arrayprint_recurse_level);
+      }
       if (arrayprint_recurse_level == 1)
 	fprintf_filtered (stream, ")");
       else
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 408c8cc..38f32e0 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -39,8 +39,6 @@
 
 extern void _initialize_f_valprint (void);
 static void info_common_command (char *, int);
-static void f77_create_arrayprint_offset_tbl (struct type *,
-					      struct ui_file *);
 static void f77_get_dynamic_length_of_aggregate (struct type *);
 
 int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
@@ -48,15 +46,6 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
 /* Array which holds offsets to be applied to get a row's elements
    for a given array.  Array also holds the size of each subarray.  */
 
-/* The following macro gives us the size of the nth dimension, Where 
-   n is 1 based.  */
-
-#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
-
-/* The following gives us the offset for row n where n is 1-based.  */
-
-#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
-
 int
 f77_get_lowerbound (struct type *type)
 {
@@ -114,47 +103,6 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
     * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
 }
 
-/* Function that sets up the array offset,size table for the array 
-   type "type".  */
-
-static void
-f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
-{
-  struct type *tmp_type;
-  int eltlen;
-  int ndimen = 1;
-  int upper, lower;
-
-  tmp_type = type;
-
-  while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
-    {
-      upper = f77_get_upperbound (tmp_type);
-      lower = f77_get_lowerbound (tmp_type);
-
-      F77_DIM_SIZE (ndimen) = upper - lower + 1;
-
-      tmp_type = TYPE_TARGET_TYPE (tmp_type);
-      ndimen++;
-    }
-
-  /* Now we multiply eltlen by all the offsets, so that later we 
-     can print out array elements correctly.  Up till now we 
-     know an offset to apply to get the item but we also 
-     have to know how much to add to get to the next item.  */
-
-  ndimen--;
-  eltlen = TYPE_LENGTH (tmp_type);
-  F77_DIM_OFFSET (ndimen) = eltlen;
-  while (--ndimen > 0)
-    {
-      eltlen *= F77_DIM_SIZE (ndimen + 1);
-      F77_DIM_OFFSET (ndimen) = eltlen;
-    }
-}
-
-
-
 /* Actual function which prints out F77 arrays, Valaddr == address in 
    the superior.  Address == the address in the inferior.  */
 
@@ -167,41 +115,62 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
 		   const struct value_print_options *options,
 		   int *elts)
 {
+  struct type *range_type = TYPE_INDEX_TYPE (check_typedef (type));
+  CORE_ADDR addr = address + embedded_offset;
+  LONGEST lowerbound, upperbound;
   int i;
 
+  get_discrete_bounds (range_type, &lowerbound, &upperbound);
+
   if (nss != ndimensions)
     {
-      for (i = 0;
-	   (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max);
+      size_t dim_size;
+      size_t offs = 0;
+      LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
+
+      if (byte_stride)
+        dim_size = byte_stride;
+      else
+        dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+
+      for (i = lowerbound;
+	   (i < upperbound + 1 && (*elts) < options->print_max);
 	   i++)
 	{
+	  struct value *subarray = value_from_contents_and_address
+	    (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
+	     + offs, addr + offs);
+
 	  fprintf_filtered (stream, "( ");
-	  f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
-			     valaddr,
-			     embedded_offset + i * F77_DIM_OFFSET (nss),
-			     address,
-			     stream, recurse, val, options, elts);
+	  f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
+			     value_contents_for_printing (subarray),
+			     value_embedded_offset (subarray),
+			     value_address (subarray),
+			     stream, recurse, subarray, options, elts);
+	  offs += dim_size;
 	  fprintf_filtered (stream, ") ");
 	}
-      if (*elts >= options->print_max && i < F77_DIM_SIZE (nss)) 
+      if (*elts >= options->print_max && i < upperbound)
 	fprintf_filtered (stream, "...");
     }
   else
     {
-      for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max;
+      for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
 	   i++, (*elts)++)
 	{
-	  val_print (TYPE_TARGET_TYPE (type),
-		     valaddr,
-		     embedded_offset + i * F77_DIM_OFFSET (ndimensions),
-		     address, stream, recurse,
-		     val, options, current_language);
+	  struct value *elt = value_subscript ((struct value *)val, i);
+
+	  val_print (value_type (elt),
+		     value_contents_for_printing (elt),
+		     value_embedded_offset (elt),
+		     value_address (elt), stream, recurse,
+		     elt, options, current_language);
 
-	  if (i != (F77_DIM_SIZE (nss) - 1))
+	  if (i != upperbound)
 	    fprintf_filtered (stream, ", ");
 
 	  if ((*elts == options->print_max - 1)
-	      && (i != (F77_DIM_SIZE (nss) - 1)))
+	      && (i != upperbound))
 	    fprintf_filtered (stream, "...");
 	}
     }
@@ -228,12 +197,6 @@ f77_print_array (struct type *type, const gdb_byte *valaddr,
 Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
 	   ndimensions, MAX_FORTRAN_DIMS);
 
-  /* Since F77 arrays are stored column-major, we set up an 
-     offset table to get at the various row's elements.  The 
-     offset table contains entries for both offset and subarray size.  */
-
-  f77_create_arrayprint_offset_tbl (type, stream);
-
   f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
 		     address, stream, recurse, val, options, &elts);
 }
@@ -378,12 +341,15 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
       fprintf_filtered (stream, "( ");
       for (index = 0; index < TYPE_NFIELDS (type); index++)
         {
-          int offset = TYPE_FIELD_BITPOS (type, index) / 8;
+	  struct value *field = value_field
+	    ((struct value *)original_value, index);
+
+          val_print (value_type (field),
+		     value_contents_for_printing (field),
+		     value_embedded_offset (field),
+		     value_address (field), stream, recurse + 1,
+		     field, options, current_language);
 
-          val_print (TYPE_FIELD_TYPE (type, index), valaddr,
-		     embedded_offset + offset,
-		     address, stream, recurse + 1,
-		     original_value, options, current_language);
           if (index != TYPE_NFIELDS (type) - 1)
             fputs_filtered (", ", stream);
         }
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index e99a2f3..53cae2c 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -805,7 +805,8 @@ allocate_stub_method (struct type *type)
 struct type *
 create_range_type (struct type *result_type, struct type *index_type,
 		   const struct dynamic_prop *low_bound,
-		   const struct dynamic_prop *high_bound)
+		   const struct dynamic_prop *high_bound,
+		   const struct dynamic_prop *stride)
 {
   if (result_type == NULL)
     result_type = alloc_type_copy (index_type);
@@ -820,6 +821,7 @@ create_range_type (struct type *result_type, struct type *index_type,
     TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
   TYPE_RANGE_DATA (result_type)->low = *low_bound;
   TYPE_RANGE_DATA (result_type)->high = *high_bound;
+  TYPE_RANGE_DATA (result_type)->stride = *stride;
 
   if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
     TYPE_UNSIGNED (result_type) = 1;
@@ -841,7 +843,7 @@ struct type *
 create_static_range_type (struct type *result_type, struct type *index_type,
 			  LONGEST low_bound, LONGEST high_bound)
 {
-  struct dynamic_prop low, high;
+  struct dynamic_prop low, high, stride;
 
   low.kind = PROP_CONST;
   low.data.const_val = low_bound;
@@ -849,7 +851,11 @@ create_static_range_type (struct type *result_type, struct type *index_type,
   high.kind = PROP_CONST;
   high.data.const_val = high_bound;
 
-  result_type = create_range_type (result_type, index_type, &low, &high);
+  stride.kind = PROP_CONST;
+  stride.data.const_val = 0;
+
+  result_type = create_range_type (result_type, index_type,
+                                   &low, &high, &stride);
 
   return result_type;
 }
@@ -1003,18 +1009,24 @@ create_array_type_with_stride (struct type *result_type,
 
   TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
   TYPE_TARGET_TYPE (result_type) = element_type;
-  if (has_static_range (TYPE_RANGE_DATA (range_type)))
+  if (has_static_range (TYPE_RANGE_DATA (range_type))
+      && dwarf2_address_data_valid (result_type))
     {
-      LONGEST low_bound, high_bound;
+      LONGEST low_bound, high_bound, byte_stride;
 
       if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 	low_bound = high_bound = 0;
       CHECK_TYPEDEF (element_type);
+
+      byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
+
       /* Be careful when setting the array length.  Ada arrays can be
 	 empty arrays with the high_bound being smaller than the low_bound.
 	 In such cases, the array length should be zero.  */
       if (high_bound < low_bound)
 	TYPE_LENGTH (result_type) = 0;
+      else if (byte_stride > 0)
+	TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
       else if (bit_stride > 0)
 	TYPE_LENGTH (result_type) =
 	  (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
@@ -1616,12 +1628,31 @@ stub_noname_complaint (void)
 static int
 is_dynamic_type_internal (struct type *type, int top_level)
 {
+  int index;
+
+  if (!type)
+    return 0;
+
   type = check_typedef (type);
 
   /* We only want to recognize references at the outermost level.  */
   if (top_level && TYPE_CODE (type) == TYPE_CODE_REF)
     type = check_typedef (TYPE_TARGET_TYPE (type));
 
+  if (TYPE_ASSOCIATED_PROP (type))
+    return 1;
+
+  if (TYPE_ALLOCATED_PROP (type))
+    return 1;
+
+  /* Scan field types in the Fortran case for nested dynamic types.
+     This will be done only for Fortran as in the C++ case an endless recursion
+     can occur in the area of classes.  */
+  if (current_language->la_language == language_fortran)
+    for (index = 0; index < TYPE_NFIELDS (type); index++)
+      if (is_dynamic_type (TYPE_FIELD_TYPE (type, index)))
+        return 1;
+
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -1631,11 +1662,19 @@ is_dynamic_type_internal (struct type *type, int top_level)
       {
 	gdb_assert (TYPE_NFIELDS (type) == 1);
 
-	/* The array is dynamic if either the bounds are dynamic,
-	   or the elements it contains have a dynamic contents.  */
+	/* The array is dynamic if either
+     - the bounds are dynamic,
+	   - the elements it contains have a dynamic contents
+     - a data_locaton attribute was found.  */
 	if (is_dynamic_type_internal (TYPE_INDEX_TYPE (type), 0))
 	  return 1;
-	return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
+	else if (TYPE_DATA_LOCATION (type) != NULL
+	         && (TYPE_DATA_LOCATION_KIND (type) == PROP_LOCEXPR
+	             || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST))
+    return 1;
+  else
+    return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
+	break;
       }
 
     case TYPE_CODE_STRUCT:
@@ -1648,6 +1687,17 @@ is_dynamic_type_internal (struct type *type, int top_level)
 	      && is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0))
 	    return 1;
       }
+    case TYPE_CODE_PTR:
+      {
+        if (TYPE_TARGET_TYPE (type)
+            && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING)
+          return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type)));
+
+        return 0;
+        break;
+      }
+    default:
+      return 0;
       break;
     }
 
@@ -1666,22 +1716,23 @@ static struct type *resolve_dynamic_type_internal (struct type *type,
 						   CORE_ADDR addr,
 						   int top_level);
 
-/* Given a dynamic range type (dyn_range_type), return a static version
-   of that type.  */
+/* Given a dynamic range type (dyn_range_type) and address,
+   return a static version of that type.  */
 
 static struct type *
-resolve_dynamic_range (struct type *dyn_range_type)
+resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr)
 {
   CORE_ADDR value;
   struct type *static_range_type;
   const struct dynamic_prop *prop;
   const struct dwarf2_locexpr_baton *baton;
-  struct dynamic_prop low_bound, high_bound;
+  struct dynamic_prop low_bound, high_bound, stride;
+  struct type *range_copy = copy_type (dyn_range_type);
 
   gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
 
   prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
-  if (dwarf2_evaluate_property (prop, &value))
+  if (dwarf2_evaluate_property (prop, addr, &value))
     {
       low_bound.kind = PROP_CONST;
       low_bound.data.const_val = value;
@@ -1693,7 +1744,7 @@ resolve_dynamic_range (struct type *dyn_range_type)
     }
 
   prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
-  if (dwarf2_evaluate_property (prop, &value))
+  if (dwarf2_evaluate_property (prop, addr, &value))
     {
       high_bound.kind = PROP_CONST;
       high_bound.data.const_val = value;
@@ -1707,10 +1758,17 @@ resolve_dynamic_range (struct type *dyn_range_type)
       high_bound.kind = PROP_UNDEFINED;
       high_bound.data.const_val = 0;
     }
+  
+  prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
+  if (dwarf2_evaluate_property (prop, addr, &value))
+    {
+      stride.kind = PROP_CONST;
+      stride.data.const_val = value;
+    }
 
-  static_range_type = create_range_type (copy_type (dyn_range_type),
-					 TYPE_TARGET_TYPE (dyn_range_type),
-					 &low_bound, &high_bound);
+  static_range_type = create_range_type (range_copy,
+					 TYPE_TARGET_TYPE (range_copy),
+					 &low_bound, &high_bound, &stride);
   TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
   return static_range_type;
 }
@@ -1720,29 +1778,52 @@ resolve_dynamic_range (struct type *dyn_range_type)
    of the associated array.  */
 
 static struct type *
-resolve_dynamic_array (struct type *type)
+resolve_dynamic_array (struct type *type, CORE_ADDR addr)
 {
   CORE_ADDR value;
   struct type *elt_type;
   struct type *range_type;
   struct type *ary_dim;
+  struct dynamic_prop *prop;
+  struct type *copy = copy_type (type);
 
-  gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
+  gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
+              || TYPE_CODE (type) == TYPE_CODE_STRING);
 
   elt_type = type;
   range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
-  range_type = resolve_dynamic_range (range_type);
+  range_type = resolve_dynamic_range (range_type, addr);
+
+  prop = TYPE_ALLOCATED_PROP (type);
+  if (dwarf2_evaluate_property (prop, addr, &value))
+    {
+      TYPE_ALLOCATED_PROP (copy)->kind = PROP_CONST;
+      TYPE_ALLOCATED_PROP (copy)->data.const_val = value;
+    }
+
+  prop = TYPE_ASSOCIATED_PROP (type);
+  if (dwarf2_evaluate_property (prop, addr, &value))
+    {
+      TYPE_ASSOCIATED_PROP (copy)->kind = PROP_CONST;
+      TYPE_ASSOCIATED_PROP (copy)->data.const_val = value;
+    }
 
   ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
 
-  if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
-    elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type));
+  if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
+          || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
+    elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr);
   else
     elt_type = TYPE_TARGET_TYPE (type);
 
-  return create_array_type (copy_type (type),
-			    elt_type,
-			    range_type);
+  if (TYPE_CODE (type) == TYPE_CODE_STRING)
+    return create_string_type (copy,
+            elt_type,
+            range_type);
+  else
+    return create_array_type (copy,
+            elt_type,
+            range_type);
 }
 
 /* Resolve dynamic bounds of members of the union TYPE to static
@@ -1846,6 +1927,8 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
 {
   struct type *real_type = check_typedef (type);
   struct type *resolved_type = type;
+  const struct dynamic_prop *prop;
+  CORE_ADDR value;
 
   if (!is_dynamic_type_internal (real_type, top_level))
     return type;
@@ -1871,11 +1954,12 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
 	}
 
       case TYPE_CODE_ARRAY:
-	resolved_type = resolve_dynamic_array (type);
+      case TYPE_CODE_STRING:
+	resolved_type = resolve_dynamic_array (type, addr);
 	break;
 
       case TYPE_CODE_RANGE:
-	resolved_type = resolve_dynamic_range (type);
+	resolved_type = resolve_dynamic_range (type, addr);
 	break;
 
     case TYPE_CODE_UNION:
@@ -1887,6 +1971,25 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
       break;
     }
 
+  /* Resolve data_location attribute.  */
+  prop = TYPE_DATA_LOCATION (resolved_type);
+  if (dwarf2_evaluate_property (prop, addr, &value))
+    {
+      struct type *range_type = TYPE_INDEX_TYPE (resolved_type);
+
+      /* Adjust the data location with the value of byte stride if set, which
+         can describe the separation between successive elements along the
+         dimension.  */
+      if (TYPE_BYTE_STRIDE (range_type) < 0)
+        value += (TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type))
+                  * TYPE_BYTE_STRIDE (range_type);
+
+      TYPE_DATA_LOCATION_ADDR (resolved_type) = value;
+      TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST;
+    }
+  else
+    TYPE_DATA_LOCATION (resolved_type) = NULL;
+
   return resolved_type;
 }
 
@@ -4104,6 +4207,27 @@ copy_type_recursive (struct objfile *objfile,
       *TYPE_RANGE_DATA (new_type) = *TYPE_RANGE_DATA (type);
     }
 
+  /* Copy the data location information.  */
+  if (TYPE_DATA_LOCATION (type) != NULL)
+    {
+      TYPE_DATA_LOCATION (new_type) = xmalloc (sizeof (struct dynamic_prop));
+      *TYPE_DATA_LOCATION (new_type) = *TYPE_DATA_LOCATION (type);
+    }
+
+  /* Copy allocated information.  */
+  if (TYPE_ALLOCATED_PROP (type) != NULL)
+    {
+      TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
+      *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type);
+    }
+
+  /* Copy associated information.  */
+  if (TYPE_ASSOCIATED_PROP (type) != NULL)
+    {
+      TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
+      *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type);
+    }
+
   /* Copy pointers to other types.  */
   if (TYPE_TARGET_TYPE (type))
     TYPE_TARGET_TYPE (new_type) = 
@@ -4150,6 +4274,44 @@ copy_type (const struct type *type)
   memcpy (TYPE_MAIN_TYPE (new_type), TYPE_MAIN_TYPE (type),
 	  sizeof (struct main_type));
 
+  if (TYPE_ALLOCATED_PROP (type))
+    {
+      TYPE_ALLOCATED_PROP (new_type)
+              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+                                struct dynamic_prop);
+      memcpy (TYPE_ALLOCATED_PROP (new_type), TYPE_ALLOCATED_PROP (type),
+        sizeof (struct dynamic_prop));
+    }
+
+  if (TYPE_ASSOCIATED_PROP (type))
+    {
+      TYPE_ASSOCIATED_PROP (new_type)
+              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+                                struct dynamic_prop);
+      memcpy (TYPE_ASSOCIATED_PROP (new_type), TYPE_ASSOCIATED_PROP (type),
+        sizeof (struct dynamic_prop));
+    }
+
+  if (TYPE_DATA_LOCATION (type))
+    {
+      TYPE_DATA_LOCATION (new_type)
+              = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+                                struct dynamic_prop);
+      memcpy (TYPE_DATA_LOCATION (new_type), TYPE_DATA_LOCATION (type),
+        sizeof (struct dynamic_prop));
+    }
+
+  if (TYPE_NFIELDS (type))
+    {
+      int nfields = TYPE_NFIELDS (type);
+
+      TYPE_FIELDS (new_type)
+              = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+                                nfields, struct field);
+      memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type),
+        nfields * sizeof (struct field));
+   }
+
   return new_type;
 }
 
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 5008ef4..436edf8 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -669,6 +669,10 @@ struct main_type
 
       struct dynamic_prop high;
 
+      /* * Stride of range.  */
+
+      struct dynamic_prop stride;
+
       /* True if HIGH range bound contains the number of elements in the
 	 subrange. This affects how the final hight bound is computed.  */
 
@@ -724,6 +728,23 @@ struct main_type
 
     struct func_type *func_stuff;
   } type_specific;
+
+  /* * Contains a location description value for the current type. Evaluating
+     this field yields to the location of the data for an object.  */
+
+  struct dynamic_prop *data_location;
+
+  /* Structure for DW_AT_allocated.
+     The presence of this attribute indicates that the object of the type
+     can be allocated/deallocated.  The value can be a dwarf expression,
+     reference, or a constant.  */
+  struct dynamic_prop *allocated;
+
+  /* Structure for DW_AT_associated.
+     The presence of this attribute indicated that the object of the type
+     can be associated.  The value can be a dwarf expression,
+     reference, or a constant.  */
+  struct dynamic_prop *associated;
 };
 
 /* * A ``struct type'' describes a particular instance of a type, with
@@ -1202,6 +1223,39 @@ extern void allocate_gnat_aux_type (struct type *);
   TYPE_RANGE_DATA(range_type)->high.kind
 #define TYPE_LOW_BOUND_KIND(range_type) \
   TYPE_RANGE_DATA(range_type)->low.kind
+#define TYPE_BYTE_STRIDE(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.data.const_val
+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.data.locexpr
+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.data.loclist
+#define TYPE_BYTE_STRIDE_KIND(range_type) \
+  TYPE_RANGE_DATA(range_type)->stride.kind
+
+
+/* Attribute accessors for the type data location.  */
+#define TYPE_DATA_LOCATION(thistype) \
+  TYPE_MAIN_TYPE(thistype)->data_location
+#define TYPE_DATA_LOCATION_BATON(thistype) \
+  TYPE_DATA_LOCATION (thistype)->data.baton
+#define TYPE_DATA_LOCATION_ADDR(thistype) \
+  TYPE_DATA_LOCATION (thistype)->data.const_val
+#define TYPE_DATA_LOCATION_KIND(thistype) \
+  TYPE_DATA_LOCATION (thistype)->kind
+#define TYPE_ALLOCATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->allocated
+#define TYPE_ASSOCIATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->associated
+
+/* Allocated status of type object.  If set to non-zero it means the object
+   is allocated. A zero value means it is not allocated.  */
+#define TYPE_NOT_ALLOCATED(t)  (TYPE_ALLOCATED_PROP (t) \
+  && TYPE_ALLOCATED_PROP (t)->kind == PROP_CONST \
+  && !TYPE_ALLOCATED_PROP (t)->data.const_val)
+
+/* Associated status of type object.  If set to non-zero it means the object
+   is associated. A zero value means it is not associated.  */
+#define TYPE_NOT_ASSOCIATED(t)  (TYPE_ASSOCIATED_PROP (t) \
+  && TYPE_ASSOCIATED_PROP (t)->kind == PROP_CONST \
+  && !TYPE_ASSOCIATED_PROP (t)->data.const_val)
 
 /* Moto-specific stuff for FORTRAN arrays.  */
 
@@ -1209,6 +1263,9 @@ extern void allocate_gnat_aux_type (struct type *);
    TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
 #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
    TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
+   (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
+
 
 #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
    (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
@@ -1677,6 +1734,7 @@ extern struct type *create_array_type_with_stride
 
 extern struct type *create_range_type (struct type *, struct type *,
 				       const struct dynamic_prop *,
+				       const struct dynamic_prop *,
 				       const struct dynamic_prop *);
 
 extern struct type *create_array_type (struct type *, struct type *,
diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp
new file mode 100644
index 0000000..20607c3
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp
@@ -0,0 +1,65 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Check the association status of various types of VLA's
+# and pointer to VLA's.
+gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
+gdb_continue_to_breakpoint "vla1-allocated"
+gdb_test "print l" " = \\.TRUE\\." \
+  "print vla1 allocation status (allocated)"
+
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
+gdb_continue_to_breakpoint "vla2-allocated"
+gdb_test "print l" " = \\.TRUE\\." \
+  "print vla2 allocation status (allocated)"
+
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+gdb_continue_to_breakpoint "pvla-associated"
+gdb_test "print l" " = \\.TRUE\\." \
+  "print pvla associated status (associated)"
+
+gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
+gdb_continue_to_breakpoint "pvla-re-associated"
+gdb_test "print l" " = \\.TRUE\\." \
+  "print pvla associated status (re-associated)"
+
+gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
+gdb_continue_to_breakpoint "pvla-deassociated"
+gdb_test "print l" " = \\.FALSE\\." \
+  "print pvla allocation status (deassociated)"
+
+gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
+gdb_continue_to_breakpoint "vla1-deallocated"
+gdb_test "print l" " = \\.FALSE\\." \
+  "print vla1 allocation status (deallocated)"
+gdb_test "print vla1" " = <not allocated>" \
+  "print deallocated vla1"
+
+gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
+gdb_continue_to_breakpoint "vla2-deallocated"
+gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated"
+gdb_test "print vla2" " = <not allocated>" "print deallocated vla2"
diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
new file mode 100644
index 0000000..20276d6
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
@@ -0,0 +1,82 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+# check that all fortran standard datatypes will be
+# handled correctly when using as VLA's
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "vlas-allocated"]
+gdb_continue_to_breakpoint "vlas-allocated"
+gdb_test "next" " = allocated\\$realvla\\$" \
+  "next to allocation status of intvla"
+gdb_test "print l" " = \\.TRUE\\." "intvla allocated"
+gdb_test "next" " = allocated\\$complexvla\\$" \
+  "next to allocation status of realvla"
+gdb_test "print l" " = \\.TRUE\\." "realvla allocated"
+gdb_test "next" " = allocated\\$logicalvla\\$" \
+  "next to allocation status of complexvla"
+gdb_test "print l" " = \\.TRUE\\." "complexvla allocated"
+gdb_test "next" " = allocated\\$charactervla\\$" \
+  "next to allocation status of logicalvla"
+gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated"
+gdb_test "next" "intvla\\$:,:,:\\$ = 1" \
+  "next to allocation status of charactervla"
+gdb_test "print l" " = \\.TRUE\\." "charactervla allocated"
+
+gdb_breakpoint [gdb_get_line_number "vlas-initialized"]
+gdb_continue_to_breakpoint "vlas-initialized"
+gdb_test "ptype intvla" "type = integer\\$kind=4\\$ \\$11,22,33\\$" \
+  "ptype intvla"
+gdb_test "ptype realvla" "type = real\\$kind=4\\$ \\$11,22,33\\$" \
+  "ptype realvla"
+gdb_test "ptype complexvla" "type = complex\\$kind=4\\$ \\$11,22,33\\$" \
+  "ptype complexvla"
+gdb_test "ptype logicalvla" "type = logical\\$kind=4\\$ \\$11,22,33\\$" \
+  "ptype logicalvla"
+gdb_test "ptype charactervla" "type = character\\\*1 \\$11,22,33\\$" \
+  "ptype charactervla"
+
+gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)"
+gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \
+  "print realvla(5,5,5) (1st)"
+gdb_test "print complexvla(5,5,5)" " = \\$2,-3\\$" \
+  "print complexvla(5,5,5) (1st)"
+gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \
+  "print logicalvla(5,5,5) (1st)"
+gdb_test "print charactervla(5,5,5)" " = 'K'" \
+  "print charactervla(5,5,5) (1st)"
+
+gdb_breakpoint [gdb_get_line_number "vlas-modified"]
+gdb_continue_to_breakpoint "vlas-modified"
+gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)"
+gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \
+  "print realvla(5,5,5) (2nd)"
+gdb_test "print complexvla(5,5,5)" " = \\$-3,2\\$" \
+  "print complexvla(5,5,5) (2nd)"
+gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \
+  "print logicalvla(5,5,5) (2nd)"
+gdb_test "print charactervla(5,5,5)" " = 'X'" \
+  "print charactervla(5,5,5) (2nd)"
diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90
new file mode 100644
index 0000000..b11879a
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90
@@ -0,0 +1,51 @@
+! Copyright 2014 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+program vla_primitives
+  integer, allocatable    :: intvla(:, :, :)
+  real, allocatable       :: realvla(:, :, :)
+  complex, allocatable    :: complexvla(:, :, :)
+  logical, allocatable    :: logicalvla(:, :, :)
+  character, allocatable  :: charactervla(:, :, :)
+  logical                 :: l
+
+  allocate (intvla (11,22,33))
+  allocate (realvla (11,22,33))
+  allocate (complexvla (11,22,33))
+  allocate (logicalvla (11,22,33))
+  allocate (charactervla (11,22,33))
+
+  l = allocated(intvla)                   ! vlas-allocated
+  l = allocated(realvla)
+  l = allocated(complexvla)
+  l = allocated(logicalvla)
+  l = allocated(charactervla)
+
+  intvla(:,:,:) = 1
+  realvla(:,:,:) = 3.14
+  complexvla(:,:,:) = cmplx(2.0,-3.0)
+  logicalvla(:,:,:) = .TRUE.
+  charactervla(:,:,:) = char(75)
+
+  intvla(5,5,5) = 42                      ! vlas-initialized
+  realvla(5,5,5) = 4.13
+  complexvla(5,5,5) = cmplx(-3.0,2.0)
+  logicalvla(5,5,5) = .FALSE.
+  charactervla(5,5,5) = 'X'
+
+  ! dummy statement for bp
+  l = .FALSE.                             ! vlas-modified
+end program vla_primitives
diff --git a/gdb/testsuite/gdb.fortran/vla-func.exp b/gdb/testsuite/gdb.fortran/vla-func.exp
new file mode 100644
index 0000000..f0f236b
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-func.exp
@@ -0,0 +1,61 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Check VLA passed to first Fortran function.
+gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]
+gdb_continue_to_breakpoint "func1-vla-passed"
+gdb_test "print vla" " = \$ *\\( *22, *22, *22,\[()22, .\]*\$" \
+  "print vla (func1)"
+gdb_test "ptype vla" "type = integer\\$kind=4\\$ \\$10,10\\$" \
+  "ptype vla (func1)"
+
+gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]
+gdb_continue_to_breakpoint "func1-vla-modified"
+gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"
+gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"
+
+# Check if the values are correct after returning from func1
+gdb_breakpoint [gdb_get_line_number "func1-returned"]
+gdb_continue_to_breakpoint "func1-returned"
+gdb_test "print ret" " = .TRUE." "print ret after func1 returned"
+
+# Check VLA passed to second Fortran function
+gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]
+gdb_continue_to_breakpoint "func2-vla-passed"
+gdb_test "print vla" \
+  " = \\$44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\$" \
+  "print vla (func2)"
+gdb_test "ptype vla" "type = integer\\$kind=4\\$ \\$10\\$" \
+  "ptype vla (func2)"
+
+# Check if the returned VLA has the correct values and ptype.
+gdb_breakpoint [gdb_get_line_number "func2-returned"]
+gdb_continue_to_breakpoint "func2-returned"
+gdb_test "print vla3" " = \\$1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\$" \
+  "print vla3 (after func2)"
+gdb_test "ptype vla3" "type = integer\\$kind=4\\$ \\$10\\$" \
+  "ptype vla3 (after func2)"
diff --git a/gdb/testsuite/gdb.fortran/vla-func.f90 b/gdb/testsuite/gdb.fortran/vla-func.f90
new file mode 100644
index 0000000..4f45da1
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-func.f90
@@ -0,0 +1,71 @@
+! Copyright 2014 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+logical function func1 (vla)
+  implicit none
+  integer, allocatable :: vla (:, :)
+  func1 = allocated(vla)
+  vla(5,5) = 55               ! func1-vla-passed
+  vla(7,7) = 77
+  return                      ! func1-vla-modified
+end function func1
+
+function func2(vla)
+  implicit none
+  integer :: vla (:)
+  integer :: func2(size(vla))
+  integer :: k
+
+  vla(1) = 1                    ! func2-vla-passed
+  vla(2) = 2
+  vla(4) = 4
+  vla(8) = 8
+
+  func2 = vla
+end function func2
+
+program vla_func
+  implicit none
+  interface
+    logical function func1 (vla)
+      integer :: vla (:, :)
+    end function
+  end interface
+  interface
+    function func2 (vla)
+      integer :: vla (:)
+      integer func2(size(vla))
+    end function
+  end interface
+
+  logical :: ret
+  integer, allocatable :: vla1 (:, :)
+  integer, allocatable :: vla2 (:)
+  integer, allocatable :: vla3 (:)
+
+  ret = .FALSE.
+
+  allocate (vla1 (10,10))
+  vla1(:,:) = 22
+
+  allocate (vla2 (10))
+  vla2(:) = 44
+
+  ret = func1(vla1)
+  vla3 = func2(vla2)          ! func1-returned
+
+  ret = .TRUE.                ! func2-returned
+end program vla_func
diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp
new file mode 100644
index 0000000..170e1eb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-history.exp
@@ -0,0 +1,62 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Set some breakpoints and print complete vla.
+gdb_breakpoint [gdb_get_line_number "vla1-init"]
+gdb_continue_to_breakpoint "vla1-init"
+gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
+
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
+gdb_continue_to_breakpoint "vla2-allocated"
+gdb_test "print vla1" " = \$ *\\( *\\( *0, *0, *0,\[()0, .\]*\$" \
+  "print vla1 allocated"
+gdb_test "print vla2" " = \$ *\\( *\\( *0, *0, *0,\[()0, .\]*\$" \
+  "print vla2 allocated"
+
+gdb_breakpoint [gdb_get_line_number "vla1-filled"]
+gdb_continue_to_breakpoint "vla1-filled"
+gdb_test "print vla1" \
+  " = \$ *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\$" \
+  "print vla1 filled"
+
+# Try to access history values for full vla prints.
+gdb_test "print \$1" " = <not allocated>" "print \$1"
+gdb_test "print \$2" " = \$ *\\( *\\( *0, *0, *0,\[()0, .\]*\$" \
+  "print \$2"
+gdb_test "print \$3" " = \$ *\\( *\\( *0, *0, *0,\[()0, .\]*\$" \
+  "print \$3"
+gdb_test "print \$4" \
+  " = \$ *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\$" "print \$4"
+
+gdb_breakpoint [gdb_get_line_number "vla2-filled"]
+gdb_continue_to_breakpoint "vla2-filled"
+gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)"
+gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)"
+
+# Try to access history values for vla values.
+gdb_test "print \$9" " = 1311" "print \$9"
+gdb_test "print \$10" " = 1001" "print \$10"
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp
new file mode 100644
index 0000000..2ee2914
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp
@@ -0,0 +1,87 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla-sub.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Pass fixed array to function and handle them as vla in function.
+gdb_breakpoint [gdb_get_line_number "not-filled"]
+gdb_continue_to_breakpoint "not-filled (1st)"
+gdb_test "ptype array1" "type = integer\\$kind=4\\$ \\$42,42\\$" \
+  "ptype array1 (passed fixed)"
+gdb_test "ptype array2" "type = real\\$kind=4\\$ \\$42,42,42\\$" \
+  "ptype array2 (passed fixed)"
+gdb_test "ptype array1(40, 10)" "type = integer\\$kind=4\\$" \
+  "ptype array1(40, 10) (passed fixed)"
+gdb_test "ptype array2(13, 11, 5)" "type = real\\$kind=4\\$" \
+  "ptype array2(13, 11, 5) (passed fixed)"
+
+# Pass sub arrays to function and handle them as vla in function.
+gdb_continue_to_breakpoint "not-filled (2nd)"
+gdb_test "ptype array1" "type = integer\\$kind=4\\$ \\$6,6\\$" \
+  "ptype array1 (passed sub-array)"
+gdb_test "ptype array2" "type = real\\$kind=4\\$ \\$6,6,6\\$" \
+  "ptype array2 (passed sub-array)"
+gdb_test "ptype array1(3, 3)" "type = integer\\$kind=4\\$" \
+  "ptype array1(3, 3) (passed sub-array)"
+gdb_test "ptype array2(4, 4, 4)" "type = real\\$kind=4\\$" \
+  "ptype array2(4, 4, 4) (passed sub-array)"
+
+# Check ptype outside of bounds. This should not crash GDB.
+gdb_test "ptype array1(100, 100)" "no such vector element" \
+  "ptype array1(100, 100) subarray do not crash (passed sub-array)"
+gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
+  "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)"
+
+# Pass vla to function.
+gdb_continue_to_breakpoint "not-filled (3rd)"
+gdb_test "ptype array1" "type = integer\\$kind=4\\$ \\$20,20\\$" \
+  "ptype array1 (passed vla)"
+gdb_test "ptype array2" "type = real\\$kind=4\\$ \\$10,10,10\\$" \
+  "ptype array2 (passed vla)"
+gdb_test "ptype array1(3, 3)" "type = integer\\$kind=4\\$" \
+  "ptype array1(3, 3) (passed vla)"
+gdb_test "ptype array2(4, 4, 4)" "type = real\\$kind=4\\$" \
+  "ptype array2(4, 4, 4) (passed vla)"
+
+# Check ptype outside of bounds. This should not crash GDB.
+gdb_test "ptype array1(100, 100)" "no such vector element" \
+  "ptype array1(100, 100) VLA do not crash (passed vla)"
+gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
+  "ptype array2(100, 100, 100) VLA do not crash (passed vla)"
+
+# Pass fixed array to function and handle it as VLA of arbitrary length in
+# function.
+gdb_breakpoint [gdb_get_line_number "end-of-bar"]
+gdb_continue_to_breakpoint "end-of-bar"
+gdb_test "ptype array1" \
+  "type = (PTR TO -> \$ )?integer(\\(kind=4\$|\\*4) \$\\*\$\\)?" \
+  "ptype array1 (arbitrary length)"
+gdb_test "ptype array2" \
+  "type = (PTR TO -> \$ )?integer(\\(kind=4\$|\\*4) \$4:9,10:\\*\$\\)?" \
+  "ptype array2 (arbitrary length)"
+gdb_test "ptype array1(100)" "type = integer\\$kind=4\\$" \
+  "ptype array1(100) (arbitrary length)"
+gdb_test "ptype array2(4,100)" "type = integer\\$kind=4\\$" \
+  "ptype array2(4,100) (arbitrary length)"
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
new file mode 100644
index 0000000..9267723
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
@@ -0,0 +1,96 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Check the ptype of various VLA states and pointer to VLA's.
+gdb_breakpoint [gdb_get_line_number "vla1-init"]
+gdb_continue_to_breakpoint "vla1-init"
+gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized"
+gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
+gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
+gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
+  "ptype vla1(3, 6, 9) not initialized"
+gdb_test "ptype vla2(5, 45, 20)" \
+  "no such vector element because not allocated" \
+  "ptype vla1(5, 45, 20) not initialized"
+
+gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
+gdb_continue_to_breakpoint "vla1-allocated"
+gdb_test "ptype vla1" "type = real\\$kind=4\\$ \\$10,10,10\\$" \
+  "ptype vla1 allocated"
+
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
+gdb_continue_to_breakpoint "vla2-allocated"
+gdb_test "ptype vla2" "type = real\\$kind=4\\$ \\$7,42:50,13:35\\$" \
+  "ptype vla2 allocated"
+
+gdb_breakpoint [gdb_get_line_number "vla1-filled"]
+gdb_continue_to_breakpoint "vla1-filled"
+gdb_test "ptype vla1" "type = real\\$kind=4\\$ \\$10,10,10\\$" \
+  "ptype vla1 filled"
+gdb_test "ptype vla1(3, 6, 9)" "type = real\\$kind=4\\$" \
+  "ptype vla1(3, 6, 9)"
+
+gdb_breakpoint [gdb_get_line_number "vla2-filled"]
+gdb_continue_to_breakpoint "vla2-filled"
+gdb_test "ptype vla2" "type = real\\$kind=4\\$ \\$7,42:50,13:35\\$" \
+  "ptype vla2 filled"
+gdb_test "ptype vla2(5, 45, 20)" "type = real\\$kind=4\\$" \
+  "ptype vla1(5, 45, 20) filled"
+
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+gdb_continue_to_breakpoint "pvla-associated"
+gdb_test "ptype pvla" "type = real\\$kind=4\\$ \\$10,10,10\\$" \
+  "ptype pvla associated"
+gdb_test "ptype pvla(3, 6, 9)" "type = real\\$kind=4\\$" \
+  "ptype pvla(3, 6, 9)"
+
+gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
+gdb_continue_to_breakpoint "pvla-re-associated"
+gdb_test "ptype pvla" "type = real\\$kind=4\\$ \\$7,42:50,13:35\\$" \
+  "ptype pvla re-associated"
+gdb_test "ptype vla2(5, 45, 20)" "type = real\\$kind=4\\$" \
+  "ptype vla1(5, 45, 20) re-associated"
+
+gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
+gdb_continue_to_breakpoint "pvla-deassociated"
+gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
+gdb_test "ptype pvla(5, 45, 20)" \
+  "no such vector element because not associated" \
+  "ptype pvla(5, 45, 20) not associated"
+
+gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
+gdb_continue_to_breakpoint "vla1-deallocated"
+gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
+gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
+  "ptype vla1(3, 6, 9) not allocated"
+
+gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
+gdb_continue_to_breakpoint "vla2-deallocated"
+gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
+gdb_test "ptype vla2(5, 45, 20)" \
+  "no such vector element because not allocated" \
+  "ptype vla2(5, 45, 20) not allocated"
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
new file mode 100644
index 0000000..6053c17
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -0,0 +1,46 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Try to access values in non allocated VLA
+gdb_breakpoint [gdb_get_line_number "vla1-init"]
+gdb_continue_to_breakpoint "vla1-init"
+gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
+
+# Try to access value in allocated VLA
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
+gdb_continue_to_breakpoint "vla2-allocated"
+gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
+
+# Try to access values in undefined pointer to VLA (dangling)
+gdb_breakpoint [gdb_get_line_number "vla1-filled"]
+gdb_continue_to_breakpoint "vla1-filled"
+gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
+
+# Try to access values in pointer to VLA and compare them
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+gdb_continue_to_breakpoint "pvla-associated"
+gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
new file mode 100644
index 0000000..35f585d
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
@@ -0,0 +1,44 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
+gdb_continue_to_breakpoint "re-reverse-elements"
+gdb_test "print pvla" " = \\$1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\$" \
+  "print re-reverse-elements"
+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
+
+gdb_breakpoint [gdb_get_line_number "odd-elements"]
+gdb_continue_to_breakpoint "odd-elements"
+gdb_test "print pvla" " = \\$1, 3, 5, 7, 9\\$" "print odd-elements"
+gdb_test "print pvla(1)" " = 1" "print first odd-element"
+gdb_test "print pvla(5)" " = 9" "print last odd-element"
+
+gdb_breakpoint [gdb_get_line_number "single-element"]
+gdb_continue_to_breakpoint "single-element"
+gdb_test "print pvla" " = \\$5\\$" "print single-element"
+gdb_test "print pvla(1)" " = 5" "print one single-element"
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
new file mode 100644
index 0000000..6aa4f2b
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
@@ -0,0 +1,30 @@
+! Copyright 2014 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+program vla_stride
+  integer, target, allocatable :: vla (:)
+  integer, pointer :: pvla (:)
+
+  allocate(vla(10))
+  vla = (/ (I, I = 1,10) /)
+
+  pvla => vla(10:1:-1)
+  pvla => pvla(10:1:-1)
+  pvla => vla(1:10:2)   ! re-reverse-elements
+  pvla => vla(5:4:-2)   ! odd-elements
+
+  pvla => null()        ! single-element
+end program vla_stride
diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp
new file mode 100644
index 0000000..7fc1734
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-strings.exp
@@ -0,0 +1,104 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+# check that all fortran standard datatypes will be
+# handled correctly when using as VLA's
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
+gdb_continue_to_breakpoint "var_char-allocated-1"
+gdb_test "print var_char" \
+  " = \$PTR TO -> \\( character\\*10 \$\\) ${hex}" \
+  "print var_char after allocated first time"
+gdb_test "print *var_char" \
+  " = '\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000'" \
+  "print *var_char after allocated first time"
+gdb_test "whatis var_char" "type = PTR TO -> \$ character\\*10 \$" \
+  "whatis var_char first time"
+gdb_test "ptype var_char" "type = PTR TO -> \$ character\\*10 \$" \
+  "ptype var_char first time"
+gdb_test "next" "\\d+.*var_char = 'foo'.*" \
+  "next to allocation status of var_char"
+gdb_test "print l" " = .TRUE." "print allocation status first time"
+
+gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
+gdb_continue_to_breakpoint "var_char-filled-1"
+gdb_test "print var_char" \
+  " = \$PTR TO -> \\( character\\*3 \$\\) ${hex}" \
+  "print var_char after filled first time"
+gdb_test "print *var_char" " = 'foo'" \
+  "print *var_char after filled first time"
+gdb_test "whatis var_char" "type = PTR TO -> \$ character\\*3 \$" \
+  "whatis var_char after filled first time"
+gdb_test "ptype var_char" "type = PTR TO -> \$ character\\*3 \$" \
+  "ptype var_char after filled first time"
+gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
+gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
+
+gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
+gdb_continue_to_breakpoint "var_char-filled-2"
+gdb_test "print var_char" \
+  " = \$PTR TO -> \\( character\\*6 \$\\) ${hex}" \
+  "print var_char after allocated second time"
+gdb_test "print *var_char" " = 'foobar'" \
+  "print *var_char after allocated second time"
+gdb_test "whatis var_char" "type = PTR TO -> \$ character\\*6 \$" \
+  "whatis var_char second time"
+gdb_test "ptype var_char" "type = PTR TO -> \$ character\\*6 \$" \
+  "ptype var_char second time"
+
+gdb_breakpoint [gdb_get_line_number "var_char-empty"]
+gdb_continue_to_breakpoint "var_char-empty"
+gdb_test "print var_char" \
+  " = \$PTR TO -> \\( character\\*0 \$\\) ${hex}" \
+  "print var_char after set empty"
+gdb_test "print *var_char" " = \"\"" "print *var_char after set empty"
+gdb_test "whatis var_char" "type = PTR TO -> \$ character\\*0 \$" \
+  "whatis var_char after set empty"
+gdb_test "ptype var_char" "type = PTR TO -> \$ character\\*0 \$" \
+  "ptype var_char after set empty"
+
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"]
+gdb_continue_to_breakpoint "var_char-allocated-3"
+gdb_test "print var_char" \
+  " = \$PTR TO -> \\( character\\*21 \$\\) ${hex}" \
+  "print var_char after allocated third time"
+gdb_test "whatis var_char" "type = PTR TO -> \$ character\\*21 \$" \
+  "whatis var_char after allocated third time"
+gdb_test "ptype var_char" "type = PTR TO -> \$ character\\*21 \$" \
+  "ptype var_char after allocated third time"
+
+gdb_breakpoint [gdb_get_line_number "var_char_p-associated"]
+gdb_continue_to_breakpoint "var_char_p-associated"
+gdb_test "print var_char_p" \
+  " = \$PTR TO -> \\( character\\*7 \$\\) ${hex}" \
+  "print var_char_p after associated"
+gdb_test "print *var_char_p" " = 'johndoe'" \
+  "print *var_char_ after associated"
+gdb_test "whatis var_char_p" "type = PTR TO -> \$ character\\*7 \$" \
+  "whatis var_char_p after associated"
+gdb_test "ptype var_char_p" "type = PTR TO -> \$ character\\*7 \$" \
+  "ptype var_char_p after associated"
diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90
new file mode 100644
index 0000000..0a1d522
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-strings.f90
@@ -0,0 +1,40 @@
+! Copyright 2014 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+program vla_strings
+  character(len=:), target, allocatable   :: var_char
+  character(len=:), pointer               :: var_char_p
+  logical                                 :: l
+
+  allocate(character(len=10) :: var_char)
+  l = allocated(var_char)                 ! var_char-allocated-1
+  var_char = 'foo'
+  deallocate(var_char)                    ! var_char-filled-1
+  l = allocated(var_char)                 ! var_char-deallocated
+  allocate(character(len=42) :: var_char)
+  l = allocated(var_char)
+  var_char = 'foobar'
+  var_char = ''                           ! var_char-filled-2
+  var_char = 'bar'                        ! var_char-empty
+  deallocate(var_char)
+  allocate(character(len=21) :: var_char)
+  l = allocated(var_char)                 ! var_char-allocated-3
+  var_char = 'johndoe'
+  var_char_p => var_char
+  l = associated(var_char_p)              ! var_char_p-associated
+  var_char_p => null()
+  l = associated(var_char_p)              ! var_char_p-not-associated
+end program vla_strings
diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90
new file mode 100644
index 0000000..8c2c9ff
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-sub.f90
@@ -0,0 +1,82 @@
+! Copyright 2014 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+! Original file written by Jakub Jelinek <jakub@redhat.com> and
+! Jan Kratochvil <jan.kratochvil@redhat.com>.
+! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>.
+
+subroutine foo (array1, array2)
+  integer :: array1 (:, :)
+  real    :: array2 (:, :, :)
+
+  array1(:,:) = 5                       ! not-filled
+  array1(1, 1) = 30
+
+  array2(:,:,:) = 6                     ! array1-filled
+  array2(:,:,:) = 3
+  array2(1,1,1) = 30
+  array2(3,3,3) = 90                    ! array2-almost-filled
+end subroutine
+
+subroutine bar (array1, array2)
+  integer :: array1 (*)
+  integer :: array2 (4:9, 10:*)
+
+  array1(5:10) = 1311
+  array1(7) = 1
+  array1(100) = 100
+  array2(4,10) = array1(7)
+  array2(4,100) = array1(7)
+  return                                ! end-of-bar
+end subroutine
+
+program vla_sub
+  interface
+    subroutine foo (array1, array2)
+      integer :: array1 (:, :)
+      real :: array2 (:, :, :)
+    end subroutine
+  end interface
+  interface
+    subroutine bar (array1, array2)
+      integer :: array1 (*)
+      integer :: array2 (4:9, 10:*)
+    end subroutine
+  end interface
+
+  real, allocatable :: vla1 (:, :, :)
+  integer, allocatable :: vla2 (:, :)
+
+  ! used for subroutine
+  integer :: sub_arr1(42, 42)
+  real    :: sub_arr2(42, 42, 42)
+  integer :: sub_arr3(42)
+
+  sub_arr1(:,:) = 1                   ! vla2-deallocated
+  sub_arr2(:,:,:) = 2
+  sub_arr3(:) = 3
+
+  call foo(sub_arr1, sub_arr2)
+  call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15))
+
+  allocate (vla1 (10,10,10))
+  allocate (vla2 (20,20))
+  vla1(:,:,:) = 1311
+  vla2(:,:) = 42
+  call foo(vla2, vla1)
+
+  call bar(sub_arr3, sub_arr1)
+end program vla_sub
diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp
new file mode 100644
index 0000000..fd11adb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp
@@ -0,0 +1,35 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla-sub.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Check VLA with arbitary length and check that elements outside of
+# bounds of the passed VLA can be accessed correctly.
+gdb_breakpoint [gdb_get_line_number "end-of-bar"]
+gdb_continue_to_breakpoint "end-of-bar"
+gdb_test "p array1(42)" " = 3" "print arbitary array1(42)"
+gdb_test "p array1(100)" " = 100" "print arbitary array1(100)"
+gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)"
+gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)"
diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp
new file mode 100644
index 0000000..a163617
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp
@@ -0,0 +1,49 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla-sub.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# "up" works with GCC but other Fortran compilers may copy the values into the
+# outer function only on the exit of the inner function.
+# We need both variants as depending on the arch we optionally may still be
+# executing the caller line or not after `finish'.
+
+gdb_breakpoint [gdb_get_line_number "array2-almost-filled"]
+gdb_continue_to_breakpoint "array2-almost-filled"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *3, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was filled"
+gdb_test "print array2(2,1,1)=20" " = 20" \
+  "set array(2,2,2) to 20 in subroutine"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *20, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was mofified in debugger"
+
+gdb_test "finish" \
+  ".*foo\\$sub_arr1\\\(5:10, 5:10\\$, sub_arr2\\$10:15,10:15,10:15\\$\\\)" \
+  "finish function"
+gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish"
+gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish"
+gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish"
+gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish"
+
diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp
new file mode 100644
index 0000000..848f9d7
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp
@@ -0,0 +1,90 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla-sub.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+    {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Check the values of VLA's in subroutine can be evaluated correctly
+
+# Try to access values from a fixed array handled as VLA in subroutine.
+gdb_breakpoint [gdb_get_line_number "not-filled"]
+gdb_continue_to_breakpoint "not-filled (1st)"
+gdb_test "print array1" " = \$\[()1, .\]*\$" \
+  "print passed array1 in foo (passed fixed array)"
+
+gdb_breakpoint [gdb_get_line_number "array1-filled"]
+gdb_continue_to_breakpoint "array1-filled (1st)"
+gdb_test "print array1(5, 7)" " = 5" \
+  "print array1(5, 7) after filled in foo (passed fixed array)"
+gdb_test "print array1(1, 1)" " = 30" \
+  "print array1(1, 1) after filled in foo (passed fixed array)"
+
+gdb_breakpoint [gdb_get_line_number "array2-almost-filled"]
+gdb_continue_to_breakpoint "array2-almost-filled (1st)"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *3, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was filled (passed fixed array)"
+gdb_test "print array2(2,1,1)=20" " = 20" \
+  "set array(2,2,2) to 20 in subroutine (passed fixed array)"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *20, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was mofified in debugger (passed fixed array)"
+
+
+# Try to access values from a fixed sub-array handled as VLA in subroutine.
+gdb_continue_to_breakpoint "not-filled (2nd)"
+gdb_test "print array1" " = \$\[()5, .\]*\$" \
+  "print passed array1 in foo (passed sub-array)"
+
+gdb_continue_to_breakpoint "array1-filled (2nd)"
+gdb_test "print array1(5, 5)" " = 5" \
+  "print array1(5, 5) after filled in foo (passed sub-array)"
+gdb_test "print array1(1, 1)" " = 30" \
+  "print array1(1, 1) after filled in foo (passed sub-array)"
+
+gdb_continue_to_breakpoint "array2-almost-filled (2nd)"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *3, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was filled (passed sub-array)"
+gdb_test "print array2(2,1,1)=20" " = 20" \
+  "set array(2,2,2) to 20 in subroutine (passed sub-array)"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *20, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was mofified in debugger (passed sub-array)"
+
+
+# Try to access values from a VLA passed to subroutine.
+gdb_continue_to_breakpoint "not-filled (3rd)"
+gdb_test "print array1" " = \$\[()42, .\]*\$" \
+  "print passed array1 in foo (passed vla)"
+
+gdb_continue_to_breakpoint "array1-filled (3rd)"
+gdb_test "print array1(5, 5)" " = 5" \
+  "print array1(5, 5) after filled in foo (passed vla)"
+gdb_test "print array1(1, 1)" " = 30" \
+  "print array1(1, 1) after filled in foo (passed vla)"
+
+gdb_continue_to_breakpoint "array2-almost-filled (3rd)"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *3, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was filled (passed vla)"
+gdb_test "print array2(2,1,1)=20" " = 20" \
+  "set array(2,2,2) to 20 in subroutine (passed vla)"
+gdb_test "print array2" " = \$ *\\( *\\( *30, *20, *3,\[()3, .\]*\$" \
+  "print array2 in foo after it was mofified in debugger (passed vla)"
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
new file mode 100644
index 0000000..d7b8a1e
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -0,0 +1,148 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+standard_testfile "vla.f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+     {debug f90 quiet}] } {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+# Try to access values in non allocated VLA
+gdb_breakpoint [gdb_get_line_number "vla1-init"]
+gdb_continue_to_breakpoint "vla1-init"
+gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
+gdb_test "print &vla1" \
+  " = \\$PTR TO -> \\\( real\\\(kind=4\\$ \\$<not allocated>\\$\\\)\\\) $hex" \
+  "print non-allocated &vla1"
+gdb_test "print vla1(1,1,1)" "no such vector element because not allocated" \
+  "print member in non-allocated vla1 (1)"
+gdb_test "print vla1(101,202,303)" \
+  "no such vector element because not allocated" \
+  "print member in non-allocated vla1 (2)"
+gdb_test "print vla1(5,2,18)=1" "no such vector element because not allocated" \
+  "set member in non-allocated vla1"
+
+# Try to access value in allocated VLA
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
+gdb_continue_to_breakpoint "vla2-allocated"
+gdb_test "next" "\\d+(\\t|\\s)+vla1\\$3, 6, 9\\$ = 42" \
+  "step over value assignment of vla1"
+gdb_test "print &vla1" \
+  " = \\$PTR TO -> \\\( real\\\(kind=4\\$ \\$10,10,10\\$\\\)\\\) $hex" \
+  "print allocated &vla1"
+gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)"
+gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)"
+gdb_test "print vla1(9, 9, 9) = 999" " = 999" \
+  "print allocated vla1(9,9,9)=1"
+
+# Try to access values in allocated VLA after specific assignment
+gdb_breakpoint [gdb_get_line_number "vla1-filled"]
+gdb_continue_to_breakpoint "vla1-filled"
+gdb_test "print vla1(3, 6, 9)" " = 42" \
+  "print allocated vla1(3,6,9) after specific assignment (filled)"
+gdb_test "print vla1(1, 3, 8)" " = 1001" \
+  "print allocated vla1(1,3,8) after specific assignment (filled)"
+gdb_test "print vla1(9, 9, 9)" " = 999" \
+  "print allocated vla1(9,9,9) after assignment in debugger (filled)"
+
+# Try to access values in undefined pointer to VLA (dangling)
+gdb_test "print pvla" " = <not associated>" "print undefined pvla"
+gdb_test "print &pvla" \
+  " = \\$PTR TO -> \\\( real\\\(kind=4\\$ \\$<not associated>\\$\\\)\\\) $hex" \
+  "print non-associated &pvla"
+gdb_test "print pvla(1, 3, 8)" "no such vector element because not associated" \
+  "print undefined pvla(1,3,8)"
+
+# Try to access values in pointer to VLA and compare them
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+gdb_continue_to_breakpoint "pvla-associated"
+gdb_test "print &pvla" \
+  " = \\$PTR TO -> \\\( real\\\(kind=4\\$ \\$10,10,10\\$\\\)\\\) $hex" \
+  "print associated &pvla"
+gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)"
+gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)"
+gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)"
+
+# Fill values to VLA using pointer and check
+gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
+gdb_continue_to_breakpoint "pvla-re-associated"
+gdb_test "print pvla(5, 45, 20)" \
+  " = 1" "print pvla(5, 45, 20) after filled using pointer"
+gdb_test "print vla2(5, 45, 20)" \
+  " = 1" "print vla2(5, 45, 20) after filled using pointer"
+gdb_test "print pvla(7, 45, 14)" " = 2" \
+  "print pvla(7, 45, 14) after filled using pointer"
+gdb_test "print vla2(7, 45, 14)" " = 2" \
+  "print vla2(7, 45, 14) after filled using pointer"
+
+# Try to access values of deassociated VLA pointer
+gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
+gdb_continue_to_breakpoint "pvla-deassociated"
+gdb_test "print pvla(5, 45, 20)" \
+  "no such vector element because not associated" \
+  "print pvla(5, 45, 20) after deassociated"
+gdb_test "print pvla(7, 45, 14)" \
+  "no such vector element because not associated" \
+  "print pvla(7, 45, 14) after dissasociated"
+gdb_test "print pvla" " = <not associated>" \
+  "print vla1 after deassociated"
+
+# Try to access values of deallocated VLA
+gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
+gdb_continue_to_breakpoint "vla1-deallocated"
+gdb_test "print vla1(3, 6, 9)" "no such vector element because not allocated" \
+  "print allocated vla1(3,6,9) after specific assignment (deallocated)"
+gdb_test "print vla1(1, 3, 8)" "no such vector element because not allocated" \
+  "print allocated vla1(1,3,8) after specific assignment (deallocated)"
+gdb_test "print vla1(9, 9, 9)" "no such vector element because not allocated" \
+  "print allocated vla1(9,9,9) after assignment in debugger (deallocated)"
+
+
+# Try to assign VLA to user variable
+clean_restart ${testfile}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
+gdb_continue_to_breakpoint "vla2-allocated"
+gdb_test "next" "\\d+.*vla1\$3, 6, 9\$ = 42" "next (1)"
+
+gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1"
+gdb_test "print \$myvar" \
+  " = \$ *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\$" \
+  "print \$myvar set to vla1"
+
+gdb_test "next" "\\d+.*vla1\$1, 3, 8\$ = 1001" "next (2)"
+gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)"
+
+gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+gdb_continue_to_breakpoint "pvla-associated"
+gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla"
+gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)"
+
+# deallocate pointer and make sure user defined variable still has the
+# right value.
+gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
+gdb_continue_to_breakpoint "pvla-deassociated"
+gdb_test "print \$mypvar(1,3,8)" " = 1001" \
+  "print \$mypvar(1,3,8) after deallocated"
diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
new file mode 100644
index 0000000..73425f3
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla.f90
@@ -0,0 +1,56 @@
+! Copyright 2014 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+program vla
+  real, target, allocatable :: vla1 (:, :, :)
+  real, target, allocatable :: vla2 (:, :, :)
+  real, target, allocatable :: vla3 (:, :)
+  real, pointer :: pvla (:, :, :)
+  logical :: l
+
+  allocate (vla1 (10,10,10))          ! vla1-init
+  l = allocated(vla1)
+
+  allocate (vla2 (1:7,42:50,13:35))   ! vla1-allocated
+  l = allocated(vla2)
+
+  vla1(:, :, :) = 1311                ! vla2-allocated
+  vla1(3, 6, 9) = 42
+  vla1(1, 3, 8) = 1001
+  vla1(6, 2, 7) = 13
+
+  vla2(:, :, :) = 1311                ! vla1-filled
+  vla2(5, 45, 20) = 42
+
+  pvla => vla1                        ! vla2-filled
+  l = associated(pvla)
+
+  pvla => vla2                        ! pvla-associated
+  l = associated(pvla)
+  pvla(5, 45, 20) = 1
+  pvla(7, 45, 14) = 2
+
+  pvla => null()                      ! pvla-re-associated
+  l = associated(pvla)
+
+  deallocate (vla1)                   ! pvla-deassociated
+  l = allocated(vla1)
+
+  deallocate (vla2)                   ! vla1-deallocated
+  l = allocated(vla2)
+
+  allocate (vla3 (2,2))               ! vla2-deallocated
+  vla3(:,:) = 13
+end program vla
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
new file mode 100644
index 0000000..72b0be2
--- /dev/null
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -0,0 +1,182 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Verify that, using the MI, we can evaluate a simple C Variable Length
+# Array (VLA).
+
+load_lib mi-support.exp
+set MIFLAGS "-i=mi"
+
+gdb_exit
+if [mi_gdb_start] {
+    continue
+}
+
+standard_testfile vla.f90
+
+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \
+     {debug f90}] != "" } {
+     untested mi-vla-fortran.exp
+     return -1
+}
+
+mi_delete_breakpoints
+mi_gdb_reinitialize_dir $srcdir/$subdir
+mi_gdb_load ${binfile}
+
+set bp_lineno [gdb_get_line_number "vla1-not-allocated"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \
+  ".*vla.f90" $bp_lineno $hex \
+  "insert breakpoint at line $bp_lineno (vla not allocated)"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "500-data-evaluate-expression vla1" \
+  "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
+
+mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
+  "create local variable vla1_not_allocated"
+mi_gdb_test "501-var-info-type vla1_not_allocated" \
+  "501\\^done,type=\"<not allocated>\"" \
+  "info type variable vla1_not_allocated"
+mi_gdb_test "502-var-show-format vla1_not_allocated" \
+  "502\\^done,format=\"natural\"" \
+  "show format variable vla1_not_allocated"
+mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \
+  "503\\^done,value=\"\\\[0\\\]\"" \
+  "eval variable vla1_not_allocated"
+mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
+    "real\\$kind=4\\$" "get children of vla1_not_allocated"
+
+
+
+set bp_lineno [gdb_get_line_number "vla1-allocated"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \
+  $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "510-data-evaluate-expression vla1" \
+  "510\\^done,value=\"\$0, 0, 0, 0, 0\$\"" "evaluate allocated vla"
+
+mi_create_varobj_checked vla1_allocated vla1 "real\\$kind=4\\$ \\$5\\$" \
+  "create local variable vla1_allocated"
+mi_gdb_test "511-var-info-type vla1_allocated" \
+  "511\\^done,type=\"real\\$kind=4\\$ \\$5\\$\"" \
+  "info type variable vla1_allocated"
+mi_gdb_test "512-var-show-format vla1_allocated" \
+  "512\\^done,format=\"natural\"" \
+  "show format variable vla1_allocated"
+mi_gdb_test "513-var-evaluate-expression vla1_allocated" \
+  "513\\^done,value=\"\\\[5\\\]\"" \
+  "eval variable vla1_allocated"
+mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
+    "real\\$kind=4\\$" "get children of vla1_allocated"
+
+
+set bp_lineno [gdb_get_line_number "vla1-filled"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \
+  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "520-data-evaluate-expression vla1" \
+  "520\\^done,value=\"\$1, 1, 1, 1, 1\$\"" "evaluate filled vla"
+
+
+set bp_lineno [gdb_get_line_number "vla1-modified"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \
+  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "530-data-evaluate-expression vla1" \
+  "530\\^done,value=\"\$1, 42, 1, 24, 1\$\"" "evaluate filled vla"
+mi_gdb_test "540-data-evaluate-expression vla1(1)" \
+  "540\\^done,value=\"1\"" "evaluate filled vla"
+mi_gdb_test "550-data-evaluate-expression vla1(2)" \
+  "550\\^done,value=\"42\"" "evaluate filled vla"
+mi_gdb_test "560-data-evaluate-expression vla1(4)" \
+  "560\\^done,value=\"24\"" "evaluate filled vla"
+
+
+set bp_lineno [gdb_get_line_number "vla1-deallocated"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \
+  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "570-data-evaluate-expression vla1" \
+  "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
+
+
+set bp_lineno [gdb_get_line_number "pvla2-not-associated"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \
+  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "580-data-evaluate-expression pvla2" \
+  "580\\^done,value=\"<not associated>\"" "evaluate not associated vla"
+
+mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
+  "create local variable pvla2_not_associated"
+mi_gdb_test "581-var-info-type pvla2_not_associated" \
+  "581\\^done,type=\"<not associated>\"" \
+  "info type variable pvla2_not_associated"
+mi_gdb_test "582-var-show-format pvla2_not_associated" \
+  "582\\^done,format=\"natural\"" \
+  "show format variable pvla2_not_associated"
+mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \
+  "583\\^done,value=\"\\\[0\\\]\"" \
+  "eval variable pvla2_not_associated"
+mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
+    "real\\$kind=4\\$" "get children of pvla2_not_associated"
+
+
+set bp_lineno [gdb_get_line_number "pvla2-associated"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \
+  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "590-data-evaluate-expression pvla2" \
+  "590\\^done,value=\"\$\\( 2, 2, 2, 2, 2\$ \$ 2, 2, 2, 2, 2\$ \\)\"" \
+  "evaluate associated vla"
+
+mi_create_varobj_checked pvla2_associated pvla2 \
+  "real\\$kind=4\\$ \\$5,2\\$" "create local variable pvla2_associated"
+mi_gdb_test "591-var-info-type pvla2_associated" \
+  "591\\^done,type=\"real\\$kind=4\\$ \\$5,2\\$\"" \
+  "info type variable pvla2_associated"
+mi_gdb_test "592-var-show-format pvla2_associated" \
+  "592\\^done,format=\"natural\"" \
+  "show format variable pvla2_associated"
+mi_gdb_test "593-var-evaluate-expression pvla2_associated" \
+  "593\\^done,value=\"\\\[2\\\]\"" \
+  "eval variable pvla2_associated"
+
+
+set bp_lineno [gdb_get_line_number "pvla2-set-to-null"]
+mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \
+  $bp_lineno $hex "insert breakpoint at line $bp_lineno"
+mi_run_cmd
+mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
+  { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
+mi_gdb_test "600-data-evaluate-expression pvla2" \
+  "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null"
+
+mi_gdb_exit
+return 0
diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90
new file mode 100644
index 0000000..46edad2
--- /dev/null
+++ b/gdb/testsuite/gdb.mi/vla.f90
@@ -0,0 +1,42 @@
+! Copyright 2014 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+program vla
+  real, allocatable :: vla1 (:)
+  real, target, allocatable :: vla2(:, :)
+  real, pointer :: pvla2 (:, :)
+  logical :: l
+
+  allocate (vla1 (5))         ! vla1-not-allocated
+  l = allocated(vla1)         ! vla1-allocated
+
+  vla1(:) = 1
+  vla1(2) = 42                ! vla1-filled
+  vla1(4) = 24
+
+  deallocate (vla1)           ! vla1-modified
+  l = allocated(vla1)         ! vla1-deallocated
+
+  allocate (vla2 (5, 2))
+  vla2(:, :) = 2
+
+  pvla2 => vla2               ! pvla2-not-associated
+  l = associated(pvla2)       ! pvla2-associated
+
+  pvla2(2, 1) = 42
+
+  pvla2 => null()
+  l = associated(pvla2)       ! pvla2-set-to-null
+end program vla
diff --git a/gdb/typeprint.c b/gdb/typeprint.c
index 026f3a2..4c861ac 100644
--- a/gdb/typeprint.c
+++ b/gdb/typeprint.c
@@ -459,6 +459,13 @@ whatis_exp (char *exp, int show)
 
   type = value_type (val);
 
+  if (TYPE_CODE (type) == TYPE_CODE_PTR)
+    if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
+      {
+	val = value_addr (value_ind (val));
+	type = value_type (val);
+      }
+
   get_user_print_options (&opts);
   if (opts.objectprint)
     {
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 4da41cb..fb9671b 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -195,12 +195,31 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
   struct type *array_type = check_typedef (value_type (array));
   struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
   unsigned int elt_size = TYPE_LENGTH (elt_type);
-  unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound);
+  unsigned int elt_offs = longest_to_int (index - lowerbound);
+  LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
   struct value *v;
 
+  if (elt_stride > 0)
+    elt_offs *= elt_stride;
+  else if (elt_stride < 0)
+    {
+      int offs = (elt_offs + 1) * elt_stride;
+
+      elt_offs = TYPE_LENGTH (array_type) + offs;
+    }
+  else
+    elt_offs *= elt_size;
+
   if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
 			     && elt_offs >= TYPE_LENGTH (array_type)))
-    error (_("no such vector element"));
+    {
+      if (TYPE_NOT_ASSOCIATED (array_type))
+        error (_("no such vector element because not associated"));
+      else if (TYPE_NOT_ALLOCATED (array_type))
+        error (_("no such vector element because not allocated"));
+      else
+        error (_("no such vector element"));
+    }
 
   if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
     v = allocate_value_lazy (elt_type);
diff --git a/gdb/valprint.c b/gdb/valprint.c
index 8600b34..2f8eac1 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -307,6 +307,18 @@ valprint_check_validity (struct ui_file *stream,
 {
   CHECK_TYPEDEF (type);
 
+  if (TYPE_NOT_ASSOCIATED (type))
+    {
+      val_print_not_associated (stream);
+      return 0;
+    }
+
+  if (TYPE_NOT_ALLOCATED (type))
+    {
+      val_print_not_allocated (stream);
+      return 0;
+    }
+
   if (TYPE_CODE (type) != TYPE_CODE_UNION
       && TYPE_CODE (type) != TYPE_CODE_STRUCT
       && TYPE_CODE (type) != TYPE_CODE_ARRAY)
@@ -362,6 +374,18 @@ val_print_invalid_address (struct ui_file *stream)
   fprintf_filtered (stream, _("<invalid address>"));
 }
 
+void
+val_print_not_allocated (struct ui_file *stream)
+{
+  fprintf_filtered (stream, _("<not allocated>"));
+}
+
+void
+val_print_not_associated (struct ui_file *stream)
+{
+  fprintf_filtered (stream, _("<not associated>"));
+}
+
 /* A generic val_print that is suitable for use by language
    implementations of the la_val_print method.  This function can
    handle most type codes, though not all, notably exception
@@ -803,12 +827,16 @@ static int
 value_check_printable (struct value *val, struct ui_file *stream,
 		       const struct value_print_options *options)
 {
+  const struct type *type;
+
   if (val == 0)
     {
       fprintf_filtered (stream, _("<address of value unknown>"));
       return 0;
     }
 
+  type = value_type (val);
+
   if (value_entirely_optimized_out (val))
     {
       if (options->summary && !val_print_scalar_type_p (value_type (val)))
@@ -834,6 +862,18 @@ value_check_printable (struct value *val, struct ui_file *stream,
       return 0;
     }
 
+  if (TYPE_NOT_ASSOCIATED (type))
+    {
+      val_print_not_associated (stream);
+      return 0;
+    }
+
+  if (TYPE_NOT_ALLOCATED (type))
+    {
+      val_print_not_allocated (stream);
+      return 0;
+    }
+
   return 1;
 }
 
diff --git a/gdb/valprint.h b/gdb/valprint.h
index 6698247..7a415cf 100644
--- a/gdb/valprint.h
+++ b/gdb/valprint.h
@@ -217,4 +217,8 @@ extern void output_command_const (const char *args, int from_tty);
 
 extern int val_print_scalar_type_p (struct type *type);
 
+extern void val_print_not_allocated (struct ui_file *stream);
+
+extern void val_print_not_associated (struct ui_file *stream);
+
 #endif
diff --git a/gdb/value.c b/gdb/value.c
index 29abe5f..5efea89 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -43,6 +43,7 @@
 #include "tracepoint.h"
 #include "cp-abi.h"
 #include "user-regs.h"
+#include "dwarf2loc.h"
 
 /* Prototypes for exported functions.  */
 
@@ -1627,6 +1628,25 @@ set_value_component_location (struct value *component,
       if (funcs->copy_closure)
         component->location.computed.closure = funcs->copy_closure (whole);
     }
+
+  /* For dynamic types compute the address of the component value location in
+     sub range types based on the location of the sub range type, if not being
+     an internal GDB variable or parts of it.  */
+  if (VALUE_LVAL (component) != lval_internalvar
+      && VALUE_LVAL (component) != lval_internalvar_component)
+    {
+      CORE_ADDR addr;
+      struct type *type = value_type (whole);
+
+      addr = value_raw_address (component);
+
+      if (TYPE_DATA_LOCATION (type)
+          && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
+        {
+          addr = TYPE_DATA_LOCATION_ADDR (type);
+          set_value_address (component, addr);
+        }
+    }
 }
 
 
@@ -2931,13 +2951,22 @@ value_primitive_field (struct value *arg1, int offset,
 	v = allocate_value_lazy (type);
       else
 	{
-	  v = allocate_value (type);
-	  value_contents_copy_raw (v, value_embedded_offset (v),
-				   arg1, value_embedded_offset (arg1) + offset,
-				   TYPE_LENGTH (type));
+	  if (TYPE_DATA_LOCATION (type)
+	      && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
+	    v = value_at_lazy (type, value_address (arg1) + offset);
+	  else
+	    {
+	      v = allocate_value (type);
+	      value_contents_copy_raw (v, value_embedded_offset (v),
+				       arg1, value_embedded_offset (arg1) + offset,
+				       TYPE_LENGTH (type));
+	    }
 	}
-      v->offset = (value_offset (arg1) + offset
-		   + value_embedded_offset (arg1));
+
+      if (!TYPE_DATA_LOCATION (type)
+          || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
+	v->offset = (value_offset (arg1) + offset
+		     + value_embedded_offset (arg1));
     }
   set_value_component_location (v, arg1);
   VALUE_REGNUM (v) = VALUE_REGNUM (arg1);
@@ -3520,7 +3549,8 @@ readjust_indirect_value_type (struct value *value, struct type *enc_type,
 			      struct value *original_value)
 {
   /* Re-adjust type.  */
-  deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
+  if (!is_dynamic_type (TYPE_TARGET_TYPE (original_type)))
+    deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
 
   /* Add embedding info.  */
   set_value_enclosing_type (value, enc_type);
@@ -3537,6 +3567,12 @@ coerce_ref (struct value *arg)
   struct value *retval;
   struct type *enc_type;
 
+  if (current_language->la_language != language_fortran
+      && TYPE_DATA_LOCATION (value_type_arg_tmp) != NULL
+      && TYPE_DATA_LOCATION_KIND (value_type_arg_tmp) == PROP_CONST)
+    arg = value_at_lazy (value_type_arg_tmp,
+                         TYPE_DATA_LOCATION_ADDR (value_type_arg_tmp));
+
   retval = coerce_ref_if_computed (arg);
   if (retval)
     return retval;
@@ -3680,8 +3716,14 @@ value_fetch_lazy (struct value *val)
     }
   else if (VALUE_LVAL (val) == lval_memory)
     {
-      CORE_ADDR addr = value_address (val);
       struct type *type = check_typedef (value_enclosing_type (val));
+      CORE_ADDR addr;
+
+      if (TYPE_DATA_LOCATION (type) != NULL
+	  && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
+	addr = TYPE_DATA_LOCATION_ADDR (type);
+      else
+	addr = value_address (val);
 
       if (TYPE_LENGTH (type))
 	read_value_memory (val, 0, value_stack (val),

Places

File gdb-vla-intel.patch of Package gdb

Places