@@ -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");
}
@@ -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).
@@ -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)"
@@ -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"
@@ -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" ]
@@ -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)"
@@ -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\"" \