* [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions
2019-03-18 12:52 ` [PATCH " Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-18 17:20 ` Eli Zaretskii
` (2 more replies)
2019-03-18 12:52 ` [PATCH 5/8] gdb/fortran: Print 'void' type in lower case Andrew Burgess
` (15 subsequent siblings)
16 siblings, 3 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
Add two new internal functions $_cimag and $_creal that extract the
imaginary and real parts of a complex value.
These internal functions can take a complex value of any type 'float
complex', 'double complex', or 'long double complex' and return a
suitable floating point value 'float', 'double', or 'long double'.
So we can now do this:
(gdb) p z1
$1 = 1.5 + 4.5 * I
(gdb) p $_cimag (z1)
$4 = 4.5
(gdb) p $_creal (z1)
$4 = 1.5
The components of a complex value are not strictly named types in
DWARF, as the complex type is itself the base type. However, once we
are able to extract the components it makes sense to be able to ask
what the type of these components is and get a sensible answer back,
rather than the error we would currently get. Currently GDB says:
(gdb) ptype z1
type = complex double
(gdb) p $_cimag (z1)
$4 = 4.5
(gdb) ptype $
type = <invalid type code 9>
With the changes in dwarf2read.c, GDB now says:
(gdb) ptype z1
type = complex double
(gdb) p $_cimag (z1)
$4 = 4.5
(gdb) ptype $
type = double
Which seems to make more sense.
gdb/ChangeLog:
* NEWS: Mention new internal functions.
* dwarf2read.c (dwarf2_init_complex_target_type): New function.
(read_base_type): Use dwarf2_init_complex_target_type.
* value.c (creal_internal_fn): New function.
(cimag_internal_fn): New function.
(_initialize_values): Register new internal functions.
gdb/doc/ChangeLog:
* gdb.texinfo (Convenience Funs): Document '$_creal' and
'$_cimag'.
gdb/testsuite/ChangeLog:
* gdb.base/complex-parts.c: New file.
* gdb.base/complex-parts.exp: New file.
---
gdb/ChangeLog | 9 +++++
gdb/NEWS | 3 ++
gdb/doc/ChangeLog | 5 +++
gdb/doc/gdb.texinfo | 15 ++++++++
gdb/dwarf2read.c | 36 ++++++++++++++++++-
gdb/testsuite/ChangeLog | 5 +++
gdb/testsuite/gdb.base/complex-parts.c | 50 ++++++++++++++++++++++++++
gdb/testsuite/gdb.base/complex-parts.exp | 62 ++++++++++++++++++++++++++++++++
gdb/testsuite/gdb.base/default.exp | 2 ++
gdb/value.c | 52 +++++++++++++++++++++++++++
10 files changed, 238 insertions(+), 1 deletion(-)
create mode 100644 gdb/testsuite/gdb.base/complex-parts.c
create mode 100644 gdb/testsuite/gdb.base/complex-parts.exp
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0c39c190475..705bcaff49f 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,12 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * NEWS: Mention new internal functions.
+ * dwarf2read.c (dwarf2_init_complex_target_type): New function.
+ (read_base_type): Use dwarf2_init_complex_target_type.
+ * value.c (creal_internal_fn): New function.
+ (cimag_internal_fn): New function.
+ (_initialize_values): Register new internal functions.
+
2019-03-17 Sergei Trofimovich <siarheit@google.com>
* unittests/string_view-selftests.c: Define
diff --git a/gdb/NEWS b/gdb/NEWS
index c45b3134064..98ab9fe8f99 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -3,6 +3,9 @@
*** Changes since GDB 8.3
+* Two new convernience functions $_cimag and $_creal that extract the
+ imaginary and real parts respectively from complex numbers.
+
*** Changes in GDB 8.3
* GDB and GDBserver now support access to additional registers on
diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog
index 6b9911c5436..00e2a2e0ed6 100644
--- a/gdb/doc/ChangeLog
+++ b/gdb/doc/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.texinfo (Convenience Funs): Document '$_creal' and
+ '$_cimag'.
+
2019-03-14 Simon Marchi <simon.marchi@efficios.com>
* gdb.texinfo (GDB/MI Development and Front Ends): Fix closing
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 271739b6cdc..8e7e622e1c5 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -11390,6 +11390,21 @@
Visiting node of type NODE_INTEGER
@end smallexample
+@item $_cimag(@var{value})
+@findex $_cimag@r{, convenience function}
+Return the imaginary part of a complex number @var{value}.
+
+The type of the imaginary part depends on the type of the complex
+number, a @code{float complex} will return an imaginary part of type
+@code{float}.
+
+@item $_creal(@var{value})
+@findex $_creal@r{, convenience function}
+Return the real part of a complex number @var{value}.
+
+The type of the real part depends on the type of the complex number, a
+@code{float complex} will return an real part of type @code{float}.
+
@end table
@value{GDBN} provides the ability to list and get help on
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 7c07a10e8c0..d865ff1a2b2 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17530,6 +17530,40 @@ dwarf2_init_integer_type (struct dwarf2_cu *cu, struct objfile *objfile,
return type;
}
+/* Initialise and return a floating point type of size BITS suitable for
+ use as a component of a complex number. The NAME_HINT is passed through
+ when initialising the floating point type and is the name of the complex
+ type.
+
+ As DWARF doesn't currently provide an explicit name for the components
+ of a complex number, but it can be helpful to have these components
+ named, we try to select a suitable name based on the size of the
+ component. */
+static struct type *
+dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
+ struct objfile *objfile,
+ int bits, const char *name_hint)
+{
+ gdbarch *gdbarch = get_objfile_arch (objfile);
+ struct type *tt = nullptr;
+
+ switch (bits)
+ {
+ case 32:
+ tt = builtin_type (gdbarch)->builtin_float;
+ break;
+ case 64:
+ tt = builtin_type (gdbarch)->builtin_double;
+ break;
+ case 128:
+ tt = builtin_type (gdbarch)->builtin_long_double;
+ break;
+ }
+
+ const char *name = (tt == nullptr) ? nullptr : TYPE_NAME (tt);
+ return dwarf2_init_float_type (objfile, bits, name, name_hint);
+}
+
/* Find a representation of a given base type and install
it in the TYPE field of the die. */
@@ -17569,7 +17603,7 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
type = init_boolean_type (objfile, bits, 1, name);
break;
case DW_ATE_complex_float:
- type = dwarf2_init_float_type (objfile, bits / 2, NULL, name);
+ type = dwarf2_init_complex_target_type (cu, objfile, bits / 2, name);
type = init_complex_type (objfile, name, type);
break;
case DW_ATE_decimal_float:
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 523013bf9b2..b471f374271 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.base/complex-parts.c: New file.
+ * gdb.base/complex-parts.exp: New file.
+
2019-03-14 Tom Tromey <tromey@adacore.com>
* gdb.base/style.exp: Add "set style sources" test.
diff --git a/gdb/testsuite/gdb.base/complex-parts.c b/gdb/testsuite/gdb.base/complex-parts.c
new file mode 100644
index 00000000000..243caee0695
--- /dev/null
+++ b/gdb/testsuite/gdb.base/complex-parts.c
@@ -0,0 +1,50 @@
+/* Copyright 2019 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Unlike the other 'complex.c' test, this one uses the "standard" header
+ file to pull in the complex types. The testing is around printing the
+ complex numbers, and using the convenience function $_cimag and $_creal
+ to extract the parts of the complex numbers. */
+
+#include <complex.h>
+
+void
+keep_around (volatile void *ptr)
+{
+ asm ("" ::: "memory");
+}
+
+int
+main (void)
+{
+ double complex z1 = 1.5 + 4.5 * I;
+ float complex z2 = 2.5 - 5.5 * I;
+ long double complex z3 = 3.5 + 6.5 * I;
+
+ double d1 = 1.5;
+ float f1 = 2.5;
+ int i1 = 3;
+
+ keep_around (&z1);
+ keep_around (&z2);
+ keep_around (&z3);
+ keep_around (&d1);
+ keep_around (&f1);
+ keep_around (&i1);
+
+ return 0; /* Break Here. */
+}
diff --git a/gdb/testsuite/gdb.base/complex-parts.exp b/gdb/testsuite/gdb.base/complex-parts.exp
new file mode 100644
index 00000000000..ce8f4277a8b
--- /dev/null
+++ b/gdb/testsuite/gdb.base/complex-parts.exp
@@ -0,0 +1,62 @@
+# Copyright 2019 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
+
+if {[prepare_for_testing "failed to prepare" $testfile $srcfile debug]} {
+ return -1
+}
+
+if { ![runto_main] } then {
+ fail "can't run to main"
+ return 0
+}
+
+gdb_breakpoint [gdb_get_line_number "Break Here"]
+gdb_continue_to_breakpoint "breakpt" ".* Break Here\\. .*"
+
+gdb_test "p z1" " = 1.5 \\+ 4.5 \\* I"
+gdb_test "p z2" " = 2.5 \\+ -5.5 \\* I"
+gdb_test "p z3" " = 3.5 \\+ 6.5 \\* I"
+
+gdb_test "ptype z1" " = complex double"
+gdb_test "ptype z2" " = complex float"
+gdb_test "ptype z3" " = complex long double"
+
+gdb_test "p \$_cimag (z1)" " = 4.5"
+gdb_test "ptype \$" " = double"
+
+gdb_test "p \$_cimag (z2)" " = -5.5"
+gdb_test "ptype \$" " = float"
+
+gdb_test "p \$_cimag (z3)" " = 6.5"
+gdb_test "ptype \$" " = long double"
+
+gdb_test "p \$_creal (z1)" " = 1.5"
+gdb_test "ptype \$" " = double"
+
+gdb_test "p \$_creal (z2)" " = 2.5"
+gdb_test "ptype \$" " = float"
+
+gdb_test "p \$_creal (z3)" " = 3.5"
+gdb_test "ptype \$" " = long double"
+
+gdb_test "p \$_cimag (d1)" "expected a complex number"
+gdb_test "p \$_cimag (f1)" "expected a complex number"
+gdb_test "p \$_cimag (i1)" "expected a complex number"
+
+gdb_test "p \$_creal (d1)" "expected a complex number"
+gdb_test "p \$_creal (f1)" "expected a complex number"
+gdb_test "p \$_creal (i1)" "expected a complex number"
diff --git a/gdb/testsuite/gdb.base/default.exp b/gdb/testsuite/gdb.base/default.exp
index ece1428e617..bdae0d471e7 100644
--- a/gdb/testsuite/gdb.base/default.exp
+++ b/gdb/testsuite/gdb.base/default.exp
@@ -601,6 +601,8 @@ set show_conv_list \
{$_probe_arg9 = <error: No frame selected>} \
{$_probe_arg10 = <error: No frame selected>} \
{$_probe_arg11 = <error: No frame selected>} \
+ {$_cimag = <internal function _cimag>} \
+ {$_creal = <internal function _creal>} \
{$_isvoid = <internal function _isvoid>} \
}
if ![skip_python_tests] {
diff --git a/gdb/value.c b/gdb/value.c
index dc297dfe0f9..eb48094dbe7 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -3933,6 +3933,44 @@ isvoid_internal_fn (struct gdbarch *gdbarch,
return value_from_longest (builtin_type (gdbarch)->builtin_int, ret);
}
+/* Implementation of the convenience function $_cimag. Extracts the
+ real part from a complex number. */
+
+static struct value *
+creal_internal_fn (struct gdbarch *gdbarch,
+ const struct language_defn *language,
+ void *cookie, int argc, struct value **argv)
+{
+ if (argc != 1)
+ error (_("You must provide one argument for $_real_from_complex."));
+
+ value *cval = argv[0];
+ type *ctype = check_typedef (value_type (cval));
+ if (TYPE_CODE (ctype) != TYPE_CODE_COMPLEX)
+ error (_("expected a complex number"));
+ return value_from_component (cval, TYPE_TARGET_TYPE (ctype), 0);
+}
+
+/* Implementation of the convenience function $_cimag. Extracts the
+ imaginary part from a complex number. */
+
+static struct value *
+cimag_internal_fn (struct gdbarch *gdbarch,
+ const struct language_defn *language,
+ void *cookie, int argc,
+ struct value **argv)
+{
+ if (argc != 1)
+ error (_("You must provide one argument for $_real_from_complex."));
+
+ value *cval = argv[0];
+ type *ctype = check_typedef (value_type (cval));
+ if (TYPE_CODE (ctype) != TYPE_CODE_COMPLEX)
+ error (_("expected a complex number"));
+ return value_from_component (cval, TYPE_TARGET_TYPE (ctype),
+ TYPE_LENGTH (TYPE_TARGET_TYPE (ctype)));
+}
+
#if GDB_SELF_TEST
namespace selftests
{
@@ -4114,6 +4152,20 @@ Usage: $_isvoid (expression)\n\
Return 1 if the expression is void, zero otherwise."),
isvoid_internal_fn, NULL);
+ add_internal_function ("_creal", _("\
+Extract the real part of a complex number.\n\
+Usage: $_real_from_complex (expression)\n\
+Return the real part of a complex number, the type depends on the\n\
+type of a complex number."),
+ creal_internal_fn, NULL);
+
+ add_internal_function ("_cimag", _("\
+Extract the imaginary part of a complex number.\n\
+Usage: $_imaginary_from_complex (expression)\n\
+Return the imaginary part of a complex number, the type depends on the\n\
+type of a complex number."),
+ cimag_internal_fn, NULL);
+
add_setshow_zuinteger_unlimited_cmd ("max-value-size",
class_support, &max_value_size, _("\
Set maximum sized value gdb will load from the inferior."), _("\
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions
2019-03-18 12:52 ` [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions Andrew Burgess
@ 2019-03-18 17:20 ` Eli Zaretskii
2019-03-29 22:41 ` Andrew Burgess
2019-03-19 19:47 ` Tom Tromey
2019-04-12 20:24 ` New FAIL on gdb.base/complex-parts.exp - unix/-m32 (was: Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions) Sergio Durigan Junior
2 siblings, 1 reply; 34+ messages in thread
From: Eli Zaretskii @ 2019-03-18 17:20 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard.Bunt
> From: Andrew Burgess <andrew.burgess@embecosm.com>
> Cc: Richard Bunt <Richard.Bunt@arm.com>, Andrew Burgess <andrew.burgess@embecosm.com>
> Date: Mon, 18 Mar 2019 12:52:16 +0000
>
> gdb/ChangeLog:
>
> * NEWS: Mention new internal functions.
> * dwarf2read.c (dwarf2_init_complex_target_type): New function.
> (read_base_type): Use dwarf2_init_complex_target_type.
> * value.c (creal_internal_fn): New function.
> (cimag_internal_fn): New function.
> (_initialize_values): Register new internal functions.
>
> gdb/doc/ChangeLog:
>
> * gdb.texinfo (Convenience Funs): Document '$_creal' and
> '$_cimag'.
The documentation parts are okay, with a couple of comments:
> +@item $_cimag(@var{value})
> +@findex $_cimag@r{, convenience function}
> +Return the imaginary part of a complex number @var{value}.
> +
> +The type of the imaginary part depends on the type of the complex
> +number, a @code{float complex} will return an imaginary part of type
> +@code{float}.
> +
> +@item $_creal(@var{value})
> +@findex $_creal@r{, convenience function}
> +Return the real part of a complex number @var{value}.
> +
> +The type of the real part depends on the type of the complex number, a
> +@code{float complex} will return an real part of type @code{float}.
There's no need to repeat the sentence about the type being dependent
on the original type; you can say that just once for both.
Also, the "a @code{float complex} will return ..." part is better
preceded by "e.g.", as this is an example, right?
And finally, "a real part", not "an real part".
> +Return the real part of a complex number, the type depends on the\n\
> +type of a complex number."),
^
"the", not "a".
> +Return the imaginary part of a complex number, the type depends on the\n\
> +type of a complex number."),
Likewise.
Thanks.
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions
2019-03-18 17:20 ` Eli Zaretskii
@ 2019-03-29 22:41 ` Andrew Burgess
2019-03-30 7:15 ` Eli Zaretskii
0 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2019-03-29 22:41 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: gdb-patches, Richard.Bunt
* Eli Zaretskii <eliz@gnu.org> [2019-03-18 19:20:26 +0200]:
> > From: Andrew Burgess <andrew.burgess@embecosm.com>
> > Cc: Richard Bunt <Richard.Bunt@arm.com>, Andrew Burgess <andrew.burgess@embecosm.com>
> > Date: Mon, 18 Mar 2019 12:52:16 +0000
> >
> > gdb/ChangeLog:
> >
> > * NEWS: Mention new internal functions.
> > * dwarf2read.c (dwarf2_init_complex_target_type): New function.
> > (read_base_type): Use dwarf2_init_complex_target_type.
> > * value.c (creal_internal_fn): New function.
> > (cimag_internal_fn): New function.
> > (_initialize_values): Register new internal functions.
> >
> > gdb/doc/ChangeLog:
> >
> > * gdb.texinfo (Convenience Funs): Document '$_creal' and
> > '$_cimag'.
>
> The documentation parts are okay, with a couple of comments:
>
> > +@item $_cimag(@var{value})
> > +@findex $_cimag@r{, convenience function}
> > +Return the imaginary part of a complex number @var{value}.
> > +
> > +The type of the imaginary part depends on the type of the complex
> > +number, a @code{float complex} will return an imaginary part of type
> > +@code{float}.
> > +
> > +@item $_creal(@var{value})
> > +@findex $_creal@r{, convenience function}
> > +Return the real part of a complex number @var{value}.
> > +
> > +The type of the real part depends on the type of the complex number, a
> > +@code{float complex} will return an real part of type @code{float}.
>
> There's no need to repeat the sentence about the type being dependent
> on the original type; you can say that just once for both.
Thanks for your feedback.
What I've done is group the @item entries for $_creal and $_cimag
together. My thinking is that if a user looks up either of these then
the documentation should be complete. If I left the @item entries
separate, and removed the sentence as you suggested then I think I'd
have to add a cross reference.
Hopefully this will be OK.
All your other feedback has been addressed. A new version of the
patch is below for your consideration.
Thanks,
Andrew
>
> Also, the "a @code{float complex} will return ..." part is better
> preceded by "e.g.", as this is an example, right?
>
> And finally, "a real part", not "an real part".
>
> > +Return the real part of a complex number, the type depends on the\n\
> > +type of a complex number."),
> ^
> "the", not "a".
>
> > +Return the imaginary part of a complex number, the type depends on the\n\
> > +type of a complex number."),
>
> Likewise.
---
gdb: Add $_cimag and $_creal internal functions
Add two new internal functions $_cimag and $_creal that extract the
imaginary and real parts of a complex value.
These internal functions can take a complex value of any type 'float
complex', 'double complex', or 'long double complex' and return a
suitable floating point value 'float', 'double', or 'long double'.
So we can now do this:
(gdb) p z1
$1 = 1.5 + 4.5 * I
(gdb) p $_cimag (z1)
$4 = 4.5
(gdb) p $_creal (z1)
$4 = 1.5
The components of a complex value are not strictly named types in
DWARF, as the complex type is itself the base type. However, once we
are able to extract the components it makes sense to be able to ask
what the type of these components is and get a sensible answer back,
rather than the error we would currently get. Currently GDB says:
(gdb) ptype z1
type = complex double
(gdb) p $_cimag (z1)
$4 = 4.5
(gdb) ptype $
type = <invalid type code 9>
With the changes in dwarf2read.c, GDB now says:
(gdb) ptype z1
type = complex double
(gdb) p $_cimag (z1)
$4 = 4.5
(gdb) ptype $
type = double
Which seems to make more sense.
gdb/ChangeLog:
* NEWS: Mention new internal functions.
* dwarf2read.c (dwarf2_init_complex_target_type): New function.
(read_base_type): Use dwarf2_init_complex_target_type.
* value.c (creal_internal_fn): New function.
(cimag_internal_fn): New function.
(_initialize_values): Register new internal functions.
gdb/doc/ChangeLog:
* gdb.texinfo (Convenience Funs): Document '$_creal' and
'$_cimag'.
gdb/testsuite/ChangeLog:
* gdb.base/complex-parts.c: New file.
* gdb.base/complex-parts.exp: New file.
diff --git a/gdb/NEWS b/gdb/NEWS
index edcc9c951a0..6d700d1cf32 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -10,6 +10,9 @@
* Support for Pointer Authentication on AArch64 Linux.
+* Two new convernience functions $_cimag and $_creal that extract the
+ imaginary and real parts respectively from complex numbers.
+
*** Changes in GDB 8.3
* GDB and GDBserver now support access to additional registers on
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 4c1d5e8294f..6dda71d83c0 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -11390,6 +11390,17 @@
Visiting node of type NODE_INTEGER
@end smallexample
+@item $_cimag(@var{value})
+@item $_creal(@var{value})
+@findex $_cimag@r{, convenience function}
+@findex $_creal@r{, convenience function}
+Return the imaginary (@code{$_cimag}) or real (@code{$_creal}) part of
+the complex number @var{value}.
+
+The type of the imaginary or real part depends on the type of the
+complex number, e.g., using @code{$_cimag} on a @code{float complex}
+will return an imaginary part of type @code{float}.
+
@end table
@value{GDBN} provides the ability to list and get help on
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 658c86264bf..e742931ad53 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17530,6 +17530,40 @@ dwarf2_init_integer_type (struct dwarf2_cu *cu, struct objfile *objfile,
return type;
}
+/* Initialise and return a floating point type of size BITS suitable for
+ use as a component of a complex number. The NAME_HINT is passed through
+ when initialising the floating point type and is the name of the complex
+ type.
+
+ As DWARF doesn't currently provide an explicit name for the components
+ of a complex number, but it can be helpful to have these components
+ named, we try to select a suitable name based on the size of the
+ component. */
+static struct type *
+dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
+ struct objfile *objfile,
+ int bits, const char *name_hint)
+{
+ gdbarch *gdbarch = get_objfile_arch (objfile);
+ struct type *tt = nullptr;
+
+ switch (bits)
+ {
+ case 32:
+ tt = builtin_type (gdbarch)->builtin_float;
+ break;
+ case 64:
+ tt = builtin_type (gdbarch)->builtin_double;
+ break;
+ case 128:
+ tt = builtin_type (gdbarch)->builtin_long_double;
+ break;
+ }
+
+ const char *name = (tt == nullptr) ? nullptr : TYPE_NAME (tt);
+ return dwarf2_init_float_type (objfile, bits, name, name_hint);
+}
+
/* Find a representation of a given base type and install
it in the TYPE field of the die. */
@@ -17569,7 +17603,7 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
type = init_boolean_type (objfile, bits, 1, name);
break;
case DW_ATE_complex_float:
- type = dwarf2_init_float_type (objfile, bits / 2, NULL, name);
+ type = dwarf2_init_complex_target_type (cu, objfile, bits / 2, name);
type = init_complex_type (objfile, name, type);
break;
case DW_ATE_decimal_float:
diff --git a/gdb/testsuite/gdb.base/complex-parts.c b/gdb/testsuite/gdb.base/complex-parts.c
new file mode 100644
index 00000000000..243caee0695
--- /dev/null
+++ b/gdb/testsuite/gdb.base/complex-parts.c
@@ -0,0 +1,50 @@
+/* Copyright 2019 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Unlike the other 'complex.c' test, this one uses the "standard" header
+ file to pull in the complex types. The testing is around printing the
+ complex numbers, and using the convenience function $_cimag and $_creal
+ to extract the parts of the complex numbers. */
+
+#include <complex.h>
+
+void
+keep_around (volatile void *ptr)
+{
+ asm ("" ::: "memory");
+}
+
+int
+main (void)
+{
+ double complex z1 = 1.5 + 4.5 * I;
+ float complex z2 = 2.5 - 5.5 * I;
+ long double complex z3 = 3.5 + 6.5 * I;
+
+ double d1 = 1.5;
+ float f1 = 2.5;
+ int i1 = 3;
+
+ keep_around (&z1);
+ keep_around (&z2);
+ keep_around (&z3);
+ keep_around (&d1);
+ keep_around (&f1);
+ keep_around (&i1);
+
+ return 0; /* Break Here. */
+}
diff --git a/gdb/testsuite/gdb.base/complex-parts.exp b/gdb/testsuite/gdb.base/complex-parts.exp
new file mode 100644
index 00000000000..ce8f4277a8b
--- /dev/null
+++ b/gdb/testsuite/gdb.base/complex-parts.exp
@@ -0,0 +1,62 @@
+# Copyright 2019 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
+
+if {[prepare_for_testing "failed to prepare" $testfile $srcfile debug]} {
+ return -1
+}
+
+if { ![runto_main] } then {
+ fail "can't run to main"
+ return 0
+}
+
+gdb_breakpoint [gdb_get_line_number "Break Here"]
+gdb_continue_to_breakpoint "breakpt" ".* Break Here\\. .*"
+
+gdb_test "p z1" " = 1.5 \\+ 4.5 \\* I"
+gdb_test "p z2" " = 2.5 \\+ -5.5 \\* I"
+gdb_test "p z3" " = 3.5 \\+ 6.5 \\* I"
+
+gdb_test "ptype z1" " = complex double"
+gdb_test "ptype z2" " = complex float"
+gdb_test "ptype z3" " = complex long double"
+
+gdb_test "p \$_cimag (z1)" " = 4.5"
+gdb_test "ptype \$" " = double"
+
+gdb_test "p \$_cimag (z2)" " = -5.5"
+gdb_test "ptype \$" " = float"
+
+gdb_test "p \$_cimag (z3)" " = 6.5"
+gdb_test "ptype \$" " = long double"
+
+gdb_test "p \$_creal (z1)" " = 1.5"
+gdb_test "ptype \$" " = double"
+
+gdb_test "p \$_creal (z2)" " = 2.5"
+gdb_test "ptype \$" " = float"
+
+gdb_test "p \$_creal (z3)" " = 3.5"
+gdb_test "ptype \$" " = long double"
+
+gdb_test "p \$_cimag (d1)" "expected a complex number"
+gdb_test "p \$_cimag (f1)" "expected a complex number"
+gdb_test "p \$_cimag (i1)" "expected a complex number"
+
+gdb_test "p \$_creal (d1)" "expected a complex number"
+gdb_test "p \$_creal (f1)" "expected a complex number"
+gdb_test "p \$_creal (i1)" "expected a complex number"
diff --git a/gdb/testsuite/gdb.base/default.exp b/gdb/testsuite/gdb.base/default.exp
index ece1428e617..bdae0d471e7 100644
--- a/gdb/testsuite/gdb.base/default.exp
+++ b/gdb/testsuite/gdb.base/default.exp
@@ -601,6 +601,8 @@ set show_conv_list \
{$_probe_arg9 = <error: No frame selected>} \
{$_probe_arg10 = <error: No frame selected>} \
{$_probe_arg11 = <error: No frame selected>} \
+ {$_cimag = <internal function _cimag>} \
+ {$_creal = <internal function _creal>} \
{$_isvoid = <internal function _isvoid>} \
}
if ![skip_python_tests] {
diff --git a/gdb/value.c b/gdb/value.c
index dc297dfe0f9..d011b396986 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -3933,6 +3933,44 @@ isvoid_internal_fn (struct gdbarch *gdbarch,
return value_from_longest (builtin_type (gdbarch)->builtin_int, ret);
}
+/* Implementation of the convenience function $_cimag. Extracts the
+ real part from a complex number. */
+
+static struct value *
+creal_internal_fn (struct gdbarch *gdbarch,
+ const struct language_defn *language,
+ void *cookie, int argc, struct value **argv)
+{
+ if (argc != 1)
+ error (_("You must provide one argument for $_creal."));
+
+ value *cval = argv[0];
+ type *ctype = check_typedef (value_type (cval));
+ if (TYPE_CODE (ctype) != TYPE_CODE_COMPLEX)
+ error (_("expected a complex number"));
+ return value_from_component (cval, TYPE_TARGET_TYPE (ctype), 0);
+}
+
+/* Implementation of the convenience function $_cimag. Extracts the
+ imaginary part from a complex number. */
+
+static struct value *
+cimag_internal_fn (struct gdbarch *gdbarch,
+ const struct language_defn *language,
+ void *cookie, int argc,
+ struct value **argv)
+{
+ if (argc != 1)
+ error (_("You must provide one argument for $_cimag."));
+
+ value *cval = argv[0];
+ type *ctype = check_typedef (value_type (cval));
+ if (TYPE_CODE (ctype) != TYPE_CODE_COMPLEX)
+ error (_("expected a complex number"));
+ return value_from_component (cval, TYPE_TARGET_TYPE (ctype),
+ TYPE_LENGTH (TYPE_TARGET_TYPE (ctype)));
+}
+
#if GDB_SELF_TEST
namespace selftests
{
@@ -4114,6 +4152,20 @@ Usage: $_isvoid (expression)\n\
Return 1 if the expression is void, zero otherwise."),
isvoid_internal_fn, NULL);
+ add_internal_function ("_creal", _("\
+Extract the real part of a complex number.\n\
+Usage: $_creal (expression)\n\
+Return the real part of a complex number, the type depends on the\n\
+type of a complex number."),
+ creal_internal_fn, NULL);
+
+ add_internal_function ("_cimag", _("\
+Extract the imaginary part of a complex number.\n\
+Usage: $_cimag (expression)\n\
+Return the imaginary part of a complex number, the type depends on the\n\
+type of a complex number."),
+ cimag_internal_fn, NULL);
+
add_setshow_zuinteger_unlimited_cmd ("max-value-size",
class_support, &max_value_size, _("\
Set maximum sized value gdb will load from the inferior."), _("\
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions
2019-03-29 22:41 ` Andrew Burgess
@ 2019-03-30 7:15 ` Eli Zaretskii
0 siblings, 0 replies; 34+ messages in thread
From: Eli Zaretskii @ 2019-03-30 7:15 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard.Bunt
> Date: Fri, 29 Mar 2019 22:41:16 +0000
> From: Andrew Burgess <andrew.burgess@embecosm.com>
> Cc: gdb-patches@sourceware.org, Richard.Bunt@arm.com
>
> What I've done is group the @item entries for $_creal and $_cimag
> together. My thinking is that if a user looks up either of these then
> the documentation should be complete. If I left the @item entries
> separate, and removed the sentence as you suggested then I think I'd
> have to add a cross reference.
>
> Hopefully this will be OK.
I have only one comment:
> +@item $_cimag(@var{value})
> +@item $_creal(@var{value})
The second @item should be @itemx.
Thanks.
^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions
2019-03-18 12:52 ` [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions Andrew Burgess
2019-03-18 17:20 ` Eli Zaretskii
@ 2019-03-19 19:47 ` Tom Tromey
2019-04-12 20:24 ` New FAIL on gdb.base/complex-parts.exp - unix/-m32 (was: Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions) Sergio Durigan Junior
2 siblings, 0 replies; 34+ messages in thread
From: Tom Tromey @ 2019-03-19 19:47 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard Bunt
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> Add two new internal functions $_cimag and $_creal that extract the
Andrew> imaginary and real parts of a complex value.
Thanks. I had one nit.
Andrew> + if (argc != 1)
Andrew> + error (_("You must provide one argument for $_real_from_complex."));
[...]
Andrew> + if (argc != 1)
Andrew> + error (_("You must provide one argument for $_real_from_complex."));
I think these should use the names $_creal and $_cimag instead.
Tom
^ permalink raw reply [flat|nested] 34+ messages in thread* New FAIL on gdb.base/complex-parts.exp - unix/-m32 (was: Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions)
2019-03-18 12:52 ` [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions Andrew Burgess
2019-03-18 17:20 ` Eli Zaretskii
2019-03-19 19:47 ` Tom Tromey
@ 2019-04-12 20:24 ` Sergio Durigan Junior
2019-04-13 0:02 ` Andrew Burgess
2 siblings, 1 reply; 34+ messages in thread
From: Sergio Durigan Junior @ 2019-04-12 20:24 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard Bunt
On Monday, March 18 2019, Andrew Burgess wrote:
> Add two new internal functions $_cimag and $_creal that extract the
> imaginary and real parts of a complex value.
[...]
Hi Andrew,
The new testcase gdb.base/complex-parts.exp has one new FAIL when
testing x86_64 GDB against unix/-m32. I.e.:
make check-gdb TESTS=gdb.base/complex-parts.exp RUNTESTFLAGS='--target_board unix/-m32'
Here's what I'm seeing:
ptype $
type = <invalid type code 9>
(gdb) FAIL: gdb.base/complex-parts.exp: ptype $
...
ptype $
type = <invalid type code 9>
(gdb) FAIL: gdb.base/complex-parts.exp: ptype $
The BuildBot run:
https://gdb-build.sergiodj.net/builders/Fedora-x86_64-m32/builds/12210
The logs:
https://gdb-build.sergiodj.net/results/Fedora-x86_64-m32/8b/8bdc16587e26100282094c8eaa8e83180ba57afd/
Let me know if you need help investigating this.
Thanks,
--
Sergio
GPG key ID: 237A 54B1 0287 28BF 00EF 31F4 D0EB 7628 65FC 5E36
Please send encrypted e-mail if possible
http://sergiodj.net/
^ permalink raw reply [flat|nested] 34+ messages in thread
* Re: New FAIL on gdb.base/complex-parts.exp - unix/-m32 (was: Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions)
2019-04-12 20:24 ` New FAIL on gdb.base/complex-parts.exp - unix/-m32 (was: Re: [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions) Sergio Durigan Junior
@ 2019-04-13 0:02 ` Andrew Burgess
2019-04-16 18:30 ` New FAIL on gdb.base/complex-parts.exp - unix/-m32 Tom Tromey
0 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2019-04-13 0:02 UTC (permalink / raw)
To: Sergio Durigan Junior; +Cc: gdb-patches, Richard Bunt
* Sergio Durigan Junior <sergiodj@redhat.com> [2019-04-12 16:23:57 -0400]:
> On Monday, March 18 2019, Andrew Burgess wrote:
>
> > Add two new internal functions $_cimag and $_creal that extract the
> > imaginary and real parts of a complex value.
> [...]
>
> Hi Andrew,
>
> The new testcase gdb.base/complex-parts.exp has one new FAIL when
> testing x86_64 GDB against unix/-m32. I.e.:
>
> make check-gdb TESTS=gdb.base/complex-parts.exp RUNTESTFLAGS='--target_board unix/-m32'
>
> Here's what I'm seeing:
>
> ptype $
> type = <invalid type code 9>
> (gdb) FAIL: gdb.base/complex-parts.exp: ptype $
> ...
> ptype $
> type = <invalid type code 9>
> (gdb) FAIL: gdb.base/complex-parts.exp: ptype $
>
> The BuildBot run:
>
> https://gdb-build.sergiodj.net/builders/Fedora-x86_64-m32/builds/12210
>
> The logs:
>
> https://gdb-build.sergiodj.net/results/Fedora-x86_64-m32/8b/8bdc16587e26100282094c8eaa8e83180ba57afd/
>
> Let me know if you need help investigating this.
Thanks for pointing this out.
I've pushed the patch below to resolve this issue.
Thanks,
Andrew
--
[PATCH] gdb: Fix failure in gdb.base/complex-parts.exp for x86-32
The x86-32 ABI specifies 96-bit long double, this was causing a
failure on the test gdb.base/complex-parts.exp.
The problem is that GDB tries to find a builtin floating point type of
the correct size in order to reuse the name of that type as the name
for the components of the complex type being built.
Previously GDB was only aware of floating point types sized 32, 64, or
128 bits. This patch teaches GDB how to handle 96 bit floating point
type.
gdb/ChangeLog:
* dwarf2read.c (dwarf2_init_complex_target_type): Handle complex
target types of size 96-bits, add some additional comments, and
check that the builtin type we found was the correct size.
---
gdb/ChangeLog | 6 ++++++
gdb/dwarf2read.c | 10 ++++++++++
2 files changed, 16 insertions(+)
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index b718192cb12..0873028e438 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17546,6 +17546,9 @@ dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
gdbarch *gdbarch = get_objfile_arch (objfile);
struct type *tt = nullptr;
+ /* Try to find a suitable floating point builtin type of size BITS.
+ We're going to use the name of this type as the name for the complex
+ target type that we are about to create. */
switch (bits)
{
case 32:
@@ -17554,11 +17557,18 @@ dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
case 64:
tt = builtin_type (gdbarch)->builtin_double;
break;
+ case 96: /* The x86-32 ABI specifies 96-bit long double. */
case 128:
tt = builtin_type (gdbarch)->builtin_long_double;
break;
}
+ /* If the type we found doesn't match the size we were looking for, then
+ pretend we didn't find a type at all, the complex target type we
+ create will then be nameless. */
+ if (TYPE_LENGTH (tt) * TARGET_CHAR_BIT != bits)
+ tt = nullptr;
+
const char *name = (tt == nullptr) ? nullptr : TYPE_NAME (tt);
return dwarf2_init_float_type (objfile, bits, name, name_hint);
}
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: New FAIL on gdb.base/complex-parts.exp - unix/-m32
2019-04-13 0:02 ` Andrew Burgess
@ 2019-04-16 18:30 ` Tom Tromey
2019-04-17 0:03 ` Andrew Burgess
0 siblings, 1 reply; 34+ messages in thread
From: Tom Tromey @ 2019-04-16 18:30 UTC (permalink / raw)
To: Andrew Burgess; +Cc: Sergio Durigan Junior, gdb-patches, Richard Bunt
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> The problem is that GDB tries to find a builtin floating point type of
Andrew> the correct size in order to reuse the name of that type as the name
Andrew> for the components of the complex type being built.
This patch caused a crash on an internal test case.
Let me know what you think of the appended.
thanks,
Tom
commit bf3507f7fcb6331401f9fd8eb7f1fad25ebfdf23
Author: Tom Tromey <tromey@adacore.com>
Date: Tue Apr 16 12:12:09 2019 -0600
Avoid crash in dwarf2_init_complex_target_type
After commit 35add35 ("gdb: Fix failure in gdb.base/complex-parts.exp
for x86-32"), dwarf2_init_complex_target_type can crash if "tt" is
nullptr. This patch avoids the problem by checking for this case.
No test case because I don't know a good way to write one; it was
found by an internal AdaCore test case that apparently uses a 16 bit
floating point type.
gdb/ChangeLog:
* dwarf2read.c (dwarf2_init_complex_target_type): Check "tt"
against nullptr before use.
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index ba1300d57ef..9281d822ade 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,8 @@
+2019-04-16 Tom Tromey <tromey@adacore.com>
+
+ * dwarf2read.c (dwarf2_init_complex_target_type): Check "tt"
+ against nullptr before use.
+
2019-04-15 Leszek Swirski <leszeks@google.com>
* amd64-tdep.c (amd64_classify_aggregate): Use cp_pass_by_reference
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 0873028e438..16bf2404a21 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17566,7 +17566,7 @@ dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
/* If the type we found doesn't match the size we were looking for, then
pretend we didn't find a type at all, the complex target type we
create will then be nameless. */
- if (TYPE_LENGTH (tt) * TARGET_CHAR_BIT != bits)
+ if (tt != nullptr && TYPE_LENGTH (tt) * TARGET_CHAR_BIT != bits)
tt = nullptr;
const char *name = (tt == nullptr) ? nullptr : TYPE_NAME (tt);
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: New FAIL on gdb.base/complex-parts.exp - unix/-m32
2019-04-16 18:30 ` New FAIL on gdb.base/complex-parts.exp - unix/-m32 Tom Tromey
@ 2019-04-17 0:03 ` Andrew Burgess
0 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-17 0:03 UTC (permalink / raw)
To: Tom Tromey; +Cc: Sergio Durigan Junior, gdb-patches, Richard Bunt
* Tom Tromey <tom@tromey.com> [2019-04-16 12:30:48 -0600]:
> >>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
>
> Andrew> The problem is that GDB tries to find a builtin floating point type of
> Andrew> the correct size in order to reuse the name of that type as the name
> Andrew> for the components of the complex type being built.
>
> This patch caused a crash on an internal test case.
> Let me know what you think of the appended.
>
> thanks,
> Tom
>
> commit bf3507f7fcb6331401f9fd8eb7f1fad25ebfdf23
> Author: Tom Tromey <tromey@adacore.com>
> Date: Tue Apr 16 12:12:09 2019 -0600
>
> Avoid crash in dwarf2_init_complex_target_type
>
> After commit 35add35 ("gdb: Fix failure in gdb.base/complex-parts.exp
> for x86-32"), dwarf2_init_complex_target_type can crash if "tt" is
> nullptr. This patch avoids the problem by checking for this case.
>
> No test case because I don't know a good way to write one; it was
> found by an internal AdaCore test case that apparently uses a 16 bit
> floating point type.
>
> gdb/ChangeLog:
> * dwarf2read.c (dwarf2_init_complex_target_type): Check "tt"
> against nullptr before use.
>
> diff --git a/gdb/ChangeLog b/gdb/ChangeLog
> index ba1300d57ef..9281d822ade 100644
> --- a/gdb/ChangeLog
> +++ b/gdb/ChangeLog
> @@ -1,3 +1,8 @@
> +2019-04-16 Tom Tromey <tromey@adacore.com>
> +
> + * dwarf2read.c (dwarf2_init_complex_target_type): Check "tt"
> + against nullptr before use.
> +
> 2019-04-15 Leszek Swirski <leszeks@google.com>
>
> * amd64-tdep.c (amd64_classify_aggregate): Use cp_pass_by_reference
> diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
> index 0873028e438..16bf2404a21 100644
> --- a/gdb/dwarf2read.c
> +++ b/gdb/dwarf2read.c
> @@ -17566,7 +17566,7 @@ dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
> /* If the type we found doesn't match the size we were looking for, then
> pretend we didn't find a type at all, the complex target type we
> create will then be nameless. */
> - if (TYPE_LENGTH (tt) * TARGET_CHAR_BIT != bits)
> + if (tt != nullptr && TYPE_LENGTH (tt) * TARGET_CHAR_BIT != bits)
> tt = nullptr;
>
> const char *name = (tt == nullptr) ? nullptr : TYPE_NAME (tt);
Thank you, that looks great.
Feel free to push this.
Andrew
^ permalink raw reply [flat|nested] 34+ messages in thread
* [PATCH 5/8] gdb/fortran: Print 'void' type in lower case
2019-03-18 12:52 ` [PATCH " Andrew Burgess
2019-03-18 12:52 ` [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-18 12:52 ` [PATCH 8/8] gdb/fortran: Add allocatable type qualifier Andrew Burgess
` (14 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
For a program compiled with gfortran the base type names are written
as lower cases in the DWARF, and so GDB will display them as lower
case. Additionally, in most places where GDB supplies its own type
names (for example all of the types defined in f-lang.c in
`build_fortran_types`), the type names are all lower case.
An exception to this is where GDB prints the void type for Fortran.
In this case GDB uses upper case.
I'm not aware of any reason why this type should merit special
attention, and it looks our of place when printing types, so this
commit changes from 'VOID' to 'void' to match all the other types.
gdb/ChangeLog:
* f-lang.c (build_fortran_types): Change name of void type to
lower case.
* f-typeprint.c (f_type_print_base): Print the name of the void
type, rather than a fixed string.
* f-valprint.c (f_decorations): Use lower case void string.
gdb/testsuite/ChangeLog:
* gdb.fortran/exprs.exp (test_convenience_variables): Expect lower
case void string.
---
gdb/ChangeLog | 8 ++++++++
gdb/f-lang.c | 2 +-
gdb/f-typeprint.c | 6 +++++-
gdb/f-valprint.c | 2 +-
gdb/testsuite/ChangeLog | 5 +++++
gdb/testsuite/gdb.fortran/exprs.exp | 2 +-
6 files changed, 21 insertions(+), 4 deletions(-)
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 51bbc6ad333..d8f752f6808 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,11 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * f-lang.c (build_fortran_types): Change name of void type to
+ lower case.
+ * f-typeprint.c (f_type_print_base): Print the name of the void
+ type, rather than a fixed string.
+ * f-valprint.c (f_decorations): Use lower case void string.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
Chris January <chris.january@arm.com>
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index dd31b42ccd0..09a2df90e49 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -497,7 +497,7 @@ build_fortran_types (struct gdbarch *gdbarch)
= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
builtin_f_type->builtin_void
- = arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT, "VOID");
+ = arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT, "void");
builtin_f_type->builtin_character
= arch_type (gdbarch, TYPE_CODE_CHAR, TARGET_CHAR_BIT, "character");
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 30e0c4dcda1..7e36ca16c69 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -329,7 +329,11 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
break;
case TYPE_CODE_VOID:
- fprintfi_filtered (level, stream, "VOID");
+ {
+ gdbarch *gdbarch = get_type_arch (type);
+ struct type *void_type = builtin_f_type (gdbarch)->builtin_void;
+ fprintfi_filtered (level, stream, "%s", TYPE_NAME (void_type));
+ }
break;
case TYPE_CODE_UNDEF:
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index eee0a62fe88..b335a2b3b50 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -199,7 +199,7 @@ static const struct generic_val_print_decorations f_decorations =
")",
".TRUE.",
".FALSE.",
- "VOID",
+ "void",
"{",
"}"
};
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 83883cefd1e..3cdc3cfa6fc 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/exprs.exp (test_convenience_variables): Expect lower
+ case void string.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/complex.exp: Expand.
diff --git a/gdb/testsuite/gdb.fortran/exprs.exp b/gdb/testsuite/gdb.fortran/exprs.exp
index 3b24f7c135f..8649d0b246d 100644
--- a/gdb/testsuite/gdb.fortran/exprs.exp
+++ b/gdb/testsuite/gdb.fortran/exprs.exp
@@ -141,7 +141,7 @@ proc test_convenience_variables {} {
gdb_test "print (\$foo = 32) + 4" " = 36" \
"Use convenience variable assignment in arithmetic expression"
- gdb_test "print \$bar" " = VOID" \
+ gdb_test "print \$bar" " = void" \
"Print contents of uninitialized convenience variable"
}
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCH 8/8] gdb/fortran: Add allocatable type qualifier
2019-03-18 12:52 ` [PATCH " Andrew Burgess
2019-03-18 12:52 ` [PATCH 1/8] gdb: Add $_cimag and $_creal internal functions Andrew Burgess
2019-03-18 12:52 ` [PATCH 5/8] gdb/fortran: Print 'void' type in lower case Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-18 12:52 ` [PATCH 2/8] gdb/fortran: Handle internal function calls Andrew Burgess
` (13 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
Types in Fortran can have the 'allocatable' qualifier attached to
indicate that memory needs to be explicitly allocated by the user.
This patch extends GDB to show this qualifier when printing types.
Lots of tests results are then updated to include this new qualifier
in the expected results.
gdb/ChangeLog:
* f-typeprint.c (f_type_print_base): Print 'allocatable' type
qualifier.
* gdbtypes.h (TYPE_IS_ALLOCATABLE): Define.
gdb/testsuite/ChangeLog:
* gdb.fortran/vla-datatypes.exp: Update expected results.
* gdb.fortran/vla-ptype.exp: Likewise.
* gdb.fortran/vla-type.exp: Likewise.
* gdb.fortran/vla-value.exp: Likewise.
---
gdb/ChangeLog | 7 +++++++
gdb/f-typeprint.c | 3 +++
gdb/gdbtypes.h | 4 ++++
gdb/testsuite/ChangeLog | 7 +++++++
gdb/testsuite/gdb.fortran/vla-datatypes.exp | 10 +++++-----
gdb/testsuite/gdb.fortran/vla-ptype.exp | 8 ++++----
gdb/testsuite/gdb.fortran/vla-type.exp | 22 +++++++++++-----------
gdb/testsuite/gdb.fortran/vla-value.exp | 4 ++--
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 4 ++--
9 files changed, 45 insertions(+), 24 deletions(-)
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 1183f6bf2f4..e3fddc2d9fb 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,10 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+ Chris January <chris.january@arm.com>
+
+ * f-typeprint.c (f_type_print_base): Print 'allocatable' type
+ qualifier.
+ * gdbtypes.h (TYPE_IS_ALLOCATABLE): Define.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* f-typeprint.c (f_print_type): Update rules for printing
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 64ee980aab5..5f8f88d998e 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -469,4 +469,7 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
break;
}
+
+ if (TYPE_IS_ALLOCATABLE (type))
+ fprintf_filtered (stream, ", allocatable");
}
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 66051cf02c7..1f1bbce40a4 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -350,6 +350,10 @@ DEF_ENUM_FLAGS_TYPE (enum type_instance_flag_value, type_instance_flags);
#define TYPE_IS_REFERENCE(t) \
(TYPE_CODE (t) == TYPE_CODE_REF || TYPE_CODE (t) == TYPE_CODE_RVALUE_REF)
+/* * True if this type is allocatable. */
+#define TYPE_IS_ALLOCATABLE(t) \
+ (get_dyn_prop (DYN_PROP_ALLOCATED, t) != NULL)
+
/* * Instruction-space delimited type. This is for Harvard architectures
which have separate instruction and data address spaces (and perhaps
others).
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 0dbe1ce91ef..ab000c289ea 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/vla-datatypes.exp: Update expected results.
+ * gdb.fortran/vla-ptype.exp: Likewise.
+ * gdb.fortran/vla-type.exp: Likewise.
+ * gdb.fortran/vla-value.exp: Likewise.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/ptr-indentation.exp: Update expected results.
diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
index afe67742bc4..bb5ed276c22 100644
--- a/gdb/testsuite/gdb.fortran/vla-datatypes.exp
+++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
@@ -55,15 +55,15 @@ 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 = $int \\\(11,22,33\\\)" \
+gdb_test "ptype intvla" "type = $int, allocatable \\\(11,22,33\\\)" \
"ptype intvla"
-gdb_test "ptype realvla" "type = $real \\\(11,22,33\\\)" \
+gdb_test "ptype realvla" "type = $real, allocatable \\\(11,22,33\\\)" \
"ptype realvla"
-gdb_test "ptype complexvla" "type = $complex \\\(11,22,33\\\)" \
+gdb_test "ptype complexvla" "type = $complex, allocatable \\\(11,22,33\\\)" \
"ptype complexvla"
-gdb_test "ptype logicalvla" "type = $logical \\\(11,22,33\\\)" \
+gdb_test "ptype logicalvla" "type = $logical, allocatable \\\(11,22,33\\\)" \
"ptype logicalvla"
-gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \
+gdb_test "ptype charactervla" "type = character\\\*1, allocatable \\\(11,22,33\\\)" \
"ptype charactervla"
gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)"
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
index a40ad917da5..0f4abb63757 100644
--- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
+++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
@@ -43,24 +43,24 @@ gdb_test "ptype vla2(5, 45, 20)" \
gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
gdb_continue_to_breakpoint "vla1-allocated"
-gdb_test "ptype vla1" "type = $real \\\(10,10,10\\\)" \
+gdb_test "ptype vla1" "type = $real, allocatable \\\(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 \\\(7,42:50,13:35\\\)" \
+gdb_test "ptype vla2" "type = $real, allocatable \\\(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 \\\(10,10,10\\\)" \
+gdb_test "ptype vla1" "type = $real, allocatable \\\(10,10,10\\\)" \
"ptype vla1 filled"
gdb_test "ptype vla1(3, 6, 9)" "type = $real" \
"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 \\\(7,42:50,13:35\\\)" \
+gdb_test "ptype vla2" "type = $real, allocatable \\\(7,42:50,13:35\\\)" \
"ptype vla2 filled"
gdb_test "ptype vla2(5, 45, 20)" "type = $real" \
"ptype vla2(5, 45, 20) filled"
diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
index 407a447a851..951f118194a 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -46,7 +46,7 @@ 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+$int :: ivla\\\(11,22,33\\\)" \
+ "\\s+$int, allocatable :: ivla\\\(11,22,33\\\)" \
"End Type one" ]
# Check type with two VLA's inside
@@ -57,8 +57,8 @@ 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+$int :: ivla1\\\(5,12,99\\\)" \
- "\\s+$int :: ivla2\\\(9,12\\\)" \
+ "\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \
+ "\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \
"End Type two" ]
gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
\\\( 1, 1, 321, 1, 1\\\)\
@@ -74,7 +74,7 @@ gdb_test "print threev%ivar" " = 3"
gdb_test "ptype threev" \
[multi_line "type = Type three" \
"\\s+$int :: ivar" \
- "\\s+$int :: ivla\\\(20\\\)" \
+ "\\s+$int, allocatable :: ivla\\\(20\\\)" \
"End Type three" ]
# Check type with attribute at end of type
@@ -87,7 +87,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+$int :: ivla\\\(10\\\)" \
+ "\\s+$int, allocatable :: ivla\\\(10\\\)" \
"\\s+$int :: ivar" \
"End Type four" ]
@@ -103,7 +103,7 @@ gdb_test "ptype fivev" \
"End Type five" ]
gdb_test "ptype fivev%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(10,10,10\\)" \
+ " $int, allocatable :: ivla\\(10,10,10\\)" \
"End Type one" ]
# Check array of types containing a VLA
@@ -120,7 +120,7 @@ gdb_test "ptype fivearr(1)" \
"End Type five" ]
gdb_test "ptype fivearr(1)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(2,4,6\\)" \
+ " $int, allocatable :: ivla\\(2,4,6\\)" \
"End Type one" ]
gdb_test "ptype fivearr(2)" \
[multi_line "type = Type five" \
@@ -128,7 +128,7 @@ gdb_test "ptype fivearr(2)" \
"End Type five" ]
gdb_test "ptype fivearr(2)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(12,14,16\\)" \
+ " $int, allocatable :: ivla\\(12,14,16\\)" \
"End Type one" ]
# Check allocation status of dynamic array and it's dynamic members
@@ -141,7 +141,7 @@ gdb_test "ptype fivedynarr(2)" \
"ptype fivedynarr(2), tone is not allocated"
gdb_test "ptype fivedynarr(2)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(<not allocated>\\)" \
+ " $int, allocatable :: ivla\\(<not allocated>\\)" \
"End Type one" ] \
"ptype fivedynarr(2)%tone, not allocated"
@@ -159,7 +159,7 @@ gdb_test "ptype fivedynarr(1)" \
"End Type five" ]
gdb_test "ptype fivedynarr(1)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(2,4,6\\)" \
+ " $int, allocatable :: ivla\\(2,4,6\\)" \
"End Type one" ]
gdb_test "ptype fivedynarr(2)" \
[multi_line "type = Type five" \
@@ -167,5 +167,5 @@ gdb_test "ptype fivedynarr(2)" \
"End Type five" ]
gdb_test "ptype fivedynarr(2)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(12,14,16\\)" \
+ " $int, allocatable :: ivla\\(12,14,16\\)" \
"End Type one" ]
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 507137bed21..be397fd95fb 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -35,7 +35,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 \\\(<not allocated>\\\) \\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real, allocatable \\\(<not allocated>\\\) \\\)\\\) $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)"
@@ -56,7 +56,7 @@ with_timeout_factor 15 {
"step over value assignment of vla1"
}
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( $real \\\(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)"
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
index bf65bf914cf..0759ccbaebe 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -77,10 +77,10 @@ mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
mi_gdb_test "510-data-evaluate-expression vla1" \
"510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla"
-mi_create_varobj_checked vla1_allocated vla1 "$real \\\(5\\\)" \
+mi_create_varobj_checked vla1_allocated vla1 "$real, allocatable \\\(5\\\)" \
"create local variable vla1_allocated"
mi_gdb_test "511-var-info-type vla1_allocated" \
- "511\\^done,type=\"$real \\\(5\\\)\"" \
+ "511\\^done,type=\"$real, allocatable \\\(5\\\)\"" \
"info type variable vla1_allocated"
mi_gdb_test "512-var-show-format vla1_allocated" \
"512\\^done,format=\"natural\"" \
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCH 2/8] gdb/fortran: Handle internal function calls
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (2 preceding siblings ...)
2019-03-18 12:52 ` [PATCH 8/8] gdb/fortran: Add allocatable type qualifier Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-19 19:52 ` Tom Tromey
2019-03-18 12:52 ` [PATCH 7/8] gdb/fortran: Update rules for printing whitespace in types Andrew Burgess
` (12 subsequent siblings)
16 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
If an convenience function is defined in python (or guile), then
currently this will not work in Fortran, instead the user is given
this message:
(gdb) set language fortran
(gdb) p $myfunc (3)
Cannot perform substring on this type
Compare this to C:
(gdb) set language c
(gdb) p $myfunc (3)
$1 = 1
After this patch we see the same behaviour in both C and Fortran.
I've extended the test to check that all languages can call the
convenience functions - only Fortran was broken.
When calling convenience functions in Fortran we don't need to perform
the same value preparation (passing by pointer) that we would for
calling a native function - passing the real value is fine.
gdb/ChangeLog:
* eval.c (evaluate_subexp_standard): Handle internal functions
during Fortran function call handling.
gdb/testsuite/ChangeLog:
* gdb.python/py-function.exp: Check calling helper function from
all languages.
* lib/gdb.exp (gdb_supported_languages): New proc.
---
gdb/ChangeLog | 5 +++++
gdb/eval.c | 12 ++++++++----
gdb/testsuite/ChangeLog | 6 ++++++
gdb/testsuite/gdb.python/py-function.exp | 8 +++++++-
gdb/testsuite/lib/gdb.exp | 8 ++++++++
5 files changed, 34 insertions(+), 5 deletions(-)
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 705bcaff49f..51863b21dc6 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * eval.c (evaluate_subexp_standard): Handle internal functions
+ during Fortran function call handling.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* NEWS: Mention new internal functions.
diff --git a/gdb/eval.c b/gdb/eval.c
index 0c0cf7f6ac7..085c00a7d65 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -1979,6 +1979,7 @@ evaluate_subexp_standard (struct type *expect_type,
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
+ case TYPE_CODE_INTERNAL_FUNCTION:
/* It's a function call. */
/* Allocate arg vector, including space for the function to be
called in argvec[0] and a terminating NULL. */
@@ -1996,10 +1997,13 @@ evaluate_subexp_standard (struct type *expect_type,
results in malloc being called with a pointer to an integer
followed by an attempt to malloc the arguments to malloc in
target memory. Infinite recursion ensues. */
- bool is_artificial =
- TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
- argvec[tem] = fortran_argument_convert (argvec[tem],
- is_artificial);
+ if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
+ {
+ bool is_artificial =
+ TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
+ argvec[tem] = fortran_argument_convert (argvec[tem],
+ is_artificial);
+ }
}
argvec[tem] = 0; /* signal end of arglist */
if (noside == EVAL_SKIP)
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index b471f374271..6094d773163 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.python/py-function.exp: Check calling helper function from
+ all languages.
+ * lib/gdb.exp (gdb_supported_languages): New proc.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.base/complex-parts.c: New file.
diff --git a/gdb/testsuite/gdb.python/py-function.exp b/gdb/testsuite/gdb.python/py-function.exp
index 76cc57d81c9..01c326b5d0b 100644
--- a/gdb/testsuite/gdb.python/py-function.exp
+++ b/gdb/testsuite/gdb.python/py-function.exp
@@ -51,7 +51,13 @@ gdb_py_test_multiple "input value-returning convenience function" \
"Double ()" "" \
"end" ""
-gdb_test "print \$double (1)" "= 2" "call value-returning function"
+# Different languages can have different parsers, so lets check that
+# internal functions are understood by every language. Place auto
+# last in the list so we end up back in 'auto' language mode.
+foreach lang [concat [gdb_supported_languages] auto] {
+ gdb_test_no_output "set language $lang"
+ gdb_test "print \$double (1)" "= 2" "call value-returning function, language = $lang"
+}
gdb_py_test_multiple "input int-returning function" \
"python" "" \
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index f13f909c344..ad5f1857e1c 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -6308,5 +6308,13 @@ proc cd { dir } {
builtin_cd $dir
}
+# Return a list of all languages supported by GDB, suitable for use in
+# 'set language NAME'. This doesn't include either the 'local' or
+# 'auto' keywords.
+proc gdb_supported_languages {} {
+ return [list c objective-c c++ d go fortran modula-2 asm pascal \
+ opencl rust minimal ada]
+}
+
# Always load compatibility stuff.
load_lib future.exp
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: [PATCH 2/8] gdb/fortran: Handle internal function calls
2019-03-18 12:52 ` [PATCH 2/8] gdb/fortran: Handle internal function calls Andrew Burgess
@ 2019-03-19 19:52 ` Tom Tromey
0 siblings, 0 replies; 34+ messages in thread
From: Tom Tromey @ 2019-03-19 19:52 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard Bunt
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> If an convenience function is defined in python (or guile), then
Andrew> currently this will not work in Fortran, instead the user is given
Andrew> this message:
Thank you. This looks good to me. I had one nit though:
Andrew> + if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
Andrew> + {
Andrew> + bool is_artificial =
Andrew> + TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
gdb style is to line break before the "=", not after.
Tom
^ permalink raw reply [flat|nested] 34+ messages in thread
* [PATCH 7/8] gdb/fortran: Update rules for printing whitespace in types
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (3 preceding siblings ...)
2019-03-18 12:52 ` [PATCH 2/8] gdb/fortran: Handle internal function calls Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-18 12:52 ` [PATCH 4/8] gdb/fortran: better types for components of complex numbers Andrew Burgess
` (11 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
The whitespace produced as types are printed seems inconsistent. This
commit updates the rules in an attempt to make whitespace more
balanced and consistent. Expected results are updated.
gdb/ChangeLog:
* f-typeprint.c (f_print_type): Update rules for printing
whitespace.
(f_type_print_varspec_suffix): Likewise.
gdb/testsuite/ChangeLog:
* gdb.fortran/ptr-indentation.exp: Update expected results.
* gdb.fortran/ptype-on-functions.exp: Likewise.
* gdb.fortran/vla-ptr-info.exp: Likewise.
* gdb.fortran/vla-value.exp: Likewise.
---
gdb/ChangeLog | 6 ++++++
gdb/f-typeprint.c | 21 ++++++++++++++-------
gdb/testsuite/ChangeLog | 7 +++++++
gdb/testsuite/gdb.fortran/ptr-indentation.exp | 2 +-
gdb/testsuite/gdb.fortran/ptype-on-functions.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-value.exp | 8 ++++----
7 files changed, 34 insertions(+), 14 deletions(-)
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0a84aea84af..1183f6bf2f4 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * f-typeprint.c (f_print_type): Update rules for printing
+ whitespace.
+ (f_type_print_varspec_suffix): Likewise.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
Chris January <chris.january@arm.com>
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index c89816f7a39..64ee980aab5 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -68,13 +68,20 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
- /* Need a space if going to print stars or brackets;
- but not if we will print just a type name. */
- || ((show > 0 || TYPE_NAME (type) == 0)
- && (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
+ /* Need a space if going to print stars or brackets; but not if we
+ will print just a type name. */
+ || ((show > 0
+ || TYPE_NAME (type) == 0)
+ && (code == TYPE_CODE_FUNC
|| code == TYPE_CODE_METHOD
|| code == TYPE_CODE_ARRAY
- || code == TYPE_CODE_REF)))
+ || ((code == TYPE_CODE_PTR
+ || code == TYPE_CODE_REF)
+ && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_FUNC
+ || (TYPE_CODE (TYPE_TARGET_TYPE (type))
+ == TYPE_CODE_METHOD)
+ || (TYPE_CODE (TYPE_TARGET_TYPE (type))
+ == TYPE_CODE_ARRAY))))))
fputs_filtered (" ", stream);
f_type_print_varspec_prefix (type, stream, show, 0);
@@ -222,7 +229,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);
- fprintf_filtered (stream, ")");
+ fprintf_filtered (stream, " )");
break;
case TYPE_CODE_FUNC:
@@ -232,7 +239,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
passed_a_ptr, 0, arrayprint_recurse_level);
if (passed_a_ptr)
- fprintf_filtered (stream, ")");
+ fprintf_filtered (stream, ") ");
fprintf_filtered (stream, "(");
if (nfields == 0 && TYPE_PROTOTYPED (type))
f_print_type (builtin_f_type (get_type_arch (type))->builtin_void,
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 931ed5a348b..0dbe1ce91ef 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/ptr-indentation.exp: Update expected results.
+ * gdb.fortran/ptype-on-functions.exp: Likewise.
+ * gdb.fortran/vla-ptr-info.exp: Likewise.
+ * gdb.fortran/vla-value.exp: Likewise.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/ptype-on-functions.exp: New file.
diff --git a/gdb/testsuite/gdb.fortran/ptr-indentation.exp b/gdb/testsuite/gdb.fortran/ptr-indentation.exp
index b0eb941eaa9..0c5d2255802 100644
--- a/gdb/testsuite/gdb.fortran/ptr-indentation.exp
+++ b/gdb/testsuite/gdb.fortran/ptr-indentation.exp
@@ -37,5 +37,5 @@ gdb_continue_to_breakpoint "BP1"
gdb_test "ptype tinsta" \
[multi_line "type = Type tuserdef" \
" $int :: i" \
- " PTR TO -> \\( $real :: ptr\\)" \
+ " PTR TO -> \\( $real :: ptr \\)" \
"End Type tuserdef"]
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
index 4ce78623b47..528828663c4 100644
--- a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
@@ -42,4 +42,4 @@ gdb_test "ptype say_numbers" \
"type = void \\(integer\\(kind=4\\), integer\\(kind=4\\), integer\\(kind=4\\)\\)"
gdb_test "ptype fun_ptr" \
- "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\)\\(REF TO -> \\( integer\\(kind=4\\) \\)\\)\\)"
+ "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\) \\(REF TO -> \\( integer\\(kind=4\\) \\)\\) \\)"
diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp
index 58f3395122f..6b9625ad996 100644
--- a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp
+++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp
@@ -28,5 +28,5 @@ if ![runto_main] {
# Check the status of a pointer to a dynamic array.
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}" \
+gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) \\(10,10,10\\) \\)\\) ${hex}" \
"print pvla pointer information"
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 3582d47c946..507137bed21 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -35,7 +35,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 \\\(<not allocated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\) \\\)\\\) $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)"
@@ -56,7 +56,7 @@ with_timeout_factor 15 {
"step over value assignment of vla1"
}
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(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)"
@@ -76,7 +76,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 \\\(<not associated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(<not associated>\\\) \\\)\\\) $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)"
@@ -85,7 +85,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)"
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCH 4/8] gdb/fortran: better types for components of complex numbers
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (4 preceding siblings ...)
2019-03-18 12:52 ` [PATCH 7/8] gdb/fortran: Update rules for printing whitespace in types Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-19 20:18 ` Tom Tromey
2019-03-18 12:52 ` [PATCH 3/8] gdb/fortran: Additional builtin procedures Andrew Burgess
` (10 subsequent siblings)
16 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
When creating a complex number in Fortran, the types of the components
should use the standard Fortran type names rather than the C type
names.
Special case the DWARF parser to use more appropriate types when
creating a complex type for Fortran.
gdb/ChangeLog:
* dwarf2read.c (dwarf2_init_complex_target_type): Use different
types for Fortran.
gdb/testsuite/ChangeLog:
* gdb.fortran/complex.exp: Expand.
* gdb.fortran/complex.f: Renamed to...
* gdb.fortran/complex.f90: ...this, and extended to add more
complex values.
---
gdb/ChangeLog | 6 +++++
gdb/dwarf2read.c | 35 +++++++++++++++++++++-------
gdb/f-typeprint.c | 29 +++++++++++++++++++++++
gdb/testsuite/ChangeLog | 7 ++++++
gdb/testsuite/gdb.fortran/complex.exp | 41 +++++++++++++++++++++++++-------
gdb/testsuite/gdb.fortran/complex.f | 24 -------------------
gdb/testsuite/gdb.fortran/complex.f90 | 44 +++++++++++++++++++++++++++++++++++
7 files changed, 145 insertions(+), 41 deletions(-)
delete mode 100644 gdb/testsuite/gdb.fortran/complex.f
create mode 100644 gdb/testsuite/gdb.fortran/complex.f90
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 6fcb1c630be..51bbc6ad333 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+ Chris January <chris.january@arm.com>
+
+ * dwarf2read.c (dwarf2_init_complex_target_type): Use different
+ types for Fortran.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
Chris January <chris.january@arm.com>
David Lecomber <david.lecomber@arm.com>
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index d865ff1a2b2..f7cb7ed12f1 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17547,16 +17547,35 @@ dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
gdbarch *gdbarch = get_objfile_arch (objfile);
struct type *tt = nullptr;
- switch (bits)
+ switch (cu->language)
{
- case 32:
- tt = builtin_type (gdbarch)->builtin_float;
- break;
- case 64:
- tt = builtin_type (gdbarch)->builtin_double;
+ case language_fortran:
+ switch (bits)
+ {
+ case 32:
+ tt = builtin_f_type (gdbarch)->builtin_real;
+ break;
+ case 64:
+ tt = builtin_f_type (gdbarch)->builtin_real_s8;
+ break;
+ case 128:
+ tt = builtin_f_type (gdbarch)->builtin_real_s16;
+ break;
+ }
break;
- case 128:
- tt = builtin_type (gdbarch)->builtin_long_double;
+ default:
+ switch (bits)
+ {
+ case 32:
+ tt = builtin_type (gdbarch)->builtin_float;
+ break;
+ case 64:
+ tt = builtin_type (gdbarch)->builtin_double;
+ break;
+ case 128:
+ tt = builtin_type (gdbarch)->builtin_long_double;
+ break;
+ }
break;
}
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 2dfae5803cd..30e0c4dcda1 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -400,6 +400,35 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
fprintfi_filtered (level, stream, "module %s", TYPE_NAME (type));
break;
+ case TYPE_CODE_FLT:
+ /* In the case where the float was extracted from a complex number
+ then the component part will not have a name set. Provide a
+ suitable name here.
+
+ QUESTION: Maybe we should be forcing the type name in the DWARF
+ parser rather than fixing up the missing name at the last minute?
+ I couldn't see any precedent for such fixing up though. */
+ if (TYPE_NAME (type) != NULL)
+ fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
+ else
+ {
+ gdbarch *gdbarch = get_type_arch (type);
+ switch (TYPE_LENGTH (type))
+ {
+ case 4:
+ type = builtin_f_type (gdbarch)->builtin_real;
+ break;
+ case 8:
+ type = builtin_f_type (gdbarch)->builtin_real_s8;
+ break;
+ case 16:
+ type = builtin_f_type (gdbarch)->builtin_real_s16;
+ break;
+ }
+ fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
+ }
+ break;
+
default_case:
default:
/* Handle types not explicitly handled by the other cases,
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 31541d86374..83883cefd1e 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/complex.exp: Expand.
+ * gdb.fortran/complex.f: Renamed to...
+ * gdb.fortran/complex.f90: ...this, and extended to add more
+ complex values.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/intrinsics.exp: Extend to cover MOD, CEILING, FLOOR,
diff --git a/gdb/testsuite/gdb.fortran/complex.exp b/gdb/testsuite/gdb.fortran/complex.exp
index 3fbbf7154d9..136f1c4df79 100644
--- a/gdb/testsuite/gdb.fortran/complex.exp
+++ b/gdb/testsuite/gdb.fortran/complex.exp
@@ -13,7 +13,7 @@
# 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 .f
+standard_testfile .f90
if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90 quiet}]} {
return -1
@@ -24,13 +24,36 @@ if ![runto MAIN__] then {
continue
}
-set bp_location [gdb_get_line_number "stop"]
-gdb_test "break $bp_location" \
- "Breakpoint.*at.* file .*$srcfile, line $bp_location\\." \
- "breakpoint at stop"
-gdb_test "continue" \
- "Continuing\\..*Breakpoint.*" \
- "continue to breakpoint"
+gdb_breakpoint [gdb_get_line_number "stop"]
+gdb_continue_to_breakpoint "continue"
+
+gdb_test "print c" " = \\(1000,-50\\)"
+gdb_test "print c4" " = \\(1000,-50\\)"
+gdb_test "print c8" " = \\(321,-22\\)"
+gdb_test "print dc" " = \\(321,-22\\)"
+
+setup_kfail gdb/18644 "*-*-*"
+gdb_test "print c16" " = \\(-874,19\\)"
+
+gdb_test "whatis c" "type = complex\\(kind=4\\)"
+gdb_test "print \$_creal (c)" " = 1000"
+gdb_test "whatis \$" " = real"
+
+gdb_test "whatis c4" "type = complex\\(kind=4\\)"
+gdb_test "print \$_creal (c4)" " = 1000"
+gdb_test "whatis \$" " = real"
+
+gdb_test "whatis c8" "type = complex\\(kind=8\\)"
+gdb_test "print \$_creal (c8)" " = 321"
+gdb_test "whatis \$" " = real\\*8"
+
+gdb_test "whatis dc" "type = complex\\(kind=8\\)"
+gdb_test "print \$_creal (dc)" " = 321"
+gdb_test "whatis \$" " = real\\*8"
+
+gdb_test "whatis c16" "type = complex\\(kind=16\\)"
+setup_kfail gdb/18644 "*-*-*"
+gdb_test "print \$_creal (c16)" " = -874"
+gdb_test "whatis \$" " = real\\*16"
-gdb_test "print c" "\\\$$decimal = \\(1000,-50\\)"
diff --git a/gdb/testsuite/gdb.fortran/complex.f b/gdb/testsuite/gdb.fortran/complex.f
deleted file mode 100644
index 2f1a7879f9e..00000000000
--- a/gdb/testsuite/gdb.fortran/complex.f
+++ /dev/null
@@ -1,24 +0,0 @@
-c Copyright 2007-2019 Free Software Foundation, Inc.
-
-c This program is free software; you can redistribute it and/or modify
-c it under the terms of the GNU General Public License as published by
-c the Free Software Foundation; either version 3 of the License, or
-c (at your option) any later version.
-c
-c This program is distributed in the hope that it will be useful,
-c but WITHOUT ANY WARRANTY; without even the implied warranty of
-c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-c GNU General Public License for more details.
-c
-c You should have received a copy of the GNU General Public License
-c along with this program. If not, see <http://www.gnu.org/licenses/>.
-
- real*8 a,b
- complex*16 c
-
- a = 1000
- b = -50
- c = cmplx(a,b)
- write(*,*) s
- stop
- end
diff --git a/gdb/testsuite/gdb.fortran/complex.f90 b/gdb/testsuite/gdb.fortran/complex.f90
new file mode 100644
index 00000000000..2b88c1ee0bb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/complex.f90
@@ -0,0 +1,44 @@
+! Copyright 2007-2019 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 test_complex
+ real*4 r4a, r4b
+ real*8 r8a, r8b
+ real*16 r16a, r16b
+
+ complex c
+ complex(kind=4) c4
+ complex(kind=8) c8
+ double complex dc
+ complex(kind=16) c16
+
+ r4a = 1000
+ r4b = -50
+ r8a = 321
+ r8b = -22
+ r16a = -874
+ r16b = 19
+
+ c = cmplx(r4a,r4b)
+ c4 = cmplx(r4a,r4b)
+ c8 = cmplx(r8a, r8b)
+ dc = cmplx(r8a, r8b)
+ c16 = cmplx(r16a, r16b)
+
+ print *, c, c4, c8, dc, c16 ! stop
+ print *, r4a, r4b
+ print *, r8a, r8b
+ print *, r16a, r16b
+end program test_complex
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: [PATCH 4/8] gdb/fortran: better types for components of complex numbers
2019-03-18 12:52 ` [PATCH 4/8] gdb/fortran: better types for components of complex numbers Andrew Burgess
@ 2019-03-19 20:18 ` Tom Tromey
0 siblings, 0 replies; 34+ messages in thread
From: Tom Tromey @ 2019-03-19 20:18 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard Bunt
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> + case TYPE_CODE_FLT:
Andrew> + /* In the case where the float was extracted from a complex number
Andrew> + then the component part will not have a name set. Provide a
Andrew> + suitable name here.
Andrew> +
Andrew> + QUESTION: Maybe we should be forcing the type name in the DWARF
Andrew> + parser rather than fixing up the missing name at the last minute?
Andrew> + I couldn't see any precedent for such fixing up though. */
I think that would be fine to do. Are the types nameless right now? Or
does the compiler emit the incorrect name?
Tom
^ permalink raw reply [flat|nested] 34+ messages in thread
* [PATCH 3/8] gdb/fortran: Additional builtin procedures
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (5 preceding siblings ...)
2019-03-18 12:52 ` [PATCH 4/8] gdb/fortran: better types for components of complex numbers Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-19 20:06 ` Tom Tromey
2019-03-18 12:52 ` [PATCH 6/8] gdb/fortran: print function arguments when printing function type Andrew Burgess
` (9 subsequent siblings)
16 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
Add some additional builtin procedures for Fortran.
gdb/ChangeLog:
* f-exp.y (BINOP_INTRINSIC): New token.
(exp): New parser rule handling BINOP_INTRINSIC.
(f77_keywords): Add new builtin procedures.
* f-lang.c (evaluate_subexp_f): Handle BINOP_MOD, UNOP_CEILING,
UNOP_FLOOR, BINOP_MODULE, BINOP_CMPLX.
* std-operator.def: Add UNOP_CEILING, UNOP_FLOOR, BINOP_MODULE,
BINOP_CMPLX
gdb/testsuite/ChangeLog:
* gdb.fortran/intrinsics.exp: Extend to cover MOD, CEILING, FLOOR,
MODULO, CMPLX.
---
gdb/ChangeLog | 12 ++++
gdb/f-exp.y | 13 +++-
gdb/f-lang.c | 111 ++++++++++++++++++++++++++++++-
gdb/std-operator.def | 6 ++
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.fortran/intrinsics.exp | 35 ++++++++++
6 files changed, 179 insertions(+), 3 deletions(-)
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 51863b21dc6..6fcb1c630be 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,15 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+ Chris January <chris.january@arm.com>
+ David Lecomber <david.lecomber@arm.com>
+
+ * f-exp.y (BINOP_INTRINSIC): New token.
+ (exp): New parser rule handling BINOP_INTRINSIC.
+ (f77_keywords): Add new builtin procedures.
+ * f-lang.c (evaluate_subexp_f): Handle BINOP_MOD, UNOP_CEILING,
+ UNOP_FLOOR, BINOP_MODULE, BINOP_CMPLX.
+ * std-operator.def: Add UNOP_CEILING, UNOP_FLOOR, BINOP_MODULE,
+ BINOP_CMPLX
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* eval.c (evaluate_subexp_standard): Handle internal functions
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 7e838b0a93a..6a26dd2249b 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -168,7 +168,7 @@ static int parse_number (struct parser_state *, const char *, int,
%token <voidval> DOLLAR_VARIABLE
%token <opcode> ASSIGN_MODIFY
-%token <opcode> UNOP_INTRINSIC
+%token <opcode> UNOP_INTRINSIC BINOP_INTRINSIC
%left ','
%left ABOVE_COMMA
@@ -257,6 +257,10 @@ exp : UNOP_INTRINSIC '(' exp ')'
{ write_exp_elt_opcode (pstate, $1); }
;
+exp : BINOP_INTRINSIC '(' exp ',' exp ')'
+ { write_exp_elt_opcode (pstate, $1); }
+ ;
+
arglist :
;
@@ -953,7 +957,12 @@ static const struct token f77_keywords[] =
/* The following correspond to actual functions in Fortran and are case
insensitive. */
{ "kind", KIND, BINOP_END, false },
- { "abs", UNOP_INTRINSIC, UNOP_ABS, false }
+ { "abs", UNOP_INTRINSIC, UNOP_ABS, false },
+ { "mod", BINOP_INTRINSIC, BINOP_MOD, false },
+ { "floor", UNOP_INTRINSIC, UNOP_FLOOR, false },
+ { "ceiling", UNOP_INTRINSIC, UNOP_CEILING, false },
+ { "modulo", BINOP_INTRINSIC, BINOP_MODULO, false },
+ { "cmplx", BINOP_INTRINSIC, BINOP_CMPLX, false },
};
/* Implementation of a dynamically expandable buffer for processing input
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 7bd119690b4..dd31b42ccd0 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -246,7 +246,7 @@ struct value *
evaluate_subexp_f (struct type *expect_type, struct expression *exp,
int *pos, enum noside noside)
{
- struct value *arg1 = NULL;
+ struct value *arg1 = NULL, *arg2 = NULL;
enum exp_opcode op;
int pc;
struct type *type;
@@ -284,6 +284,115 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
}
error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type));
+ case BINOP_MOD:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE (value_type (arg2)))
+ error (_("non-matching types for parameters to MOD ()"));
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_FLT:
+ {
+ double d1
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ double d2
+ = target_float_to_host_double (value_contents (arg2),
+ value_type (arg2));
+ double d3 = fmod (d1, d2);
+ return value_from_host_double (type, d3);
+ }
+ case TYPE_CODE_INT:
+ {
+ LONGEST v1 = value_as_long (arg1);
+ LONGEST v2 = value_as_long (arg2);
+ if (v2 == 0)
+ error (_("calling MOD (N, 0) is undefined"));
+ LONGEST v3 = v1 - (v1 / v2) * v2;
+ return value_from_longest (value_type (arg1), v3);
+ }
+ }
+ error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type));
+
+ case UNOP_CEILING:
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE_FLT)
+ error (_("argument to CEILING must be of type float"));
+ double val
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ val = ceil (val);
+ return value_from_host_double (type, val);
+ }
+
+ case UNOP_FLOOR:
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE_FLT)
+ error (_("argument to FLOOR must be of type float"));
+ double val
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ val = floor (val);
+ return value_from_host_double (type, val);
+ }
+
+ case BINOP_MODULO:
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE (value_type (arg2)))
+ error (_("non-matching types for parameters to MODULO ()"));
+ /* MODULO(A, P) = A - FLOOR (A / P) * P */
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_INT:
+ {
+ LONGEST a = value_as_long (arg1);
+ LONGEST p = value_as_long (arg2);
+ LONGEST result = a - (a / p) * p;
+ if (result != 0 && (a < 0) != (p < 0))
+ result += p;
+ return value_from_longest (value_type (arg1), result);
+ }
+ case TYPE_CODE_FLT:
+ {
+ double a
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ double p
+ = target_float_to_host_double (value_contents (arg2),
+ value_type (arg2));
+ double result = fmod (a, p);
+ if (result != 0 && (a < 0.0) != (p < 0.0))
+ result += p;
+ return value_from_host_double (type, result);
+ }
+ }
+ error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type));
+ }
+
+ case BINOP_CMPLX:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = builtin_f_type(exp->gdbarch)->builtin_complex_s16;
+ return value_literal_complex (arg1, arg2, type);
+
case UNOP_KIND:
arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
type = value_type (arg1);
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index e26861bd131..15d3140c47e 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -54,6 +54,9 @@ OP (BINOP_EXP) /* Exponentiation */
OP (BINOP_MIN) /* <? */
OP (BINOP_MAX) /* >? */
+OP (BINOP_CMPLX) /* Fortran builtin. */
+OP (BINOP_MODULO) /* Fortran builtin. */
+
/* STRUCTOP_MEMBER is used for pointer-to-member constructs.
X . * Y translates into X STRUCTOP_MEMBER Y. */
OP (STRUCTOP_MEMBER)
@@ -250,6 +253,9 @@ OP (UNOP_MIN)
OP (UNOP_ODD)
OP (UNOP_TRUNC)
+OP (UNOP_FLOOR) /* Fortran builtin. */
+OP (UNOP_CEILING) /* Fortran builtin. */
+
OP (OP_BOOL) /* Modula-2 builtin BOOLEAN type */
OP (OP_M2_STRING) /* Modula-2 string constants */
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 6094d773163..31541d86374 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/intrinsics.exp: Extend to cover MOD, CEILING, FLOOR,
+ MODULO, CMPLX.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.python/py-function.exp: Check calling helper function from
diff --git a/gdb/testsuite/gdb.fortran/intrinsics.exp b/gdb/testsuite/gdb.fortran/intrinsics.exp
index 00396c74c2f..64d9e56daab 100644
--- a/gdb/testsuite/gdb.fortran/intrinsics.exp
+++ b/gdb/testsuite/gdb.fortran/intrinsics.exp
@@ -49,3 +49,38 @@ gdb_test "p abs (11)" " = 11"
# rounding, which can vary.
gdb_test "p abs (-9.1)" " = 9.$decimal"
gdb_test "p abs (9.1)" " = 9.$decimal"
+
+# Test MOD
+
+gdb_test "p mod (3.0, 2.0)" " = 1"
+gdb_test "ptype mod (3.0, 2.0)" "type = real\\*8"
+gdb_test "p mod (2.0, 3.0)" " = 2"
+gdb_test "p mod (8, 5)" " = 3"
+gdb_test "ptype mod (8, 5)" "type = int"
+gdb_test "p mod (-8, 5)" " = -3"
+gdb_test "p mod (8, -5)" " = 3"
+gdb_test "p mod (-8, -5)" " = -3"
+
+# Test CEILING
+
+gdb_test "p ceiling (3.7)" " = 4"
+gdb_test "p ceiling (-3.7)" " = -3"
+
+# Test FLOOR
+
+gdb_test "p floor (3.7)" " = 3"
+gdb_test "p floor (-3.7)" " = -4"
+
+# Test MODULO
+
+gdb_test "p MODULO (8,5)" " = 3"
+gdb_test "ptype MODULO (8,5)" "type = int"
+gdb_test "p MODULO (-8,5)" " = 2"
+gdb_test "p MODULO (8,-5)" " = -2"
+gdb_test "p MODULO (-8,-5)" " = -3"
+gdb_test "p MODULO (3.0,2.0)" " = 1"
+gdb_test "ptype MODULO (3.0,2.0)" "type = real\\*8"
+
+# Test CMPLX
+
+gdb_test "p CMPLX (4.1, 2.0)" " = \\(4.$decimal,2\\)"
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: [PATCH 3/8] gdb/fortran: Additional builtin procedures
2019-03-18 12:52 ` [PATCH 3/8] gdb/fortran: Additional builtin procedures Andrew Burgess
@ 2019-03-19 20:06 ` Tom Tromey
0 siblings, 0 replies; 34+ messages in thread
From: Tom Tromey @ 2019-03-19 20:06 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard Bunt
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> * f-lang.c (evaluate_subexp_f): Handle BINOP_MOD, UNOP_CEILING,
Andrew> UNOP_FLOOR, BINOP_MODULE, BINOP_CMPLX.
I think MODULE should be MODULO here.
Andrew> + { "mod", BINOP_INTRINSIC, BINOP_MOD, false },
...
Andrew> + { "modulo", BINOP_INTRINSIC, BINOP_MODULO, false },
... however, it seems confusing to have both BINOP_MOD and BINOP_MODULO.
Maybe the new one could mention Fortran somehow?
Tom
^ permalink raw reply [flat|nested] 34+ messages in thread
* [PATCH 6/8] gdb/fortran: print function arguments when printing function type
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (6 preceding siblings ...)
2019-03-18 12:52 ` [PATCH 3/8] gdb/fortran: Additional builtin procedures Andrew Burgess
@ 2019-03-18 12:52 ` Andrew Burgess
2019-03-19 20:27 ` [PATCH 0/8] Series of Fortran type printing patches Tom Tromey
` (8 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-03-18 12:52 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
gdb/ChangeLog:
* f-typeprint.c (f_type_print_varspec_suffix): Handle printing
function arguments.
gdb/testsuite/ChangeLog:
* gdb.fortran/ptype-on-functions.exp: New file.
* gdb.fortran/ptype-on-functions.f90: New file.
---
gdb/ChangeLog | 6 ++
gdb/f-typeprint.c | 27 +++++++--
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp | 2 +-
gdb/testsuite/gdb.fortran/ptype-on-functions.exp | 45 ++++++++++++++
gdb/testsuite/gdb.fortran/ptype-on-functions.f90 | 74 +++++++++++++++++++++++
6 files changed, 153 insertions(+), 6 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/ptype-on-functions.exp
create mode 100644 gdb/testsuite/gdb.fortran/ptype-on-functions.f90
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index d8f752f6808..0a84aea84af 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+ Chris January <chris.january@arm.com>
+
+ * f-typeprint.c (f_type_print_varspec_suffix): Handle printing
+ function arguments.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* f-lang.c (build_fortran_types): Change name of void type to
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 7e36ca16c69..c89816f7a39 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -226,12 +226,29 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
break;
case TYPE_CODE_FUNC:
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
- passed_a_ptr, 0, arrayprint_recurse_level);
- if (passed_a_ptr)
- fprintf_filtered (stream, ")");
+ {
+ int i, nfields = TYPE_NFIELDS (type);
- fprintf_filtered (stream, "()");
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+ passed_a_ptr, 0, arrayprint_recurse_level);
+ if (passed_a_ptr)
+ fprintf_filtered (stream, ")");
+ fprintf_filtered (stream, "(");
+ if (nfields == 0 && TYPE_PROTOTYPED (type))
+ f_print_type (builtin_f_type (get_type_arch (type))->builtin_void,
+ "", stream, -1, 0, 0);
+ else
+ for (i = 0; i < nfields; i++)
+ {
+ if (i > 0)
+ {
+ fputs_filtered (", ", stream);
+ wrap_here (" ");
+ }
+ f_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, 0);
+ }
+ fprintf_filtered (stream, ")");
+ }
break;
case TYPE_CODE_UNDEF:
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 3cdc3cfa6fc..931ed5a348b 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/ptype-on-functions.exp: New file.
+ * gdb.fortran/ptype-on-functions.f90: New file.
+
2019-03-18 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/exprs.exp (test_convenience_variables): Expect lower
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp b/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
index 2824e16bf34..ce24854a35b 100644
--- a/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
+++ b/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
@@ -45,7 +45,7 @@ gdb_test "set case-sensitive off" {warning: the current case sensitivity setting
# Note that info functions gives the FUNC_lang result using the fortran syntax
# as specified in dw-case-insensitive-debug.S DW_AT_language.
gdb_test "info functions fUnC_lang" \
- "All functions matching regular expression \"fUnC_lang\":\[\r\n\]+File file1.txt:\r\n\tfoo FUNC_lang\\(\\);(\r\n\r\nNon-debugging symbols:\r\n0x\[0-9a-f\]+ +\\.FUNC_lang)?" \
+ "All functions matching regular expression \"fUnC_lang\":\[\r\n\]+File file1.txt:\r\n\tfoo FUNC_lang\\(void\\);(\r\n\r\nNon-debugging symbols:\r\n0x\[0-9a-f\]+ +\\.FUNC_lang)?" \
"regexp case-sensitive off"
gdb_test "p fuNC_lang" { = {foo \(void\)} 0x[0-9a-f]+ <FUNC_lang>}
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
new file mode 100644
index 00000000000..4ce78623b47
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
@@ -0,0 +1,45 @@
+# Copyright 2019 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/>.
+
+# This file contains a test for printing the types of functions.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f90
+load_lib "fortran.exp"
+
+if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}]} {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_test "ptype some_module::get_number" \
+ "type = integer\\(kind=4\\) \\(Type __class_some_module_Number_t\\)"
+
+gdb_test "ptype some_module::set_number" \
+ "type = void \\(Type __class_some_module_Number_t, integer\\(kind=4\\)\\)"
+
+gdb_test "ptype is_bigger" \
+ "type = logical\\(kind=4\\) \\(integer\\(kind=4\\), integer\\(kind=4\\)\\)"
+
+gdb_test "ptype say_numbers" \
+ "type = void \\(integer\\(kind=4\\), integer\\(kind=4\\), integer\\(kind=4\\)\\)"
+
+gdb_test "ptype fun_ptr" \
+ "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\)\\(REF TO -> \\( integer\\(kind=4\\) \\)\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.f90 b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
new file mode 100644
index 00000000000..bb8e0a6f825
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
@@ -0,0 +1,74 @@
+module some_module
+ implicit none
+
+ type, public :: Number
+ integer :: a
+ contains
+ procedure :: get => get_number
+ procedure :: set => set_number
+ end type Number
+
+contains
+
+ function get_number (this) result (val)
+ class (Number), intent (in) :: this
+ integer :: val
+ val = this%a
+ end function get_number
+
+ subroutine set_number (this, val)
+ class (Number), intent (inout) :: this
+ integer :: val
+ this%a = val
+ end subroutine set_number
+
+end module some_module
+
+logical function is_bigger (a,b)
+ integer, intent(in) :: a
+ integer, intent(in) :: b
+ is_bigger = a > b
+end function is_bigger
+
+subroutine say_numbers (v1,v2,v3)
+ integer,intent(in) :: v1
+ integer,intent(in) :: v2
+ integer,intent(in) :: v3
+ print *, v1,v2,v3
+end subroutine say_numbers
+
+program test
+ use some_module
+
+ interface
+ integer function fun1 (x)
+ integer :: x
+ end function fun1
+
+ integer function fun2 (x)
+ integer :: x
+ end function fun2
+ end interface
+
+ type (Number) :: n1
+ type (Number) :: n2
+
+ procedure(fun1), pointer:: fun_ptr => NULL()
+
+ call say_numbers (1,2,3) ! stop here
+ print *, fun_ptr (3)
+
+end program test
+
+integer function fun1 (x)
+ implicit none
+ integer :: x
+ fun1 = x + 1
+end function fun1
+
+integer function fun2 (x)
+ implicit none
+ integer :: x
+ fun2 = x + 2
+end function fun2
+
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* Re: [PATCH 0/8] Series of Fortran type printing patches
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (7 preceding siblings ...)
2019-03-18 12:52 ` [PATCH 6/8] gdb/fortran: print function arguments when printing function type Andrew Burgess
@ 2019-03-19 20:27 ` Tom Tromey
2019-04-02 23:58 ` [PATCHv2 1/8] gdb: Remove an unbalanced stray double quote from a comment Andrew Burgess
` (7 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Tom Tromey @ 2019-03-19 20:27 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard Bunt
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> The first patch is not Fortran at all, but is required to test later
Andrew> patches.
Andrew> The rest mostly relate to type printing, except #3 which adds some
Andrew> more Fortran builtin procedures.
I read through these. I don't know Fortran, so I limited my comments to
just gdb things. Overall it seems good to me. Thank you for doing
this, the Fortran support can use the attention.
Tom
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCHv2 1/8] gdb: Remove an unbalanced stray double quote from a comment
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (8 preceding siblings ...)
2019-03-19 20:27 ` [PATCH 0/8] Series of Fortran type printing patches Tom Tromey
@ 2019-04-02 23:58 ` Andrew Burgess
2019-04-02 23:58 ` [PATCHv2 3/8] gdb/fortran: Additional builtin procedures Andrew Burgess
` (6 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:58 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
What appears to be a stray double quote character in std-operator.def
causes incorrect highlighting in my editor.
The quote was introduced in this commit:
commit 858be34c5a03bb8973679ebf00d360182434dc00
Date: Mon Sep 4 20:21:15 2017 +0100
Handle "p S::method()::static_var" in the C++ parser
I can't see any reason why the quote should be there, so this commit
removes it.
gdb/ChangeLog:
* std-operator.def: Remove unbalanced, stray double quote
character.
---
gdb/ChangeLog | 5 +++++
gdb/std-operator.def | 2 +-
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index e26861bd131..001ae61e481 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -300,7 +300,7 @@ OP (OP_SCOPE)
p 'S:method() const'::var
then the C-specific handling directly in the parser takes over (see
- "block/variable productions).
+ block/variable productions).
Also, if the whole function+var is quoted like this:
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCHv2 3/8] gdb/fortran: Additional builtin procedures
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (9 preceding siblings ...)
2019-04-02 23:58 ` [PATCHv2 1/8] gdb: Remove an unbalanced stray double quote from a comment Andrew Burgess
@ 2019-04-02 23:58 ` Andrew Burgess
2019-04-02 23:58 ` [PATCHv2 2/8] gdb/fortran: Introduce fortran-operator.def file Andrew Burgess
` (5 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:58 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
Add some additional builtin procedures for Fortran, these are MOD,
CEILING, FLOOR, MODULO, and CMPLX.
gdb/ChangeLog:
* f-exp.y (BINOP_INTRINSIC): New token.
(exp): New parser rule handling BINOP_INTRINSIC.
(f77_keywords): Add new builtin procedures.
* f-lang.c (evaluate_subexp_f): Handle BINOP_MOD, UNOP_FORTRAN_CEILING,
UNOP_FORTRAN_FLOOR, BINOP_FORTRAN_MODULO, BINOP_FORTRAN_CMPLX.
(operator_length_f): Handle UNOP_FORTRAN_CEILING,
UNOP_FORTRAN_FLOOR, BINOP_FORTRAN_MODULO, BINOP_FORTRAN_CMPLX.
(print_unop_subexp_f): New function.
(print_binop_subexp_f): New function.
(print_subexp_f): Handle UNOP_FORTRAN_CEILING, UNOP_FORTRAN_FLOOR,
BINOP_FORTRAN_MODULO, BINOP_FORTRAN_CMPLX.
(dump_subexp_body_f): Likewise.
(operator_check_f): Likewise.
* fortran-operator.def: Add UNOP_FORTRAN_CEILING, UNOP_FORTRAN_FLOOR,
BINOP_FORTRAN_MODULO, BINOP_FORTRAN_CMPLX
gdb/testsuite/ChangeLog:
* gdb.fortran/intrinsics.exp: Extend to cover MOD, CEILING, FLOOR,
MODULO, CMPLX.
---
gdb/ChangeLog | 20 ++++
gdb/f-exp.y | 13 ++-
gdb/f-lang.c | 178 ++++++++++++++++++++++++++++++-
gdb/fortran-operator.def | 5 +
gdb/testsuite/ChangeLog | 5 +
gdb/testsuite/gdb.fortran/intrinsics.exp | 35 ++++++
6 files changed, 249 insertions(+), 7 deletions(-)
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 06851a0aa7c..32427aede75 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -167,7 +167,7 @@ static int parse_number (struct parser_state *, const char *, int,
%token <voidval> DOLLAR_VARIABLE
%token <opcode> ASSIGN_MODIFY
-%token <opcode> UNOP_INTRINSIC
+%token <opcode> UNOP_INTRINSIC BINOP_INTRINSIC
%left ','
%left ABOVE_COMMA
@@ -256,6 +256,10 @@ exp : UNOP_INTRINSIC '(' exp ')'
{ write_exp_elt_opcode (pstate, $1); }
;
+exp : BINOP_INTRINSIC '(' exp ',' exp ')'
+ { write_exp_elt_opcode (pstate, $1); }
+ ;
+
arglist :
;
@@ -952,7 +956,12 @@ static const struct token f77_keywords[] =
/* The following correspond to actual functions in Fortran and are case
insensitive. */
{ "kind", KIND, BINOP_END, false },
- { "abs", UNOP_INTRINSIC, UNOP_ABS, false }
+ { "abs", UNOP_INTRINSIC, UNOP_ABS, false },
+ { "mod", BINOP_INTRINSIC, BINOP_MOD, false },
+ { "floor", UNOP_INTRINSIC, UNOP_FORTRAN_FLOOR, false },
+ { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false },
+ { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false },
+ { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false },
};
/* Implementation of a dynamically expandable buffer for processing input
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 91bf73b800a..5eeb7dba6e5 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -246,7 +246,7 @@ struct value *
evaluate_subexp_f (struct type *expect_type, struct expression *exp,
int *pos, enum noside noside)
{
- struct value *arg1 = NULL;
+ struct value *arg1 = NULL, *arg2 = NULL;
enum exp_opcode op;
int pc;
struct type *type;
@@ -284,6 +284,115 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
}
error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type));
+ case BINOP_MOD:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE (value_type (arg2)))
+ error (_("non-matching types for parameters to MOD ()"));
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_FLT:
+ {
+ double d1
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ double d2
+ = target_float_to_host_double (value_contents (arg2),
+ value_type (arg2));
+ double d3 = fmod (d1, d2);
+ return value_from_host_double (type, d3);
+ }
+ case TYPE_CODE_INT:
+ {
+ LONGEST v1 = value_as_long (arg1);
+ LONGEST v2 = value_as_long (arg2);
+ if (v2 == 0)
+ error (_("calling MOD (N, 0) is undefined"));
+ LONGEST v3 = v1 - (v1 / v2) * v2;
+ return value_from_longest (value_type (arg1), v3);
+ }
+ }
+ error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type));
+
+ case UNOP_FORTRAN_CEILING:
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE_FLT)
+ error (_("argument to CEILING must be of type float"));
+ double val
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ val = ceil (val);
+ return value_from_host_double (type, val);
+ }
+
+ case UNOP_FORTRAN_FLOOR:
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE_FLT)
+ error (_("argument to FLOOR must be of type float"));
+ double val
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ val = floor (val);
+ return value_from_host_double (type, val);
+ }
+
+ case BINOP_FORTRAN_MODULO:
+ {
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (TYPE_CODE (type) != TYPE_CODE (value_type (arg2)))
+ error (_("non-matching types for parameters to MODULO ()"));
+ /* MODULO(A, P) = A - FLOOR (A / P) * P */
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_INT:
+ {
+ LONGEST a = value_as_long (arg1);
+ LONGEST p = value_as_long (arg2);
+ LONGEST result = a - (a / p) * p;
+ if (result != 0 && (a < 0) != (p < 0))
+ result += p;
+ return value_from_longest (value_type (arg1), result);
+ }
+ case TYPE_CODE_FLT:
+ {
+ double a
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ double p
+ = target_float_to_host_double (value_contents (arg2),
+ value_type (arg2));
+ double result = fmod (a, p);
+ if (result != 0 && (a < 0.0) != (p < 0.0))
+ result += p;
+ return value_from_host_double (type, result);
+ }
+ }
+ error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type));
+ }
+
+ case BINOP_FORTRAN_CMPLX:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = builtin_f_type(exp->gdbarch)->builtin_complex_s16;
+ return value_literal_complex (arg1, arg2, type);
+
case UNOP_FORTRAN_KIND:
arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
type = value_type (arg1);
@@ -323,15 +432,53 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
return;
case UNOP_FORTRAN_KIND:
+ case UNOP_FORTRAN_FLOOR:
+ case UNOP_FORTRAN_CEILING:
oplen = 1;
args = 1;
break;
+
+ case BINOP_FORTRAN_CMPLX:
+ case BINOP_FORTRAN_MODULO:
+ oplen = 1;
+ args = 2;
+ break;
}
*oplenp = oplen;
*argsp = args;
}
+/* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
+ the extra argument NAME which is the text that should be printed as the
+ name of this operation. */
+static void
+print_unop_subexp_f (struct expression *exp, int *pos,
+ struct ui_file *stream, enum precedence prec,
+ const char *name)
+{
+ (*pos)++;
+ fprintf_filtered (stream, "%s(", name);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (")", stream);
+}
+
+/* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
+ the extra argument NAME which is the text that should be printed as the
+ name of this operation. */
+static void
+print_binop_subexp_f (struct expression *exp, int *pos,
+ struct ui_file *stream, enum precedence prec,
+ const char *name)
+{
+ (*pos)++;
+ fprintf_filtered (stream, "%s(", name);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (",", stream);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (")", stream);
+}
+
/* Special expression printing for Fortran. */
static void
print_subexp_f (struct expression *exp, int *pos,
@@ -347,10 +494,23 @@ print_subexp_f (struct expression *exp, int *pos,
return;
case UNOP_FORTRAN_KIND:
- (*pos)++;
- fputs_filtered ("KIND(", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (")", stream);
+ print_unop_subexp_f (exp, pos, stream, prec, "KIND");
+ return;
+
+ case UNOP_FORTRAN_FLOOR:
+ print_unop_subexp_f (exp, pos, stream, prec, "FLOOR");
+ return;
+
+ case UNOP_FORTRAN_CEILING:
+ print_unop_subexp_f (exp, pos, stream, prec, "CEILING");
+ return;
+
+ case BINOP_FORTRAN_CMPLX:
+ print_binop_subexp_f (exp, pos, stream, prec, "CMPLX");
+ return;
+
+ case BINOP_FORTRAN_MODULO:
+ print_binop_subexp_f (exp, pos, stream, prec, "MODULO");
return;
}
}
@@ -386,6 +546,10 @@ dump_subexp_body_f (struct expression *exp,
return dump_subexp_body_standard (exp, stream, elt);
case UNOP_FORTRAN_KIND:
+ case UNOP_FORTRAN_FLOOR:
+ case UNOP_FORTRAN_CEILING:
+ case BINOP_FORTRAN_CMPLX:
+ case BINOP_FORTRAN_MODULO:
operator_length_f (exp, (elt + 1), &oplen, &nargs);
break;
}
@@ -409,6 +573,10 @@ operator_check_f (struct expression *exp, int pos,
switch (elts[pos].opcode)
{
case UNOP_FORTRAN_KIND:
+ case UNOP_FORTRAN_FLOOR:
+ case UNOP_FORTRAN_CEILING:
+ case BINOP_FORTRAN_CMPLX:
+ case BINOP_FORTRAN_MODULO:
/* Any references to objfiles are held in the arguments to this
expression, not within the expression itself, so no additional
checking is required here, the outer expression iteration code
diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def
index c3176de428e..cb40108aa83 100644
--- a/gdb/fortran-operator.def
+++ b/gdb/fortran-operator.def
@@ -19,4 +19,9 @@
/* Single operand builtins. */
OP (UNOP_FORTRAN_KIND)
+OP (UNOP_FORTRAN_FLOOR)
+OP (UNOP_FORTRAN_CEILING)
+/* Two operand builtins. */
+OP (BINOP_FORTRAN_CMPLX)
+OP (BINOP_FORTRAN_MODULO)
diff --git a/gdb/testsuite/gdb.fortran/intrinsics.exp b/gdb/testsuite/gdb.fortran/intrinsics.exp
index 00396c74c2f..64d9e56daab 100644
--- a/gdb/testsuite/gdb.fortran/intrinsics.exp
+++ b/gdb/testsuite/gdb.fortran/intrinsics.exp
@@ -49,3 +49,38 @@ gdb_test "p abs (11)" " = 11"
# rounding, which can vary.
gdb_test "p abs (-9.1)" " = 9.$decimal"
gdb_test "p abs (9.1)" " = 9.$decimal"
+
+# Test MOD
+
+gdb_test "p mod (3.0, 2.0)" " = 1"
+gdb_test "ptype mod (3.0, 2.0)" "type = real\\*8"
+gdb_test "p mod (2.0, 3.0)" " = 2"
+gdb_test "p mod (8, 5)" " = 3"
+gdb_test "ptype mod (8, 5)" "type = int"
+gdb_test "p mod (-8, 5)" " = -3"
+gdb_test "p mod (8, -5)" " = 3"
+gdb_test "p mod (-8, -5)" " = -3"
+
+# Test CEILING
+
+gdb_test "p ceiling (3.7)" " = 4"
+gdb_test "p ceiling (-3.7)" " = -3"
+
+# Test FLOOR
+
+gdb_test "p floor (3.7)" " = 3"
+gdb_test "p floor (-3.7)" " = -4"
+
+# Test MODULO
+
+gdb_test "p MODULO (8,5)" " = 3"
+gdb_test "ptype MODULO (8,5)" "type = int"
+gdb_test "p MODULO (-8,5)" " = 2"
+gdb_test "p MODULO (8,-5)" " = -2"
+gdb_test "p MODULO (-8,-5)" " = -3"
+gdb_test "p MODULO (3.0,2.0)" " = 1"
+gdb_test "ptype MODULO (3.0,2.0)" "type = real\\*8"
+
+# Test CMPLX
+
+gdb_test "p CMPLX (4.1, 2.0)" " = \\(4.$decimal,2\\)"
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCHv2 2/8] gdb/fortran: Introduce fortran-operator.def file
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (10 preceding siblings ...)
2019-04-02 23:58 ` [PATCHv2 3/8] gdb/fortran: Additional builtin procedures Andrew Burgess
@ 2019-04-02 23:58 ` Andrew Burgess
2019-04-02 23:59 ` [PATCHv2 8/8] gdb/fortran: Add allocatable type qualifier Andrew Burgess
` (4 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:58 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
Future commits will add more Fortran specific expression operators.
In preparation for these new operators, this commit adds a new
fortran-operator.def file similar to how GDB already has
ada-operator.def.
I've moved UNOP_KIND the Fortran specific operator I introduced in
commit 4d00f5d8f6c4 into this file, and renamed it to make it clearer
that the operator is Fortran specific. I've then updated the Fortran
exp_descriptor table (exp_descriptor_f) to use entirely Fortran
specific functions that now handle UNOP_FORTRAN_KIND (the new name for
UNOP_KIND).
There should be no visible changes for standard users after this
commit, though for developers, the output when 'set debug expression
1' is now better, before:
(gdb) p kind (l1)
Dump of expression @ 0x2ccc7a0, before conversion to prefix form:
Language fortran, 5 elements, 16 bytes each.
Index Opcode Hex Value String Value
0 OP_VAR_VALUE 42 *...............
1 OP_NULL 47730176 .N..............
2 BINOP_INTDIV 47729184 J..............
3 OP_VAR_VALUE 42 *...............
4 UNOP_KIND 78 N...............
Dump of expression @ 0x2ccc7a0, after conversion to prefix form:
Expression: `Invalid expression
(gdb)
and after:
(gdb) p kind (l1)
Dump of expression @ 0x294d0b0, before conversion to prefix form:
Language fortran, 5 elements, 16 bytes each.
Index Opcode Hex Value String Value
0 OP_VAR_VALUE 40 (...............
1 unknown opcode: 224 44088544 ................
2 unknown opcode: 208 44087504 ................
3 OP_VAR_VALUE 40 (...............
4 UNOP_FORTRAN_KIND 119 w...............
Dump of expression @ 0x294d0b0, after conversion to prefix form:
Expression: `KIND(test::l1)'
Language fortran, 5 elements, 16 bytes each.
0 UNOP_FORTRAN_KIND
1 OP_VAR_VALUE Block @0x2a0bce0, symbol @0x2a0b8d0 (l1)
$1 = 1
(gdb)
gdb/ChangeLog:
* gdb/expprint.c (dump_subexp_body_standard): Remove use of
UNOP_KIND.
* gdb/expression.h (exp_opcode): Include 'fortran-operator.def'.
* gdb/f-exp.y (exp): Rename UNOP_KIND to UNOP_FORTRAN_KIND.
* gdb/f-lang.c (evaluate_subexp_f): Likewise.
(operator_length_f): New fuction.
(print_subexp_f): New function.
(op_name_f): New function.
(dump_subexp_body_f): New function.
(operator_check_f): New function.
(exp_descriptor_f): Replace standard expression handling functions
with new functions.
* gdb/fortran-operator.def: New file.
* gdb/parse.c (operator_length_standard): Remove use of UNOP_KIND.
* gdb/std-operator.def: Remove UNOP_KIND.
---
gdb/ChangeLog | 18 +++++++
gdb/expprint.c | 1 -
gdb/expression.h | 1 +
gdb/f-exp.y | 2 +-
gdb/f-lang.c | 126 ++++++++++++++++++++++++++++++++++++++++++++---
gdb/fortran-operator.def | 22 +++++++++
gdb/parse.c | 1 -
gdb/std-operator.def | 1 -
8 files changed, 162 insertions(+), 10 deletions(-)
create mode 100644 gdb/fortran-operator.def
diff --git a/gdb/expprint.c b/gdb/expprint.c
index a22499f4833..d7ad1a71878 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -869,7 +869,6 @@ dump_subexp_body_standard (struct expression *exp,
case UNOP_MIN:
case UNOP_ODD:
case UNOP_TRUNC:
- case UNOP_KIND:
elt = dump_subexp (exp, stream, elt);
break;
case OP_LONG:
diff --git a/gdb/expression.h b/gdb/expression.h
index 8db4b9d7e26..beb8aad92b2 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -66,6 +66,7 @@ enum exp_opcode : uint8_t
/* Language specific operators. */
#include "ada-operator.def"
+#include "fortran-operator.def"
#undef OP
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index f99c26d326e..06851a0aa7c 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -233,7 +233,7 @@ exp : SIZEOF exp %prec UNARY
;
exp : KIND '(' exp ')' %prec UNARY
- { write_exp_elt_opcode (pstate, UNOP_KIND); }
+ { write_exp_elt_opcode (pstate, UNOP_FORTRAN_KIND); }
;
/* No more explicit array operators, we treat everything in F77 as
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 7bd119690b4..91bf73b800a 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -284,7 +284,7 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
}
error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type));
- case UNOP_KIND:
+ case UNOP_FORTRAN_KIND:
arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
type = value_type (arg1);
@@ -308,6 +308,120 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
return nullptr;
}
+/* Special expression lengths for Fortran. */
+static void
+operator_length_f (const struct expression *exp, int pc, int *oplenp,
+ int *argsp)
+{
+ int oplen = 1;
+ int args = 0;
+
+ switch (exp->elts[pc - 1].opcode)
+ {
+ default:
+ operator_length_standard (exp, pc, oplenp, argsp);
+ return;
+
+ case UNOP_FORTRAN_KIND:
+ oplen = 1;
+ args = 1;
+ break;
+ }
+
+ *oplenp = oplen;
+ *argsp = args;
+}
+
+/* Special expression printing for Fortran. */
+static void
+print_subexp_f (struct expression *exp, int *pos,
+ struct ui_file *stream, enum precedence prec)
+{
+ int pc = *pos;
+ enum exp_opcode op = exp->elts[pc].opcode;
+
+ switch (op)
+ {
+ default:
+ print_subexp_standard (exp, pos, stream, prec);
+ return;
+
+ case UNOP_FORTRAN_KIND:
+ (*pos)++;
+ fputs_filtered ("KIND(", stream);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (")", stream);
+ return;
+ }
+}
+
+/* Special expression names for Fortran. */
+static const char *
+op_name_f (enum exp_opcode opcode)
+{
+ switch (opcode)
+ {
+ default:
+ return op_name_standard (opcode);
+
+#define OP(name) \
+ case name: \
+ return #name ;
+#include "fortran-operator.def"
+#undef OP
+ }
+}
+
+/* Special expression dumping for Fortran. */
+static int
+dump_subexp_body_f (struct expression *exp,
+ struct ui_file *stream, int elt)
+{
+ int opcode = exp->elts[elt].opcode;
+ int oplen, nargs, i;
+
+ switch (opcode)
+ {
+ default:
+ return dump_subexp_body_standard (exp, stream, elt);
+
+ case UNOP_FORTRAN_KIND:
+ operator_length_f (exp, (elt + 1), &oplen, &nargs);
+ break;
+ }
+
+ elt += oplen;
+ for (i = 0; i < nargs; i += 1)
+ elt = dump_subexp (exp, stream, elt);
+
+ return elt;
+}
+
+/* Special expression checking for Fortran. */
+static int
+operator_check_f (struct expression *exp, int pos,
+ int (*objfile_func) (struct objfile *objfile,
+ void *data),
+ void *data)
+{
+ const union exp_element *const elts = exp->elts;
+
+ switch (elts[pos].opcode)
+ {
+ case UNOP_FORTRAN_KIND:
+ /* Any references to objfiles are held in the arguments to this
+ expression, not within the expression itself, so no additional
+ checking is required here, the outer expression iteration code
+ will take care of checking each argument. */
+ break;
+
+ default:
+ return operator_check_standard (exp, pos, objfile_func, data);
+ }
+
+ return 0;
+}
+
static const char *f_extensions[] =
{
".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
@@ -318,11 +432,11 @@ static const char *f_extensions[] =
/* Expression processing for Fortran. */
static const struct exp_descriptor exp_descriptor_f =
{
- print_subexp_standard,
- operator_length_standard,
- operator_check_standard,
- op_name_standard,
- dump_subexp_body_standard,
+ print_subexp_f,
+ operator_length_f,
+ operator_check_f,
+ op_name_f,
+ dump_subexp_body_f,
evaluate_subexp_f
};
diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def
new file mode 100644
index 00000000000..c3176de428e
--- /dev/null
+++ b/gdb/fortran-operator.def
@@ -0,0 +1,22 @@
+/* Fortran language operator definitions for GDB, the GNU debugger.
+
+ Copyright (C) 2019 Free Software Foundation, Inc.
+
+ This file is part of GDB.
+
+ 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/>. */
+
+/* Single operand builtins. */
+OP (UNOP_FORTRAN_KIND)
+
diff --git a/gdb/parse.c b/gdb/parse.c
index 63cbc746aaa..6b5acac8c7f 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -924,7 +924,6 @@ operator_length_standard (const struct expression *expr, int endpos,
case UNOP_CHR:
case UNOP_FLOAT:
case UNOP_HIGH:
- case UNOP_KIND:
case UNOP_ODD:
case UNOP_ORD:
case UNOP_TRUNC:
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index 001ae61e481..a5247ab9409 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -244,7 +244,6 @@ OP (UNOP_ORD)
OP (UNOP_ABS)
OP (UNOP_FLOAT)
OP (UNOP_HIGH)
-OP (UNOP_KIND) /* Fortran KIND function. */
OP (UNOP_MAX)
OP (UNOP_MIN)
OP (UNOP_ODD)
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCHv2 8/8] gdb/fortran: Add allocatable type qualifier
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (11 preceding siblings ...)
2019-04-02 23:58 ` [PATCHv2 2/8] gdb/fortran: Introduce fortran-operator.def file Andrew Burgess
@ 2019-04-02 23:59 ` Andrew Burgess
2019-04-02 23:59 ` [PATCHv2 5/8] gdb/fortran: Print 'void' type in lower case Andrew Burgess
` (3 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
Types in Fortran can have the 'allocatable' qualifier attached to
indicate that memory needs to be explicitly allocated by the user.
This patch extends GDB to show this qualifier when printing types.
Lots of tests results are then updated to include this new qualifier
in the expected results.
gdb/ChangeLog:
* f-typeprint.c (f_type_print_base): Print 'allocatable' type
qualifier.
* gdbtypes.h (TYPE_IS_ALLOCATABLE): Define.
gdb/testsuite/ChangeLog:
* gdb.fortran/vla-datatypes.exp: Update expected results.
* gdb.fortran/vla-ptype.exp: Likewise.
* gdb.fortran/vla-type.exp: Likewise.
* gdb.fortran/vla-value.exp: Likewise.
---
gdb/ChangeLog | 7 +++++++
gdb/f-typeprint.c | 3 +++
gdb/gdbtypes.h | 4 ++++
gdb/testsuite/ChangeLog | 7 +++++++
gdb/testsuite/gdb.fortran/vla-datatypes.exp | 10 +++++-----
gdb/testsuite/gdb.fortran/vla-ptype.exp | 8 ++++----
gdb/testsuite/gdb.fortran/vla-type.exp | 22 +++++++++++-----------
gdb/testsuite/gdb.fortran/vla-value.exp | 4 ++--
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 4 ++--
9 files changed, 45 insertions(+), 24 deletions(-)
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 66a450a65c7..a7c1a00a714 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -440,4 +440,7 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
break;
}
+
+ if (TYPE_IS_ALLOCATABLE (type))
+ fprintf_filtered (stream, ", allocatable");
}
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 2125ed991d0..a1535d1d0b4 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -350,6 +350,10 @@ DEF_ENUM_FLAGS_TYPE (enum type_instance_flag_value, type_instance_flags);
#define TYPE_IS_REFERENCE(t) \
(TYPE_CODE (t) == TYPE_CODE_REF || TYPE_CODE (t) == TYPE_CODE_RVALUE_REF)
+/* * True if this type is allocatable. */
+#define TYPE_IS_ALLOCATABLE(t) \
+ (get_dyn_prop (DYN_PROP_ALLOCATED, t) != NULL)
+
/* * Instruction-space delimited type. This is for Harvard architectures
which have separate instruction and data address spaces (and perhaps
others).
diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
index afe67742bc4..bb5ed276c22 100644
--- a/gdb/testsuite/gdb.fortran/vla-datatypes.exp
+++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
@@ -55,15 +55,15 @@ 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 = $int \\\(11,22,33\\\)" \
+gdb_test "ptype intvla" "type = $int, allocatable \\\(11,22,33\\\)" \
"ptype intvla"
-gdb_test "ptype realvla" "type = $real \\\(11,22,33\\\)" \
+gdb_test "ptype realvla" "type = $real, allocatable \\\(11,22,33\\\)" \
"ptype realvla"
-gdb_test "ptype complexvla" "type = $complex \\\(11,22,33\\\)" \
+gdb_test "ptype complexvla" "type = $complex, allocatable \\\(11,22,33\\\)" \
"ptype complexvla"
-gdb_test "ptype logicalvla" "type = $logical \\\(11,22,33\\\)" \
+gdb_test "ptype logicalvla" "type = $logical, allocatable \\\(11,22,33\\\)" \
"ptype logicalvla"
-gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \
+gdb_test "ptype charactervla" "type = character\\\*1, allocatable \\\(11,22,33\\\)" \
"ptype charactervla"
gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)"
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
index a40ad917da5..0f4abb63757 100644
--- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
+++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
@@ -43,24 +43,24 @@ gdb_test "ptype vla2(5, 45, 20)" \
gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
gdb_continue_to_breakpoint "vla1-allocated"
-gdb_test "ptype vla1" "type = $real \\\(10,10,10\\\)" \
+gdb_test "ptype vla1" "type = $real, allocatable \\\(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 \\\(7,42:50,13:35\\\)" \
+gdb_test "ptype vla2" "type = $real, allocatable \\\(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 \\\(10,10,10\\\)" \
+gdb_test "ptype vla1" "type = $real, allocatable \\\(10,10,10\\\)" \
"ptype vla1 filled"
gdb_test "ptype vla1(3, 6, 9)" "type = $real" \
"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 \\\(7,42:50,13:35\\\)" \
+gdb_test "ptype vla2" "type = $real, allocatable \\\(7,42:50,13:35\\\)" \
"ptype vla2 filled"
gdb_test "ptype vla2(5, 45, 20)" "type = $real" \
"ptype vla2(5, 45, 20) filled"
diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
index 407a447a851..951f118194a 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -46,7 +46,7 @@ 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+$int :: ivla\\\(11,22,33\\\)" \
+ "\\s+$int, allocatable :: ivla\\\(11,22,33\\\)" \
"End Type one" ]
# Check type with two VLA's inside
@@ -57,8 +57,8 @@ 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+$int :: ivla1\\\(5,12,99\\\)" \
- "\\s+$int :: ivla2\\\(9,12\\\)" \
+ "\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \
+ "\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \
"End Type two" ]
gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
\\\( 1, 1, 321, 1, 1\\\)\
@@ -74,7 +74,7 @@ gdb_test "print threev%ivar" " = 3"
gdb_test "ptype threev" \
[multi_line "type = Type three" \
"\\s+$int :: ivar" \
- "\\s+$int :: ivla\\\(20\\\)" \
+ "\\s+$int, allocatable :: ivla\\\(20\\\)" \
"End Type three" ]
# Check type with attribute at end of type
@@ -87,7 +87,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+$int :: ivla\\\(10\\\)" \
+ "\\s+$int, allocatable :: ivla\\\(10\\\)" \
"\\s+$int :: ivar" \
"End Type four" ]
@@ -103,7 +103,7 @@ gdb_test "ptype fivev" \
"End Type five" ]
gdb_test "ptype fivev%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(10,10,10\\)" \
+ " $int, allocatable :: ivla\\(10,10,10\\)" \
"End Type one" ]
# Check array of types containing a VLA
@@ -120,7 +120,7 @@ gdb_test "ptype fivearr(1)" \
"End Type five" ]
gdb_test "ptype fivearr(1)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(2,4,6\\)" \
+ " $int, allocatable :: ivla\\(2,4,6\\)" \
"End Type one" ]
gdb_test "ptype fivearr(2)" \
[multi_line "type = Type five" \
@@ -128,7 +128,7 @@ gdb_test "ptype fivearr(2)" \
"End Type five" ]
gdb_test "ptype fivearr(2)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(12,14,16\\)" \
+ " $int, allocatable :: ivla\\(12,14,16\\)" \
"End Type one" ]
# Check allocation status of dynamic array and it's dynamic members
@@ -141,7 +141,7 @@ gdb_test "ptype fivedynarr(2)" \
"ptype fivedynarr(2), tone is not allocated"
gdb_test "ptype fivedynarr(2)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(<not allocated>\\)" \
+ " $int, allocatable :: ivla\\(<not allocated>\\)" \
"End Type one" ] \
"ptype fivedynarr(2)%tone, not allocated"
@@ -159,7 +159,7 @@ gdb_test "ptype fivedynarr(1)" \
"End Type five" ]
gdb_test "ptype fivedynarr(1)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(2,4,6\\)" \
+ " $int, allocatable :: ivla\\(2,4,6\\)" \
"End Type one" ]
gdb_test "ptype fivedynarr(2)" \
[multi_line "type = Type five" \
@@ -167,5 +167,5 @@ gdb_test "ptype fivedynarr(2)" \
"End Type five" ]
gdb_test "ptype fivedynarr(2)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(12,14,16\\)" \
+ " $int, allocatable :: ivla\\(12,14,16\\)" \
"End Type one" ]
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 507137bed21..be397fd95fb 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -35,7 +35,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 \\\(<not allocated>\\\) \\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real, allocatable \\\(<not allocated>\\\) \\\)\\\) $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)"
@@ -56,7 +56,7 @@ with_timeout_factor 15 {
"step over value assignment of vla1"
}
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( $real \\\(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)"
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
index bf65bf914cf..0759ccbaebe 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -77,10 +77,10 @@ mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
mi_gdb_test "510-data-evaluate-expression vla1" \
"510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla"
-mi_create_varobj_checked vla1_allocated vla1 "$real \\\(5\\\)" \
+mi_create_varobj_checked vla1_allocated vla1 "$real, allocatable \\\(5\\\)" \
"create local variable vla1_allocated"
mi_gdb_test "511-var-info-type vla1_allocated" \
- "511\\^done,type=\"$real \\\(5\\\)\"" \
+ "511\\^done,type=\"$real, allocatable \\\(5\\\)\"" \
"info type variable vla1_allocated"
mi_gdb_test "512-var-show-format vla1_allocated" \
"512\\^done,format=\"natural\"" \
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCHv2 5/8] gdb/fortran: Print 'void' type in lower case
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (12 preceding siblings ...)
2019-04-02 23:59 ` [PATCHv2 8/8] gdb/fortran: Add allocatable type qualifier Andrew Burgess
@ 2019-04-02 23:59 ` Andrew Burgess
2019-04-02 23:59 ` [PATCHv2 4/8] gdb/fortran: better types for components of complex numbers Andrew Burgess
` (2 subsequent siblings)
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
For a program compiled with gfortran the base type names are written
as lower cases in the DWARF, and so GDB will display them as lower
case. Additionally, in most places where GDB supplies its own type
names (for example all of the types defined in f-lang.c in
`build_fortran_types`), the type names are all lower case.
An exception to this is where GDB prints the void type for Fortran.
In this case GDB uses upper case.
I'm not aware of any reason why this type should merit special
attention, and it looks our of place when printing types, so this
commit changes from 'VOID' to 'void' to match all the other types.
gdb/ChangeLog:
* f-lang.c (build_fortran_types): Change name of void type to
lower case.
* f-typeprint.c (f_type_print_base): Print the name of the void
type, rather than a fixed string.
* f-valprint.c (f_decorations): Use lower case void string.
gdb/testsuite/ChangeLog:
* gdb.fortran/exprs.exp (test_convenience_variables): Expect lower
case void string.
---
gdb/ChangeLog | 8 ++++++++
gdb/f-lang.c | 2 +-
gdb/f-typeprint.c | 6 +++++-
gdb/f-valprint.c | 2 +-
gdb/testsuite/ChangeLog | 5 +++++
gdb/testsuite/gdb.fortran/exprs.exp | 2 +-
6 files changed, 21 insertions(+), 4 deletions(-)
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 5eeb7dba6e5..abad2a0a2eb 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -670,7 +670,7 @@ build_fortran_types (struct gdbarch *gdbarch)
= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
builtin_f_type->builtin_void
- = arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT, "VOID");
+ = arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT, "void");
builtin_f_type->builtin_character
= arch_type (gdbarch, TYPE_CODE_CHAR, TARGET_CHAR_BIT, "character");
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index a0e34b3058d..26ea9014135 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -328,7 +328,11 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
break;
case TYPE_CODE_VOID:
- fprintfi_filtered (level, stream, "VOID");
+ {
+ gdbarch *gdbarch = get_type_arch (type);
+ struct type *void_type = builtin_f_type (gdbarch)->builtin_void;
+ fprintfi_filtered (level, stream, "%s", TYPE_NAME (void_type));
+ }
break;
case TYPE_CODE_UNDEF:
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 5f9dd4dedb8..e216db6b63c 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -199,7 +199,7 @@ static const struct generic_val_print_decorations f_decorations =
")",
".TRUE.",
".FALSE.",
- "VOID",
+ "void",
"{",
"}"
};
diff --git a/gdb/testsuite/gdb.fortran/exprs.exp b/gdb/testsuite/gdb.fortran/exprs.exp
index 3b24f7c135f..8649d0b246d 100644
--- a/gdb/testsuite/gdb.fortran/exprs.exp
+++ b/gdb/testsuite/gdb.fortran/exprs.exp
@@ -141,7 +141,7 @@ proc test_convenience_variables {} {
gdb_test "print (\$foo = 32) + 4" " = 36" \
"Use convenience variable assignment in arithmetic expression"
- gdb_test "print \$bar" " = VOID" \
+ gdb_test "print \$bar" " = void" \
"Print contents of uninitialized convenience variable"
}
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCHv2 4/8] gdb/fortran: better types for components of complex numbers
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (13 preceding siblings ...)
2019-04-02 23:59 ` [PATCHv2 5/8] gdb/fortran: Print 'void' type in lower case Andrew Burgess
@ 2019-04-02 23:59 ` Andrew Burgess
2019-05-03 0:21 ` Regression on gdb.fortran/complex.exp on unix/-m32 (was: Re: [PATCHv2 4/8] gdb/fortran: better types for components of complex numbers) Sergio Durigan Junior
2019-04-02 23:59 ` [PATCHv2 7/8] gdb/fortran: Update rules for printing whitespace in types Andrew Burgess
2019-04-02 23:59 ` [PATCHv2 6/8] gdb/fortran: print function arguments when printing function type Andrew Burgess
16 siblings, 1 reply; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
Currently when using $_creal and $_cimag to access the components of a
complex number the types of these components will have C type names
'float', 'double', etc. This is because the components of a complex
number are not given type names in DWARF, so GDB has to pick some
suitable names, and currently we always use the C names.
This commit changes the type names used based on the language, so for
Fortran we will now use the Fortran float types, and so will get the
Fortran float type names 'real', 'real*8', etc.
gdb/ChangeLog:
* dwarf2read.c (dwarf2_init_complex_target_type): Use different
types for Fortran.
gdb/testsuite/ChangeLog:
* gdb.fortran/complex.exp: Expand.
* gdb.fortran/complex.f: Renamed to...
* gdb.fortran/complex.f90: ...this, and extended to add more
complex values.
---
gdb/ChangeLog | 6 +++++
gdb/dwarf2read.c | 35 +++++++++++++++++++++-------
gdb/testsuite/ChangeLog | 7 ++++++
gdb/testsuite/gdb.fortran/complex.exp | 41 +++++++++++++++++++++++++-------
gdb/testsuite/gdb.fortran/complex.f | 24 -------------------
gdb/testsuite/gdb.fortran/complex.f90 | 44 +++++++++++++++++++++++++++++++++++
6 files changed, 116 insertions(+), 41 deletions(-)
delete mode 100644 gdb/testsuite/gdb.fortran/complex.f
create mode 100644 gdb/testsuite/gdb.fortran/complex.f90
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 8881a1e28a8..1277b8acb53 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17547,16 +17547,35 @@ dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
gdbarch *gdbarch = get_objfile_arch (objfile);
struct type *tt = nullptr;
- switch (bits)
+ switch (cu->language)
{
- case 32:
- tt = builtin_type (gdbarch)->builtin_float;
- break;
- case 64:
- tt = builtin_type (gdbarch)->builtin_double;
+ case language_fortran:
+ switch (bits)
+ {
+ case 32:
+ tt = builtin_f_type (gdbarch)->builtin_real;
+ break;
+ case 64:
+ tt = builtin_f_type (gdbarch)->builtin_real_s8;
+ break;
+ case 128:
+ tt = builtin_f_type (gdbarch)->builtin_real_s16;
+ break;
+ }
break;
- case 128:
- tt = builtin_type (gdbarch)->builtin_long_double;
+ default:
+ switch (bits)
+ {
+ case 32:
+ tt = builtin_type (gdbarch)->builtin_float;
+ break;
+ case 64:
+ tt = builtin_type (gdbarch)->builtin_double;
+ break;
+ case 128:
+ tt = builtin_type (gdbarch)->builtin_long_double;
+ break;
+ }
break;
}
diff --git a/gdb/testsuite/gdb.fortran/complex.exp b/gdb/testsuite/gdb.fortran/complex.exp
index 3fbbf7154d9..136f1c4df79 100644
--- a/gdb/testsuite/gdb.fortran/complex.exp
+++ b/gdb/testsuite/gdb.fortran/complex.exp
@@ -13,7 +13,7 @@
# 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 .f
+standard_testfile .f90
if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90 quiet}]} {
return -1
@@ -24,13 +24,36 @@ if ![runto MAIN__] then {
continue
}
-set bp_location [gdb_get_line_number "stop"]
-gdb_test "break $bp_location" \
- "Breakpoint.*at.* file .*$srcfile, line $bp_location\\." \
- "breakpoint at stop"
-gdb_test "continue" \
- "Continuing\\..*Breakpoint.*" \
- "continue to breakpoint"
+gdb_breakpoint [gdb_get_line_number "stop"]
+gdb_continue_to_breakpoint "continue"
+
+gdb_test "print c" " = \\(1000,-50\\)"
+gdb_test "print c4" " = \\(1000,-50\\)"
+gdb_test "print c8" " = \\(321,-22\\)"
+gdb_test "print dc" " = \\(321,-22\\)"
+
+setup_kfail gdb/18644 "*-*-*"
+gdb_test "print c16" " = \\(-874,19\\)"
+
+gdb_test "whatis c" "type = complex\\(kind=4\\)"
+gdb_test "print \$_creal (c)" " = 1000"
+gdb_test "whatis \$" " = real"
+
+gdb_test "whatis c4" "type = complex\\(kind=4\\)"
+gdb_test "print \$_creal (c4)" " = 1000"
+gdb_test "whatis \$" " = real"
+
+gdb_test "whatis c8" "type = complex\\(kind=8\\)"
+gdb_test "print \$_creal (c8)" " = 321"
+gdb_test "whatis \$" " = real\\*8"
+
+gdb_test "whatis dc" "type = complex\\(kind=8\\)"
+gdb_test "print \$_creal (dc)" " = 321"
+gdb_test "whatis \$" " = real\\*8"
+
+gdb_test "whatis c16" "type = complex\\(kind=16\\)"
+setup_kfail gdb/18644 "*-*-*"
+gdb_test "print \$_creal (c16)" " = -874"
+gdb_test "whatis \$" " = real\\*16"
-gdb_test "print c" "\\\$$decimal = \\(1000,-50\\)"
diff --git a/gdb/testsuite/gdb.fortran/complex.f b/gdb/testsuite/gdb.fortran/complex.f
deleted file mode 100644
index 2f1a7879f9e..00000000000
--- a/gdb/testsuite/gdb.fortran/complex.f
+++ /dev/null
@@ -1,24 +0,0 @@
-c Copyright 2007-2019 Free Software Foundation, Inc.
-
-c This program is free software; you can redistribute it and/or modify
-c it under the terms of the GNU General Public License as published by
-c the Free Software Foundation; either version 3 of the License, or
-c (at your option) any later version.
-c
-c This program is distributed in the hope that it will be useful,
-c but WITHOUT ANY WARRANTY; without even the implied warranty of
-c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-c GNU General Public License for more details.
-c
-c You should have received a copy of the GNU General Public License
-c along with this program. If not, see <http://www.gnu.org/licenses/>.
-
- real*8 a,b
- complex*16 c
-
- a = 1000
- b = -50
- c = cmplx(a,b)
- write(*,*) s
- stop
- end
diff --git a/gdb/testsuite/gdb.fortran/complex.f90 b/gdb/testsuite/gdb.fortran/complex.f90
new file mode 100644
index 00000000000..2b88c1ee0bb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/complex.f90
@@ -0,0 +1,44 @@
+! Copyright 2007-2019 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 test_complex
+ real*4 r4a, r4b
+ real*8 r8a, r8b
+ real*16 r16a, r16b
+
+ complex c
+ complex(kind=4) c4
+ complex(kind=8) c8
+ double complex dc
+ complex(kind=16) c16
+
+ r4a = 1000
+ r4b = -50
+ r8a = 321
+ r8b = -22
+ r16a = -874
+ r16b = 19
+
+ c = cmplx(r4a,r4b)
+ c4 = cmplx(r4a,r4b)
+ c8 = cmplx(r8a, r8b)
+ dc = cmplx(r8a, r8b)
+ c16 = cmplx(r16a, r16b)
+
+ print *, c, c4, c8, dc, c16 ! stop
+ print *, r4a, r4b
+ print *, r8a, r8b
+ print *, r16a, r16b
+end program test_complex
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* Regression on gdb.fortran/complex.exp on unix/-m32 (was: Re: [PATCHv2 4/8] gdb/fortran: better types for components of complex numbers)
2019-04-02 23:59 ` [PATCHv2 4/8] gdb/fortran: better types for components of complex numbers Andrew Burgess
@ 2019-05-03 0:21 ` Sergio Durigan Junior
0 siblings, 0 replies; 34+ messages in thread
From: Sergio Durigan Junior @ 2019-05-03 0:21 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches, Richard Bunt
On Tuesday, April 02 2019, Andrew Burgess wrote:
> Currently when using $_creal and $_cimag to access the components of a
> complex number the types of these components will have C type names
> 'float', 'double', etc. This is because the components of a complex
> number are not given type names in DWARF, so GDB has to pick some
> suitable names, and currently we always use the C names.
>
> This commit changes the type names used based on the language, so for
> Fortran we will now use the Fortran float types, and so will get the
> Fortran float type names 'real', 'real*8', etc.
Hi Andrew,
This patch has caused a regression when testing a 64-bit against a
unix/-m32 board:
print c16
$5 = (../../binutils-gdb/gdb/target-float.c:2228: internal-error: target_float_ops_kind get_target_float_ops_kind(const type*): unexpected type code
A problem internal to GDB has been detected,
further debugging may prove unreliable.
Quit this debugging session? (y or n) KFAIL: gdb.fortran/complex.exp: print c16 (GDB internal error) (PRMS: gdb/18644)
Resyncing due to internal error.
n
This is a bug, please report it. For instructions, see:
<http://www.gnu.org/software/gdb/bugs/>.
../../binutils-gdb/gdb/target-float.c:2228: internal-error: target_float_ops_kind get_target_float_ops_kind(const type*): unexpected type code
A problem internal to GDB has been detected,
further debugging may prove unreliable.
Create a core file of GDB? (y or n) n
Command aborted.
I haven't been able to investigate more, sorry.
Thanks,
> gdb/ChangeLog:
>
> * dwarf2read.c (dwarf2_init_complex_target_type): Use different
> types for Fortran.
>
> gdb/testsuite/ChangeLog:
>
> * gdb.fortran/complex.exp: Expand.
> * gdb.fortran/complex.f: Renamed to...
> * gdb.fortran/complex.f90: ...this, and extended to add more
> complex values.
> ---
> gdb/ChangeLog | 6 +++++
> gdb/dwarf2read.c | 35 +++++++++++++++++++++-------
> gdb/testsuite/ChangeLog | 7 ++++++
> gdb/testsuite/gdb.fortran/complex.exp | 41 +++++++++++++++++++++++++-------
> gdb/testsuite/gdb.fortran/complex.f | 24 -------------------
> gdb/testsuite/gdb.fortran/complex.f90 | 44 +++++++++++++++++++++++++++++++++++
> 6 files changed, 116 insertions(+), 41 deletions(-)
> delete mode 100644 gdb/testsuite/gdb.fortran/complex.f
> create mode 100644 gdb/testsuite/gdb.fortran/complex.f90
>
> diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
> index 8881a1e28a8..1277b8acb53 100644
> --- a/gdb/dwarf2read.c
> +++ b/gdb/dwarf2read.c
> @@ -17547,16 +17547,35 @@ dwarf2_init_complex_target_type (struct dwarf2_cu *cu,
> gdbarch *gdbarch = get_objfile_arch (objfile);
> struct type *tt = nullptr;
>
> - switch (bits)
> + switch (cu->language)
> {
> - case 32:
> - tt = builtin_type (gdbarch)->builtin_float;
> - break;
> - case 64:
> - tt = builtin_type (gdbarch)->builtin_double;
> + case language_fortran:
> + switch (bits)
> + {
> + case 32:
> + tt = builtin_f_type (gdbarch)->builtin_real;
> + break;
> + case 64:
> + tt = builtin_f_type (gdbarch)->builtin_real_s8;
> + break;
> + case 128:
> + tt = builtin_f_type (gdbarch)->builtin_real_s16;
> + break;
> + }
> break;
> - case 128:
> - tt = builtin_type (gdbarch)->builtin_long_double;
> + default:
> + switch (bits)
> + {
> + case 32:
> + tt = builtin_type (gdbarch)->builtin_float;
> + break;
> + case 64:
> + tt = builtin_type (gdbarch)->builtin_double;
> + break;
> + case 128:
> + tt = builtin_type (gdbarch)->builtin_long_double;
> + break;
> + }
> break;
> }
>
> diff --git a/gdb/testsuite/gdb.fortran/complex.exp b/gdb/testsuite/gdb.fortran/complex.exp
> index 3fbbf7154d9..136f1c4df79 100644
> --- a/gdb/testsuite/gdb.fortran/complex.exp
> +++ b/gdb/testsuite/gdb.fortran/complex.exp
> @@ -13,7 +13,7 @@
> # 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 .f
> +standard_testfile .f90
>
> if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90 quiet}]} {
> return -1
> @@ -24,13 +24,36 @@ if ![runto MAIN__] then {
> continue
> }
>
> -set bp_location [gdb_get_line_number "stop"]
> -gdb_test "break $bp_location" \
> - "Breakpoint.*at.* file .*$srcfile, line $bp_location\\." \
> - "breakpoint at stop"
>
> -gdb_test "continue" \
> - "Continuing\\..*Breakpoint.*" \
> - "continue to breakpoint"
> +gdb_breakpoint [gdb_get_line_number "stop"]
> +gdb_continue_to_breakpoint "continue"
> +
> +gdb_test "print c" " = \\(1000,-50\\)"
> +gdb_test "print c4" " = \\(1000,-50\\)"
> +gdb_test "print c8" " = \\(321,-22\\)"
> +gdb_test "print dc" " = \\(321,-22\\)"
> +
> +setup_kfail gdb/18644 "*-*-*"
> +gdb_test "print c16" " = \\(-874,19\\)"
> +
> +gdb_test "whatis c" "type = complex\\(kind=4\\)"
> +gdb_test "print \$_creal (c)" " = 1000"
> +gdb_test "whatis \$" " = real"
> +
> +gdb_test "whatis c4" "type = complex\\(kind=4\\)"
> +gdb_test "print \$_creal (c4)" " = 1000"
> +gdb_test "whatis \$" " = real"
> +
> +gdb_test "whatis c8" "type = complex\\(kind=8\\)"
> +gdb_test "print \$_creal (c8)" " = 321"
> +gdb_test "whatis \$" " = real\\*8"
> +
> +gdb_test "whatis dc" "type = complex\\(kind=8\\)"
> +gdb_test "print \$_creal (dc)" " = 321"
> +gdb_test "whatis \$" " = real\\*8"
> +
> +gdb_test "whatis c16" "type = complex\\(kind=16\\)"
> +setup_kfail gdb/18644 "*-*-*"
> +gdb_test "print \$_creal (c16)" " = -874"
> +gdb_test "whatis \$" " = real\\*16"
>
> -gdb_test "print c" "\\\$$decimal = \\(1000,-50\\)"
> diff --git a/gdb/testsuite/gdb.fortran/complex.f b/gdb/testsuite/gdb.fortran/complex.f
> deleted file mode 100644
> index 2f1a7879f9e..00000000000
> --- a/gdb/testsuite/gdb.fortran/complex.f
> +++ /dev/null
> @@ -1,24 +0,0 @@
> -c Copyright 2007-2019 Free Software Foundation, Inc.
> -
> -c This program is free software; you can redistribute it and/or modify
> -c it under the terms of the GNU General Public License as published by
> -c the Free Software Foundation; either version 3 of the License, or
> -c (at your option) any later version.
> -c
> -c This program is distributed in the hope that it will be useful,
> -c but WITHOUT ANY WARRANTY; without even the implied warranty of
> -c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> -c GNU General Public License for more details.
> -c
> -c You should have received a copy of the GNU General Public License
> -c along with this program. If not, see <http://www.gnu.org/licenses/>.
> -
> - real*8 a,b
> - complex*16 c
> -
> - a = 1000
> - b = -50
> - c = cmplx(a,b)
> - write(*,*) s
> - stop
> - end
> diff --git a/gdb/testsuite/gdb.fortran/complex.f90 b/gdb/testsuite/gdb.fortran/complex.f90
> new file mode 100644
> index 00000000000..2b88c1ee0bb
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/complex.f90
> @@ -0,0 +1,44 @@
> +! Copyright 2007-2019 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 test_complex
> + real*4 r4a, r4b
> + real*8 r8a, r8b
> + real*16 r16a, r16b
> +
> + complex c
> + complex(kind=4) c4
> + complex(kind=8) c8
> + double complex dc
> + complex(kind=16) c16
> +
> + r4a = 1000
> + r4b = -50
> + r8a = 321
> + r8b = -22
> + r16a = -874
> + r16b = 19
> +
> + c = cmplx(r4a,r4b)
> + c4 = cmplx(r4a,r4b)
> + c8 = cmplx(r8a, r8b)
> + dc = cmplx(r8a, r8b)
> + c16 = cmplx(r16a, r16b)
> +
> + print *, c, c4, c8, dc, c16 ! stop
> + print *, r4a, r4b
> + print *, r8a, r8b
> + print *, r16a, r16b
> +end program test_complex
> --
> 2.14.5
--
Sergio
GPG key ID: 237A 54B1 0287 28BF 00EF 31F4 D0EB 7628 65FC 5E36
Please send encrypted e-mail if possible
http://sergiodj.net/
^ permalink raw reply [flat|nested] 34+ messages in thread
* [PATCHv2 7/8] gdb/fortran: Update rules for printing whitespace in types
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (14 preceding siblings ...)
2019-04-02 23:59 ` [PATCHv2 4/8] gdb/fortran: better types for components of complex numbers Andrew Burgess
@ 2019-04-02 23:59 ` Andrew Burgess
2019-04-02 23:59 ` [PATCHv2 6/8] gdb/fortran: print function arguments when printing function type Andrew Burgess
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
The whitespace produced as types are printed seems inconsistent. This
commit updates the rules in an attempt to make whitespace more
balanced and consistent. Expected results are updated.
gdb/ChangeLog:
* f-typeprint.c (f_print_type): Update rules for printing
whitespace.
(f_type_print_varspec_suffix): Likewise.
gdb/testsuite/ChangeLog:
* gdb.fortran/ptr-indentation.exp: Update expected results.
* gdb.fortran/ptype-on-functions.exp: Likewise.
* gdb.fortran/vla-ptr-info.exp: Likewise.
* gdb.fortran/vla-value.exp: Likewise.
---
gdb/ChangeLog | 6 ++++++
gdb/f-typeprint.c | 21 ++++++++++++++-------
gdb/testsuite/ChangeLog | 7 +++++++
gdb/testsuite/gdb.fortran/ptr-indentation.exp | 2 +-
gdb/testsuite/gdb.fortran/ptype-on-functions.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 2 +-
gdb/testsuite/gdb.fortran/vla-value.exp | 8 ++++----
7 files changed, 34 insertions(+), 14 deletions(-)
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 0329e50fd0b..66a450a65c7 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -68,13 +68,20 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
- /* Need a space if going to print stars or brackets;
- but not if we will print just a type name. */
- || ((show > 0 || TYPE_NAME (type) == 0)
- && (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
+ /* Need a space if going to print stars or brackets; but not if we
+ will print just a type name. */
+ || ((show > 0
+ || TYPE_NAME (type) == 0)
+ && (code == TYPE_CODE_FUNC
|| code == TYPE_CODE_METHOD
|| code == TYPE_CODE_ARRAY
- || code == TYPE_CODE_REF)))
+ || ((code == TYPE_CODE_PTR
+ || code == TYPE_CODE_REF)
+ && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_FUNC
+ || (TYPE_CODE (TYPE_TARGET_TYPE (type))
+ == TYPE_CODE_METHOD)
+ || (TYPE_CODE (TYPE_TARGET_TYPE (type))
+ == TYPE_CODE_ARRAY))))))
fputs_filtered (" ", stream);
f_type_print_varspec_prefix (type, stream, show, 0);
@@ -222,7 +229,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);
- fprintf_filtered (stream, ")");
+ fprintf_filtered (stream, " )");
break;
case TYPE_CODE_FUNC:
@@ -232,7 +239,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
passed_a_ptr, 0, arrayprint_recurse_level);
if (passed_a_ptr)
- fprintf_filtered (stream, ")");
+ fprintf_filtered (stream, ") ");
fprintf_filtered (stream, "(");
if (nfields == 0 && TYPE_PROTOTYPED (type))
f_print_type (builtin_f_type (get_type_arch (type))->builtin_void,
diff --git a/gdb/testsuite/gdb.fortran/ptr-indentation.exp b/gdb/testsuite/gdb.fortran/ptr-indentation.exp
index b0eb941eaa9..0c5d2255802 100644
--- a/gdb/testsuite/gdb.fortran/ptr-indentation.exp
+++ b/gdb/testsuite/gdb.fortran/ptr-indentation.exp
@@ -37,5 +37,5 @@ gdb_continue_to_breakpoint "BP1"
gdb_test "ptype tinsta" \
[multi_line "type = Type tuserdef" \
" $int :: i" \
- " PTR TO -> \\( $real :: ptr\\)" \
+ " PTR TO -> \\( $real :: ptr \\)" \
"End Type tuserdef"]
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
index 4ce78623b47..528828663c4 100644
--- a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
@@ -42,4 +42,4 @@ gdb_test "ptype say_numbers" \
"type = void \\(integer\\(kind=4\\), integer\\(kind=4\\), integer\\(kind=4\\)\\)"
gdb_test "ptype fun_ptr" \
- "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\)\\(REF TO -> \\( integer\\(kind=4\\) \\)\\)\\)"
+ "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\) \\(REF TO -> \\( integer\\(kind=4\\) \\)\\) \\)"
diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp
index 58f3395122f..6b9625ad996 100644
--- a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp
+++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp
@@ -28,5 +28,5 @@ if ![runto_main] {
# Check the status of a pointer to a dynamic array.
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}" \
+gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) \\(10,10,10\\) \\)\\) ${hex}" \
"print pvla pointer information"
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 3582d47c946..507137bed21 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -35,7 +35,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 \\\(<not allocated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\) \\\)\\\) $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)"
@@ -56,7 +56,7 @@ with_timeout_factor 15 {
"step over value assignment of vla1"
}
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(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)"
@@ -76,7 +76,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 \\\(<not associated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(<not associated>\\\) \\\)\\\) $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)"
@@ -85,7 +85,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)"
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread* [PATCHv2 6/8] gdb/fortran: print function arguments when printing function type
2019-03-18 12:52 ` [PATCH " Andrew Burgess
` (15 preceding siblings ...)
2019-04-02 23:59 ` [PATCHv2 7/8] gdb/fortran: Update rules for printing whitespace in types Andrew Burgess
@ 2019-04-02 23:59 ` Andrew Burgess
16 siblings, 0 replies; 34+ messages in thread
From: Andrew Burgess @ 2019-04-02 23:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Richard Bunt, Andrew Burgess
gdb/ChangeLog:
* f-typeprint.c (f_type_print_varspec_suffix): Handle printing
function arguments.
gdb/testsuite/ChangeLog:
* gdb.fortran/ptype-on-functions.exp: New file.
* gdb.fortran/ptype-on-functions.f90: New file.
---
gdb/ChangeLog | 6 ++
gdb/f-typeprint.c | 27 +++++++--
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp | 2 +-
gdb/testsuite/gdb.fortran/ptype-on-functions.exp | 45 ++++++++++++++
gdb/testsuite/gdb.fortran/ptype-on-functions.f90 | 74 +++++++++++++++++++++++
6 files changed, 153 insertions(+), 6 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/ptype-on-functions.exp
create mode 100644 gdb/testsuite/gdb.fortran/ptype-on-functions.f90
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 26ea9014135..0329e50fd0b 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -226,12 +226,29 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
break;
case TYPE_CODE_FUNC:
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
- passed_a_ptr, 0, arrayprint_recurse_level);
- if (passed_a_ptr)
- fprintf_filtered (stream, ")");
+ {
+ int i, nfields = TYPE_NFIELDS (type);
- fprintf_filtered (stream, "()");
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+ passed_a_ptr, 0, arrayprint_recurse_level);
+ if (passed_a_ptr)
+ fprintf_filtered (stream, ")");
+ fprintf_filtered (stream, "(");
+ if (nfields == 0 && TYPE_PROTOTYPED (type))
+ f_print_type (builtin_f_type (get_type_arch (type))->builtin_void,
+ "", stream, -1, 0, 0);
+ else
+ for (i = 0; i < nfields; i++)
+ {
+ if (i > 0)
+ {
+ fputs_filtered (", ", stream);
+ wrap_here (" ");
+ }
+ f_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, 0);
+ }
+ fprintf_filtered (stream, ")");
+ }
break;
case TYPE_CODE_UNDEF:
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp b/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
index 2824e16bf34..ce24854a35b 100644
--- a/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
+++ b/gdb/testsuite/gdb.dwarf2/dw2-case-insensitive.exp
@@ -45,7 +45,7 @@ gdb_test "set case-sensitive off" {warning: the current case sensitivity setting
# Note that info functions gives the FUNC_lang result using the fortran syntax
# as specified in dw-case-insensitive-debug.S DW_AT_language.
gdb_test "info functions fUnC_lang" \
- "All functions matching regular expression \"fUnC_lang\":\[\r\n\]+File file1.txt:\r\n\tfoo FUNC_lang\\(\\);(\r\n\r\nNon-debugging symbols:\r\n0x\[0-9a-f\]+ +\\.FUNC_lang)?" \
+ "All functions matching regular expression \"fUnC_lang\":\[\r\n\]+File file1.txt:\r\n\tfoo FUNC_lang\\(void\\);(\r\n\r\nNon-debugging symbols:\r\n0x\[0-9a-f\]+ +\\.FUNC_lang)?" \
"regexp case-sensitive off"
gdb_test "p fuNC_lang" { = {foo \(void\)} 0x[0-9a-f]+ <FUNC_lang>}
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
new file mode 100644
index 00000000000..4ce78623b47
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp
@@ -0,0 +1,45 @@
+# Copyright 2019 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/>.
+
+# This file contains a test for printing the types of functions.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f90
+load_lib "fortran.exp"
+
+if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}]} {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_test "ptype some_module::get_number" \
+ "type = integer\\(kind=4\\) \\(Type __class_some_module_Number_t\\)"
+
+gdb_test "ptype some_module::set_number" \
+ "type = void \\(Type __class_some_module_Number_t, integer\\(kind=4\\)\\)"
+
+gdb_test "ptype is_bigger" \
+ "type = logical\\(kind=4\\) \\(integer\\(kind=4\\), integer\\(kind=4\\)\\)"
+
+gdb_test "ptype say_numbers" \
+ "type = void \\(integer\\(kind=4\\), integer\\(kind=4\\), integer\\(kind=4\\)\\)"
+
+gdb_test "ptype fun_ptr" \
+ "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\)\\(REF TO -> \\( integer\\(kind=4\\) \\)\\)\\)"
diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.f90 b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
new file mode 100644
index 00000000000..bb8e0a6f825
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.f90
@@ -0,0 +1,74 @@
+module some_module
+ implicit none
+
+ type, public :: Number
+ integer :: a
+ contains
+ procedure :: get => get_number
+ procedure :: set => set_number
+ end type Number
+
+contains
+
+ function get_number (this) result (val)
+ class (Number), intent (in) :: this
+ integer :: val
+ val = this%a
+ end function get_number
+
+ subroutine set_number (this, val)
+ class (Number), intent (inout) :: this
+ integer :: val
+ this%a = val
+ end subroutine set_number
+
+end module some_module
+
+logical function is_bigger (a,b)
+ integer, intent(in) :: a
+ integer, intent(in) :: b
+ is_bigger = a > b
+end function is_bigger
+
+subroutine say_numbers (v1,v2,v3)
+ integer,intent(in) :: v1
+ integer,intent(in) :: v2
+ integer,intent(in) :: v3
+ print *, v1,v2,v3
+end subroutine say_numbers
+
+program test
+ use some_module
+
+ interface
+ integer function fun1 (x)
+ integer :: x
+ end function fun1
+
+ integer function fun2 (x)
+ integer :: x
+ end function fun2
+ end interface
+
+ type (Number) :: n1
+ type (Number) :: n2
+
+ procedure(fun1), pointer:: fun_ptr => NULL()
+
+ call say_numbers (1,2,3) ! stop here
+ print *, fun_ptr (3)
+
+end program test
+
+integer function fun1 (x)
+ implicit none
+ integer :: x
+ fun1 = x + 1
+end function fun1
+
+integer function fun2 (x)
+ implicit none
+ integer :: x
+ fun2 = x + 2
+end function fun2
+
--
2.14.5
^ permalink raw reply [flat|nested] 34+ messages in thread