Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
pub
Farith
Commits
69e587a8
Commit
69e587a8
authored
Jun 02, 2022
by
François Bobot
Browse files
Readd tests
parent
a9675c55
Changes
6
Hide whitespace changes
Inline
Side-by-side
tests/dune
0 → 100644
View file @
69e587a8
(tests
(names issue_005 mode subnormal test)
(libraries farith))
tests/issue_005.ml
View file @
69e587a8
open
Format
open
Farith
2
open
Farith
let
f_convert
r
=
let
fp
=
F
.
of_float
r
in
printf
"[F] %f : %a@."
r
F
.
pp
fp
;
fp
printf
"[F] %f : %a@."
r
F
.
pp
fp
;
fp
let
()
=
begin
ignore
(
f_convert
0
.
1
)
;
end
let
()
=
ignore
(
f_convert
0
.
1
)
tests/mode.ml
View file @
69e587a8
module
F
=
Farith
2
.
F
module
F
=
Farith
.
F
let
fpp
mode
fmt
q
=
F
.
pp
fmt
(
F
.
of_q
mode
~
mw
:
52
~
ew
:
11
q
)
let
()
=
begin
let
f
=
(
F
.
of_float
3
.
1
)
in
Format
.
printf
"[F] 3.1 = %a@."
F
.
pp
f
;
let
q
=
Q
.
make
(
Z
.
of_int
31
)
(
Z
.
of_int
10
)
in
Format
.
printf
"[Fp] 3.1 = %a@."
F
.
pp
(
F
.
round
~
mw
:
24
~
ew
:
11
ZR
(
F
.
of_float
3
.
1
))
;
Format
.
printf
"[Fq] 3.1 = %a@."
F
.
pp
(
F
.
of_q
~
mw
:
24
~
ew
:
11
ZR
q
)
;
Format
.
printf
"-----------------------@."
;
Format
.
printf
" Simple Roundings@."
;
let
job
m
m2
q
=
begin
Format
.
printf
"-----------------------@."
;
Format
.
printf
"Q=%a@."
Q
.
pp_print
q
;
Format
.
printf
"[F-%s] %a@."
m
(
fpp
m2
)
q
;
Format
.
printf
"[F-%s] %a@."
m
(
fpp
m2
)
(
Q
.
neg
q
)
;
end
in
job
"NE"
Farith2
.
NE
q
;
job
"NA"
Farith2
.
NA
q
;
job
"ZR"
Farith2
.
ZR
q
;
job
"UP"
Farith2
.
UP
q
;
job
"DN"
Farith2
.
DN
q
;
Format
.
printf
"-----------------------@."
;
Format
.
printf
" Tie Breaks (NE)@."
;
let
eps
=
Z
.
shift_left
Z
.
one
51
in
let
e_ex
=
Q
.
make
(
Z
.
of_int
0b100
)
eps
in
let
e_lo
=
Q
.
make
(
Z
.
of_int
0b101
)
eps
in
let
e_ti
=
Q
.
make
(
Z
.
of_int
0b110
)
eps
in
let
e_up
=
Q
.
make
(
Z
.
of_int
0b111
)
eps
in
job
"NE-ex"
Farith2
.
NE
(
Q
.
add
Q
.
one
e_ex
)
;
job
"NE-lo"
Farith2
.
NE
(
Q
.
add
Q
.
one
e_lo
)
;
job
"NE-ti"
Farith2
.
NE
(
Q
.
add
Q
.
one
e_ti
)
;
job
"NE-up"
Farith2
.
NE
(
Q
.
add
Q
.
one
e_up
)
;
Format
.
printf
"-----------------------@."
;
Format
.
printf
" Tie Breaks (NA)@."
;
job
"NA-ex"
Farith2
.
NA
(
Q
.
add
Q
.
one
e_ex
)
;
job
"NA-lo"
Farith2
.
NA
(
Q
.
add
Q
.
one
e_lo
)
;
job
"NA-ti"
Farith2
.
NA
(
Q
.
add
Q
.
one
e_ti
)
;
job
"NA-up"
Farith2
.
NA
(
Q
.
add
Q
.
one
e_up
)
;
end
let
f
=
F
.
of_float
3
.
1
in
Format
.
printf
"[F] 3.1 = %a@."
F
.
pp
f
;
let
q
=
Q
.
make
(
Z
.
of_int
31
)
(
Z
.
of_int
10
)
in
Format
.
printf
"[Fp] 3.1 = %a@."
F
.
pp
(
F
.
round
~
mw
:
24
~
ew
:
11
ZR
(
F
.
of_float
3
.
1
));
Format
.
printf
"[Fq] 3.1 = %a@."
F
.
pp
(
F
.
of_q
~
mw
:
24
~
ew
:
11
ZR
q
);
Format
.
printf
"-----------------------@."
;
Format
.
printf
" Simple Roundings@."
;
let
job
m
m2
q
=
Format
.
printf
"-----------------------@."
;
Format
.
printf
"Q=%a@."
Q
.
pp_print
q
;
Format
.
printf
"[F-%s] %a@."
m
(
fpp
m2
)
q
;
Format
.
printf
"[F-%s] %a@."
m
(
fpp
m2
)
(
Q
.
neg
q
)
in
job
"NE"
Farith
.
Mode
.
NE
q
;
job
"NA"
Farith
.
Mode
.
NA
q
;
job
"ZR"
Farith
.
Mode
.
ZR
q
;
job
"UP"
Farith
.
Mode
.
UP
q
;
job
"DN"
Farith
.
Mode
.
DN
q
;
Format
.
printf
"-----------------------@."
;
Format
.
printf
" Tie Breaks (NE)@."
;
let
eps
=
Z
.
shift_left
Z
.
one
51
in
let
e_ex
=
Q
.
make
(
Z
.
of_int
0b100
)
eps
in
let
e_lo
=
Q
.
make
(
Z
.
of_int
0b101
)
eps
in
let
e_ti
=
Q
.
make
(
Z
.
of_int
0b110
)
eps
in
let
e_up
=
Q
.
make
(
Z
.
of_int
0b111
)
eps
in
job
"NE-ex"
Farith
.
Mode
.
NE
(
Q
.
add
Q
.
one
e_ex
);
job
"NE-lo"
Farith
.
Mode
.
NE
(
Q
.
add
Q
.
one
e_lo
);
job
"NE-ti"
Farith
.
Mode
.
NE
(
Q
.
add
Q
.
one
e_ti
);
job
"NE-up"
Farith
.
Mode
.
NE
(
Q
.
add
Q
.
one
e_up
);
Format
.
printf
"-----------------------@."
;
Format
.
printf
" Tie Breaks (NA)@."
;
job
"NA-ex"
Farith
.
Mode
.
NA
(
Q
.
add
Q
.
one
e_ex
);
job
"NA-lo"
Farith
.
Mode
.
NA
(
Q
.
add
Q
.
one
e_lo
);
job
"NA-ti"
Farith
.
Mode
.
NA
(
Q
.
add
Q
.
one
e_ti
);
job
"NA-up"
Farith
.
Mode
.
NA
(
Q
.
add
Q
.
one
e_up
)
tests/subnormal.ml
View file @
69e587a8
open
Farith
2
open
Farith
let
eps
n
=
Stdlib
.
ldexp
1
.
0
n
let
pp_class
fmt
u
=
Format
.
pp_print_string
fmt
begin
match
classify_float
u
with
|
FP_zero
->
"zero"
|
FP_normal
->
"normal"
|
FP_subnormal
->
"sub-normal"
|
FP_infinite
->
"infinity"
|
FP_nan
->
"nan"
end
(
match
classify_float
u
with
|
FP_zero
->
"zero"
|
FP_normal
->
"normal"
|
FP_subnormal
->
"sub-normal"
|
FP_infinite
->
"infinity"
|
FP_nan
->
"nan"
)
let
test_of_float
n
=
let
u
=
eps
n
in
let
f
=
F
.
of_float
u
in
Format
.
printf
"of-float 1p%d = %a (%a)@."
n
F
.
pp
f
pp_class
u
let
f
=
F
.
of_float
u
in
Format
.
printf
"of-float 1p%d = %a (%a)@."
n
F
.
pp
f
pp_class
u
(* let test_to_float n =
* begin
...
...
@@ -30,10 +28,5 @@ let test_of_float n =
* Format.printf " obtained = %fp%d@." fv ev ;
* end *)
let
limits
=
[
1023
;
1024
;
-
1022
;
-
1023
;
-
1048
;
-
1074
;
-
1075
]
let
()
=
begin
List
.
iter
test_of_float
limits
;
(* List.iter test_to_float limits ; *)
end
let
limits
=
[
1023
;
1024
;
-
1022
;
-
1023
;
-
1048
;
-
1074
;
-
1075
]
let
()
=
List
.
iter
test_of_float
limits
(* List.iter test_to_float limits ; *)
tests/test.expected
View file @
69e587a8
Flocq version: 40
0
00
Flocq version: 40
1
00
Run tests with Farith2.F
0.100000 + 2.000000 = 2.100000
0.100000 : +3602879701896397p-55
...
...
tests/test.ml
View file @
69e587a8
open
Format
let
()
=
printf
"Flocq version: %a@."
Z
.
pp_print
Farith2
.
flocq_version
let
()
=
printf
"Flocq version: %a@."
Z
.
pp_print
Farith
.
flocq_version
open
Farith
2
open
Farith
module
Run
=
struct
let
()
=
...
...
@@ -17,10 +15,10 @@ module Run = struct
printf
"%f + %f = %f@
\n
"
u
v
r
;
printf
"%f : %a@
\n
"
u
F
.
pp
fu
;
printf
"%f : %a@
\n
"
v
F
.
pp
fv
;
printf
"%f : %a@]@
\n
"
r
F
.
pp
fr
;
printf
"%f : %a@]@
\n
"
r
F
.
pp
fr
in
add
(
0
.
1
)
(
2
.
0
)
;
add
(
-
.
0
.
1
)
(
2
.
0
)
;
add
(
-
.
0
.
1
)
(
-
.
2
.
0
);
add
(
0
.
1
)
(
-
.
2
.
0
)
add
0
.
1
2
.
0
;
add
(
-
0
.
1
)
2
.
0
;
add
(
-
0
.
1
)
(
-
2
.
0
);
add
0
.
1
(
-
2
.
0
)
end
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment