diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2013-05-08 08:38:55 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2013-05-08 08:38:55 +0000 |
| commit | 0f45880800ac00767889f462dd6d5255bb93d742 (patch) | |
| tree | 3f0d114fdea088cdf156112db9f4592dc898dcd0 | |
| parent | 51c65627cb98c11d74086af7fd90a5eb053fc5f7 (diff) | |
| download | ocaml-0f45880800ac00767889f462dd6d5255bb93d742.tar.gz | |
PR#6010: Big_int.extract_big_int gives wrong results on negative arguments
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13660 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | Changes | 3 | ||||
| -rw-r--r-- | otherlibs/num/big_int.ml | 8 | ||||
| -rw-r--r-- | testsuite/tests/lib-num/end_test.reference | 2 | ||||
| -rw-r--r-- | testsuite/tests/lib-num/test_big_ints.ml | 10 |
4 files changed, 18 insertions, 5 deletions
@@ -86,7 +86,8 @@ Bug fixes: - PR#5981: Incompatibility check assumes abstracted types are injective - PR#5985: Unexpected interaction between variance and GADTs - PR#6004: Type information does not flow to "inherit" parameters -- PR#6005: Obj.magic with recursive modules +- PR#6005: Type unsoundness with recursive modules +- PR#6010: Big_int.extract_big_int gives wrong results on negative arguments Internals: - Moved debugger/envaux.ml to typing/envaux.ml to publish env_of_only_summary diff --git a/otherlibs/num/big_int.ml b/otherlibs/num/big_int.ml index c33fea56a2..95c6f6a8a9 100644 --- a/otherlibs/num/big_int.ml +++ b/otherlibs/num/big_int.ml @@ -739,7 +739,13 @@ let extract_big_int bi ofs n = if bi.sign < 0 then begin (* Two's complement *) complement_nat res 0 size_res; - ignore (incr_nat res 0 size_res 1) + (* PR#6010: need to increment res iff digits 0...ndigits-1 of bi are 0. + In this case, digits 0...ndigits-1 of not(bi) are all 0xFF...FF, + and adding 1 to them produces a carry out at ndigits. *) + let rec carry_incr i = + i >= ndigits || i >= size_bi || + (is_digit_zero bi.abs_value i && carry_incr (i + 1)) in + if carry_incr 0 then ignore (incr_nat res 0 size_res 1) end; if nbits > 0 then begin let tmp = create_nat 1 in diff --git a/testsuite/tests/lib-num/end_test.reference b/testsuite/tests/lib-num/end_test.reference index 8e7ac4b6cd..1c31f7121a 100644 --- a/testsuite/tests/lib-num/end_test.reference +++ b/testsuite/tests/lib-num/end_test.reference @@ -82,7 +82,7 @@ shift_right_big_int shift_right_towards_zero_big_int 1... 2... extract_big_int - 1... 2... 3... 4... 5... 6... + 1... 2... 3... 4... 5... 6... 7... 8... hashing of big integers 1... 2... 3... 4... 5... 6... create_ratio diff --git a/testsuite/tests/lib-num/test_big_ints.ml b/testsuite/tests/lib-num/test_big_ints.ml index a8a5673d8a..3bdb988868 100644 --- a/testsuite/tests/lib-num/test_big_ints.ml +++ b/testsuite/tests/lib-num/test_big_ints.ml @@ -932,8 +932,14 @@ test 5 eq_big_int (extract_big_int (big_int_of_int64 0x123456789ABCDEFL) 0 32, big_int_of_int64 2309737967L);; test 6 eq_big_int - (extract_big_int (big_int_of_int (-1)) 2048 254, - zero_big_int);; + (extract_big_int (big_int_of_int (-1)) 0 16, + big_int_of_int 0xFFFF);; +test 7 eq_big_int + (extract_big_int (big_int_of_int (-1)) 1027 12, + big_int_of_int 0xFFF);; +test 8 eq_big_int + (extract_big_int (big_int_of_int (-1234567)) 0 16, + big_int_of_int 10617);; testing_function "hashing of big integers";; |