Commit | Line | Data |
---|---|---|
b811d2c2 | 1 | # Copyright 2016-2020 Free Software Foundation, Inc. |
9920b434 BH |
2 | |
3 | # This program is free software; you can redistribute it and/or modify | |
4 | # it under the terms of the GNU General Public License as published by | |
5 | # the Free Software Foundation; either version 3 of the License, or | |
6 | # (at your option) any later version. | |
7 | # | |
8 | # This program is distributed in the hope that it will be useful, | |
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | # GNU General Public License for more details. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
14 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | |
15 | ||
16 | standard_testfile ".f90" | |
17 | load_lib "fortran.exp" | |
18 | ||
a54a7f13 PA |
19 | if {[skip_fortran_tests]} { return -1 } |
20 | ||
5b362f04 | 21 | if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile} \ |
9920b434 BH |
22 | {debug f90 quiet}] } { |
23 | return -1 | |
24 | } | |
25 | ||
86cd6bc8 | 26 | if ![fortran_runto_main] { |
9920b434 BH |
27 | untested "could not run to main" |
28 | return -1 | |
29 | } | |
30 | ||
31 | # Depending on the compiler being used, the type names can be printed differently. | |
32 | set int [fortran_int4] | |
33 | ||
34 | # Check if not allocated VLA in type does not break | |
35 | # the debugger when accessing it. | |
c2fd7fae AKS |
36 | # break main for Flang compiler already breaks here |
37 | if ![test_compiler_info "clang-*"] { | |
38 | gdb_breakpoint [gdb_get_line_number "before-allocated"] | |
39 | gdb_continue_to_breakpoint "before-allocated" | |
40 | } | |
41 | ||
04d59df6 | 42 | gdb_test "print twov" " = \\\( ivla1 = <not allocated>, ivla2 = <not allocated> \\\)" \ |
9920b434 BH |
43 | "print twov before allocated" |
44 | gdb_test "print twov%ivla1" " = <not allocated>" \ | |
45 | "print twov%ivla1 before allocated" | |
46 | ||
47 | # Check type with one VLA's inside | |
48 | gdb_breakpoint [gdb_get_line_number "onev-filled"] | |
49 | gdb_continue_to_breakpoint "onev-filled" | |
50 | gdb_test "print onev%ivla(5, 11, 23)" " = 1" | |
51 | gdb_test "print onev%ivla(1, 2, 3)" " = 123" | |
52 | gdb_test "print onev%ivla(3, 2, 1)" " = 321" | |
53 | gdb_test "ptype onev" \ | |
54 | [multi_line "type = Type one" \ | |
bc68014d | 55 | "\\s+$int, allocatable :: ivla\\\(11,22,33\\\)" \ |
9920b434 BH |
56 | "End Type one" ] |
57 | ||
58 | # Check type with two VLA's inside | |
59 | gdb_breakpoint [gdb_get_line_number "twov-filled"] | |
60 | gdb_continue_to_breakpoint "twov-filled" | |
61 | gdb_test "print twov%ivla1(5, 11, 23)" " = 1" | |
62 | gdb_test "print twov%ivla1(1, 2, 3)" " = 123" | |
63 | gdb_test "print twov%ivla1(3, 2, 1)" " = 321" | |
64 | gdb_test "ptype twov" \ | |
65 | [multi_line "type = Type two" \ | |
bc68014d AB |
66 | "\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \ |
67 | "\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \ | |
9920b434 | 68 | "End Type two" ] |
c8d5abea AB |
69 | gdb_test "print twov" " = \\\( ivla1 = \\\(\\\(\\\(1, 1, 1, 1, 1\\\)\ |
70 | \\\(1, 1, 321, 1, 1\\\)\ | |
71 | \\\(1, 1, 1, 1, 1\\\) .*" | |
9920b434 BH |
72 | |
73 | # Check type with attribute at beginn of type | |
74 | gdb_breakpoint [gdb_get_line_number "threev-filled"] | |
75 | gdb_continue_to_breakpoint "threev-filled" | |
76 | gdb_test "print threev%ivla(1)" " = 1" | |
77 | gdb_test "print threev%ivla(5)" " = 42" | |
78 | gdb_test "print threev%ivla(14)" " = 24" | |
79 | gdb_test "print threev%ivar" " = 3" | |
80 | gdb_test "ptype threev" \ | |
81 | [multi_line "type = Type three" \ | |
82 | "\\s+$int :: ivar" \ | |
bc68014d | 83 | "\\s+$int, allocatable :: ivla\\\(20\\\)" \ |
9920b434 BH |
84 | "End Type three" ] |
85 | ||
86 | # Check type with attribute at end of type | |
87 | gdb_breakpoint [gdb_get_line_number "fourv-filled"] | |
88 | gdb_continue_to_breakpoint "fourv-filled" | |
89 | gdb_test "print fourv%ivla(1)" " = 1" | |
90 | gdb_test "print fourv%ivla(2)" " = 2" | |
91 | gdb_test "print fourv%ivla(7)" " = 7" | |
92 | gdb_test "print fourv%ivla(12)" "no such vector element" | |
93 | gdb_test "print fourv%ivar" " = 3" | |
94 | gdb_test "ptype fourv" \ | |
95 | [multi_line "type = Type four" \ | |
bc68014d | 96 | "\\s+$int, allocatable :: ivla\\\(10\\\)" \ |
9920b434 BH |
97 | "\\s+$int :: ivar" \ |
98 | "End Type four" ] | |
99 | ||
100 | # Check nested types containing a VLA | |
101 | gdb_breakpoint [gdb_get_line_number "fivev-filled"] | |
102 | gdb_continue_to_breakpoint "fivev-filled" | |
103 | gdb_test "print fivev%tone%ivla(5, 5, 1)" " = 1" | |
104 | gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123" | |
105 | gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321" | |
106 | gdb_test "ptype fivev" \ | |
107 | [multi_line "type = Type five" \ | |
e188eb36 | 108 | "\\s+Type one :: tone" \ |
9920b434 | 109 | "End Type five" ] |
86d8a848 BH |
110 | gdb_test "ptype fivev%tone" \ |
111 | [multi_line "type = Type one" \ | |
bc68014d | 112 | " $int, allocatable :: ivla\\(10,10,10\\)" \ |
86d8a848 | 113 | "End Type one" ] |
8f07e298 BH |
114 | |
115 | # Check array of types containing a VLA | |
116 | gdb_breakpoint [gdb_get_line_number "fivearr-filled"] | |
117 | gdb_continue_to_breakpoint "fivearr-filled" | |
118 | gdb_test "print fivearr(1)%tone%ivla(1, 2, 3)" " = 1" | |
119 | gdb_test "print fivearr(1)%tone%ivla(2, 2, 10)" "no such vector element" | |
120 | gdb_test "print fivearr(1)%tone%ivla(2, 2, 3)" " = 223" | |
121 | gdb_test "print fivearr(2)%tone%ivla(12, 14, 16)" " = 2" | |
122 | gdb_test "print fivearr(2)%tone%ivla(6, 7, 8)" " = 678" | |
123 | gdb_test "ptype fivearr(1)" \ | |
124 | [multi_line "type = Type five" \ | |
e188eb36 | 125 | "\\s+Type one :: tone" \ |
8f07e298 | 126 | "End Type five" ] |
86d8a848 BH |
127 | gdb_test "ptype fivearr(1)%tone" \ |
128 | [multi_line "type = Type one" \ | |
bc68014d | 129 | " $int, allocatable :: ivla\\(2,4,6\\)" \ |
86d8a848 | 130 | "End Type one" ] |
8f07e298 BH |
131 | gdb_test "ptype fivearr(2)" \ |
132 | [multi_line "type = Type five" \ | |
e188eb36 | 133 | "\\s+Type one :: tone" \ |
8f07e298 | 134 | "End Type five" ] |
86d8a848 BH |
135 | gdb_test "ptype fivearr(2)%tone" \ |
136 | [multi_line "type = Type one" \ | |
bc68014d | 137 | " $int, allocatable :: ivla\\(12,14,16\\)" \ |
86d8a848 | 138 | "End Type one" ] |
8f07e298 BH |
139 | |
140 | # Check allocation status of dynamic array and it's dynamic members | |
584a927c AB |
141 | gdb_test "ptype fivedynarr" \ |
142 | [multi_line "type = Type five" \ | |
143 | " Type one :: tone" \ | |
144 | "End Type five, allocatable \\(:\\)" ] | |
8f07e298 BH |
145 | gdb_test "next" "" |
146 | gdb_test "ptype fivedynarr(2)" \ | |
147 | [multi_line "type = Type five" \ | |
e188eb36 | 148 | "\\s+Type one :: tone" \ |
8b70175d BH |
149 | "End Type five" ] \ |
150 | "ptype fivedynarr(2), tone is not allocated" | |
86d8a848 BH |
151 | gdb_test "ptype fivedynarr(2)%tone" \ |
152 | [multi_line "type = Type one" \ | |
584a927c | 153 | " $int, allocatable :: ivla\\(:,:,:\\)" \ |
86d8a848 BH |
154 | "End Type one" ] \ |
155 | "ptype fivedynarr(2)%tone, not allocated" | |
8f07e298 BH |
156 | |
157 | # Check dynamic array of types containing a VLA | |
158 | gdb_breakpoint [gdb_get_line_number "fivedynarr-filled"] | |
159 | gdb_continue_to_breakpoint "fivedynarr-filled" | |
160 | gdb_test "print fivedynarr(1)%tone%ivla(1, 2, 3)" " = 1" | |
161 | gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 10)" "no such vector element" | |
162 | gdb_test "print fivedynarr(1)%tone%ivla(2, 2, 3)" " = 223" | |
163 | gdb_test "print fivedynarr(2)%tone%ivla(12, 14, 16)" " = 2" | |
164 | gdb_test "print fivedynarr(2)%tone%ivla(6, 7, 8)" " = 678" | |
165 | gdb_test "ptype fivedynarr(1)" \ | |
166 | [multi_line "type = Type five" \ | |
e188eb36 | 167 | "\\s+Type one :: tone" \ |
8f07e298 | 168 | "End Type five" ] |
86d8a848 BH |
169 | gdb_test "ptype fivedynarr(1)%tone" \ |
170 | [multi_line "type = Type one" \ | |
bc68014d | 171 | " $int, allocatable :: ivla\\(2,4,6\\)" \ |
86d8a848 | 172 | "End Type one" ] |
8f07e298 BH |
173 | gdb_test "ptype fivedynarr(2)" \ |
174 | [multi_line "type = Type five" \ | |
e188eb36 | 175 | "\\s+Type one :: tone" \ |
8f07e298 | 176 | "End Type five" ] |
86d8a848 BH |
177 | gdb_test "ptype fivedynarr(2)%tone" \ |
178 | [multi_line "type = Type one" \ | |
bc68014d | 179 | " $int, allocatable :: ivla\\(12,14,16\\)" \ |
86d8a848 | 180 | "End Type one" ] |