1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
# Copyright 1994-2024 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/>.
# This file was adapted from old Chill tests by Stan Shebs
# (shebs@cygnus.com).
load_lib "fortran.exp"
require allow_fortran_tests
proc test_integer_literal_types_accepted {} {
global gdb_prompt
# Test various decimal values.
# Should be integer*4 probably.
gdb_test "pt 123" "type = int"
}
proc test_character_literal_types_accepted {} {
global gdb_prompt
# Test various character values.
gdb_test "pt 'a'" "type = character\\*1"
}
proc test_integer_literal_types_rejected {} {
global gdb_prompt
test_print_reject "pt _"
}
proc test_logical_literal_types_accepted {} {
global gdb_prompt
# Test the only possible values for a logical, TRUE and FALSE (and
# also true and false).
gdb_test "pt .TRUE." "type = logical\\*4"
gdb_test "pt .FALSE." "type = logical\\*4"
gdb_test "pt .true." "type = logical\\*4"
gdb_test "pt .false." "type = logical\\*4"
}
proc test_float_literal_types_accepted {} {
global gdb_prompt
# Test various floating point formats
# this used to guess whether to look for "real*4" or
# "real*8" based on a target config variable, but no one
# maintained it properly.
gdb_test "pt .44" "type = real\\*\[0-9\]+"
gdb_test "pt 44.0" "type = real\\*\[0-9\]+"
gdb_test "pt 10D20" "type = real\\*\[0-9\]+"
gdb_test "pt 10d20" "type = real\\*\[0-9\]+"
gdb_test "pt 10E20" "type = real\\*\[0-9\]+"
gdb_test "pt 10e20" "type = real\\*\[0-9\]+"
}
# Test the default primitive Fortran types.
proc test_default_types {} {
gdb_test "ptype integer" "type = integer\\*4"
gdb_test "ptype logical" "type = logical\\*4"
gdb_test "ptype real" "type = real\\*4"
gdb_test "ptype complex" "type = complex\\*4"
}
# Test the the primitive Fortran types, those that GDB should always
# know, even if the program does not define them, are in fact, known.
proc test_primitive_types_known {} {
foreach type {void character \
integer*1 integer*2 integer*4 integer*8 \
integer_1 integer_2 integer_4 integer_8 \
logical*1 logical*2 logical*4 logical*8 \
logical_1 logical_2 logical_4 logical_8 \
real*4 real*8 real*16 real_4 real_8 real_16 \
complex*4 complex*8 complex*16 \
complex_4 complex_8 complex_16} {
# While TYPE_KIND is allowed as input, GDB will always return the
# Fortran notation TYPE*KIND
regsub -all "_" $type "\*" type_res
set re [string_to_regexp "type = $type_res"]
switch $type {
real*16 - complex*16 {
regexp {^[^*_]*} $type base
set re_unsupported \
[string_to_regexp \
"unsupported kind 16 for type $base*4"]
set re ($re|$re_unsupported)
}
real_16 - complex_16 {
set re_unsupported \
[string_to_regexp \
"unsupported type $type_res"]
set re ($re|$re_unsupported)
}
}
gdb_test "ptype $type" $re
}
}
clean_restart
gdb_test "set print sevenbit-strings" ""
if {[set_lang_fortran]} {
test_primitive_types_known
test_default_types
test_integer_literal_types_accepted
test_integer_literal_types_rejected
test_logical_literal_types_accepted
test_character_literal_types_accepted
test_float_literal_types_accepted
} else {
warning "$test_name tests suppressed." 0
}
|
