summaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.ada/float-bits.exp
blob: 7edd117d829a8c569d5e8464eb3b54061e1e771a (plain)
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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
# Copyright 2022-2023 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/>.

# Test floating-point literal extension.

load_lib "ada.exp"

require !skip_ada_tests

standard_ada_testfile prog

if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
    return -1
}

# Given a floating point EXPRESSION, return the size of the result.

proc float_size { expression } {

    set size 0
    gdb_test_multiple "ptype ${expression}" "" {
	-re -wrap "<16-byte float>" {
	    set size 16
	}
	-re -wrap "<12-byte float>" {
	    set size 12
	}
	-re -wrap "<\\d+-byte float>" {
	    # Assume 8 for anything less than or equal to 8.
	    set size 8
	}
    }

    return $size
}

clean_restart ${testfile}

set bp_location [gdb_get_line_number "BREAK" ${testdir}/prog.adb]
runto "prog.adb:$bp_location"

gdb_test "print 16f#41b80000#" " = 23.0"
gdb_test "print val_float" " = 23.0"
gdb_test "print val_float := 16f#41b80000#" " = 23.0"
gdb_test "print val_float" " = 23.0" \
    "print val_float after assignment"

gdb_test "print 16lf#bc0d83c94fb6d2ac#" " = -2.0e-19"
gdb_test "print val_double" " = -2.0e-19"
gdb_test "print val_double := 16lf#bc0d83c94fb6d2ac#" " = -2.0e-19"
gdb_test "print val_double" " = -2.0e-19" \
    "print val_double after assignment"

# Fetch the size of a compiler-generated long double.
set compiler_long_double_size [float_size "long_long_float" ]

# Fetch the size of an internal long double type in GDB.
set gdb_long_double_size [float_size "16llf#0#" ]

# Different architectures use different long double formats.  For
# example, IEEE quad versus i387 long doubles.  Account for that in the
# tests below.

# Get the used long double format.
set long_double_format ""
set cmd "maint print architecture"
gdb_test_multiple $cmd  "" {
    -re "^[string_to_regexp $cmd](?=\r\n)" {
	exp_continue
    }
    -re "^\r\ngdbarch_dump: long_double_format = (\[^\r\n\]*)(?=\r\n)" {
	set long_double_format $expect_out(1,string)
	exp_continue
    }
    -re "^\r\n$gdb_prompt $" {
	pass $gdb_test_name
    }
    -re "^\r\n(\[^\r\n\]*)(?=\r\n)" {
	exp_continue
    }
}

# Set default values for 128-bit IEEE quad long doubles.
set valid_long_double "16llf#4000921fb54442d18469898cc51701b8#"
set printed_long_double "3.1415926535897932384626433832795028"
set invalid_long_double ""
set has_invalid_long_double 0

switch -glob $long_double_format {
    floatformat_ibm_long_double_* {
	set w1 c1e1c00000000000
	set w2 4544adf4b7320335
	switch $long_double_format {
	    floatformat_ibm_long_double_big {
		set valid_long_double "16llf#$w2$w1#"
	    }
	    floatformat_ibm_long_double_little {
		set valid_long_double "16llf#$w1$w2#"
	    }
	}
	set printed_long_double "50000000000000000000000000.0"
    }
}

if { [istarget x86_64-*-* ] || [istarget i?86-*-*] } {
    # i387 long double have invalid values
    set has_invalid_long_double 1
    if { $compiler_long_double_size == 16 } {
	# 5.0e+25 in i387 128-bit long double.
	set valid_long_double "16llf#7ffff7ff4054a56fa5b99019a5c8#"
	set invalid_long_double "16llf#a56fa5b99019a5c800007ffff7ff4054#"
	set printed_long_double "5.0e\\+25"
    } elseif { $compiler_long_double_size == 12 } {
	# 5.0e+25 in i387 80-bit long double.
	set valid_long_double "16llf#56554054a56fa5b99019a5c8#"
	set invalid_long_double "16llf#9019a5c800007ffff7ff4054#"
	set printed_long_double "5.0e\\+25"
    }
}

# Exercise GDB-side long doubles.
if { $gdb_long_double_size > 8 } {
    gdb_test "print ${valid_long_double}" " = ${printed_long_double}"
    gdb_test "print \$foo:=${valid_long_double}" "= ${printed_long_double}"
    gdb_test "print \$foo" "= ${printed_long_double}" \
	"print internal long double variable after assignment"
}

# Exercise compiler-side long doubles.
if { $compiler_long_double_size > 8 } {
    gdb_test "print val_long_double" " = 5.0e\\+25"
    gdb_test "print val_long_double := ${valid_long_double}" \
	" = ${printed_long_double}"
    gdb_test "print val_long_double" " = ${printed_long_double}" \
	"print val_long_double after assignment"
}

# If the target has invalid long double values, test it now.
if { $has_invalid_long_double } {
    gdb_test "print ${invalid_long_double}" \
	" = <invalid float value>" "print invalid long double value"
}