]>
Commit | Line | Data |
---|---|---|
213516ef | 1 | # Copyright 2022-2023 Free Software Foundation, Inc. |
63fc2437 TT |
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 | # Test floating-point literal extension. | |
17 | ||
18 | load_lib "ada.exp" | |
19 | ||
20 | if { [skip_ada_tests] } { return -1 } | |
21 | ||
22 | standard_ada_testfile prog | |
23 | ||
24 | if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { | |
25 | return -1 | |
26 | } | |
27 | ||
d1fb8316 LM |
28 | # Given a floating point EXPRESSION, return the size of the result. |
29 | ||
30 | proc float_size { expression } { | |
31 | ||
32 | set size 0 | |
33 | gdb_test_multiple "ptype ${expression}" "" { | |
34 | -re -wrap "<16-byte float>" { | |
35 | set size 16 | |
36 | } | |
37 | -re -wrap "<12-byte float>" { | |
38 | set size 12 | |
39 | } | |
40 | -re -wrap "<\\d+-byte float>" { | |
41 | # Assume 8 for anything less than or equal to 8. | |
42 | set size 8 | |
43 | } | |
44 | } | |
45 | ||
46 | return $size | |
47 | } | |
48 | ||
63fc2437 TT |
49 | clean_restart ${testfile} |
50 | ||
51 | set bp_location [gdb_get_line_number "BREAK" ${testdir}/prog.adb] | |
52 | runto "prog.adb:$bp_location" | |
53 | ||
54 | gdb_test "print 16f#41b80000#" " = 23.0" | |
55 | gdb_test "print val_float" " = 23.0" | |
56 | gdb_test "print val_float := 16f#41b80000#" " = 23.0" | |
57 | gdb_test "print val_float" " = 23.0" \ | |
58 | "print val_float after assignment" | |
59 | ||
60 | gdb_test "print 16lf#bc0d83c94fb6d2ac#" " = -2.0e-19" | |
61 | gdb_test "print val_double" " = -2.0e-19" | |
62 | gdb_test "print val_double := 16lf#bc0d83c94fb6d2ac#" " = -2.0e-19" | |
63 | gdb_test "print val_double" " = -2.0e-19" \ | |
64 | "print val_double after assignment" | |
65 | ||
d1fb8316 LM |
66 | # Fetch the size of a compiler-generated long double. |
67 | set compiler_long_double_size [float_size "long_long_float" ] | |
68 | ||
69 | # Fetch the size of an internal long double type in GDB. | |
70 | set gdb_long_double_size [float_size "16llf#0#" ] | |
71 | ||
72 | # Different architectures use different long double formats. For | |
73 | # example, IEEE quad versus i387 long doubles. Account for that in the | |
74 | # tests below. | |
75 | ||
32a5aa26 TV |
76 | # Get the used long double format. |
77 | set long_double_format "" | |
63dc62b2 TV |
78 | set cmd "maint print architecture" |
79 | gdb_test_multiple $cmd "" { | |
80 | -re "^[string_to_regexp $cmd](?=\r\n)" { | |
81 | exp_continue | |
82 | } | |
83 | -re "^\r\ngdbarch_dump: long_double_format = (\[^\r\n\]*)(?=\r\n)" { | |
32a5aa26 TV |
84 | set long_double_format $expect_out(1,string) |
85 | exp_continue | |
86 | } | |
63dc62b2 | 87 | -re "^\r\n$gdb_prompt $" { |
32a5aa26 TV |
88 | pass $gdb_test_name |
89 | } | |
63dc62b2 TV |
90 | -re "^\r\n(\[^\r\n\]*)(?=\r\n)" { |
91 | exp_continue | |
92 | } | |
32a5aa26 TV |
93 | } |
94 | ||
d1fb8316 LM |
95 | # Set default values for 128-bit IEEE quad long doubles. |
96 | set valid_long_double "16llf#4000921fb54442d18469898cc51701b8#" | |
97 | set printed_long_double "3.1415926535897932384626433832795028" | |
98 | set invalid_long_double "" | |
99 | set has_invalid_long_double 0 | |
100 | ||
32a5aa26 TV |
101 | switch -glob $long_double_format { |
102 | floatformat_ibm_long_double_* { | |
103 | set w1 c1e1c00000000000 | |
104 | set w2 4544adf4b7320335 | |
105 | switch $long_double_format { | |
106 | floatformat_ibm_long_double_big { | |
107 | set valid_long_double "16llf#$w2$w1#" | |
108 | } | |
109 | floatformat_ibm_long_double_little { | |
110 | set valid_long_double "16llf#$w1$w2#" | |
111 | } | |
112 | } | |
113 | set printed_long_double "50000000000000000000000000.0" | |
114 | } | |
115 | } | |
116 | ||
d1fb8316 LM |
117 | if { [istarget x86_64-*-* ] || [istarget i?86-*-*] } { |
118 | # i387 long double have invalid values | |
119 | set has_invalid_long_double 1 | |
120 | if { $compiler_long_double_size == 16 } { | |
121 | # 5.0e+25 in i387 128-bit long double. | |
122 | set valid_long_double "16llf#7ffff7ff4054a56fa5b99019a5c8#" | |
123 | set invalid_long_double "16llf#a56fa5b99019a5c800007ffff7ff4054#" | |
124 | set printed_long_double "5.0e\\+25" | |
125 | } elseif { $compiler_long_double_size == 12 } { | |
126 | # 5.0e+25 in i387 80-bit long double. | |
127 | set valid_long_double "16llf#56554054a56fa5b99019a5c8#" | |
128 | set invalid_long_double "16llf#9019a5c800007ffff7ff4054#" | |
129 | set printed_long_double "5.0e\\+25" | |
3b9809bc TV |
130 | } |
131 | } | |
132 | ||
d1fb8316 LM |
133 | # Exercise GDB-side long doubles. |
134 | if { $gdb_long_double_size > 8 } { | |
135 | gdb_test "print ${valid_long_double}" " = ${printed_long_double}" | |
136 | gdb_test "print \$foo:=${valid_long_double}" "= ${printed_long_double}" | |
137 | gdb_test "print \$foo" "= ${printed_long_double}" \ | |
138 | "print internal long double variable after assignment" | |
3b9809bc | 139 | } |
d1fb8316 LM |
140 | |
141 | # Exercise compiler-side long doubles. | |
142 | if { $compiler_long_double_size > 8 } { | |
143 | gdb_test "print val_long_double" " = 5.0e\\+25" | |
144 | gdb_test "print val_long_double := ${valid_long_double}" \ | |
145 | " = ${printed_long_double}" | |
146 | gdb_test "print val_long_double" " = ${printed_long_double}" \ | |
147 | "print val_long_double after assignment" | |
3b9809bc | 148 | } |
aacf24b4 | 149 | |
d1fb8316 LM |
150 | # If the target has invalid long double values, test it now. |
151 | if { $has_invalid_long_double } { | |
152 | gdb_test "print ${invalid_long_double}" \ | |
153 | " = <invalid float value>" "print invalid long double value" | |
3b9809bc | 154 | } |