[PATCH V2 3/3] fort_dyn_array: Use value constructor instead of raw-buffer manipulation.

[PATCH V2 3/3] fort_dyn_array: Use value constructor instead of raw-buffer manipulation.

[Bernhard Heckel]

From: Keven Boell <keven.boell@intel.com>

Instead of pre-computing indices into a fortran array re-use
the value_* interfaces to subscript a fortran array.
The benefit of using the new interface is that it takes care of
dynamic types and resolve them when needed.
This fixes issues when printing structures with dynamic arrays from toplevel.

Before:
(gdb) p twov
$1 = ( (( ( 6352320, 0, -66, -1, 267) ( 343476, 1, -15, 1, 0) ( 5, 0, 5, 0, 1) ...

After:
(gdb) p twov
$1 = ( (( ( 1, 1, 1, 1, 1) ( 1, 1, 321, 1, 1) ( 1, 1, 1, 1, 1) ...

2014-05-28  Sanimir Agovic  <sanimir.agovic@intel.com>
            Keven Boell  <keven.boell@intel.com>
            Bernhard Heckel  <bernhard.heckel@intel.com>

gdb/Changelog:
	* f-valprint.c (f77_create_arrayprint_offset_tbl): Remove
	function.
	(F77_DIM_SIZE, F77_DIM_OFFSET): Remove macro.
	(f77_print_array_1): Use value_subscript to subscript a
	value array.
	(f77_print_array): Remove call to f77_create_arrayprint_offset_tbl.
	(f_val_print): Use value_field to construct a field value.

gdb/testsuite/Changelog:
	* vla-type.exp: Print structure from toplevel.

---
 gdb/f-valprint.c                       | 118 +++++++++++----------------------
 gdb/testsuite/gdb.fortran/vla-type.exp |   3 +
 2 files changed, 42 insertions(+), 79 deletions(-)

diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 1438fc6..71bd2c3 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -36,8 +36,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];
@@ -45,15 +43,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)
 {
@@ -111,47 +100,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.  */
 
@@ -164,41 +112,56 @@ 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 = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+      size_t offs = 0;
+
+      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, "...");
 	}
     }
@@ -225,12 +188,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);
 }
@@ -375,12 +332,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/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
index f9c0b61..25a3183 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -56,6 +56,9 @@ gdb_test "ptype twov" \
                      "\\s+integer\\\(kind=4\\\) :: ivla1\\\(5,12,99\\\)" \
                      "\\s+integer\\\(kind=4\\\) :: ivla2\\\(9,12\\\)" \
                      "End Type two" ]
+gdb_test "print twov" " = \\\( \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
+ \\\( 1, 1, 321, 1, 1\\\)\
+ \\\( 1, 1, 1, 1, 1\\\) .*"
 
 # Check type with attribute at beginn of type
 gdb_breakpoint [gdb_get_line_number "threev-filled"]
-- 
2.7.1.339.g0233b80

[PATCH V2 2/3] fort_dyn_array: Support evaluation of dynamic elements inside arrays.

[Bernhard Heckel]

Resolve type of an array's element to be printed in case it is dynamic.
Otherwise we don't use the correct boundaries nor the right location.

Before:
  ptype fivearr(1)
  type = Type five
      Type one
          integer(kind=4) :: ivla(34196784:34196832,34197072:34197120,34197360:34197408)
      End Type one :: tone
  End Type five

After:
  ptype fivearr(1)
  type = Type five
      Type one
          integer(kind=4) :: ivla(2,4,6)
      End Type one :: tone
  End Type five

2016-02-24  Bernhard Heckel  <bernhard.heckel@intel.com>

gdb/Changelog:
	* valarith.c (value_address): Resolve dynamic types.

gdb/testsuite/Changelog:
	* gdb.fortran/vla-type.f90: Add test for static and dynamic arrays
	of dynamic types.
	* gdb.fortran/vla-type.exp: Add test for static and dynamic arrays
	of dynamic types.

---
 gdb/testsuite/gdb.fortran/vla-type.exp | 52 ++++++++++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/vla-type.f90 | 20 +++++++++++--
 gdb/valarith.c                         |  8 ++++++
 3 files changed, 78 insertions(+), 2 deletions(-)

diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
index 1d09451..f9c0b61 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -96,3 +96,55 @@ gdb_test "ptype fivev" \
                      "\\s+integer\\\(kind=4\\\) :: ivla\\\(10,10,10\\\)" \
                      "\\s+End Type one :: tone" \
                      "End Type five" ]
+
+# Check array of types containing a VLA
+gdb_breakpoint [gdb_get_line_number "fivearr-filled"]
+gdb_continue_to_breakpoint "fivearr-filled"
+gdb_test "print fivearr(1)%tone%ivla(1, 2, 3)" " = 1"
+gdb_test "print fivearr(1)%tone%ivla(2, 2, 10)" "no such vector element"
+gdb_test "print fivearr(1)%tone%ivla(2, 2, 3)" " = 223"
+gdb_test "print fivearr(2)%tone%ivla(12, 14, 16)" " = 2"
+gdb_test "print fivearr(2)%tone%ivla(6, 7, 8)" " = 678"
+gdb_test "ptype fivearr(1)" \
+         [multi_line "type = Type five" \
+                     "\\s+Type one" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(2,4,6\\\)" \
+                     "\\s+End Type one :: tone" \
+                     "End Type five" ]
+gdb_test "ptype fivearr(2)" \
+         [multi_line "type = Type five" \
+                     "\\s+Type one" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(12,14,16\\\)" \
+                     "\\s+End Type one :: tone" \
+                     "End Type five" ]
+
+# Check allocation status of dynamic array and it's dynamic members
+gdb_test "ptype fivedynarr" "type = <not allocated>"
+gdb_test "next" ""
+gdb_test "ptype fivedynarr(2)" \
+         [multi_line "type = Type five" \
+                     "\\s+Type one" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(<not allocated>\\\)" \
+                     "\\s+End Type one :: tone" \
+                     "End Type five" ]
+
+# Check dynamic array of types containing a VLA
+gdb_breakpoint [gdb_get_line_number "fivedynarr-filled"]
+gdb_continue_to_breakpoint "fivedynarr-filled"
+gdb_test "print fivedynarr(1)%tone%ivla(1, 2, 3)" " = 1"
+gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 10)" "no such vector element"
+gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 3)" " = 223"
+gdb_test "print fivedynarr(2)%tone%ivla(12, 14, 16)" " = 2"
+gdb_test "print fivedynarr(2)%tone%ivla(6, 7, 8)" " = 678"
+gdb_test "ptype fivedynarr(1)" \
+         [multi_line "type = Type five" \
+                     "\\s+Type one" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(2,4,6\\\)" \
+                     "\\s+End Type one :: tone" \
+                     "End Type five" ]
+gdb_test "ptype fivedynarr(2)" \
+         [multi_line "type = Type five" \
+                     "\\s+Type one" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(12,14,16\\\)" \
+                     "\\s+End Type one :: tone" \
+                     "End Type five" ]
diff --git a/gdb/testsuite/gdb.fortran/vla-type.f90 b/gdb/testsuite/gdb.fortran/vla-type.f90
index a106617..5473124 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.f90
+++ b/gdb/testsuite/gdb.fortran/vla-type.f90
@@ -38,6 +38,8 @@ program vla_struct
   type(three)              :: threev
   type(four)               :: fourv
   type(five)               :: fivev
+  type(five)               :: fivearr (2)
+  type(five), allocatable  :: fivedynarr (:)
   logical                  :: l
   integer                  :: i, j
 
@@ -83,6 +85,20 @@ program vla_struct
   fivev%tone%ivla(1, 2, 3) = 123
   fivev%tone%ivla(3, 2, 1) = 321
 
-  ! dummy statement for bp
-  l = allocated(fivev%tone%ivla)                  ! fivev-filled
+  allocate (fivearr(1)%tone%ivla (2, 4, 6))        ! fivev-filled
+  allocate (fivearr(2)%tone%ivla (12, 14, 16))
+  fivearr(1)%tone%ivla(:, :, :) = 1
+  fivearr(1)%tone%ivla(2, 2, 3) = 223
+  fivearr(2)%tone%ivla(:, :, :) = 2
+  fivearr(2)%tone%ivla(6, 7, 8) = 678
+
+  allocate (fivedynarr(2))                         ! fivearr-filled
+  allocate (fivedynarr(1)%tone%ivla (2, 4, 6))
+  allocate (fivedynarr(2)%tone%ivla (12, 14, 16))
+  fivedynarr(1)%tone%ivla(:, :, :) = 1
+  fivedynarr(1)%tone%ivla(2, 2, 3) = 223
+  fivedynarr(2)%tone%ivla(:, :, :) = 2
+  fivedynarr(2)%tone%ivla(6, 7, 8) = 678
+
+  l = allocated(fivedynarr)                        ! fivedynarr-filled
 end program vla_struct
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 7959f3b..254d998 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -207,6 +207,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
         error (_("no such vector element"));
     }
 
+  if (is_dynamic_type (elt_type))
+    {
+      CORE_ADDR address;
+
+      address = value_address (array) + elt_offs;
+      elt_type = resolve_dynamic_type (elt_type, NULL, address);
+    }
+
   if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
     v = allocate_value_lazy (elt_type);
   else
-- 
2.7.1.339.g0233b80

[PATCH V2 1/3] fort_dyn_array: Enable dynamic member types inside a structure.

[Bernhard Heckel]

Fortran supports dynamic types for which bounds, size and location
can vary during their lifetime. As a result of the dynamic
behaviour, they have to be resolved at every query.
This patch will resolve the type of a structure field when it
is dynamic.

2016-02-24  Bernhard Heckel  <bernhard.heckel@intel.com>
2015-03-20  Keven Boell  <keven.boell@intel.com>

Before:
(gdb) print threev%ivla(1)
Cannot access memory at address 0x3
(gdb) print threev%ivla(5)
no such vector element

After:
(gdb) print threev%ivla(1)
$9 = 1
(gdb) print threev%ivla(5)
$10 = 42

gdb/Changelog:

	* NEWS: Add new supported features for fortran.
	* gdbtypes.c (remove_dyn_prop): New.
	(resolve_dynamic_struct): Keep type length for fortran structs.
	* gdbtypes.h: Forward declaration of new function.
	* value.c (value_address): Return dynamic resolved location of a value.
	(set_value_component_location): Adjust the value address
	for single value prints.
	(value_primitive_field): Support value types with a dynamic location.
	(set_internalvar): Remove dynamic location property of
	internal variables.

gdb/testsuite/Changelog:

	* gdb.fortran/vla-type.f90: New file.
	* gdb.fortran/vla-type.exp: New file.

---
 gdb/NEWS                               |  3 ++
 gdb/gdbtypes.c                         | 43 +++++++++++++--
 gdb/gdbtypes.h                         |  3 ++
 gdb/testsuite/gdb.fortran/vla-type.exp | 98 ++++++++++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/vla-type.f90 | 88 ++++++++++++++++++++++++++++++
 gdb/value.c                            | 35 ++++++++++--
 6 files changed, 264 insertions(+), 6 deletions(-)
 create mode 100755 gdb/testsuite/gdb.fortran/vla-type.exp
 create mode 100755 gdb/testsuite/gdb.fortran/vla-type.f90

diff --git a/gdb/NEWS b/gdb/NEWS
index be15902..056d56c 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -3,6 +3,9 @@
 
 *** Changes since GDB 7.11
 
+* Fortran: Support structures with fields of dynamic types and 
+  arrays of dynamic types.
+
 * Intel MPX bound violation handling.
 
    Segmentation faults caused by a Intel MPX boundary violation
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index f129b0e..b0b49d0 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2064,7 +2064,8 @@ resolve_dynamic_struct (struct type *type,
 
       pinfo.type = check_typedef (TYPE_FIELD_TYPE (type, i));
       pinfo.valaddr = addr_stack->valaddr;
-      pinfo.addr = addr_stack->addr;
+      pinfo.addr = addr_stack->addr
+              + (TYPE_FIELD_BITPOS (resolved_type, i) / TARGET_CHAR_BIT);
       pinfo.next = addr_stack;
 
       TYPE_FIELD_TYPE (resolved_type, i)
@@ -2090,8 +2091,13 @@ resolve_dynamic_struct (struct type *type,
 	resolved_type_bit_length = new_bit_length;
     }
 
-  TYPE_LENGTH (resolved_type)
-    = (resolved_type_bit_length + TARGET_CHAR_BIT - 1) / TARGET_CHAR_BIT;
+  /* The length of a type won't change for fortran, but it does for C and Ada.
+     For fortran the size of dynamic fields might change over time but not the
+     type length of the structure.  If we would adapt it we run into problems
+     when calculating the element offset for arrays of structs.  */
+  if (current_language->la_language != language_fortran)
+    TYPE_LENGTH (resolved_type)
+      = (resolved_type_bit_length + TARGET_CHAR_BIT - 1) / TARGET_CHAR_BIT;
 
   /* The Ada language uses this field as a cache for static fixed types: reset
      it as RESOLVED_TYPE must have its own static fixed type.  */
@@ -2224,6 +2230,37 @@ add_dyn_prop (enum dynamic_prop_node_kind prop_kind, struct dynamic_prop prop,
   TYPE_DYN_PROP_LIST (type) = temp;
 }
 
+/* Remove dynamic property from TYPE in case it exist.  */
+
+void
+remove_dyn_prop (enum dynamic_prop_node_kind prop_kind,
+                 struct type *type)
+{
+  struct dynamic_prop_list *prev_node, *curr_node;
+
+  curr_node = TYPE_DYN_PROP_LIST (type);
+  prev_node = NULL;
+
+  while (NULL != curr_node)
+    {
+      if (curr_node->prop_kind == prop_kind)
+	{
+	  /* Upadate the linked list but don't free anything.
+	     The property was allocated on objstack and it is not known
+	     if we are on top of it.  Nevertheless, everything is released
+	     when the complete objstack is freed.  */
+	  if (NULL == prev_node)
+	    TYPE_DYN_PROP_LIST (type) = curr_node->next;
+	  else
+	    prev_node->next = curr_node->next;
+
+	  return;
+	}
+
+      prev_node = curr_node;
+      curr_node = curr_node->next;
+    }
+}
 
 /* Find the real type of TYPE.  This function returns the real type,
    after removing all layers of typedefs, and completing opaque or stub
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index e775a1d..b118610 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -1823,6 +1823,9 @@ extern void add_dyn_prop
   (enum dynamic_prop_node_kind kind, struct dynamic_prop prop,
    struct type *type, struct objfile *objfile);
 
+extern void remove_dyn_prop (enum dynamic_prop_node_kind prop_kind,
+                             struct type *type);
+
 extern struct type *check_typedef (struct type *);
 
 extern void check_stub_method_group (struct type *, int);
diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
new file mode 100755
index 0000000..1d09451
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -0,0 +1,98 @@
+# Copyright 2016 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] {
+    untested "could not run to main"
+    return -1
+}
+
+# Check if not allocated VLA in type does not break
+# the debugger when accessing it.
+gdb_breakpoint [gdb_get_line_number "before-allocated"]
+gdb_continue_to_breakpoint "before-allocated"
+gdb_test "print twov" " = \\\( <not allocated>, <not allocated> \\\)" \
+  "print twov before allocated"
+gdb_test "print twov%ivla1" " = <not allocated>" \
+  "print twov%ivla1 before allocated"
+
+# Check type with one VLA's inside
+gdb_breakpoint [gdb_get_line_number "onev-filled"]
+gdb_continue_to_breakpoint "onev-filled"
+gdb_test "print onev%ivla(5, 11, 23)" " = 1"
+gdb_test "print onev%ivla(1, 2, 3)" " = 123"
+gdb_test "print onev%ivla(3, 2, 1)" " = 321"
+gdb_test "ptype onev" \
+         [multi_line "type = Type one" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(11,22,33\\\)" \
+                     "End Type one" ]
+
+# Check type with two VLA's inside
+gdb_breakpoint [gdb_get_line_number "twov-filled"]
+gdb_continue_to_breakpoint "twov-filled"
+gdb_test "print twov%ivla1(5, 11, 23)" " = 1"
+gdb_test "print twov%ivla1(1, 2, 3)" " = 123"
+gdb_test "print twov%ivla1(3, 2, 1)" " = 321"
+gdb_test "ptype twov" \
+         [multi_line "type = Type two" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla1\\\(5,12,99\\\)" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla2\\\(9,12\\\)" \
+                     "End Type two" ]
+
+# Check type with attribute at beginn of type
+gdb_breakpoint [gdb_get_line_number "threev-filled"]
+gdb_continue_to_breakpoint "threev-filled"
+gdb_test "print threev%ivla(1)" " = 1"
+gdb_test "print threev%ivla(5)" " = 42"
+gdb_test "print threev%ivla(14)" " = 24"
+gdb_test "print threev%ivar" " = 3"
+gdb_test "ptype threev" \
+         [multi_line "type = Type three" \
+                     "\\s+integer\\\(kind=4\\\) :: ivar" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(20\\\)" \
+                     "End Type three" ]
+
+# Check type with attribute at end of type
+gdb_breakpoint [gdb_get_line_number "fourv-filled"]
+gdb_continue_to_breakpoint "fourv-filled"
+gdb_test "print fourv%ivla(1)" " = 1"
+gdb_test "print fourv%ivla(2)" " = 2"
+gdb_test "print fourv%ivla(7)" " = 7"
+gdb_test "print fourv%ivla(12)" "no such vector element"
+gdb_test "print fourv%ivar" " = 3"
+gdb_test "ptype fourv" \
+         [multi_line "type = Type four" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(10\\\)" \
+                     "\\s+integer\\\(kind=4\\\) :: ivar" \
+                     "End Type four" ]
+
+# Check nested types containing a VLA
+gdb_breakpoint [gdb_get_line_number "fivev-filled"]
+gdb_continue_to_breakpoint "fivev-filled"
+gdb_test "print fivev%tone%ivla(5, 5, 1)" " = 1"
+gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123"
+gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321"
+gdb_test "ptype fivev" \
+         [multi_line "type = Type five" \
+                     "\\s+Type one" \
+                     "\\s+integer\\\(kind=4\\\) :: ivla\\\(10,10,10\\\)" \
+                     "\\s+End Type one :: tone" \
+                     "End Type five" ]
diff --git a/gdb/testsuite/gdb.fortran/vla-type.f90 b/gdb/testsuite/gdb.fortran/vla-type.f90
new file mode 100755
index 0000000..a106617
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-type.f90
@@ -0,0 +1,88 @@
+! Copyright 2016 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_struct
+  type :: one
+    integer, allocatable :: ivla (:, :, :)
+  end type one
+  type :: two
+    integer, allocatable :: ivla1 (:, :, :)
+    integer, allocatable :: ivla2 (:, :)
+  end type two
+  type :: three
+    integer :: ivar
+    integer, allocatable :: ivla (:)
+  end type three
+  type :: four
+    integer, allocatable :: ivla (:)
+    integer :: ivar
+  end type four
+  type :: five
+    type(one) :: tone
+  end type five
+
+  type(one), target        :: onev
+  type(two)                :: twov
+  type(three)              :: threev
+  type(four)               :: fourv
+  type(five)               :: fivev
+  logical                  :: l
+  integer                  :: i, j
+
+  allocate (onev%ivla (11,22,33))         ! before-allocated
+  l = allocated(onev%ivla)
+
+  onev%ivla(:, :, :) = 1
+  onev%ivla(1, 2, 3) = 123
+  onev%ivla(3, 2, 1) = 321
+
+  allocate (twov%ivla1 (5,12,99))         ! onev-filled
+  l = allocated(twov%ivla1)
+  allocate (twov%ivla2 (9,12))
+  l = allocated(twov%ivla2)
+
+  twov%ivla1(:, :, :) = 1
+  twov%ivla1(1, 2, 3) = 123
+  twov%ivla1(3, 2, 1) = 321
+
+  twov%ivla2(:, :) = 1
+  twov%ivla2(1, 2) = 12
+  twov%ivla2(2, 1) = 21
+
+  threev%ivar = 3                      ! twov-filled
+  allocate (threev%ivla (20))
+  l = allocated(threev%ivla)
+
+  threev%ivla(:) = 1
+  threev%ivla(5) = 42
+  threev%ivla(14) = 24
+
+  allocate (fourv%ivla (10))             ! threev-filled
+  l = allocated(fourv%ivla)
+
+  fourv%ivar = 3
+  fourv%ivla(:) = 1
+  fourv%ivla(2) = 2
+  fourv%ivla(7) = 7
+
+  allocate (fivev%tone%ivla (10, 10, 10))         ! fourv-filled
+  l = allocated(fivev%tone%ivla)
+  fivev%tone%ivla(:, :, :) = 1
+  fivev%tone%ivla(1, 2, 3) = 123
+  fivev%tone%ivla(3, 2, 1) = 321
+
+  ! dummy statement for bp
+  l = allocated(fivev%tone%ivla)                  ! fivev-filled
+end program vla_struct
diff --git a/gdb/value.c b/gdb/value.c
index 738b2b2..751f430 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -1530,8 +1530,13 @@ value_address (const struct value *value)
     return 0;
   if (value->parent != NULL)
     return value_address (value->parent) + value->offset;
-  else
-    return value->location.address + value->offset;
+  if (TYPE_DATA_LOCATION (value_type (value)))
+    {
+      gdb_assert (PROP_CONST == TYPE_DATA_LOCATION_KIND (value_type (value)));
+      return TYPE_DATA_LOCATION_ADDR (value_type (value));
+    }
+
+  return value->location.address + value->offset;
 }
 
 CORE_ADDR
@@ -1846,6 +1851,8 @@ void
 set_value_component_location (struct value *component,
 			      const struct value *whole)
 {
+  struct type *type;
+
   gdb_assert (whole->lval != lval_xcallable);
 
   if (whole->lval == lval_internalvar)
@@ -1861,9 +1868,14 @@ set_value_component_location (struct value *component,
       if (funcs->copy_closure)
         component->location.computed.closure = funcs->copy_closure (whole);
     }
+
+  /* If type has a dynamic resolved location property update it's value address.  */
+  type = value_type (whole);
+  if (TYPE_DATA_LOCATION (type)
+      && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
+    set_value_address (component, TYPE_DATA_LOCATION_ADDR (type));
 }
 
-\f
 /* Access to the value history.  */
 
 /* Record a new value in the value history.
@@ -2416,6 +2428,12 @@ set_internalvar (struct internalvar *var, struct value *val)
 	 call error () until new_data is installed into the var->u to avoid
 	 leaking memory.  */
       release_value (new_data.value);
+
+      /* Internal variables which are created from values with a dynamic location
+         don't need the location property of the origin anymore.
+         Remove the location property in case it exist.  */
+      remove_dyn_prop (DYN_PROP_DATA_LOCATION, value_type (new_data.value));
+
       break;
     }
 
@@ -3157,6 +3175,17 @@ value_primitive_field (struct value *arg1, int offset,
       v->offset = value_offset (arg1);
       v->embedded_offset = offset + value_embedded_offset (arg1) + boffset;
     }
+  else if (TYPE_DATA_LOCATION (type))
+    {
+      /* Field is a dynamic data member.  */
+
+      gdb_assert (0 == offset);
+      /* We expect an already resolved data location.  */
+      gdb_assert (PROP_CONST == TYPE_DATA_LOCATION_KIND (type));
+      /* For dynamic data types defer memory allocation
+         until we actual access the value.  */
+      v = allocate_value_lazy (type);
+    }
   else
     {
       /* Plain old data member */
-- 
2.7.1.339.g0233b80

[PATCH V2 0/3] fortran: Enable arrays of structures with dynamic member types.

[Bernhard Heckel]

Addressed in V2:
* Commit-Msg: Added missing changes and added some more comments.
* NEWS: Added new fortran features.
* gdbtypes.c (several comments): Two blanks after dot.
  (resolve_dynamic_struct): Changed comment why length is not changed for fortran.
* valarith.c (value_subscripted_rvalue): Replace variable by NULL.

This patch series enables the user to evaluate:
1. Local structures with dynamic member types.
2. Local arrays of structs with dynamic member types.
3. Dynamic arrays of structs with static and/or dynamic member types.

Bernhard Heckel (2):
  fort_dyn_array: Enable dynamic member types inside a structure.
  fort_dyn_array: Support evaluation of dynamic elements inside arrays.

Keven Boell (1):
  fort_dyn_array: Use value constructor instead of raw-buffer
    manipulation.

 gdb/NEWS                               |   3 +
 gdb/f-valprint.c                       | 118 +++++++++----------------
 gdb/gdbtypes.c                         |  43 ++++++++-
 gdb/gdbtypes.h                         |   3 +
 gdb/testsuite/gdb.fortran/vla-type.exp | 153 +++++++++++++++++++++++++++++++++
 gdb/testsuite/gdb.fortran/vla-type.f90 | 104 ++++++++++++++++++++++
 gdb/valarith.c                         |   8 ++
 gdb/value.c                            |  35 +++++++-
 8 files changed, 382 insertions(+), 85 deletions(-)
 create mode 100755 gdb/testsuite/gdb.fortran/vla-type.exp
 create mode 100755 gdb/testsuite/gdb.fortran/vla-type.f90

-- 
2.7.1.339.g0233b80

Re: [PATCH V2 1/3] fort_dyn_array: Enable dynamic member types inside a structure.

[Yao Qi]

Bernhard Heckel <bernhard.heckel@intel.com> writes:

Hi Bernhard,
Patch is good to me, two nits below,

> +  /* If type has a dynamic resolved location property update it's value address.  */

This line is too long.

> +  type = value_type (whole);
> +  if (TYPE_DATA_LOCATION (type)
> +      && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
> +    set_value_address (component, TYPE_DATA_LOCATION_ADDR (type));
>  }
>  
> -\f
>  /* Access to the value history.  */
>  
>  /* Record a new value in the value history.
> @@ -2416,6 +2428,12 @@ set_internalvar (struct internalvar *var, struct value *val)
>  	 call error () until new_data is installed into the var->u to avoid
>  	 leaking memory.  */
>        release_value (new_data.value);
> +
> +      /* Internal variables which are created from values with a dynamic location

This line is too long.

> +         don't need the location property of the origin anymore.
> +         Remove the location property in case it exist.  */
> +      remove_dyn_prop (DYN_PROP_DATA_LOCATION, value_type (new_data.value));

-- 
Yao (齐尧)

Re: [PATCH V2 2/3] fort_dyn_array: Support evaluation of dynamic elements inside arrays.

[Yao Qi]

Bernhard Heckel <bernhard.heckel@intel.com> writes:

> 2016-02-24  Bernhard Heckel  <bernhard.heckel@intel.com>
>
> gdb/Changelog:
> 	* valarith.c (value_address): Resolve dynamic types.
                    ^^^^^^^^^^^^^^^^ value_subscripted_rvalue

>
> gdb/testsuite/Changelog:
> 	* gdb.fortran/vla-type.f90: Add test for static and dynamic arrays
> 	of dynamic types.
> 	* gdb.fortran/vla-type.exp: Add test for static and dynamic arrays
> 	of dynamic types.

Patch is good to me.

-- 
Yao (齐尧)

Re: [PATCH V2 3/3] fort_dyn_array: Use value constructor instead of raw-buffer manipulation.

[Yao Qi]

Bernhard Heckel <bernhard.heckel@intel.com> writes:

> 2014-05-28  Sanimir Agovic  <sanimir.agovic@intel.com>
>             Keven Boell  <keven.boell@intel.com>
>             Bernhard Heckel  <bernhard.heckel@intel.com>
>
> gdb/Changelog:
> 	* f-valprint.c (f77_create_arrayprint_offset_tbl): Remove
> 	function.
> 	(F77_DIM_SIZE, F77_DIM_OFFSET): Remove macro.
> 	(f77_print_array_1): Use value_subscript to subscript a
> 	value array.
> 	(f77_print_array): Remove call to f77_create_arrayprint_offset_tbl.
> 	(f_val_print): Use value_field to construct a field value.
>
> gdb/testsuite/Changelog:
> 	* vla-type.exp: Print structure from toplevel.

Patch is good to me.

-- 
Yao (齐尧)

Re: [PATCH V2 1/3] fort_dyn_array: Enable dynamic member types inside a structure.

[Yao Qi]

Bernhard Heckel <bernhard.heckel@intel.com> writes:

> diff --git a/gdb/NEWS b/gdb/NEWS
> index be15902..056d56c 100644
> --- a/gdb/NEWS
> +++ b/gdb/NEWS
> @@ -3,6 +3,9 @@
>  
>  *** Changes since GDB 7.11
>  
> +* Fortran: Support structures with fields of dynamic types and 
> +  arrays of dynamic types.
> +

To be clear, NEWS bits still need Eli's review.

-- 
Yao (齐尧)

Re: [PATCH V2 1/3] fort_dyn_array: Enable dynamic member types inside a structure.

[Heckel, Bernhard]

On 07/04/2016 18:25, Yao Qi wrote:
> Bernhard Heckel <bernhard.heckel@intel.com> writes:
>
>> diff --git a/gdb/NEWS b/gdb/NEWS
>> index be15902..056d56c 100644
>> --- a/gdb/NEWS
>> +++ b/gdb/NEWS
>> @@ -3,6 +3,9 @@
>>   
>>   *** Changes since GDB 7.11
>>   
>> +* Fortran: Support structures with fields of dynamic types and
>> +  arrays of dynamic types.
>> +
> To be clear, NEWS bits still need Eli's review.
>
Loop-in Eli
Intel Deutschland GmbH
Registered Address: Am Campeon 10-12, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de
Managing Directors: Christin Eisenschmid, Christian Lamprechter
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

Re: [PATCH V2 1/3] fort_dyn_array: Enable dynamic member types inside a structure.

[Joel Brobecker]

Just a few minor nits that I happen to see while glancing at the patch:

> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -2064,7 +2064,8 @@ resolve_dynamic_struct (struct type *type,
>  
>        pinfo.type = check_typedef (TYPE_FIELD_TYPE (type, i));
>        pinfo.valaddr = addr_stack->valaddr;
> -      pinfo.addr = addr_stack->addr;
> +      pinfo.addr = addr_stack->addr
> +              + (TYPE_FIELD_BITPOS (resolved_type, i) / TARGET_CHAR_BIT);

The GCS recommends in that case to use an extra pair of parens.
The purpose is to help code formatters align the code properly.

      pinfo.addr
        = (addr_stack->addr
           + (TYPE_FIELD_BITPOS (resolved_type, i) / TARGET_CHAR_BIT));

> +  /* The length of a type won't change for fortran, but it does for C and Ada.
> +     For fortran the size of dynamic fields might change over time but not the
> +     type length of the structure.  If we would adapt it we run into problems
> +     when calculating the element offset for arrays of structs.  */

May I suggest the following rephrasing, which sounds a litle better
to me?

"If we adapt it, we run into problems [...]"

> +/* Remove dynamic property from TYPE in case it exist.  */

"exists"

> +void
> +remove_dyn_prop (enum dynamic_prop_node_kind prop_kind,
> +                 struct type *type)
> +{
> +  struct dynamic_prop_list *prev_node, *curr_node;
> +
> +  curr_node = TYPE_DYN_PROP_LIST (type);
> +  prev_node = NULL;
> +
> +  while (NULL != curr_node)
> +    {
> +      if (curr_node->prop_kind == prop_kind)
> +	{
> +	  /* Upadate the linked list but don't free anything.

"Update"

> +      /* Internal variables which are created from values with a dynamic location
> +         don't need the location property of the origin anymore.
> +         Remove the location property in case it exist.  */
> +      remove_dyn_prop (DYN_PROP_DATA_LOCATION, value_type (new_data.value));

I am also wondering why it makes a difference to remove it, and
it would be useful to explain it here.

-- 
Joel