# Copyright 2016 Free Software Foundation, Inc. | |
# This program is free software; you can redistribute it and/or modify | |
# it under the terms of the GNU General Public License as published by | |
# the Free Software Foundation; either version 3 of the License, or | |
# (at your option) any later version. | |
# | |
# This program is distributed in the hope that it will be useful, | |
# but WITHOUT ANY WARRANTY; without even the implied warranty of | |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
# GNU General Public License for more details. | |
# | |
# You should have received a copy of the GNU General Public License | |
# along with this program. If not, see <http://www.gnu.org/licenses/>. | |
standard_testfile ".f90" | |
load_lib "fortran.exp" | |
if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ | |
{debug f90 quiet}] } { | |
return -1 | |
} | |
if ![runto_main] { | |
untested "could not run to main" | |
return -1 | |
} | |
# Depending on the compiler being used, the type names can be printed differently. | |
set real [fortran_real4] | |
gdb_breakpoint [gdb_get_line_number "! Before vla allocation"] | |
gdb_continue_to_breakpoint "! Before vla allocation" ".*! Before vla allocation" | |
gdb_test "whatis wp_vla" "type = <not allocated>" | |
gdb_breakpoint [gdb_get_line_number "! After value assignment"] | |
gdb_continue_to_breakpoint "! After value assignment" ".*! After value assignment" | |
set test "p wp%coo" | |
gdb_test_multiple "$test" "$test" { | |
-re " = \\(1, 2, 1\\)\r\n$gdb_prompt $" { | |
pass "$test" | |
} | |
-re "There is no member named coo.\r\n$gdb_prompt $" { | |
kfail "gcc/49475" "$test" | |
} | |
} | |
gdb_test "p wp%point%coo" " = \\(1, 2, 1\\)" | |
gdb_test "p wp%point" " = \\( coo = \\(1, 2, 1\\) \\)" | |
gdb_test "p wp" " = \\( point = \\( coo = \\(1, 2, 1\\) \\), angle = 100 \\)" | |
gdb_test "whatis wp" "type = Type waypoint" | |
set output_pass [multi_line "type = Type, extends\\(point\\) :: waypoint" \ | |
" Type point :: point" \ | |
" $real :: angle" \ | |
"End Type waypoint"] | |
set output_kfail [multi_line "type = Type waypoint" \ | |
" Type point :: point" \ | |
" $real :: angle" \ | |
"End Type waypoint"] | |
set test "ptype wp" | |
gdb_test_multiple $test %test { | |
-re "$output_pass\r\n$gdb_prompt $" { | |
pass "$test" | |
} | |
-re "$output_kfail\r\n$gdb_prompt $" { | |
kfail "gcc/49475" "$test" | |
} | |
} | |
set test "ptype wp%coo" | |
gdb_test_multiple "$test" "$test" { | |
-re "$real \\(3\\)\r\n$gdb_prompt $" { | |
pass "$test" | |
} | |
-re "There is no member named coo.\r\n$gdb_prompt $" { | |
kfail "gcc/49475" "$test" | |
} | |
} | |
gdb_test "ptype wp%point%coo" "$real \\(3\\)" | |
set test "p wp_vla(1)%coo" | |
gdb_test_multiple "$test" "$test" { | |
-re " = \\(10, 12, 10\\)\r\n$gdb_prompt $" { | |
pass "$test" | |
} | |
-re "There is no member named coo.\r\n$gdb_prompt $" { | |
kfail "gcc/49475" "$test" | |
} | |
} | |
gdb_test "p wp_vla(1)%point%coo" " = \\(10, 12, 10\\)" | |
gdb_test "p wp_vla(1)%point" " = \\( coo = \\(10, 12, 10\\) \\)" | |
gdb_test "p wp_vla(1)" " = \\( point = \\( coo = \\(10, 12, 10\\) \\), angle = 101 \\)" | |
gdb_test "whatis wp_vla" "type = Type waypoint \\(3\\)" | |
set test "ptype wp_vla" | |
gdb_test_multiple $test %test { | |
-re "$output_pass \\(3\\)\r\n$gdb_prompt $" { | |
pass "$test" | |
} | |
-re "$output_kfail \\(3\\)\r\n$gdb_prompt $" { | |
kfail "gcc/49475" "$test" | |
} | |
} | |
set test "ptype wp_vla(1)%coo" | |
gdb_test_multiple "$test" "$test" { | |
-re "$real \\(3\\)\r\n$gdb_prompt $" { | |
pass "$test" | |
} | |
-re "There is no member named coo.\r\n$gdb_prompt $" { | |
kfail "gcc/49475" "$test" | |
} | |
} | |
gdb_test "ptype wp_vla(1)%point%coo" "$real \\(3\\)" |