1# Copyright 2005-2020 Free Software Foundation, Inc.
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# This file was written by Wu Zhou. (woodzltc@cn.ibm.com)
17
18# This file is part of the gdb testsuite.  It contains tests for evaluating
19# Fortran subarray expression.
20
21if { [skip_fortran_tests] } { return -1 }
22
23standard_testfile .f
24load_lib fortran.exp
25
26if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}]} {
27    return -1
28}
29
30gdb_exit
31gdb_start
32gdb_reinitialize_dir $srcdir/$subdir
33gdb_load ${binfile}
34
35if ![fortran_runto_main] then {
36    perror "couldn't run to main"
37    continue
38}
39
40# Try to set breakpoint at the last write statement.
41
42set bp_location [gdb_get_line_number "str(:)"]
43gdb_test "break $bp_location" \
44    "Breakpoint.*at.* file .*$srcfile, line $bp_location\\." \
45    "breakpoint at the last write statement"
46gdb_test "continue" \
47    "Continuing\\..*Breakpoint.*" \
48    "continue to breakpoint"
49
50# Test four different kinds of subarray expression evaluation.
51
52set test "print str(2:4)"
53gdb_test_multiple $test $test {
54    -re "\\$\[0-9\]+ = 'bcd'\r\n$gdb_prompt $" {
55	pass $test
56    }
57    -re "\\$\[0-9\]+ = \\(98 'b', 99 'c', 100 'd'\\)\r\n$gdb_prompt $" {
58	# Compiler should produce string, not an array of characters.
59	setup_xfail "*-*-*"
60	fail $test
61    }
62}
63
64set test "print str(:3)"
65gdb_test_multiple $test $test {
66    -re "\\$\[0-9\]+ = 'abc'\r\n$gdb_prompt $" {
67	pass $test
68    }
69    -re "\\$\[0-9\]+ = \\(97 'a', 98 'b', 99 'c'\\)\r\n$gdb_prompt $" {
70	# Compiler should produce string, not an array of characters.
71	setup_xfail "*-*-*"
72	fail $test
73    }
74}
75
76set test "print str(5:)"
77gdb_test_multiple $test $test {
78    -re "\\$\[0-9\]+ = 'efg'\r\n$gdb_prompt $" {
79	pass $test
80    }
81    -re "\\$\[0-9\]+ = \\(101 'e', 102 'f', 103 'g'\\)\r\n$gdb_prompt $" {
82	# Compiler should produce string, not an array of characters.
83	setup_xfail "*-*-*"
84	fail $test
85    }
86}
87
88set test "print str(:)"
89gdb_test_multiple $test $test {
90    -re "\\$\[0-9\]+ = 'abcdefg'\r\n$gdb_prompt $" {
91	pass $test
92    }
93    -re "\\$\[0-9\]+ = \\(97 'a', 98 'b', 99 'c', 100 'd', 101 'e', 102 'f', 103 'g'\\)\r\n$gdb_prompt $" {
94	# Compiler should produce string, not an array of characters.
95	setup_xfail "*-*-*"
96	fail $test
97    }
98}
99
100gdb_test "print array(2:4)" "\\$\[0-9\]+ = \\(2, 3, 4\\)"
101gdb_test "print array(:3)" "\\$\[0-9\]+ = \\(1, 2, 3\\)"
102gdb_test "print array(5:)" "\\$\[0-9\]+ = \\(5, 6, 7\\)"
103gdb_test "print array(:)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7\\)"
104