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.
This commit is contained in:
Andrew Burgess 2019-01-17 16:30:35 +00:00
parent 4d00f5d8f6
commit 3be47f7aa9
4 changed files with 87 additions and 1 deletions

View File

@ -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>

View File

@ -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));

View File

@ -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.

View File

@ -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
}