gdb/fortran: Add allocatable type qualifier
authorAndrew Burgess <andrew.burgess@embecosm.com>
Thu, 7 Mar 2019 16:53:54 +0000 (16:53 +0000)
committerAndrew Burgess <andrew.burgess@embecosm.com>
Tue, 30 Apr 2019 09:36:57 +0000 (10:36 +0100)
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.

gdb/ChangeLog
gdb/f-typeprint.c
gdb/gdbtypes.h
gdb/testsuite/ChangeLog
gdb/testsuite/gdb.fortran/vla-datatypes.exp
gdb/testsuite/gdb.fortran/vla-ptype.exp
gdb/testsuite/gdb.fortran/vla-type.exp
gdb/testsuite/gdb.fortran/vla-value.exp
gdb/testsuite/gdb.mi/mi-vla-fortran.exp

index fcc784c4678a7443d325d253ec976d976e59e52b..f4a50e17887f514bcd789242f856785d6cd69f6d 100644 (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>
 
        * f-typeprint.c (f_print_type): Update rules for printing
index 66a450a65c7f3dfa4c7629539319a848fb841181..a7c1a00a71495d72932a1dc36c66df5308cc073a 100644 (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));
       break;
     }
+
+  if (TYPE_IS_ALLOCATABLE (type))
+    fprintf_filtered (stream, ", allocatable");
 }
index 147a2de355edc72eed5f91a84d4f95050325bb40..edea6f05474a3d48ce99afe8d0b43a989bc0f2a8 100644 (file)
@@ -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).
index 636d36d6044732228d6a374d78fc6e9cf5043fe3..d3be74d8c16c698bfd8f0c6b540314bd9ed21ff4 100644 (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>
 
        * gdb.fortran/ptr-indentation.exp: Update expected results.
index afe67742bc4da2857b192b27fd41537e805943fd..bb5ed276c22609f2eb46caf3c956d8ccc4b30de6 100644 (file)
@@ -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)"
index a40ad917da5ea03c2c63b7be990bdd4d1ae94825..0f4abb637571c697d0a9b5c1546fb50a0e51c634 100644 (file)
@@ -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"
index 407a447a851bc39d178ba11457135e1ac022b2ca..951f118194af63669c0eed728f67d873e37f0804 100755 (executable)
@@ -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\\(<not allocated>\\)" \
+                     "    $int, allocatable :: ivla\\(<not allocated>\\)" \
                      "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" ]
index 507137bed2186b748d0c775322004c9800756b9a..be397fd95fb96a8dc6b5612c5768df2a76d1890e 100644 (file)
@@ -35,7 +35,7 @@ gdb_breakpoint [gdb_get_line_number "vla1-init"]
 gdb_continue_to_breakpoint "vla1-init"
 gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
 gdb_test "print &vla1" \
-  " = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\) \\\)\\\) $hex" \
+  " = \\\(PTR TO -> \\\( $real, allocatable \\\(<not allocated>\\\) \\\)\\\) $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)"
index bf65bf914cf4fa5b9e3dd337f81b34447bdf5b01..0759ccbaebe69cf8574038bc07a0470548518a16 100644 (file)
@@ -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\"" \