gdb/fortran: Add Fortran 'kind' intrinsic and keyword

The 'kind' keyword has two uses in Fortran, it is the name of a
builtin intrinsic function, and it is also a keyword used to create a
type of a specific kind.

This commit adds support for using kind as an intrinsic function, and
also adds some initial support for using kind to create types of a
specific kind.

This commit only allows the creation of the type 'character(kind=1)',
however, it will be easy enough to extend this in future to support
more type kinds.

The kind of any expression can be queried using the kind intrinsic
function.  At the moment the kind returned corresponds to the size of
the type, this matches how gfortran handles kinds.  However, the
correspondence between kind and type size depends on the compiler
and/or the specific target, so this might not be correct for
everyone.  If we want to support different compilers/targets in future
the code to compute the kind from a type will need to be updated.

gdb/ChangeLog:

	* expprint.c (dump_subexp_body_standard): Support UNOP_KIND.
	* f-exp.y: Define 'KIND' token.
	(exp): New pattern for KIND expressions.
	(ptype): Handle types with a kind extension.
	(direct_abs_decl): Extend to spot kind extensions.
	(f77_keywords): Add 'kind' to the list.
	(push_kind_type): New function.
	(convert_to_kind_type): New function.
	* f-lang.c (evaluate_subexp_f): Support UNOP_KIND.
	* parse.c (operator_length_standard): Likewise.
	* parser-defs.h (enum type_pieces): Add tp_kind.
	* std-operator.def: Add UNOP_KIND.

gdb/testsuite/ChangeLog:

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

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 806847a5e6f2241070a25bc70c941c7ad36809aa..e2efdb24393121ebe50209d39e974947edcd5e0e 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,19 @@
+2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
+           Chris January  <chris.january@arm.com>
+
+       * expprint.c (dump_subexp_body_standard): Support UNOP_KIND.
+       * f-exp.y: Define 'KIND' token.
+       (exp): New pattern for KIND expressions.
+       (ptype): Handle types with a kind extension.
+       (direct_abs_decl): Extend to spot kind extensions.
+       (f77_keywords): Add 'kind' to the list.
+       (push_kind_type): New function.
+       (convert_to_kind_type): New function.
+       * f-lang.c (evaluate_subexp_f): Support UNOP_KIND.
+       * parse.c (operator_length_standard): Likewise.
+       * parser-defs.h (enum type_pieces): Add tp_kind.
+       * std-operator.def: Add UNOP_KIND.
+
 2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
 
        * f-exp.y (f_parse): Set yydebug.

diff --git a/gdb/expprint.c b/gdb/expprint.c
index d7ad1a71878077f22a2028eeef2e874e57d2512e..a22499f4833b2379bc08323718bf1d5dec5e602f 100644 (file)
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -869,6 +869,7 @@ 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/f-exp.y b/gdb/f-exp.y
index c223d366db3484a4ac1766ff854a773c120529e9..327f13736bd3ac526cf0dc015da768551b01e261 100644 (file)
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -78,6 +78,10 @@ static void growbuf_by_size (int);
 
 static int match_string_literal (void);
 
+static void push_kind_type (LONGEST val, struct type *type);
+
+static struct type *convert_to_kind_type (struct type *basetype, int kind);
+
 %}
 
 /* Although the yacc "value" of an expression is not used,
@@ -149,7 +153,7 @@ static int parse_number (struct parser_state *, const char *, int,
 
 %token <ssym> NAME_OR_INT 
 
-%token  SIZEOF 
+%token SIZEOF KIND
 %token ERROR
 
 /* Special type cases, put in to allow the parser to distinguish different
@@ -228,6 +232,10 @@ exp        :       SIZEOF exp       %prec UNARY
                        { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
        ;
 
+exp    :       KIND '(' exp ')'       %prec UNARY
+                       { write_exp_elt_opcode (pstate, UNOP_KIND); }
+       ;
+
 /* No more explicit array operators, we treat everything in F77 as 
    a function call.  The disambiguation as to whether we are 
    doing a subscript operation or a function call is done 
@@ -530,6 +538,13 @@ ptype      :       typebase
                      case tp_function:
                        follow_type = lookup_function_type (follow_type);
                        break;
+                     case tp_kind:
+                       {
+                         int kind_val = pop_type_int ();
+                         follow_type
+                           = convert_to_kind_type (follow_type, kind_val);
+                       }
+                       break;
                      }
                  $$ = follow_type;
                }
@@ -548,6 +563,8 @@ abs_decl:   '*'
 
 direct_abs_decl: '(' abs_decl ')'
                        { $$ = $2; }
+       |       '(' KIND '=' INT ')'
+                       { push_kind_type ($4.val, $4.type); }
        |       direct_abs_decl func_mod
                        { push_type (tp_function); }
        |       func_mod
@@ -773,6 +790,54 @@ parse_number (struct parser_state *par_state,
   return INT;
 }
 
+/* Called to setup the type stack when we encounter a '(kind=N)' type
+   modifier, performs some bounds checking on 'N' and then pushes this to
+   the type stack followed by the 'tp_kind' marker.  */
+static void
+push_kind_type (LONGEST val, struct type *type)
+{
+  int ival;
+
+  if (TYPE_UNSIGNED (type))
+    {
+      ULONGEST uval = static_cast <ULONGEST> (val);
+      if (uval > INT_MAX)
+       error (_("kind value out of range"));
+      ival = static_cast <int> (uval);
+    }
+  else
+    {
+      if (val > INT_MAX || val < 0)
+       error (_("kind value out of range"));
+      ival = static_cast <int> (val);
+    }
+
+  push_type_int (ival);
+  push_type (tp_kind);
+}
+
+/* Called when a type has a '(kind=N)' modifier after it, for example
+   'character(kind=1)'.  The BASETYPE is the type described by 'character'
+   in our example, and KIND is the integer '1'.  This function returns a
+   new type that represents the basetype of a specific kind.  */
+static struct type *
+convert_to_kind_type (struct type *basetype, int kind)
+{
+  if (basetype == parse_f_type (pstate)->builtin_character)
+    {
+      /* Character of kind 1 is a special case, this is the same as the
+        base character type.  */
+      if (kind == 1)
+       return parse_f_type (pstate)->builtin_character;
+    }
+
+  error (_("unsupported kind %d for type %s"),
+        kind, TYPE_SAFE_NAME (basetype));
+
+  /* Should never get here.  */
+  return nullptr;
+}
+
 struct token
 {
   /* The string to match against.  */
@@ -840,6 +905,9 @@ static const struct token f77_keywords[] =
   { "sizeof", SIZEOF, BINOP_END, true },
   { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
   { "real", REAL_KEYWORD, BINOP_END, true },
+  /* The following correspond to actual functions in Fortran and are case
+     insensitive.  */
+  { "kind", KIND, BINOP_END, false }
 };
 
 /* Implementation of a dynamically expandable buffer for processing input

diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 5beb46c5f3174b2737bbf920a51fd6fe0804e143..34ebfd9de6b1803d474ee441660b7e4d3be2979b 100644 (file)
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -244,8 +244,43 @@ struct value *
 evaluate_subexp_f (struct type *expect_type, struct expression *exp,
                   int *pos, enum noside noside)
 {
-  /* Currently no special handling is required. */
-  return evaluate_subexp_standard (expect_type, exp, pos, noside);
+  struct value *arg1 = NULL;
+  enum exp_opcode op;
+  int pc;
+  struct type *type;
+
+  pc = *pos;
+  *pos += 1;
+  op = exp->elts[pc].opcode;
+
+  switch (op)
+    {
+    default:
+      *pos -= 1;
+      return evaluate_subexp_standard (expect_type, exp, pos, noside);
+
+    case UNOP_KIND:
+      arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+      type = value_type (arg1);
+
+      switch (TYPE_CODE (type))
+        {
+          case TYPE_CODE_STRUCT:
+          case TYPE_CODE_UNION:
+          case TYPE_CODE_MODULE:
+          case TYPE_CODE_FUNC:
+            error (_("argument to kind must be an intrinsic type"));
+        }
+
+      if (!TYPE_TARGET_TYPE (type))
+        return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
+                                  TYPE_LENGTH (type));
+      return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
+                                TYPE_LENGTH (TYPE_TARGET_TYPE(type)));
+    }
+
+  /* Should be unreachable.  */
+  return nullptr;
 }
 
 static const char *f_extensions[] =

diff --git a/gdb/parse.c b/gdb/parse.c
index e7168acf7ab339e9381b13483c2ecdb31e329c24..661574e544e5c7ec6607e3c57613ebca7e20e625 100644 (file)
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -927,6 +927,7 @@ 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/parser-defs.h b/gdb/parser-defs.h
index 5d2ee331c05f100fd1eaa6cc53f800df072d352d..a607eea24938e5e9739e1268884f3e4b66ab0089 100644 (file)
--- a/gdb/parser-defs.h
+++ b/gdb/parser-defs.h
@@ -214,7 +214,8 @@ enum type_pieces
     tp_const, 
     tp_volatile, 
     tp_space_identifier,
-    tp_type_stack
+    tp_type_stack,
+    tp_kind
   };
 /* The stack can contain either an enum type_pieces or an int.  */
 union type_stack_elt

diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index 102c17715ada049fd560c349fbfbae46f031eaa4..e26861bd131a7cd1b4b475309c2627535e8db1dc 100644 (file)
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -244,6 +244,7 @@ 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)

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 296f03d65be1ce645126d2f7abd3b29796d2ed86..221e30012db2cfd779ab60978339e5ae8f82c6e2 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
+
+       * gdb.fortran/intrinsics.exp: New file.
+       * gdb.fortran/intrinsics.f90: New file.
+       * gdb.fortran/type-kinds.exp: New file.
+
 2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
 
        * gdb.fortran/dot-ops.exp: New file.

diff --git a/gdb/testsuite/gdb.fortran/intrinsics.exp b/gdb/testsuite/gdb.fortran/intrinsics.exp
new file mode 100644 (file)
index 0000000..674f299
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/intrinsics.exp
@@ -0,0 +1,42 @@
+# 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 tests GDB's handling of Fortran builtin intrinsic functions.
+
+load_lib "fortran.exp"
+
+if { [skip_fortran_tests] } { continue }
+
+standard_testfile .f90
+
+if { [prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}] } {
+    return -1
+}
+
+if { ![runto MAIN__] } {
+    perror "Could not run to breakpoint `MAIN__'."
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "stop-here"]
+gdb_continue_to_breakpoint "stop-here" ".*stop-here.*"
+
+# Test KIND
+
+gdb_test "p kind (l1)" " = 1"
+gdb_test "p kind (l2)" " = 2"
+gdb_test "p kind (l4)" " = 4"
+gdb_test "p kind (l8)" " = 8"
+gdb_test "p kind (s1)" "argument to kind must be an intrinsic type"

diff --git a/gdb/testsuite/gdb.fortran/intrinsics.f90 b/gdb/testsuite/gdb.fortran/intrinsics.f90
new file mode 100644 (file)
index 0000000..1be22ba
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/intrinsics.f90
@@ -0,0 +1,39 @@
+! 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/>.
+
+program test
+  logical :: l
+  logical (kind=1) :: l1
+  logical (kind=2) :: l2
+  logical (kind=4) :: l4
+  logical (kind=8) :: l8
+
+  type :: a_struct
+     logical :: a1
+     logical :: a2
+  end type a_struct
+
+  type (a_struct) :: s1
+
+  s1%a1 = .TRUE.
+  s1%a2 = .FALSE.
+
+  l1 = .TRUE.
+  l2 = .TRUE.
+  l4 = .TRUE.
+  l8 = .TRUE.
+
+  l = .FALSE.                                  ! stop-here
+end

diff --git a/gdb/testsuite/gdb.fortran/type-kinds.exp b/gdb/testsuite/gdb.fortran/type-kinds.exp
new file mode 100644 (file)
index 0000000..b60b804
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/type-kinds.exp
@@ -0,0 +1,35 @@
+# 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 is a set of tests related to GDB's ability to parse and
+# correctly handle the (kind=N) type adjustment mechanism within
+# Fortran.
+
+load_lib "fortran.exp"
+
+if { [skip_fortran_tests] } { continue }
+
+# Test parsing of `(kind=N)` type modifiers.
+proc test_basic_parsing_of_type_kinds {} {
+    gdb_test "p ((character (kind=1)) 1)" " = 1"
+}
+
+clean_restart
+
+if [set_lang_fortran] then {
+    test_basic_parsing_of_type_kinds
+} else {
+    warning "$test_name tests suppressed." 0
+}