FreeChainXenon/binutils-gdb
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gdb/fortran: Add allocatable type qualifier

Browse source 
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.
This commit is contained in:
Andrew Burgess 2019-03-07 16:53:54 +00:00
parent f1fdc96066
commit bc68014d16
9 changed files with 45 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

7
gdb/ChangeLog
View file

@ -1,3 +1,10 @@
2019-04-30 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-04-30 Andrew Burgess <andrew.burgess@embecosm.com> 2019-04-30 Andrew Burgess <andrew.burgess@embecosm.com>
* f-typeprint.c (f_print_type): Update rules for printing * f-typeprint.c (f_print_type): Update rules for printing

3
gdb/f-typeprint.c
View file

@ -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)); error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
break; break;
} }
if (TYPE_IS_ALLOCATABLE (type))
fprintf_filtered (stream, ", allocatable");
} }

4
gdb/gdbtypes.h
View file

@ -350,6 +350,10 @@ DEF_ENUM_FLAGS_TYPE (enum type_instance_flag_value, type_instance_flags);
#define TYPE_IS_REFERENCE(t) \ #define TYPE_IS_REFERENCE(t) \
(TYPE_CODE (t) == TYPE_CODE_REF || TYPE_CODE (t) == TYPE_CODE_RVALUE_REF) (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 /* * Instruction-space delimited type. This is for Harvard architectures
which have separate instruction and data address spaces (and perhaps which have separate instruction and data address spaces (and perhaps
others). others).

7
gdb/testsuite/ChangeLog
View file

@ -1,3 +1,10 @@
2019-04-30 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-04-30 Andrew Burgess <andrew.burgess@embecosm.com> 2019-04-30 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/ptr-indentation.exp: Update expected results. * gdb.fortran/ptr-indentation.exp: Update expected results.

10
gdb/testsuite/gdb.fortran/vla-datatypes.exp
View file

@ -55,15 +55,15 @@ gdb_test "print l" " = \\.TRUE\\." "charactervla allocated"
gdb_breakpoint [gdb_get_line_number "vlas-initialized"] gdb_breakpoint [gdb_get_line_number "vlas-initialized"]
gdb_continue_to_breakpoint "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" "ptype intvla"
gdb_test "ptype realvla" "type = $real \\\(11,22,33\\\)" \ gdb_test "ptype realvla" "type = $real, allocatable \\\(11,22,33\\\)" \
"ptype realvla" "ptype realvla"
gdb_test "ptype complexvla" "type = $complex \\\(11,22,33\\\)" \ gdb_test "ptype complexvla" "type = $complex, allocatable \\\(11,22,33\\\)" \
"ptype complexvla" "ptype complexvla"
gdb_test "ptype logicalvla" "type = $logical \\\(11,22,33\\\)" \ gdb_test "ptype logicalvla" "type = $logical, allocatable \\\(11,22,33\\\)" \
"ptype logicalvla" "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" "ptype charactervla"
gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)"

8
gdb/testsuite/gdb.fortran/vla-ptype.exp
View file

@ -43,24 +43,24 @@ gdb_test "ptype vla2(5, 45, 20)" \
gdb_breakpoint [gdb_get_line_number "vla1-allocated"] gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
gdb_continue_to_breakpoint "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" "ptype vla1 allocated"
gdb_breakpoint [gdb_get_line_number "vla2-allocated"] gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
gdb_continue_to_breakpoint "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" "ptype vla2 allocated"
gdb_breakpoint [gdb_get_line_number "vla1-filled"] gdb_breakpoint [gdb_get_line_number "vla1-filled"]
gdb_continue_to_breakpoint "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" "ptype vla1 filled"
gdb_test "ptype vla1(3, 6, 9)" "type = $real" \ gdb_test "ptype vla1(3, 6, 9)" "type = $real" \
"ptype vla1(3, 6, 9)" "ptype vla1(3, 6, 9)"
gdb_breakpoint [gdb_get_line_number "vla2-filled"] gdb_breakpoint [gdb_get_line_number "vla2-filled"]
gdb_continue_to_breakpoint "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" "ptype vla2 filled"
gdb_test "ptype vla2(5, 45, 20)" "type = $real" \ gdb_test "ptype vla2(5, 45, 20)" "type = $real" \
"ptype vla2(5, 45, 20) filled" "ptype vla2(5, 45, 20) filled"

22
gdb/testsuite/gdb.fortran/vla-type.exp
View file

@ -46,7 +46,7 @@ gdb_test "print onev%ivla(1, 2, 3)" " = 123"
gdb_test "print onev%ivla(3, 2, 1)" " = 321" gdb_test "print onev%ivla(3, 2, 1)" " = 321"
gdb_test "ptype onev" \ gdb_test "ptype onev" \
[multi_line "type = Type one" \ [multi_line "type = Type one" \
"\\s+$int :: ivla\\\(11,22,33\\\)" \ "\\s+$int, allocatable :: ivla\\\(11,22,33\\\)" \
"End Type one" ] "End Type one" ]
# Check type with two VLA's inside # 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 "print twov%ivla1(3, 2, 1)" " = 321"
gdb_test "ptype twov" \ gdb_test "ptype twov" \
[multi_line "type = Type two" \ [multi_line "type = Type two" \
"\\s+$int :: ivla1\\\(5,12,99\\\)" \ "\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \
"\\s+$int :: ivla2\\\(9,12\\\)" \ "\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \
"End Type two" ] "End Type two" ]
gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\ gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
\\\( 1, 1, 321, 1, 1\\\)\ \\\( 1, 1, 321, 1, 1\\\)\
@ -74,7 +74,7 @@ gdb_test "print threev%ivar" " = 3"
gdb_test "ptype threev" \ gdb_test "ptype threev" \
[multi_line "type = Type three" \ [multi_line "type = Type three" \
"\\s+$int :: ivar" \ "\\s+$int :: ivar" \
"\\s+$int :: ivla\\\(20\\\)" \ "\\s+$int, allocatable :: ivla\\\(20\\\)" \
"End Type three" ] "End Type three" ]
# Check type with attribute at end of type # 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 "print fourv%ivar" " = 3"
gdb_test "ptype fourv" \ gdb_test "ptype fourv" \
[multi_line "type = Type four" \ [multi_line "type = Type four" \
"\\s+$int :: ivla\\\(10\\\)" \ "\\s+$int, allocatable :: ivla\\\(10\\\)" \
"\\s+$int :: ivar" \ "\\s+$int :: ivar" \
"End Type four" ] "End Type four" ]
@ -103,7 +103,7 @@ gdb_test "ptype fivev" \
"End Type five" ] "End Type five" ]
gdb_test "ptype fivev%tone" \ gdb_test "ptype fivev%tone" \
[multi_line "type = Type one" \ [multi_line "type = Type one" \
" $int :: ivla\\(10,10,10\\)" \ " $int, allocatable :: ivla\\(10,10,10\\)" \
"End Type one" ] "End Type one" ]
# Check array of types containing a VLA # Check array of types containing a VLA
@ -120,7 +120,7 @@ gdb_test "ptype fivearr(1)" \
"End Type five" ] "End Type five" ]
gdb_test "ptype fivearr(1)%tone" \ gdb_test "ptype fivearr(1)%tone" \
[multi_line "type = Type one" \ [multi_line "type = Type one" \
" $int :: ivla\\(2,4,6\\)" \ " $int, allocatable :: ivla\\(2,4,6\\)" \
"End Type one" ] "End Type one" ]
gdb_test "ptype fivearr(2)" \ gdb_test "ptype fivearr(2)" \
[multi_line "type = Type five" \ [multi_line "type = Type five" \
@ -128,7 +128,7 @@ gdb_test "ptype fivearr(2)" \
"End Type five" ] "End Type five" ]
gdb_test "ptype fivearr(2)%tone" \ gdb_test "ptype fivearr(2)%tone" \
[multi_line "type = Type one" \ [multi_line "type = Type one" \
" $int :: ivla\\(12,14,16\\)" \ " $int, allocatable :: ivla\\(12,14,16\\)" \
"End Type one" ] "End Type one" ]
# Check allocation status of dynamic array and it's dynamic members # 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" "ptype fivedynarr(2), tone is not allocated"
gdb_test "ptype fivedynarr(2)%tone" \ gdb_test "ptype fivedynarr(2)%tone" \
[multi_line "type = Type one" \ [multi_line "type = Type one" \
" $int :: ivla\\(<not allocated>\\)" \ " $int, allocatable :: ivla\\(<not allocated>\\)" \
"End Type one" ] \ "End Type one" ] \
"ptype fivedynarr(2)%tone, not allocated" "ptype fivedynarr(2)%tone, not allocated"
@ -159,7 +159,7 @@ gdb_test "ptype fivedynarr(1)" \
"End Type five" ] "End Type five" ]
gdb_test "ptype fivedynarr(1)%tone" \ gdb_test "ptype fivedynarr(1)%tone" \
[multi_line "type = Type one" \ [multi_line "type = Type one" \
" $int :: ivla\\(2,4,6\\)" \ " $int, allocatable :: ivla\\(2,4,6\\)" \
"End Type one" ] "End Type one" ]
gdb_test "ptype fivedynarr(2)" \ gdb_test "ptype fivedynarr(2)" \
[multi_line "type = Type five" \ [multi_line "type = Type five" \
@ -167,5 +167,5 @@ gdb_test "ptype fivedynarr(2)" \
"End Type five" ] "End Type five" ]
gdb_test "ptype fivedynarr(2)%tone" \ gdb_test "ptype fivedynarr(2)%tone" \
[multi_line "type = Type one" \ [multi_line "type = Type one" \
" $int :: ivla\\(12,14,16\\)" \ " $int, allocatable :: ivla\\(12,14,16\\)" \
"End Type one" ] "End Type one" ]

4
gdb/testsuite/gdb.fortran/vla-value.exp
View file

@ -35,7 +35,7 @@ gdb_breakpoint [gdb_get_line_number "vla1-init"]
gdb_continue_to_breakpoint "vla1-init" gdb_continue_to_breakpoint "vla1-init"
gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
gdb_test "print &vla1" \ gdb_test "print &vla1" \
" = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\) \\\)\\\) $hex" \ " = \\\(PTR TO -> \\\( $real, allocatable \\\(<not allocated>\\\) \\\)\\\) $hex" \
"print non-allocated &vla1" "print non-allocated &vla1"
gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \ gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \
"print member in non-allocated vla1 (1)" "print member in non-allocated vla1 (1)"
@ -56,7 +56,7 @@ with_timeout_factor 15 {
"step over value assignment of vla1" "step over value assignment of vla1"
} }
gdb_test "print &vla1" \ gdb_test "print &vla1" \
" = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\) \\\)\\\) $hex" \ " = \\\(PTR TO -> \\\( $real, allocatable \\\(10,10,10\\\) \\\)\\\) $hex" \
"print allocated &vla1" "print allocated &vla1"
gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)" 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)" gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)"

4
gdb/testsuite/gdb.mi/mi-vla-fortran.exp
View file

@ -77,10 +77,10 @@ mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
mi_gdb_test "510-data-evaluate-expression vla1" \ mi_gdb_test "510-data-evaluate-expression vla1" \
"510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla" "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" "create local variable vla1_allocated"
mi_gdb_test "511-var-info-type 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" "info type variable vla1_allocated"
mi_gdb_test "512-var-show-format vla1_allocated" \ mi_gdb_test "512-var-show-format vla1_allocated" \
"512\\^done,format=\"natural\"" \ "512\\^done,format=\"natural\"" \