Preparing printf positional specifications.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7373 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 9 insertions, 1 deletions

diff --git a/typing/typecore.ml b/typing/typecore.ml
index d8c1cb4cc..59801ca48 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -627,6 +627,11 @@ and is_nonexpansive_opt = function
 (* Typing of printf formats.
    (Handling of * modifiers contributed by Thorsten Ohl.) *)
 
+external string_to_format :
+ string -> ('a, 'b, 'c, 'd) format4 = "%identity"
+external format_to_string :
+ ('a, 'b, 'c, 'd) format4 -> string = "%identity"
+
 let type_format loc fmt =
 
   let ty_arrow gty ty = newty (Tarrow ("", instance gty, ty, Cok)) in
@@ -745,7 +750,10 @@ let type_format loc fmt =
           let j = j + 1 in
           if j >= len then incomplete_format fmt else
           let sj =
-            Printf.sub_format incomplete_format bad_conversion c fmt j in
+            Printf.sub_format
+              (fun fmt -> incomplete_format (format_to_string fmt))
+              (fun fmt -> bad_conversion (format_to_string fmt))
+              c (string_to_format 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