Skip to content

Commit 1069abe

Browse files
ivanivanov884jeffmahoney
ivanivanov884
authored and
jeffmahoney
committed
gdb-vla-intel-tests.patch
;;=fedoratest
1 parent 29b9eb6 commit 1069abe

File tree

4 files changed

+273
-0
lines changed

4 files changed

+273
-0
lines changed

‎gdb/testsuite/gdb.fortran/vla-func.exp

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
# Copyright 2014 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+
standard_testfile ".f90"
17+
18+
if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
19+
{debug f90 quiet}] } {
20+
return -1
21+
}
22+
23+
if ![runto MAIN__] then {
24+
perror "couldn't run to breakpoint MAIN__"
25+
continue
26+
}
27+
28+
# Check VLA passed to first Fortran function.
29+
gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]
30+
gdb_continue_to_breakpoint "func1-vla-passed"
31+
gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \
32+
"print vla (func1)"
33+
gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \
34+
"ptype vla (func1)"
35+
36+
gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]
37+
gdb_continue_to_breakpoint "func1-vla-modified"
38+
gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"
39+
gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"
40+
41+
# Check if the values are correct after returning from func1
42+
gdb_breakpoint [gdb_get_line_number "func1-returned"]
43+
gdb_continue_to_breakpoint "func1-returned"
44+
gdb_test "print ret" " = .TRUE." "print ret after func1 returned"
45+
46+
# Check VLA passed to second Fortran function
47+
gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]
48+
gdb_continue_to_breakpoint "func2-vla-passed"
49+
gdb_test "print vla" \
50+
" = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \
51+
"print vla (func2)"
52+
gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
53+
"ptype vla (func2)"
54+
55+
# Check if the returned VLA has the correct values and ptype.
56+
gdb_breakpoint [gdb_get_line_number "func2-returned"]
57+
gdb_continue_to_breakpoint "func2-returned"
58+
gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \
59+
"print vla3 (after func2)"
60+
gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
61+
"ptype vla3 (after func2)"

‎gdb/testsuite/gdb.fortran/vla-func.f90

Lines changed: 71 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,71 @@
1+
! Copyright 2014 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 2 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, write to the Free Software
15+
! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
16+
17+
logical function func1 (vla)
18+
implicit none
19+
integer, allocatable :: vla (:, :)
20+
func1 = allocated(vla)
21+
vla(5,5) = 55 ! func1-vla-passed
22+
vla(7,7) = 77
23+
return ! func1-vla-modified
24+
end function func1
25+
26+
function func2(vla)
27+
implicit none
28+
integer :: vla (:)
29+
integer :: func2(size(vla))
30+
integer :: k
31+
32+
vla(1) = 1 ! func2-vla-passed
33+
vla(2) = 2
34+
vla(4) = 4
35+
vla(8) = 8
36+
37+
func2 = vla
38+
end function func2
39+
40+
program vla_func
41+
implicit none
42+
interface
43+
logical function func1 (vla)
44+
integer, allocatable :: vla (:, :)
45+
end function
46+
end interface
47+
interface
48+
function func2 (vla)
49+
integer :: vla (:)
50+
integer func2(size(vla))
51+
end function
52+
end interface
53+
54+
logical :: ret
55+
integer, allocatable :: vla1 (:, :)
56+
integer, allocatable :: vla2 (:)
57+
integer, allocatable :: vla3 (:)
58+
59+
ret = .FALSE.
60+
61+
allocate (vla1 (10,10))
62+
vla1(:,:) = 22
63+
64+
allocate (vla2 (10))
65+
vla2(:) = 44
66+
67+
ret = func1(vla1)
68+
vla3 = func2(vla2) ! func1-returned
69+
70+
ret = .TRUE. ! func2-returned
71+
end program vla_func

‎gdb/testsuite/gdb.fortran/vla-stringsold.exp

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
# Copyright 2014 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+
standard_testfile ".f90"
17+
18+
if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
19+
{debug f90 quiet}] } {
20+
return -1
21+
}
22+
23+
# check that all fortran standard datatypes will be
24+
# handled correctly when using as VLA's
25+
26+
if ![runto MAIN__] then {
27+
perror "couldn't run to breakpoint MAIN__"
28+
continue
29+
}
30+
31+
gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
32+
gdb_continue_to_breakpoint "var_char-allocated-1"
33+
gdb_test "print var_char" \
34+
" = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \
35+
"print var_char after allocated first time"
36+
gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10 \\)" \
37+
"whatis var_char first time"
38+
gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10 \\)" \
39+
"ptype var_char first time"
40+
gdb_test "next" "\\d+.*var_char = 'foo'.*" \
41+
"next to allocation status of var_char"
42+
gdb_test "print l" " = .TRUE." "print allocation status first time"
43+
44+
gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
45+
gdb_continue_to_breakpoint "var_char-filled-1"
46+
gdb_test "print var_char" \
47+
" = \\(PTR TO -> \\( character\\*3 \\)\\) ${hex}" \
48+
"print var_char after filled first time"
49+
gdb_test "print *var_char" " = 'foo'" \
50+
"print *var_char after filled first time"
51+
gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3 \\)" \
52+
"whatis var_char after filled first time"
53+
gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3 \\)" \
54+
"ptype var_char after filled first time"
55+
gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
56+
gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
57+
58+
gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
59+
gdb_continue_to_breakpoint "var_char-filled-2"
60+
gdb_test "print var_char" \
61+
" = \\(PTR TO -> \\( character\\*6 \\)\\) ${hex}" \
62+
"print var_char after allocated second time"
63+
gdb_test "print *var_char" " = 'foobar'" \
64+
"print *var_char after allocated second time"
65+
gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6 \\)" \
66+
"whatis var_char second time"
67+
gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6 \\)" \
68+
"ptype var_char second time"
69+
70+
gdb_breakpoint [gdb_get_line_number "var_char-empty"]
71+
gdb_continue_to_breakpoint "var_char-empty"
72+
gdb_test "print var_char" \
73+
" = \\(PTR TO -> \\( character\\*0 \\)\\) ${hex}" \
74+
"print var_char after set empty"
75+
gdb_test "print *var_char" " = \"\"" "print *var_char after set empty"
76+
gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0 \\)" \
77+
"whatis var_char after set empty"
78+
gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0 \\)" \
79+
"ptype var_char after set empty"
80+
81+
gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"]
82+
gdb_continue_to_breakpoint "var_char-allocated-3"
83+
gdb_test "print var_char" \
84+
" = \\(PTR TO -> \\( character\\*21 \\)\\) ${hex}" \
85+
"print var_char after allocated third time"
86+
gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21 \\)" \
87+
"whatis var_char after allocated third time"
88+
gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21 \\)" \
89+
"ptype var_char after allocated third time"
90+
91+
gdb_breakpoint [gdb_get_line_number "var_char_p-associated"]
92+
gdb_continue_to_breakpoint "var_char_p-associated"
93+
gdb_test "print var_char_p" \
94+
" = \\(PTR TO -> \\( character\\*7 \\)\\) ${hex}" \
95+
"print var_char_p after associated"
96+
gdb_test "print *var_char_p" " = 'johndoe'" \
97+
"print *var_char_ after associated"
98+
gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
99+
"whatis var_char_p after associated"
100+
gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
101+
"ptype var_char_p after associated"

‎gdb/testsuite/gdb.fortran/vla-stringsold.f90

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
! Copyright 2014 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 2 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, write to the Free Software
15+
! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
16+
17+
program vla_strings
18+
character(len=:), target, allocatable :: var_char
19+
character(len=:), pointer :: var_char_p
20+
logical :: l
21+
22+
allocate(character(len=10) :: var_char)
23+
l = allocated(var_char) ! var_char-allocated-1
24+
var_char = 'foo'
25+
deallocate(var_char) ! var_char-filled-1
26+
l = allocated(var_char) ! var_char-deallocated
27+
allocate(character(len=42) :: var_char)
28+
l = allocated(var_char)
29+
var_char = 'foobar'
30+
var_char = '' ! var_char-filled-2
31+
var_char = 'bar' ! var_char-empty
32+
deallocate(var_char)
33+
allocate(character(len=21) :: var_char)
34+
l = allocated(var_char) ! var_char-allocated-3
35+
var_char = 'johndoe'
36+
var_char_p => var_char
37+
l = associated(var_char_p) ! var_char_p-associated
38+
var_char_p => null()
39+
l = associated(var_char_p) ! var_char_p-not-associated
40+
end program vla_strings

0 commit comments

Comments
 (0)