summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--otherlibs/num/big_int.ml22
-rw-r--r--otherlibs/num/ratio.ml87
-rw-r--r--otherlibs/num/test/Makefile4
-rw-r--r--otherlibs/num/test/test_big_ints.ml4
-rw-r--r--otherlibs/num/test/test_ratios.ml18
5 files changed, 77 insertions, 58 deletions
diff --git a/otherlibs/num/big_int.ml b/otherlibs/num/big_int.ml
index f9c04e443..d742c595b 100644
--- a/otherlibs/num/big_int.ml
+++ b/otherlibs/num/big_int.ml
@@ -368,7 +368,7 @@ let big_int_of_int64 i =
else (-1, Int64.neg i) in
let res = create_nat 2 in
set_digit_nat_native res 0 (Int64.to_nativeint i);
- set_digit_nat_native res 1 (Int64.to_nativeint (Int64.shift_left i 32));
+ set_digit_nat_native res 1 (Int64.to_nativeint (Int64.shift_right i 32));
{ sign = sg; abs_value = res }
end
@@ -380,7 +380,9 @@ let int64_of_big_int bi =
match num_digits_big_int bi with
| 1 -> Int64.of_nativeint (nth_digit_nat_native bi.abs_value 0)
| 2 -> Int64.logor
- (Int64.of_nativeint (nth_digit_nat_native bi.abs_value 0))
+ (Int64.logand
+ (Int64.of_nativeint (nth_digit_nat_native bi.abs_value 0))
+ 0xFFFFFFFFL)
(Int64.shift_left
(Int64.of_nativeint (nth_digit_nat_native bi.abs_value 1))
32)
@@ -619,14 +621,14 @@ let round_futur_last_digit s off_set length =
if Char.code(String.get s l) >= Char.code '5'
then
let rec round_rec l =
- let current_char = String.get s l in
- if current_char = '9'
- then
- (String.set s l '0';
- if l = off_set then true else round_rec (pred l))
- else
- (String.set s l (Char.chr (succ (Char.code current_char)));
- false)
+ if l < off_set then true else begin
+ let current_char = String.get s l in
+ if current_char = '9' then
+ (String.set s l '0'; round_rec (pred l))
+ else
+ (String.set s l (Char.chr (succ (Char.code current_char)));
+ false)
+ end
in round_rec (pred l)
else false
diff --git a/otherlibs/num/ratio.ml b/otherlibs/num/ratio.ml
index 3ee228a6a..e587efe3e 100644
--- a/otherlibs/num/ratio.ml
+++ b/otherlibs/num/ratio.ml
@@ -425,55 +425,54 @@ let approx_ratio_fix n r =
let sign_r = sign_ratio r in
if sign_r = 0
then "+0" (* r = 0 *)
- else (* r.numerator and r.denominator are not null numbers
- s contains one more digit than desired for the round off operation
- and to have enough room in s when including the decimal point *)
- if n >= 0 then
- let s =
- let nat =
+ else
+ (* r.numerator and r.denominator are not null numbers
+ s1 contains one more digit than desired for the round off operation *)
+ if n >= 0 then begin
+ let s1 =
+ string_of_nat
(nat_of_big_int
(div_big_int
(base_power_big_int
10 (succ n) (abs_big_int r.numerator))
- r.denominator))
- in (if sign_r = -1 then "-" else "+") ^ string_of_nat nat in
- let l = String.length s in
- if round_futur_last_digit s 1 (pred l)
- then begin (* if one more char is needed in s *)
- let str = (String.make (succ l) '0') in
- String.set str 0 (if sign_r = -1 then '-' else '+');
- String.set str 1 '1';
- String.set str (l - n) '.';
- str
- end else (* s can contain the final result *)
- if l > n + 2
- then begin (* |r| >= 1, set decimal point *)
- let l2 = (pred l) - n in
- String.blit s l2 s (succ l2) n;
- String.set s l2 '.'; s
- end else begin (* |r| < 1, there must be 0-characters *)
- (* before the significant development, *)
- (* with care to the sign of the number *)
- let size = n + 3 in
- let m = size - l + 2
- and str = String.make size '0' in
-
- (String.blit (if sign_r = 1 then "+0." else "-0.") 0 str 0 3);
- (String.blit s 1 str m (l - 2));
- str
- end
- else begin
- let s = string_of_big_int
- (div_big_int
- (abs_big_int r.numerator)
- (base_power_big_int
- 10 (-n) r.denominator)) in
- let len = succ (String.length s) in
- let s' = String.make len '0' in
- String.set s' 0 (if sign_r = -1 then '-' else '+');
- String.blit s 0 s' 1 (pred len);
- s'
+ r.denominator)) in
+ (* Round up and add 1 in front if needed *)
+ let s2 =
+ if round_futur_last_digit s1 0 (String.length s1)
+ then "1" ^ s1
+ else s1 in
+ let l2 = String.length s2 - 1 in
+ (* if s2 without last digit is xxxxyyy with n 'yyy' digits:
+ <sign> xxxx . yyy
+ if s2 without last digit is yy with <= n digits:
+ <sign> 0 . 0yy *)
+ if l2 > n then begin
+ let s = String.make (l2 + 2) '0' in
+ String.set s 0 (if sign_r = -1 then '-' else '+');
+ String.blit s2 0 s 1 (l2 - n);
+ String.set s (l2 - n + 1) '.';
+ String.blit s2 (l2 - n) s (l2 - n + 2) n;
+ s
+ end else begin
+ let s = String.make (n + 3) '0' in
+ String.set s 0 (if sign_r = -1 then '-' else '+');
+ String.set s 2 '.';
+ String.blit s2 0 s (n + 3 - l2) l2;
+ s
end
+ end else begin
+ (* Dubious; what is this code supposed to do? *)
+ let s = string_of_big_int
+ (div_big_int
+ (abs_big_int r.numerator)
+ (base_power_big_int
+ 10 (-n) r.denominator)) in
+ let len = succ (String.length s) in
+ let s' = String.make len '0' in
+ String.set s' 0 (if sign_r = -1 then '-' else '+');
+ String.blit s 0 s' 1 (pred len);
+ s'
+ end
(* Number of digits of the decimal representation of an int *)
let num_decimal_digits_int n =
diff --git a/otherlibs/num/test/Makefile b/otherlibs/num/test/Makefile
index 34735c2a6..44560b322 100644
--- a/otherlibs/num/test/Makefile
+++ b/otherlibs/num/test/Makefile
@@ -31,7 +31,7 @@ TESTFILES=test.cmo \
TESTOPTFILES=$(TESTFILES:.cmo=.cmx)
test.byt: $(TESTFILES) ../nums.cma ../libnums.a
- $(CAMLC) -ccopt -L.. -I .. -o test.byt ../nums.cma $(TESTFILES)
+ $(CAMLC) -ccopt -L.. -I .. -o test.byt -g ../nums.cma $(TESTFILES)
test.opt: $(TESTOPTFILES) ../nums.cmxa ../libnums.a
$(CAMLOPT) -ccopt -L.. -I .. -o test.opt ../nums.cmxa $(TESTOPTFILES)
@@ -44,7 +44,7 @@ $(TESTOPTFILES): ../../../ocamlopt
.SUFFIXES: .ml .cmo .cmx
.ml.cmo:
- $(CAMLC) -I .. -c $<
+ $(CAMLC) -I .. -c -g $<
.ml.cmx:
$(CAMLOPT) -I .. -c $<
diff --git a/otherlibs/num/test/test_big_ints.ml b/otherlibs/num/test/test_big_ints.ml
index 225491840..f3080e5d1 100644
--- a/otherlibs/num/test/test_big_ints.ml
+++ b/otherlibs/num/test/test_big_ints.ml
@@ -757,9 +757,9 @@ test 1 eq_int64
(int64_of_big_int zero_big_int, 0L);;
test 2 eq_int64
(int64_of_big_int (big_int_of_string "9223372036854775807"), 9223372036854775807L);;
-test 2 eq_int64
- (int64_of_big_int (big_int_of_string "-9223372036854775808"), -9223372036854775808L);;
test 3 eq_int64
+ (int64_of_big_int (big_int_of_string "-9223372036854775808"), -9223372036854775808L);;
+test 4 eq_int64
(int64_of_big_int (big_int_of_string "-9223372036854775"), -9223372036854775L);;
let should_fail s =
try ignore (int64_of_big_int (big_int_of_string s)); 0
diff --git a/otherlibs/num/test/test_ratios.ml b/otherlibs/num/test/test_ratios.ml
index 45fdce8b1..a20057077 100644
--- a/otherlibs/num/test/test_ratios.ml
+++ b/otherlibs/num/test/test_ratios.ml
@@ -883,6 +883,24 @@ failwith_test 11
(approx_ratio_fix 5) (create_ratio (big_int_of_int 0) (big_int_of_int 0))
(Failure "approx_ratio_fix infinite or undefined rational number");;
+(* PR#4566 *)
+test 12
+eq_string (approx_ratio_fix 8
+ (create_ratio (big_int_of_int 9603)
+ (big_int_of_string "100000000000")),
+
+ "+0.00000010");;
+test 13
+eq_string (approx_ratio_fix 1
+ (create_ratio (big_int_of_int 94)
+ (big_int_of_int 1000)),
+ "+0.1");;
+test 14
+eq_string (approx_ratio_fix 1
+ (create_ratio (big_int_of_int 49)
+ (big_int_of_int 1000)),
+ "+0.0");;
+
testing_function "approx_ratio_exp";;
test 1