Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Correcting bug about erroneous erro reporting in case of wrong 

conversions in format strings.
Static and dynamic messages about wrong format strings are now very
similar in printf.ml, scanf.ml, and typecore.ml.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6802 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Pierre Weis 2005-03-04 14:51:31 +00:00
parent 9e569d061c
commit 280dcb3097
6 changed files with 69 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile
View File

@ -487,7 +487,8 @@ partialclean::
beforedepend:: asmcomp/emit.ml
tools/cvt_emit: tools/cvt_emit.mll
cd tools; $(MAKE) CAMLC="../$(CAMLRUN) ../ocamlc -I ../stdlib" cvt_emit
cd tools; \
$(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../stdlib" cvt_emit
# The "expunge" utility

28
byterun/floats.c
View File

@ -106,6 +106,34 @@ CAMLprim value caml_format_float(value fmt, value arg)
return res;
}
/*CAMLprim*/ value caml_float_of_substring(value vs, value idx, value l)
{
char parse_buffer[64];
char * buf, * src, * dst, * end;
mlsize_t len, lenvs;
double d;
long flen = Int_val(l);
long fidx = Int_val(idx);
lenvs = caml_string_length(vs);
len =
fidx >= 0 && fidx < lenvs && flen > 0 && flen <= lenvs - fidx
? flen : 0;
buf = len < sizeof(parse_buffer) ? parse_buffer : caml_stat_alloc(len + 1);
src = String_val(vs) + fidx;
dst = buf;
while (len--) {
char c = *src++;
if (c != '_') *dst++ = c;
}
*dst = 0;
if (dst == buf) caml_failwith("float_of_string");
d = strtod((const char *) buf, &end);
if (buf != parse_buffer) caml_stat_free(buf);
if (end != dst) caml_failwith("float_of_string");
return caml_copy_double(d);
}
CAMLprim value caml_float_of_string(value vs)
{
char parse_buffer[64];

11
stdlib/printf.ml
View File

@ -23,7 +23,7 @@ external format_float: string -> float -> string = "caml_format_float"
let bad_conversion fmt i c =
invalid_arg
("printf: bad conversion %" ^ String.make 1 c ^ ", at char number " ^
string_of_int i ^ " in format ``" ^ fmt ^ "''");;
string_of_int i ^ " in format string ``" ^ fmt ^ "''");;
let incomplete_format fmt =
invalid_arg
@ -88,9 +88,10 @@ let format_int_with_conv conv fmt i =
(* Returns the position of the last character of the meta format
string, starting from position [i], inside a given format [fmt].
According to the character [conv], the meta format string is
enclosed by the delimitors %{ and %} (when [conv = '{'])
or %( and %) (when [conv = '(']). Hence [sub_format] returns the
index of the character ')' or '}' that ends the meta format. *)
enclosed by the delimitors %{ and %} (when [conv = '{']) or %( and
%) (when [conv = '(']). Hence, [sub_format] returns the index of
the character ')' or '}' that ends the meta format, according to
the character [conv]. *)
let sub_format incomplete_format bad_conversion conv fmt i =
let len = String.length fmt in
let rec sub_fmt c i =
@ -106,7 +107,7 @@ let sub_format incomplete_format bad_conversion conv fmt i =
| '(' | '{' as c ->
let j = sub_fmt c (j + 1) in sub (j + 1)
| ')' | '}' as c ->
if c = close then j else bad_conversion fmt j c
if c = close then j else bad_conversion fmt i c
| _ -> sub (j + 1) in
sub i in
sub_fmt conv i;;

11
stdlib/scanf.ml
View File

@ -252,14 +252,15 @@ let scanf_bad_input ib = function
bad_input (Printf.sprintf "scanf: bad input at char number %i: %s" i s)
| x -> raise x;;
let incomplete_format fmt =
invalid_arg
(Printf.sprintf "scanf: premature end of format string ``%s''" fmt);;
let bad_conversion fmt i c =
invalid_arg
(Printf.sprintf
"scanf: bad conversion %%%c, at char number %i in format %S" c i fmt);;
"scanf: bad conversion %%%c, at char number %i \
in format string ``%s''" c i fmt);;
let incomplete_format fmt =
invalid_arg
(Printf.sprintf "scanf: premature end of format string ``%s''" fmt);;
let bad_float () = bad_input "no dot or exponent part found in float token";;

47
typing/typecore.ml
View File

@ -37,8 +37,8 @@ type error =
| Label_multiply_defined of Longident.t
| Label_missing of string list
| Label_not_mutable of Longident.t
| Bad_format of string
| Bad_conversion of string * string
| Incomplete_format of string
| Bad_conversion of string * int * char
| Undefined_method of type_expr * string
| Undefined_inherited_method of string
| Unbound_class of Longident.t
@ -624,21 +624,21 @@ and is_nonexpansive_opt = function
None -> true
| Some e -> is_nonexpansive e
(* Typing of printf formats.
(* Typing of printf formats.
(Handling of * modifiers contributed by Thorsten Ohl.) *)
let type_format loc fmt =
let ty_arrow gty ty = newty (Tarrow ("", instance gty, ty, Cok)) in
let bad_conversion fmt i c =
raise (Error (loc, Bad_conversion (fmt, i, c))) in
let incomplete_format fmt =
raise (Error (loc, Incomplete_format fmt)) in
let rec type_in_format fmt =
let len = String.length fmt in
let bad_conversion fmt i c =
raise (Error (loc, Bad_conversion (fmt, String.sub fmt i len))) in
let incomplete i =
raise (Error (loc, Bad_format (String.sub fmt i (len - i)))) in
let ty_input = newvar ()
and ty_result = newvar ()
and ty_aresult = newvar () in
@ -647,29 +647,31 @@ let type_format loc fmt =
let rec scan_format i =
if i >= len then
if !meta = 0 then ty_aresult, ty_result else incomplete (i - 1) else
if !meta = 0
then ty_aresult, ty_result
else incomplete_format fmt else
match fmt.[i] with
| '%' -> scan_opts i (i + 1)
| _ -> scan_format (i + 1)
and scan_opts i j =
if j >= len then incomplete i else
if j >= len then incomplete_format fmt else
match fmt.[j] with
| '_' -> scan_rest true i (j + 1)
| _ -> scan_rest false i j
and scan_rest skip i j =
let rec scan_flags i j =
if j >= len then incomplete i else
if j >= len then incomplete_format fmt else
match fmt.[j] with
| '#' | '0' | '-' | ' ' | '+' -> scan_flags i (j + 1)
| _ -> scan_width i j
and scan_width i j = scan_width_or_prec_value scan_precision i j
and scan_decimal_string scan i j =
if j >= len then incomplete i else
if j >= len then incomplete_format fmt else
match fmt.[j] with
| '0' .. '9' -> scan_decimal_string scan i (j + 1)
| _ -> scan i j
and scan_width_or_prec_value scan i j =
if j >= len then incomplete i else
if j >= len then incomplete_format fmt else
match fmt.[j] with
| '*' ->
let ty_aresult, ty_result = scan i (j + 1) in
@ -677,7 +679,7 @@ let type_format loc fmt =
| '-' | '+' -> scan_decimal_string scan i (j + 1)
| _ -> scan_decimal_string scan i j
and scan_precision i j =
if j >= len then incomplete i else
if j >= len then incomplete_format fmt else
match fmt.[j] with
| '.' -> scan_width_or_prec_value scan_conversion i (j + 1)
| _ -> scan_conversion i j
@ -688,7 +690,7 @@ let type_format loc fmt =
if skip then ty_result else ty_arrow ty_arg ty_result
and scan_conversion i j =
if j >= len then incomplete i else
if j >= len then incomplete_format fmt else
match fmt.[j] with
| '%' | '!' -> scan_format (j + 1)
| 's' | 'S' | '[' -> conversion j Predef.type_string
@ -718,10 +720,9 @@ let type_format loc fmt =
end
| '{' | '(' as c ->
let j = j + 1 in
if j >= len then incomplete i else
if j >= len then incomplete_format fmt else
let sj =
Printf.sub_format
(fun fmt -> incomplete 0) bad_conversion c fmt j in
Printf.sub_format incomplete_format bad_conversion c fmt j in
let sfmt = String.sub fmt j (sj - j - 1) in
let ty_sfmt = type_in_format sfmt in
begin match c with
@ -1995,10 +1996,12 @@ let report_error ppf = function
print_labels labels
| Label_not_mutable lid ->
fprintf ppf "The record field label %a is not mutable" longident lid
| Bad_format s ->
fprintf ppf "Bad format %S" s
| Bad_conversion (fmt, conv) ->
fprintf ppf "Bad conversion %S in format %S" fmt conv
| Incomplete_format s ->
fprintf ppf "Premature end of format string ``%S''" s
| Bad_conversion (fmt, i, c) ->
fprintf ppf
"Bad conversion %%%c, at char number %d \
in format string ``%s''" c i fmt
| Undefined_method (ty, me) ->
reset_and_mark_loops ty;
fprintf ppf

4
typing/typecore.mli
View File

@ -74,8 +74,8 @@ type error =
| Label_multiply_defined of Longident.t
| Label_missing of string list
| Label_not_mutable of Longident.t
| Bad_format of string
| Bad_conversion of string * string
| Incomplete_format of string
| Bad_conversion of string * int * char
| Undefined_method of type_expr * string
| Undefined_inherited_method of string
| Unbound_class of Longident.t