gdb/gdb-vla-intel-fortran-vla-strings.patch
DistroBaker 3ce82c330b Merged update from upstream sources
This is an automated DistroBaker update from upstream sources.
If you do not know what this is about or would like to opt out,
contact the OSCI team.

Source: https://src.fedoraproject.org/rpms/gdb.git#ed8730b4d9720b8c71cb7de29ce2165f730955cc
2020-11-06 01:04:27 +00:00

1087 lines
40 KiB
Diff

From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
From: Fedora GDB patches <invalid@email.com>
Date: Fri, 27 Oct 2017 21:07:50 +0200
Subject: gdb-vla-intel-fortran-vla-strings.patch
;;=push
git diff --stat -p gdb/master...gdb/users/bheckel/fortran-vla-strings
0ad7d8d1a3a36c6e04e3b6d37d8825f18d595723
gdb/NEWS | 2 +
gdb/c-valprint.c | 22 +++++
gdb/dwarf2read.c | 158 +++++++++++++++++++++++++-----
gdb/f-typeprint.c | 93 +++++++++---------
gdb/gdbtypes.c | 44 ++++++++-
gdb/testsuite/gdb.cp/vla-cxx.cc | 9 ++
gdb/testsuite/gdb.cp/vla-cxx.exp | 9 ++
gdb/testsuite/gdb.fortran/pointers.exp | 143 +++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.f90 | 109 +++++++++++++++++++++
gdb/testsuite/gdb.fortran/print_type.exp | 100 +++++++++++++++++++
gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 +--
gdb/testsuite/gdb.fortran/vla-strings.exp | 103 +++++++++++++++++++
gdb/testsuite/gdb.fortran/vla-strings.f90 | 39 ++++++++
gdb/testsuite/gdb.fortran/vla-type.exp | 7 +-
gdb/testsuite/gdb.fortran/vla-value.exp | 12 ++-
gdb/testsuite/gdb.mi/mi-var-child-f.exp | 7 +-
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 27 ++---
gdb/typeprint.c | 19 ++++
gdb/valops.c | 16 ++-
gdb/valprint.c | 6 --
20 files changed, 827 insertions(+), 110 deletions(-)
diff --git a/gdb/NEWS b/gdb/NEWS
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -985,6 +985,8 @@ SH-5/SH64 running OpenBSD SH-5/SH64 support in sh*-*-openbsd*
*** Changes in GDB 8.1
+* Fortran: Support pointers to dynamic types.
+
* GDB now supports dynamically creating arbitrary register groups specified
in XML target descriptions. This allows for finer grain grouping of
registers on systems with a large amount of registers.
diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c
--- a/gdb/c-valprint.c
+++ b/gdb/c-valprint.c
@@ -572,6 +572,28 @@ c_value_print (struct value *val, struct ui_file *stream,
else
{
/* normal case */
+ if (type->code () == TYPE_CODE_PTR
+ && 1 == is_dynamic_type (type))
+ {
+ CORE_ADDR addr;
+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type)))
+ addr = value_address (val);
+ else
+ addr = value_as_address (val);
+
+ /* We resolve the target-type only when the
+ pointer is associated. */
+ if ((addr != 0)
+ && (0 == type_not_associated (type)))
+ TYPE_TARGET_TYPE (type) =
+ resolve_dynamic_type (TYPE_TARGET_TYPE (type),
+ {}, addr);
+ }
+ else
+ {
+ /* Do nothing. References are already resolved from the beginning,
+ only pointers are resolved when we actual need the target. */
+ }
fprintf_filtered (stream, "(");
type_print (value_type (val), "", stream, -1);
fprintf_filtered (stream, ") ");
diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -1562,7 +1562,10 @@ static void read_signatured_type (signatured_type *sig_type,
static int attr_to_dynamic_prop (const struct attribute *attr,
struct die_info *die, struct dwarf2_cu *cu,
- struct dynamic_prop *prop, struct type *type);
+ struct dynamic_prop *prop,
+ struct type *default_type,
+ const gdb_byte *additional_data,
+ int additional_data_size);
/* memory allocation interface */
@@ -13631,7 +13634,7 @@ read_func_scope (struct die_info *die, struct dwarf2_cu *cu)
newobj->static_link
= XOBNEW (&objfile->objfile_obstack, struct dynamic_prop);
attr_to_dynamic_prop (attr, die, cu, newobj->static_link,
- cu->addr_type ());
+ cu->addr_type (), NULL, 0);
}
cu->list_in_scope = cu->get_builder ()->get_local_symbols ();
@@ -16073,7 +16076,7 @@ read_structure_type (struct die_info *die, struct dwarf2_cu *cu)
else
{
struct dynamic_prop prop;
- if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ()))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type (), NULL, 0))
type->add_dyn_prop (DYN_PROP_BYTE_SIZE, prop);
TYPE_LENGTH (type) = 0;
}
@@ -16764,7 +16767,7 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu)
byte_stride_prop
= (struct dynamic_prop *) alloca (sizeof (struct dynamic_prop));
stride_ok = attr_to_dynamic_prop (attr, die, cu, byte_stride_prop,
- prop_type);
+ prop_type, NULL, 0);
if (!stride_ok)
{
complaint (_("unable to read array DW_AT_byte_stride "
@@ -17522,7 +17525,7 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
struct attribute *attr;
struct dynamic_prop prop;
bool length_is_constant = true;
- LONGEST length;
+ ULONGEST length = UINT_MAX;
/* There are a couple of places where bit sizes might be made use of
when parsing a DW_TAG_string_type, however, no producer that we know
@@ -17543,6 +17546,10 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
}
}
+ 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 in memory. */
attr = dwarf2_attr (die, DW_AT_string_length, cu);
if (attr != nullptr && !attr->form_is_constant ())
{
@@ -17569,13 +17576,68 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
}
/* Convert the attribute into a dynamic property. */
- if (!attr_to_dynamic_prop (attr, die, cu, &prop, prop_type))
+ if (!attr_to_dynamic_prop (attr, die, cu, &prop, prop_type, NULL, 0))
length = 1;
else
length_is_constant = false;
}
else if (attr != nullptr)
{
+ if (attr->form_is_block ())
+ {
+ 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 in combination with
+ DW_AT_bit_size. */
+ if (byte_size != NULL && bit_size != NULL)
+ complaint (_("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,
+ DW_AT_byte_size describes the number of bytes that should be read
+ from the length memory location. */
+ if (byte_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. */
+ (gdb_byte) DW_UNSND(byte_size) };
+
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, index_type,
+ append_ops, ARRAY_SIZE(append_ops)))
+ complaint (_("Could not parse DW_AT_byte_size"));
+ }
+ else if (bit_size != NULL)
+ complaint (_("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, index_type,
+ append_ops, ARRAY_SIZE(append_ops)))
+ complaint (_("Could not parse DW_AT_string_length"));
+ }
+
+ range_type->bounds ()->high = high;
+ }
+ else
+ range_type->bounds ()->high.set_const_val (DW_UNSND(attr));
+
/* This DW_AT_string_length just contains the length with no
indirection. There's no need to create a dynamic property in this
case. Pass 0 for the default value as we know it will not be
@@ -17589,6 +17651,14 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
}
else
{
+ /* 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)
+ range_type->bounds ()->high.set_const_val (DW_UNSND(attr));
+ else
+ range_type->bounds ()->high.set_const_val (1);
+
/* Use 1 as a fallback length if we have nothing else. */
length = 1;
}
@@ -17603,6 +17673,7 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
low_bound.set_const_val (1);
range_type = create_range_type (NULL, index_type, &low_bound, &prop, 0);
}
+
char_type = language_string_char_type (cu->language_defn, gdbarch);
type = create_string_type (NULL, char_type, range_type);
@@ -18078,7 +18149,8 @@ read_base_type (struct die_info *die, 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,
- struct type *default_type)
+ struct type *default_type,
+ const gdb_byte *additional_data, int additional_data_size)
{
struct dwarf2_property_baton *baton;
dwarf2_per_objfile *per_objfile = cu->per_objfile;
@@ -18108,6 +18180,26 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
break;
}
+ if (additional_data != NULL && additional_data_size > 0)
+ {
+ gdb_byte *data;
+
+ data = (gdb_byte *) obstack_alloc(
+ &cu->per_objfile->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->set_locexpr (baton);
gdb_assert (prop->baton () != NULL);
}
@@ -18142,11 +18234,31 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
baton->property_type = die_type (target_die, target_cu);
baton->locexpr.per_cu = cu->per_cu;
baton->locexpr.per_objfile = per_objfile;
- baton->locexpr.size = DW_BLOCK (target_attr)->size;
- baton->locexpr.data = DW_BLOCK (target_attr)->data;
baton->locexpr.is_reference = true;
+
+ if (additional_data != NULL && additional_data_size > 0)
+ {
+ gdb_byte *data;
+
+ data = (gdb_byte *) obstack_alloc (&cu->per_objfile->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->set_locexpr (baton);
- gdb_assert (prop->baton () != NULL);
+ gdb_assert (prop->baton() != NULL);
}
else
{
@@ -18308,8 +18420,8 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
}
attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
- if (attr != nullptr)
- attr_to_dynamic_prop (attr, die, cu, &low, base_type);
+ if (attr)
+ attr_to_dynamic_prop (attr, die, cu, &low, base_type, NULL, 0);
else if (!low_default_is_valid)
complaint (_("Missing DW_AT_lower_bound "
"- DIE at %s [in module %s]"),
@@ -18318,10 +18430,10 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
struct attribute *attr_ub, *attr_count;
attr = attr_ub = dwarf2_attr (die, DW_AT_upper_bound, cu);
- if (!attr_to_dynamic_prop (attr, die, cu, &high, base_type))
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, base_type, NULL, 0))
{
attr = attr_count = dwarf2_attr (die, DW_AT_count, cu);
- if (attr_to_dynamic_prop (attr, die, cu, &high, base_type))
+ if (attr_to_dynamic_prop (attr, die, cu, &high, base_type, NULL, 0))
{
/* If bounds are constant do the final calculation here. */
if (low.kind () == PROP_CONST && high.kind () == PROP_CONST)
@@ -18372,7 +18484,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
{
struct type *prop_type = cu->addr_sized_int_type (false);
attr_to_dynamic_prop (attr_byte_stride, die, cu, &byte_stride_prop,
- prop_type);
+ prop_type, NULL, 0);
}
struct dynamic_prop bit_stride_prop;
@@ -18392,7 +18504,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
{
struct type *prop_type = cu->addr_sized_int_type (false);
attr_to_dynamic_prop (attr_bit_stride, die, cu, &bit_stride_prop,
- prop_type);
+ prop_type, NULL, 0);
}
}
@@ -24424,7 +24536,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
if (attr != NULL)
{
struct type *prop_type = cu->addr_sized_int_type (false);
- if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type, NULL, 0))
type->add_dyn_prop (DYN_PROP_ALLOCATED, prop);
}
@@ -24433,13 +24545,13 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
if (attr != NULL)
{
struct type *prop_type = cu->addr_sized_int_type (false);
- if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type, NULL, 0))
type->add_dyn_prop (DYN_PROP_ASSOCIATED, 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, cu->addr_type ()))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type (), NULL, 0))
type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop);
if (per_objfile->die_type_hash == NULL)
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -217,8 +217,9 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
else
{
LONGEST lower_bound = f77_get_lowerbound (type);
+
if (lower_bound != 1) /* Not the default. */
- fprintf_filtered (stream, "%s:", plongest (lower_bound));
+ fprintf_filtered (stream, "%s:", plongest (lower_bound));
/* Make sure that, if we have an assumed size array, we
print out a warning and print the upperbound as '*'. */
@@ -229,7 +230,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
{
LONGEST upper_bound = f77_get_upperbound (type);
- fputs_filtered (plongest (upper_bound), stream);
+ fprintf_filtered (stream, "%s", plongest (upper_bound));
}
}
@@ -249,7 +250,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
case TYPE_CODE_REF:
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
arrayprint_recurse_level, false);
- fprintf_filtered (stream, " )");
+ fprintf_filtered (stream, ")");
break;
case TYPE_CODE_FUNC:
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1977,7 +1977,8 @@ is_dynamic_type_internal (struct type *type, int top_level)
type = check_typedef (type);
/* We only want to recognize references at the outermost level. */
- if (top_level && type->code () == TYPE_CODE_REF)
+ if (top_level &&
+ (type->code () == TYPE_CODE_REF || type-> code() == TYPE_CODE_PTR))
type = check_typedef (TYPE_TARGET_TYPE (type));
/* Types that have a dynamic TYPE_DATA_LOCATION are considered
@@ -2017,10 +2018,10 @@ is_dynamic_type_internal (struct type *type, int top_level)
|| is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0));
}
- case TYPE_CODE_STRING:
/* Strings are very much like an array of characters, and can be
treated as one here. */
case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
{
gdb_assert (type->num_fields () == 1);
@@ -2183,11 +2184,15 @@ resolve_dynamic_array_or_string (struct type *type,
ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
- if (ary_dim != NULL && ary_dim->code () == TYPE_CODE_ARRAY)
+ if (ary_dim != NULL && (ary_dim->code () == TYPE_CODE_ARRAY
+ || ary_dim->code () == TYPE_CODE_STRING))
elt_type = resolve_dynamic_array_or_string (ary_dim, addr_stack);
else
elt_type = TYPE_TARGET_TYPE (type);
+ if (type->code () == TYPE_CODE_STRING)
+ return create_string_type (type, elt_type, range_type);
+
prop = type->dyn_prop (DYN_PROP_BYTE_STRIDE);
if (prop != NULL)
{
@@ -2533,6 +2538,25 @@ resolve_dynamic_struct (struct type *type,
return resolved_type;
}
+/* Worker for pointer types. */
+
+static struct type *
+resolve_dynamic_pointer (struct type *type,
+ struct property_addr_info *addr_stack)
+{
+ struct dynamic_prop *prop;
+ CORE_ADDR value;
+
+ type = copy_type (type);
+
+ /* Resolve associated property. */
+ prop = TYPE_ASSOCIATED_PROP (type);
+ if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ prop->set_const_val (value);
+
+ return type;
+}
+
/* Worker for resolved_dynamic_type. */
static struct type *
@@ -2594,6 +2618,9 @@ resolve_dynamic_type_internal (struct type *type,
case TYPE_CODE_ARRAY:
resolved_type = resolve_dynamic_array_or_string (type, addr_stack);
break;
+ case TYPE_CODE_PTR:
+ resolved_type = resolve_dynamic_pointer (type, addr_stack);
+ break;
case TYPE_CODE_RANGE:
resolved_type = resolve_dynamic_range (type, addr_stack);
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc
--- a/gdb/testsuite/gdb.cp/vla-cxx.cc
+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc
@@ -15,6 +15,10 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
+extern "C" {
+#include <stddef.h>
+}
+
struct container;
struct element
@@ -40,11 +44,16 @@ int main(int argc, char **argv)
typedef typeof (vla) &vlareftypedef;
vlareftypedef vlaref2 (vla);
container c;
+ typeof (vla) *ptr = NULL;
+
+ // Before pointer assignment
+ ptr = &vla;
for (int i = 0; i < z; ++i)
vla[i] = 5 + 2 * i;
// vlas_filled
vla[0] = 2 * vla[0];
+
return vla[2];
}
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
--- a/gdb/testsuite/gdb.cp/vla-cxx.exp
+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
@@ -23,6 +23,12 @@ if ![runto_main] {
return -1
}
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment"
+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" "print ptr, Before pointer assignment"
+gdb_test "print *ptr" "Cannot access memory at address 0x0" "print *ptr, Before pointer assignment"
+
gdb_breakpoint [gdb_get_line_number "vlas_filled"]
gdb_continue_to_breakpoint "vlas_filled"
@@ -33,3 +39,6 @@ gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}"
# bug being tested, it's better not to depend on the exact spelling.
gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}"
gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}"
+gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]"
+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex"
+gdb_test "print *ptr" " = \\{5, 7, 9\\}"
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -0,0 +1,143 @@
+# 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 "pointers.f90"
+load_lib fortran.exp
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+if ![runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# Depending on the compiler being used, the type names can be printed differently.
+set logical [fortran_logical4]
+set real [fortran_real4]
+set int [fortran_int4]
+set complex [fortran_complex4]
+
+
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+gdb_test "print logp" "= \\(PTR TO -> \\( $logical\\)\\) 0x0" "print logp, not associated"
+gdb_test "print *logp" "Cannot access memory at address 0x0" "print *logp, not associated"
+gdb_test "print comp" "= \\(PTR TO -> \\( $complex\\)\\) 0x0" "print comp, not associated"
+gdb_test "print *comp" "Cannot access memory at address 0x0" "print *comp, not associated"
+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1\\)\\) 0x0" "print charp, not associated"
+gdb_test "print *charp" "Cannot access memory at address 0x0" "print *charp, not associated"
+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3\\)\\) 0x0" "print charap, not associated"
+gdb_test "print *charap" "Cannot access memory at address 0x0" "print *charap, not associated"
+gdb_test "print intp" "= \\(PTR TO -> \\( $int\\)\\) 0x0" "print intp, not associated"
+gdb_test "print *intp" "Cannot access memory at address 0x0" "print *intp, not associated"
+set test "print intap, not associated"
+gdb_test_multiple "print intap" $test {
+ -re " = \\(PTR TO -> \\( $int \\(:,:\\)\\)\\) <not associated>\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re " = <not associated>\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+gdb_test "print realp" "= \\(PTR TO -> \\( $real\\)\\) 0x0" "print realp, not associated"
+gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated"
+gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int\\)\\) 0x0"
+set test "print cyclicp1, not associated"
+gdb_test_multiple "print cyclicp1" $test {
+ -re "= \\( i = -?\\d+, p = 0x0 \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "= \\( i = -?\\d+, p = <not associated> \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "print cyclicp1%p, not associated"
+gdb_test_multiple "print cyclicp1%p" $test {
+ -re "= \\(PTR TO -> \\( Type typewithpointer\\)\\) 0x0\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "= \\(PTR TO -> \\( Type typewithpointer\\)\\) <not associated>\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+
+
+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
+gdb_continue_to_breakpoint "Before value assignment"
+gdb_test "print *(twop)%ivla2" "= <not allocated>"
+
+
+gdb_breakpoint [gdb_get_line_number "After value assignment"]
+gdb_continue_to_breakpoint "After value assignment"
+gdb_test "print logp" "= \\(PTR TO -> \\( $logical\\)\\) $hex\( <.*>\)?"
+gdb_test "print *logp" "= \\.TRUE\\."
+gdb_test "print comp" "= \\(PTR TO -> \\( $complex\\)\\) $hex\( <.*>\)?"
+gdb_test "print *comp" "= \\(1,2\\)"
+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1\\)\\) $hex\( <.*>\)?"
+gdb_test "print *charp" "= 'a'"
+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3\\)\\) $hex\( <.*>\)?"
+gdb_test "print *charap" "= 'abc'"
+gdb_test "print intp" "= \\(PTR TO -> \\( $int\\)\\) $hex\( <.*>\)?"
+gdb_test "print *intp" "= 10"
+set test_name "print intap, associated"
+gdb_test_multiple "print intap" $test_name {
+ -re "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "= \\(PTR TO -> \\( $int \\(10,2\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
+ gdb_test "print *intap" "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)"
+ pass $test_name
+ }
+}
+set test_name "print intvlap, associated"
+gdb_test_multiple "print intvlap" $test_name {
+ -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
+ gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)"
+ pass $test_name
+ }
+}
+gdb_test "print realp" "= \\(PTR TO -> \\( $real\\)\\) $hex\( <.*>\)?"
+gdb_test "print *realp" "= 3\\.14000\\d+"
+gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two\\)\\) $hex\( <.*>\)?"
+gdb_test "print *(arrayOfPtr(2)%p)" "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)"
+set test_name "print arrayOfPtr(3)%p"
+gdb_test_multiple $test_name $test_name {
+ -re "= \\(PTR TO -> \\( Type two\\)\\) <not associated>\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "= \\(PTR TO -> \\( Type two\\)\\) 0x0\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+}
+set test_name "print *(arrayOfPtr(3)%p), associated"
+gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name {
+ -re "Cannot access memory at address 0x0\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+ -re "Attempt to take contents of a not associated pointer.\r\n$gdb_prompt $" {
+ pass $test_name
+ }
+}
+gdb_test "print cyclicp1" "= \\( i = 1, p = $hex\( <.*>\)? \\)"
+gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer\\)\\) $hex\( <.*>\)?"
+gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array"
+gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla"
+gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\) \\(\\)\\)\\) $hex <pointers\\+\\d+>" "Print program counter"
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -20,21 +20,34 @@ program pointers
integer, allocatable :: ivla2 (:, :)
end type two
+ type :: typeWithPointer
+ integer i
+ type(typeWithPointer), pointer:: p
+ end type typeWithPointer
+
+ type :: twoPtr
+ type (two), pointer :: p
+ end type twoPtr
+
logical, target :: logv
complex, target :: comv
character, target :: charv
character (len=3), target :: chara
integer, target :: intv
integer, target, dimension (10,2) :: inta
- real, target :: realv
- type(two), target :: twov
+ integer, target, allocatable, dimension (:) :: intvla
+ real, target :: realv
+ type(two), target :: twov
+ type(twoPtr) :: arrayOfPtr (3)
+ type(typeWithPointer), target:: cyclicp1,cyclicp2
logical, pointer :: logp
complex, pointer :: comp
- character, pointer :: charp
- character (len=3), pointer :: charap
+ character, pointer:: charp
+ character (len=3), pointer:: charap
integer, pointer :: intp
integer, pointer, dimension (:,:) :: intap
+ integer, pointer, dimension (:) :: intvlap
real, pointer :: realp
type(two), pointer :: twop
@@ -44,8 +57,14 @@ program pointers
nullify (charap)
nullify (intp)
nullify (intap)
+ nullify (intvlap)
nullify (realp)
nullify (twop)
+ nullify (arrayOfPtr(1)%p)
+ nullify (arrayOfPtr(2)%p)
+ nullify (arrayOfPtr(3)%p)
+ nullify (cyclicp1%p)
+ nullify (cyclicp2%p)
logp => logv ! Before pointer assignment
comp => comv
@@ -53,8 +72,14 @@ program pointers
charap => chara
intp => intv
intap => inta
+ intvlap => intvla
realp => realv
twop => twov
+ arrayOfPtr(2)%p => twov
+ cyclicp1%i = 1
+ cyclicp1%p => cyclicp2
+ cyclicp2%i = 2
+ cyclicp2%p => cyclicp1
logv = associated(logp) ! Before value assignment
comv = cmplx(1,2)
@@ -63,6 +88,10 @@ program pointers
intv = 10
inta(:,:) = 1
inta(3,1) = 3
+ allocate (intvla(10))
+ intvla(:) = 2
+ intvla(4) = 4
+ intvlap => intvla
realv = 3.14
allocate (twov%ivla1(3))
diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp
--- a/gdb/testsuite/gdb.fortran/print_type.exp
+++ b/gdb/testsuite/gdb.fortran/print_type.exp
@@ -1,5 +1,6 @@
# Copyright 2019-2020 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
@@ -42,7 +43,7 @@ set complex [fortran_complex4]
# matches the string TYPE.
proc check_pointer_type { var_name type } {
gdb_test "ptype ${var_name}" \
- "type = PTR TO -> \\( ${type} \\)"
+ "type = PTR TO -> \\( ${type}\\)"
}
gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
@@ -87,7 +88,8 @@ gdb_test "ptype twop" \
[multi_line "type = PTR TO -> \\( Type two" \
" $int, allocatable :: ivla1\\(:\\)" \
" $int, allocatable :: ivla2\\(:,:\\)" \
- "End Type two \\)"]
+ "End Type two\\)"]
+
gdb_breakpoint [gdb_get_line_number "After value assignment"]
gdb_continue_to_breakpoint "After value assignment"
@@ -99,11 +101,11 @@ gdb_test "ptype intv" "type = $int"
gdb_test "ptype inta" "type = $int \\(10,2\\)"
gdb_test "ptype realv" "type = $real"
-gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)"
-gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)"
-gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)"
-gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)"
-gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)"
+gdb_test "ptype logp" "type = PTR TO -> \\( $logical\\)"
+gdb_test "ptype comp" "type = PTR TO -> \\( $complex\\)"
+gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1\\)"
+gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3\\)"
+gdb_test "ptype intp" "type = PTR TO -> \\( $int\\)"
set test "ptype intap"
gdb_test_multiple $test $test {
-re "type = $int \\(10,2\\)\r\n$gdb_prompt $" {
@@ -113,4 +115,4 @@ gdb_test_multiple $test $test {
pass $test
}
}
-gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)"
+gdb_test "ptype realp" "type = PTR TO -> \\( $real\\)"
diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-strings.exp
@@ -0,0 +1,103 @@
+# 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
+}
+
+# check that all fortran standard datatypes will be
+# handled correctly when using as VLA's
+
+if ![runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
+gdb_continue_to_breakpoint "var_char-allocated-1"
+set test "whatis var_char first time"
+gdb_test_multiple "whatis var_char" $test {
+ -re "type = PTR TO -> \\( character\\*10\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*10\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "ptype var_char first time"
+gdb_test_multiple "ptype var_char" $test {
+ -re "type = PTR TO -> \\( character\\*10\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*10\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+
+
+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"
+set test "print var_char, var_char-filled-1"
+gdb_test_multiple "print var_char" $test {
+ -re "= \\(PTR TO -> \\( character\\*3\\)\\) $hex\r\n$gdb_prompt $" {
+ gdb_test "print *var_char" "= 'foo'" "print *var_char, var_char-filled-1"
+ pass $test
+ }
+ -re "= 'foo'\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "ptype var_char, var_char-filled-1"
+gdb_test_multiple "ptype var_char" $test {
+ -re "type = PTR TO -> \\( character\\*3\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*3\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+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"
+set test "print var_char, var_char-filled-2"
+gdb_test_multiple "print var_char" $test {
+ -re "= \\(PTR TO -> \\( character\\*6\\)\\) $hex\r\n$gdb_prompt $" {
+ gdb_test "print *var_char" "= 'foobar'" "print *var_char, var_char-filled-2"
+ pass $test
+ }
+ -re "= 'foobar'\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "ptype var_char, var_char-filled-2"
+gdb_test_multiple "ptype var_char" $test {
+ -re "type = PTR TO -> \\( character\\*6\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*6\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90
new file mode 100644
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-strings.f90
@@ -0,0 +1,39 @@
+! 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_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-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -37,7 +37,7 @@ 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, allocatable \\\(:,:,:\\\) \\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real, allocatable \\\(:,:,:\\\)\\\)\\\) $hex" \
"print non-allocated &vla1"
gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \
"print member in non-allocated vla1 (1)"
@@ -58,7 +58,7 @@ with_timeout_factor 15 {
"step over value assignment of vla1"
}
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( $real, allocatable \\\(10,10,10\\\) \\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real, allocatable \\\(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)"
@@ -78,7 +78,7 @@ gdb_test "print vla1(9, 9, 9)" " = 999" \
# 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 \\\(:,:,:\\\) \\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \
"print non-associated &pvla"
gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \
"print undefined pvla(1,3,8)"
@@ -87,7 +87,7 @@ gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated
gdb_breakpoint [gdb_get_line_number "pvla-associated"]
gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print &pvla" \
- " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\) \\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(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)"
diff --git a/gdb/typeprint.c b/gdb/typeprint.c
--- a/gdb/typeprint.c
+++ b/gdb/typeprint.c
@@ -565,6 +565,25 @@ whatis_exp (const char *exp, int show)
printf_filtered (" */\n");
}
+ /* Resolve any dynamic target type, as we might print
+ additional information about the target.
+ For example, in Fortran and C we are printing the dimension of the
+ dynamic array the pointer is pointing to. */
+ if (type->code () == TYPE_CODE_PTR
+ && is_dynamic_type (type) == 1)
+ {
+ CORE_ADDR addr;
+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE(type)))
+ addr = value_address (val);
+ else
+ addr = value_as_address (val);
+
+ if (addr != 0
+ && type_not_associated (type) == 0)
+ TYPE_TARGET_TYPE (type) = resolve_dynamic_type (TYPE_TARGET_TYPE (type),
+ {}, addr);
+ }
+
LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags);
printf_filtered ("\n");
}
diff --git a/gdb/valops.c b/gdb/valops.c
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1553,6 +1553,19 @@ value_ind (struct value *arg1)
if (base_type->code () == TYPE_CODE_PTR)
{
struct type *enc_type;
+ CORE_ADDR addr;
+
+ if (type_not_associated (base_type))
+ error (_("Attempt to take contents of a not associated pointer."));
+
+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type)))
+ addr = value_address (arg1);
+ else
+ addr = value_as_address (arg1);
+
+ if (addr != 0)
+ TYPE_TARGET_TYPE (base_type) =
+ resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), {}, addr);
/* We may be pointing to something embedded in a larger object.
Get the real type of the enclosing object. */
@@ -1570,8 +1583,7 @@ value_ind (struct value *arg1)
else
{
/* Retrieve the enclosing object pointed to. */
- base_addr = (value_as_address (arg1)
- - value_pointed_to_offset (arg1));
+ base_addr = (addr - value_pointed_to_offset (arg1));
}
arg2 = value_at_lazy (enc_type, base_addr);
enc_type = value_type (arg2);
diff --git a/gdb/valprint.c b/gdb/valprint.c
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1046,12 +1046,6 @@ value_check_printable (struct value *val, struct ui_file *stream,
return 0;
}
- if (type_not_associated (value_type (val)))
- {
- val_print_not_associated (stream);
- return 0;
- }
-
if (type_not_allocated (value_type (val)))
{
val_print_not_allocated (stream);