diff options
-rw-r--r-- | otherlibs/num/big_int.ml | 22 | ||||
-rw-r--r-- | otherlibs/num/ratio.ml | 87 | ||||
-rw-r--r-- | otherlibs/num/test/Makefile | 4 | ||||
-rw-r--r-- | otherlibs/num/test/test_big_ints.ml | 4 | ||||
-rw-r--r-- | otherlibs/num/test/test_ratios.ml | 18 |
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 |