1 # Copyright
2005, 2006, 2007 Free Software Foundation
, Inc.
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.
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.
13 # You should have received a copy of the GNU General Public License
14 # along with GCC
; see the file COPYING3.
If not see
15 #
<http
://www.gnu.org
/licenses
/>.
17 # DejaGnu test driver around Mike Cowlishaw
's testsuite for decimal
18 # decimal arithmetic ("decTest"). See:
19 # <http://www2.hursley.ibm.com/decimal/dectest.html>.
21 # Contributed by Ben Elliston <bje@au.ibm.com>.
23 set TORTURE_OPTIONS [list {} -O1 -O2 -O3 -Os -msoft-float]
25 proc target-specific-flags {} {
26 set result "-frounding-math "
30 # Load support procs (borrow these from c-torture).
31 load_lib c-torture.exp
32 load_lib target-supports.exp
34 # Skip these tests for targets that don't support this extension.
35 if { ![check_effective_target_dfp
] } {
39 # The list format is
[coefficient
, max-exponent
, min-exponent
].
40 set properties
(_Decimal32
) [list
7 96 -95]
41 set properties
(_Decimal64
) [list
16 384 -383]
42 set properties
(_Decimal128
) [list
34 6144 -6143]
44 # Operations implemented by the compiler.
45 set operators
(add
) {+}
46 set operators
(compare
) {==}
47 set operators
(divide
) {/}
48 set operators
(multiply
) {*}
49 set operators
(subtract
) {-}
50 set operators
(minus
) {-}
51 set operators
(plus
) {+}
52 set operators
(apply
) {}
54 # Operations imlemented by the library.
55 set libfuncs
(abs) fabsl
56 set libfuncs
(squareroot
) sqrtl
57 set libfuncs
(max) fmaxl
58 set libfuncs
(min) fminl
59 set libfuncs
(quantize
) quantize
60 set libfuncs
(samequantum
) samequantum
61 set libfuncs
(power
) powl
62 set libfuncs
(toSci
) unknown
63 set libfuncs
(tosci
) unknown
64 set libfuncs
(toEng
) unknown
65 set libfuncs
(toeng
) unknown
66 set libfuncs
(divideint
) unknown
67 set libfuncs
(rescale
) unknown
68 set libfuncs
(remainder
) unknown
69 set libfuncs
(remaindernear
) unknown
70 set libfuncs
(normalize
) unknown
71 set libfuncs
(tointegral
) unknown
72 set libfuncs
(trim
) unknown
74 # Run all of the tests listed in TESTCASES by invoking df
-run
-test
on
75 # each. Skip tests that not included by the user invoking runtest
76 # with the foo.exp
=test.c syntax.
78 proc dfp
-run
-tests
{ testcases
} {
80 foreach test $testcases
{
81 #
If we
're only testing specific files and this isn't one of
83 if ![runtest_file_p $runtests $test
] continue
88 # Run a single test case named by TESTCASE.
89 # Called
for each test by dfp
-run
-tests.
91 proc dfp
-run
-test
{ testcase
} {
92 set fd
[open $testcase r
]
93 while {[gets $fd line
] != -1} {
94 switch -regexp
-- $line
{
101 {^
[ \t]*[^
:]*:[^
:]*} {
102 regsub
-- {[ \t]*--.
*$
} $line
{} line
103 process
-directive $line
106 process
-test
-case $testcase $line
113 #
Return the appropriate constant from
<fenv.h
> for MODE.
115 proc c
-rounding
-mode { mode } {
116 switch [string tolower $
mode] {
117 "floor" { return 0 } # FE_DEC_DOWNWARD
118 "half_even" { return 1 } # FE_DEC_TONEARESTFROMZERO
119 "half_up" { return 2 } # FE_DEC_TONEAREST
120 "down" { return 3 } # FE_DEC_TOWARDZERO
121 "ceiling" { return 4 } # FE_DEC_UPWARD
123 error
"unsupported rounding mode ($mode)"
126 #
Return a string of C code that forms the preamble to perform the
129 proc c
-test
-preamble
{ id
} {
130 append result
"/* Machine generated test case for $id */\n"
132 append result
"\#include <assert.h>\n"
133 append result
"\#include <fenv.h>\n"
134 append result
"\#include <math.h>\n"
136 append result
"int main ()\n"
141 #
Return a string of C code that forms the postable to the test named ID.
143 proc c
-test
-postamble
{ id
} {
147 # Generate a C unary expression that applies OPERATION to OP.
149 proc c
-unary
-expression
{operation op
} {
152 if [catch
{set result
"$operators($operation) $op"}] {
153 #
If operation isn
't in the operators or libfuncs arrays,
154 # we'll throw an error. That
's what we want.
155 # FIXME: append d32, etc. here.
156 set result "$libfuncs($operation) ($op)"
161 # Generate a C binary expression that applies OPERATION to OP1 and OP2.
163 proc c-binary-expression {operation op1 op2} {
166 if [catch {set result "$op1 $operators($operation) $op2"}] {
167 # If operation isn't in the operators or libfuncs arrays
,
168 # we
'll throw an error. That's what we want.
169 set result
"$libfuncs($operation) ($op1, $op2)"
174 #
Return the most appropriate C type
(_Decimal32
, etc
) for this test.
176 proc c
-decimal
-type
{ } {
178 if [catch
{set precision $directives
(precision
)}] {
179 set precision
"_Decimal128"
181 if { $precision
== 7 } {
182 set result
"_Decimal32"
183 } elseif
{$precision
== 16} {
184 set result
"_Decimal64"
185 } elseif
{$precision
== 34} {
186 set result
"_Decimal128"
188 error
"Unsupported precision"
193 #
Return the size of the most appropriate C type
, in bytes.
195 proc c
-sizeof
-decimal
-type
{ } {
196 switch [c
-decimal
-type
] {
197 "_Decimal32" { return 4 }
198 "_Decimal64" { return 8 }
199 "_Decimal128" { return 16 }
201 error
"Unsupported precision"
204 #
Return the right literal suffix
for CTYPE.
206 proc c
-type
-suffix
{ ctype
} {
208 "_Decimal32" { return "df" }
209 "_Decimal64" { return "dd" }
210 "_Decimal128" { return "dl" }
211 "float" { return "f" }
212 "long double" { return "l" }
217 proc nan
-p
{ operand
} {
218 if {[string match
"NaN*" $operand] || [string match "-NaN*" $operand]} {
225 proc infinity
-p
{ operand
} {
226 if {[string match
"Inf*" $operand] || [string match "-Inf*" $operand]} {
233 proc isnan
-builtin
-name { } {
234 set bits
[expr
[c
-sizeof
-decimal
-type
] * 8]
235 return "__builtin_isnand$bits"
238 proc isinf
-builtin
-name { } {
239 set bits
[expr
[c
-sizeof
-decimal
-type
] * 8]
240 return "__builtin_isinfd$bits"
243 #
Return a string that declares a C union containing the decimal type
244 # and an unsigned char array of the right size.
246 proc c
-union
-decl
{ } {
247 append result
" union {\n"
248 append result
" [c-decimal-type] d;\n"
249 append result
" unsigned char bytes\[[c-sizeof-decimal-type]\];\n"
250 append result
" } u;"
254 proc transform
-hex
-constant
{value
} {
255 regsub \# $value
{} value
256 regsub
-all
(\.\.
) $value
{0x\
1, } bytes
260 # Create a C
program file
(named using ID
) containing a test
for a
261 # binary OPERATION
on OP1 and OP2 that expects RESULT and CONDITIONS.
263 proc make
-c
-test
{testcase id operation result conditions op1
{op2
"NONE"}} {
266 set outfd
[open $filename w
]
268 puts $outfd
[c
-test
-preamble $id
]
269 puts $outfd
[c
-union
-decl
]
270 if {[string compare $result ?
] != 0} {
271 if {[string index $result
0] == "\#"} {
272 puts $outfd
" static unsigned char compare\[[c-sizeof-decimal-type]\] = [transform-hex-constant $result];"
275 if {[string compare $op2
NONE] == 0} {
276 if {[string index $op1
0] == "\#"} {
277 puts $outfd
" static unsigned char fill\[[c-sizeof-decimal-type]\] = [transform-hex-constant $op1];"
282 puts $outfd
" /* FIXME: Set rounding mode with fesetround() once in libc. */"
283 puts $outfd
" __dfp_set_round ([c-rounding-mode $directives(rounding)]);"
286 # Build the expression to be tested.
287 if {[string compare $op2
NONE] == 0} {
288 if {[string index $op1
0] == "\#"} {
289 puts $outfd
" memcpy (u.bytes, fill, [c-sizeof-decimal-type]);"
291 puts $outfd
" u.d = [c-unary-expression $operation [c-operand $op1]];"
294 puts $outfd
" u.d = [c-binary-expression $operation [c-operand $op1] [c-operand $op2]];"
298 if {[string compare $result ?
] != 0} {
299 # Not an undefined result ..
300 if {[string index $result
0] == "\#"} {
301 # Handle hex comparisons.
302 puts $outfd
" return memcmp (u.bytes, compare, [c-sizeof-decimal-type]);"
303 } elseif
{[nan
-p $result
]} {
304 puts $outfd
" return ![isnan-builtin-name] (u.d);"
305 } elseif
{[infinity
-p $result
]} {
306 puts $outfd
" return ![isinf-builtin-name] (u.d);"
309 puts $outfd
" return !(u.d == [c-operand $result]);"
312 puts $outfd
" return 0;"
315 puts $outfd
[c
-test
-postamble $id
]
320 # Is the test supported
for this target?
322 proc supported
-p
{ id op
} {
326 # Ops that are unsupported. Many of these tests fail because they
327 #
do not tolerate the C front
-end rounding the value of floating
328 # point literals to suit the type of the constant. Otherwise
, by
329 # treating the `apply
' operator like C assignment, some of them do
335 # Ditto for the following miscellaneous tests.
337 addx1130 { return 0 }
338 addx1131 { return 0 }
339 addx1132 { return 0 }
340 addx1133 { return 0 }
341 addx1134 { return 0 }
342 addx1135 { return 0 }
343 addx1136 { return 0 }
344 addx1138 { return 0 }
345 addx1139 { return 0 }
346 addx1140 { return 0 }
347 addx1141 { return 0 }
348 addx1142 { return 0 }
349 addx1151 { return 0 }
350 addx1152 { return 0 }
351 addx1153 { return 0 }
352 addx1154 { return 0 }
353 addx1160 { return 0 }
359 if [info exist libfuncs($op)] {
360 # No library support for now.
363 if [catch {c-rounding-mode $directives(rounding)}] {
364 # Unsupported rounding mode.
367 if [catch {c-decimal-type}] {
368 # Unsupported precision.
374 # Break LINE into a list of tokens. Be sensitive to quoting.
375 # There has to be a better way to do this :-|
377 proc tokenize { line } {
381 foreach char [split $line {}] {
383 if { [info exists token] && $char == " " } {
384 if {[string compare "$token" "--"] == 0} {
385 # Only comments remain.
388 lappend tokens $token
391 if {![info exists token] && $char == "'" } {
394 if { $char
!= " " } {
401 if { $char
== "'" } {
403 if [info exists token
] {
404 lappend tokens $token
414 # Flush
any residual token.
415 if {[info exists token
] && [string compare $token
"--"]} {
416 lappend tokens $token
421 # Process a directive in LINE.
423 proc process
-directive
{ line
} {
425 set keyword
[string tolower
[string trim
[lindex
[split $line
:] 0]]]
426 set value
[string tolower
[string trim
[lindex
[split $line
:] 1]]]
427 set directives
($keyword
) $value
430 # Produce a C99
-valid floating point literal.
432 proc c
-operand
{operand
} {
433 set bits
[expr
8 * [c
-sizeof
-decimal
-type
]]
435 switch -glob
-- $operand
{
436 "Inf*" { return "__builtin_infd${bits} ()" }
437 "-Inf*" { return "- __builtin_infd${bits} ()" }
438 "NaN*" { return "__builtin_nand${bits} (\"\")" }
439 "-NaN*" { return "- __builtin_nand${bits} (\"\")" }
440 "sNaN*" { return "__builtin_nand${bits} (\"\")" }
441 "-sNaN*" { return "- __builtin_nand${bits} (\"\")" }
444 if {[string first . $operand
] < 0 && \
445 [string first E $operand
] < 0 && \
446 [string first e $operand
] < 0} {
449 set suffix
[c
-type
-suffix
[c
-decimal
-type
]]
450 return [append operand $suffix
]
453 # Process an arithmetic test in LINE from TESTCASE.
455 proc process
-test
-case
{ testcase line
} {
456 set testfile
[file tail $testcase
]
458 # Compress multiple spaces down to one.
459 regsub
-all
{ *} $line
{ } line
461 set args [tokenize $line
]
462 if {[llength $
args] < 5} {
463 error
"Skipping invalid test: $line"
467 set id
[string trim
[lindex $
args 0]]
468 set operation
[string trim
[lindex $
args 1]]
469 set operand1
[string trim
[lindex $
args 2]]
471 if { [string compare
[lindex $
args 3] -> ] == 0 } {
478 set operand2
[string trim
[lindex $
args 3]]
479 if { [string compare
[lindex $
args 4] -> ] != 0 } {
480 warning
"Skipping invalid test: $line"
487 set result
[string trim
[lindex $
args $result_index
]]
488 set conditions
[list
]
489 for { set i $cond_index
} { $i
< [llength $
args] } { incr i
} {
490 lappend conditions
[string tolower
[lindex $
args $i
]]
493 #
If this test is unsupported
, say so.
494 if ![supported
-p $id $operation
] {
495 unsupported
"$testfile ($id)"
499 if {[string compare $operand1 \#
] == 0 || \
500 [string compare $operand2 \#
] == 0} {
501 unsupported
"$testfile ($id), null reference"
505 # Construct a C
program and
then compile/execute it
on the target.
506 # Grab some stuff from the c
-torture.exp test driver
for this.
508 set cprog
[make
-c
-test $testfile $id $operation $result $conditions $operand1 $operand2
]
509 c
-torture
-execute $cprog
[target
-specific
-flags
]
514 if [catch
{set testdir $env
(DECTEST
)}] {
515 #
If $DECTEST is unset
, skip this test driver altogether.
519 note
"Using tests in $testdir"
520 dfp
-run
-tests
[lsort
[glob
-nocomplain $testdir
/*.decTest
]]