diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2009-07-15 14:50:31 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2009-07-15 14:50:31 +0000 |
| commit | a5aa0b7e3772645aa586b2b4db0eb9cc7f3e4e32 (patch) | |
| tree | 76581d7ab0b1e37872b11280ef21816db97aaf47 | |
| parent | 11217e8f704644e11a22c944fbf9dcee0e767547 (diff) | |
PR#4210, PR#4245: tightened bound checking in string->integer conversion functions, without changing what the lexer accepts
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9317 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | Changes | 16 | ||||
| -rw-r--r-- | byterun/ints.c | 17 | ||||
| -rw-r--r-- | parsing/lexer.mll | 29 |
3 files changed, 43 insertions, 19 deletions
@@ -1,11 +1,21 @@ Objective Caml 3.12.0: ---------------------- +(Changes that can break existing programs are marked with a "*" ) + +Compilers and toplevel: +- Added option '-no-app-funct' to turn applicative functors off. + This option can help working around mysterious type incompatibilities + caused by the incomplete comparison of applicative paths F(X).t. + Standard library: -* To prevent confusion when mixing Format printing functions and direct low +- PR#4210, #4245: stricter range checking in string->integer conversion + functions (int_of_string, Int32.of_string, Int64.of_string, + Nativeint.of_string). The decimal string corresponding to + max_int + 1 is no longer accepted. +- To prevent confusion when mixing Format printing functions and direct low level output, values Format.stdout and Format.stderr have been added. - -* To prevent confusion when mixing Scanf scanning functions and direct low +- To prevent confusion when mixing Scanf scanning functions and direct low level input, value Scanf.stdin has been added. Bug Fixes: diff --git a/byterun/ints.c b/byterun/ints.c index 5fc15c626..7b8a13675 100644 --- a/byterun/ints.c +++ b/byterun/ints.c @@ -83,9 +83,12 @@ static intnat parse_intnat(value s, int nbits) caml_failwith("int_of_string"); } if (base == 10) { - /* Signed representation expected, allow -2^(nbits-1) to 2^(nbits - 1) */ - if (res > (uintnat)1 << (nbits - 1)) - caml_failwith("int_of_string"); + /* Signed representation expected, allow -2^(nbits-1) to 2^(nbits-1) - 1 */ + if (sign >= 0) { + if (res >= (uintnat)1 << (nbits - 1)) caml_failwith("int_of_string"); + } else { + if (res > (uintnat)1 << (nbits - 1)) caml_failwith("int_of_string"); + } } else { /* Unsigned representation expected, allow 0 to 2^nbits - 1 and tolerate -(2^nbits - 1) to 0 */ @@ -540,7 +543,8 @@ CAMLprim value caml_int64_of_string(value s) { char * p; uint64 max_uint64 = I64_literal(0xFFFFFFFF, 0xFFFFFFFF); - uint64 max_int64 = I64_literal(0x80000000, 0x00000000); + uint64 max_int64_pos = I64_literal(0x7FFFFFFF, 0xFFFFFFFF); + uint64 max_int64_neg = I64_literal(0x80000000, 0x00000000); uint64 res, threshold; int sign, base, d; @@ -563,7 +567,10 @@ CAMLprim value caml_int64_of_string(value s) if (p != String_val(s) + caml_string_length(s)){ caml_failwith("int_of_string"); } - if (base == 10 && I64_ult(max_int64, res)) caml_failwith("int_of_string"); + if (base == 10) { + if (I64_ult((sign >= 0 ? max_int64_pos : max_int64_neg), res)) + caml_failwith("int_of_string"); + } if (sign < 0) res = I64_neg(res); return caml_copy_int64(res); } diff --git a/parsing/lexer.mll b/parsing/lexer.mll index c2e693dc4..0696aac80 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -156,6 +156,17 @@ let char_for_hexadecimal_code lexbuf i = in Char.chr (val1 * 16 + val2) +(* To convert integer literals, allowing max_int + 1 (PR#4210) *) + +let cvt_int_literal s = + - int_of_string ("-" ^ s) +let cvt_int32_literal s = + Int32.neg (Int32.of_string ("-" ^ String.sub s 0 (String.length s - 1))) +let cvt_int64_literal s = + Int64.neg (Int64.of_string ("-" ^ String.sub s 0 (String.length s - 1))) +let cvt_nativeint_literal s = + Nativeint.neg (Nativeint.of_string ("-" ^ String.sub s 0 (String.length s - 1))) + (* Remove underscores from float literals *) let remove_underscores s = @@ -264,29 +275,25 @@ rule token = parse { UIDENT(Lexing.lexeme lexbuf) } (* No capitalized keywords *) | int_literal { try - INT (int_of_string(Lexing.lexeme lexbuf)) + INT (cvt_int_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int", Location.curr lexbuf)) } | float_literal { FLOAT (remove_underscores(Lexing.lexeme lexbuf)) } | int_literal "l" - { let s = Lexing.lexeme lexbuf in - try - INT32 (Int32.of_string(String.sub s 0 (String.length s - 1))) + { try + INT32 (cvt_int32_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int32", Location.curr lexbuf)) } | int_literal "L" - { let s = Lexing.lexeme lexbuf in - try - INT64 (Int64.of_string(String.sub s 0 (String.length s - 1))) + { try + INT64 (cvt_int64_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "int64", Location.curr lexbuf)) } | int_literal "n" - { let s = Lexing.lexeme lexbuf in - try - NATIVEINT - (Nativeint.of_string(String.sub s 0 (String.length s - 1))) + { try + NATIVEINT (cvt_nativeint_literal (Lexing.lexeme lexbuf)) with Failure _ -> raise (Error(Literal_overflow "nativeint", Location.curr lexbuf)) } | "\"" |