From: Andrew Burgess <andrew.burgess@embecosm.com>
Date: Thu, 17 Jan 2019 16:30:35 +0000 (+0000)
Subject: gdb/fortran: Expand the set of types that support (kind=N)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3be47f7aa99dc90190e642a4e191c9f049e0a934;p=binutils-gdb.git

gdb/fortran: Expand the set of types that support (kind=N)

Expand the number of types that can be adjusted with a (kind=N) type
extension.

gdb/ChangeLog:

	* f-exp.y (convert_to_kind_type): Handle more type kinds.

gdb/testsuite/ChangeLog:

	* gdb.fortran/type-kinds.exp (test_cast_1_to_type_kind): New
	function.
	(test_basic_parsing_of_type_kinds): Expand types tested.
	(test_parsing_invalid_type_kinds): New function.
---

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index e2efdb24393..be7b96b132d 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,7 @@
+2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
+
+	* f-exp.y (convert_to_kind_type): Handle more type kinds.
+
 2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
 	    Chris January  <chris.january@arm.com>
 
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 327f13736bd..980ee4b4adb 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -830,6 +830,42 @@ convert_to_kind_type (struct type *basetype, int kind)
       if (kind == 1)
 	return parse_f_type (pstate)->builtin_character;
     }
+  else if (basetype == parse_f_type (pstate)->builtin_complex_s8)
+    {
+      if (kind == 4)
+	return parse_f_type (pstate)->builtin_complex_s8;
+      else if (kind == 8)
+	return parse_f_type (pstate)->builtin_complex_s16;
+      else if (kind == 16)
+	return parse_f_type (pstate)->builtin_complex_s32;
+    }
+  else if (basetype == parse_f_type (pstate)->builtin_real)
+    {
+      if (kind == 4)
+	return parse_f_type (pstate)->builtin_real;
+      else if (kind == 8)
+	return parse_f_type (pstate)->builtin_real_s8;
+      else if (kind == 16)
+	return parse_f_type (pstate)->builtin_real_s16;
+    }
+  else if (basetype == parse_f_type (pstate)->builtin_logical)
+    {
+      if (kind == 1)
+	return parse_f_type (pstate)->builtin_logical_s1;
+      else if (kind == 2)
+	return parse_f_type (pstate)->builtin_logical_s2;
+      else if (kind == 4)
+	return parse_f_type (pstate)->builtin_logical;
+      else if (kind == 8)
+	return parse_f_type (pstate)->builtin_logical_s8;
+    }
+  else if (basetype == parse_f_type (pstate)->builtin_integer)
+    {
+      if (kind == 2)
+	return parse_f_type (pstate)->builtin_integer_s2;
+      else if (kind == 4)
+	return parse_f_type (pstate)->builtin_integer;
+    }
 
   error (_("unsupported kind %d for type %s"),
 	 kind, TYPE_SAFE_NAME (basetype));
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 221e30012db..a4411652b74 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
+
+	* gdb.fortran/type-kinds.exp (test_cast_1_to_type_kind): New
+	function.
+	(test_basic_parsing_of_type_kinds): Expand types tested.
+	(test_parsing_invalid_type_kinds): New function.
+
 2019-03-06  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* gdb.fortran/intrinsics.exp: New file.
diff --git a/gdb/testsuite/gdb.fortran/type-kinds.exp b/gdb/testsuite/gdb.fortran/type-kinds.exp
index b60b8044110..c679bc504f9 100644
--- a/gdb/testsuite/gdb.fortran/type-kinds.exp
+++ b/gdb/testsuite/gdb.fortran/type-kinds.exp
@@ -21,15 +21,54 @@ load_lib "fortran.exp"
 
 if { [skip_fortran_tests] } { continue }
 
+# Cast the value 1 to the type 'BASE_TYPE (kind=TYPE_KIND)'.  The
+# expected result of the cast is CAST_RESULT, and the size of the
+# value returned by the cast should be SIZE_RESULT.
+proc test_cast_1_to_type_kind {base_type type_kind cast_result size_result} {
+    set type_string "$base_type (kind=$type_kind)"
+    gdb_test "p (($type_string) 1)" " = $cast_result"
+
+    if {($base_type == "real" || $base_type == "complex")
+	&& $type_kind == 16} {
+	setup_kfail gdb/18644 "*-*-*"
+    }
+
+    gdb_test "p sizeof (($type_string) 1)" " = $size_result"
+}
+
 # Test parsing of `(kind=N)` type modifiers.
 proc test_basic_parsing_of_type_kinds {} {
-    gdb_test "p ((character (kind=1)) 1)" " = 1"
+    test_cast_1_to_type_kind "character" "1" "1" "1"
+
+    test_cast_1_to_type_kind "complex" "4" "\\(1,0\\)" "8"
+    test_cast_1_to_type_kind "complex" "8" "\\(1,0\\)" "16"
+    test_cast_1_to_type_kind "complex" "16" "\\(1,0\\)" "32"
+
+    test_cast_1_to_type_kind "real" "4" "1" "4"
+    test_cast_1_to_type_kind "real" "8" "1" "8"
+    test_cast_1_to_type_kind "real" "16" "1" "16"
+
+    test_cast_1_to_type_kind "logical" "1" "\\.TRUE\\." "1"
+    test_cast_1_to_type_kind "logical" "4" "\\.TRUE\\." "4"
+    test_cast_1_to_type_kind "logical" "8" "\\.TRUE\\." "8"
+
+    test_cast_1_to_type_kind "integer" "2" "1" "2"
+    test_cast_1_to_type_kind "integer" "4" "1" "4"
+}
+
+proc test_parsing_invalid_type_kinds {} {
+    foreach typename {complex real logical integer} {
+	foreach typesize {3 5 7 9} {
+	    gdb_test "p (($typename (kind=$typesize)) 1)" "unsupported kind $typesize for type $typename.*"
+	}
+    }
 }
 
 clean_restart
 
 if [set_lang_fortran] then {
     test_basic_parsing_of_type_kinds
+    test_parsing_invalid_type_kinds
 } else {
     warning "$test_name tests suppressed." 0
 }