diff --git a/gdb/ChangeLog b/gdb/ChangeLog index fcc784c4678..f4a50e17887 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,10 @@ +2019-04-30 Andrew Burgess + Chris January + + * f-typeprint.c (f_type_print_base): Print 'allocatable' type + qualifier. + * gdbtypes.h (TYPE_IS_ALLOCATABLE): Define. + 2019-04-30 Andrew Burgess * f-typeprint.c (f_print_type): Update rules for printing 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 147a2de355e..edea6f05474 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 636d36d6044..d3be74d8c16 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2019-04-30 Andrew Burgess + + * 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 * 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\\(\\)" \ + " $int, allocatable :: ivla\\(\\)" \ "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" " = " "print non-allocated vla1" gdb_test "print &vla1" \ - " = \\\(PTR TO -> \\\( $real \\\(\\\) \\\)\\\) $hex" \ + " = \\\(PTR TO -> \\\( $real, allocatable \\\(\\\) \\\)\\\) $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\"" \