PR#5380: copy fix from 3.12 branch

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

Author: Damien Doligez

stdlib/printf.ml

@@ -217,7 +217,7 @@ let iter_on_format_args fmt add_conv add_char =
   and scan_conv skip i =
     if i > lim then incomplete_format fmt else
     match Sformat.unsafe_get fmt i with
-    | '%' | '!' | ',' -> succ i
+    | '%' | '@' | '!' | ',' -> succ i
     | 's' | 'S' | '[' -> add_conv skip i 's'
     | 'c' | 'C' -> add_conv skip i 'c'
     | 'd' | 'i' |'o' | 'u' | 'x' | 'X' | 'N' -> add_conv skip i 'i'
@@ -505,8 +505,10 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
 
   and scan_conv spec n widths i =
     match Sformat.unsafe_get fmt i with
-    | '%' ->
-      cont_s n "%" (succ i)
+    | '%' | '@' as c ->
+      cont_s n (String.make 1 c) (succ i)
+    | '!' -> cont_f n (succ i)
+    | ',' -> cont_s n "" (succ i)
     | 's' | 'S' as conv ->
       let (x : string) = get_arg spec n in
       let x = if conv = 's' then x else "\"" ^ String.escaped x ^ "\"" in
@@ -515,6 +517,8 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
         if i = succ pos then x else
         format_string (extract_format fmt pos i widths) x in
       cont_s (next_index spec n) s (succ i)
+    | '[' as conv ->
+      bad_conversion_format fmt i conv
     | 'c' | 'C' as conv ->
       let (x : char) = get_arg spec n in
       let s =
@@ -546,6 +550,8 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
       let n = Sformat.succ_index (get_index spec n) in
       let arg = get_arg Spec_none n in
       cont_a (next_index spec n) printer arg (succ i)
+    | 'r' as conv ->
+      bad_conversion_format fmt i conv
     | 't' ->
       let printer = get_arg spec n in
       cont_t (next_index spec n) printer (succ i)
@@ -570,8 +576,6 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
         let s = format_int (extract_format_int 'n' fmt pos i widths) x in
         cont_s (next_index spec n) s (succ i)
       end
-    | ',' -> cont_s n "" (succ i)
-    | '!' -> cont_f n (succ i)
     | '{' | '(' as conv (* ')' '}' *) ->
       let (xf : ('a, 'b, 'c, 'd, 'e, 'f) format6) = get_arg spec n in
       let i = succ i in

stdlib/printf.mli

@@ -20,7 +20,7 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
    [arg1] to [argN] according to the format string [format], and
    outputs the resulting string on the channel [outchan].
 
-   The format is a character string which contains two types of
+   The format string is a character string which contains two types of
    objects: plain characters, which are simply copied to the output
    channel, and conversion specifications, each of which causes
    conversion and printing of arguments.
@@ -31,20 +31,23 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
 
    In short, a conversion specification consists in the [%] character,
    followed by optional modifiers and a type which is made of one or
-   two characters. The types and their meanings are:
+   two characters.
 
-   - [d], [i], [n], [l], [L], or [N]: convert an integer argument to
-     signed decimal.
-   - [u]: convert an integer argument to unsigned decimal.
+   The types and their meanings are:
+
+   - [d], [i]: convert an integer argument to signed decimal.
+   - [u], [n], [l], [L], or [N]: convert an integer argument to
+     unsigned decimal.  Warning: [n], [l], [L], and [N] are
+     used for [scanf], and should not be used for [printf].
    - [x]: convert an integer argument to unsigned hexadecimal,
      using lowercase letters.
    - [X]: convert an integer argument to unsigned hexadecimal,
      using uppercase letters.
    - [o]: convert an integer argument to unsigned octal.
    - [s]: insert a string argument.
-   - [S]: insert a string argument in OCaml syntax (double quotes, escapes).
+   - [S]: convert a string argument to OCaml syntax (double quotes, escapes).
    - [c]: insert a character argument.
-   - [C]: insert a character argument in OCaml syntax (single quotes, escapes).
+   - [C]: convert a character argument to OCaml syntax (single quotes, escapes).
    - [f]: convert a floating-point argument to decimal notation,
      in the style [dddd.ddd].
    - [F]: convert a floating-point argument to OCaml syntax ([dddd.]
@@ -54,37 +57,40 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
    - [g] or [G]: convert a floating-point argument to decimal notation,
      in style [f] or [e], [E] (whichever is more compact).
    - [B]: convert a boolean argument to the string [true] or [false]
-   - [b]: convert a boolean argument (for backward compatibility; do not
-     use in new programs).
+   - [b]: convert a boolean argument (deprecated; do not use in new
+     programs).
    - [ld], [li], [lu], [lx], [lX], [lo]: convert an [int32] argument to
      the format specified by the second letter (decimal, hexadecimal, etc).
    - [nd], [ni], [nu], [nx], [nX], [no]: convert a [nativeint] argument to
      the format specified by the second letter.
    - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: convert an [int64] argument to
      the format specified by the second letter.
-   - [a]: user-defined printer. Takes two arguments and applies the
+   - [a]: user-defined printer. Take two arguments and apply the
      first one to [outchan] (the current output channel) and to the
      second argument. The first argument must therefore have type
      [out_channel -> 'b -> unit] and the second ['b].
      The output produced by the function is inserted in the output of
      [fprintf] at the current point.
-   - [t]: same as [%a], but takes only one argument (with type
+   - [t]: same as [%a], but take only one argument (with type
      [out_channel -> unit]) and apply it to [outchan].
    - [\{ fmt %\}]: convert a format string argument. The argument must
      have the same type as the internal format string [fmt].
-   - [( fmt %)]: format string substitution. Takes a format string
-     argument and substitutes it to the internal format string [fmt]
+   - [( fmt %)]: format string substitution. Take a format string
+     argument and substitute it to the internal format string [fmt]
      to print following arguments. The argument must have the same
      type as the internal format string [fmt].
    - [!]: take no argument and flush the output.
    - [%]: take no argument and output one [%] character.
-   - [,]: the no-op delimiter for conversion specifications.
+   - [\@]: take no argument and output one [\@] character.
+   - [,]: take no argument and do nothing.
 
    The optional [flags] are:
    - [-]: left-justify the output (default is right justification).
    - [0]: for numerical conversions, pad with zeroes instead of spaces.
-   - [+]: for numerical conversions, prefix number with a [+] sign if positive.
-   - space: for numerical conversions, prefix number with a space if positive.
+   - [+]: for signed numerical conversions, prefix number with a [+]
+     sign if positive.
+   - space: for signed numerical conversions, prefix number with a
+     space if positive.
    - [#]: request an alternate formatting style for numbers.
 
    The optional [width] is an integer indicating the minimal

stdlib/scanf.ml

@@ -438,7 +438,7 @@ let int_of_width_opt = function
 ;;
 
 let int_of_prec_opt = function
-  | None -> 0
+  | None -> max_int
   | Some prec -> prec
 ;;
 
@@ -999,31 +999,51 @@ type char_set =
    | Neg_set of string (* Negative (complementary) set. *)
 ;;
 
+
 (* Char sets are read as sub-strings in the format string. *)
-let read_char_set fmt i =
-  let lim = Sformat.length fmt - 1 in
+let scan_range fmt j =
+
+  let len = Sformat.length fmt in
+
+  let buffer = Buffer.create len in
 
-  let rec find_in_set j =
-    if j > lim then incomplete_format fmt else
+  let rec scan_closing j =
+    if j >= len then incomplete_format fmt else
     match Sformat.get fmt j with
-    | ']' -> j
-    | _ -> find_in_set (succ j)
-
-  and find_set i =
-    if i > lim then incomplete_format fmt else
-    match Sformat.get fmt i with
-    | ']' -> find_in_set (succ i)
-    | _ -> find_in_set i in
-
-  if i > lim then incomplete_format fmt else
-  match Sformat.get fmt i with
-  | '^' ->
-    let i = succ i in
-    let j = find_set i in
-    j, Neg_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
-  | _ ->
-    let j = find_set i in
-    j, Pos_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
+    | ']' -> j, Buffer.contents buffer
+    | '%' ->
+      let j = j + 1 in
+      if j >= len then incomplete_format fmt else
+      begin match Sformat.get fmt j with
+      | '%' | '@' as c ->
+        Buffer.add_char buffer c;
+        scan_closing (j + 1)
+      | c -> bad_conversion fmt j c
+      end
+    | c ->
+      Buffer.add_char buffer c;
+      scan_closing (j + 1) in
+
+  let scan_first_pos j =
+    if j >= len then incomplete_format fmt else
+    match Sformat.get fmt j with
+    | ']' as c ->
+      Buffer.add_char buffer c;
+      scan_closing (j + 1)
+    | _ -> scan_closing j in
+
+  let rec scan_first_neg j =
+    if j >= len then incomplete_format fmt else
+    match Sformat.get fmt j with
+    | '^' ->
+      let j = j + 1 in
+      let k, char_set = scan_first_pos j in
+      k, Neg_set char_set
+    | _ ->
+      let k, char_set = scan_first_pos j in
+      k, Pos_set char_set in
+
+  scan_first_neg j
 ;;
 
 (* Char sets are now represented as bit vectors that are represented as
@@ -1370,18 +1390,19 @@ let scan_format ib ef fmt rv f =
       let width = int_of_width_opt width_opt in
       let prec = int_of_prec_opt prec_opt in
       match Sformat.get fmt i with
-      | '%' as conv ->
-        check_char ib conv; scan_fmt ir f (succ i)
+      | '%' | '@' as c ->
+        check_char ib c;
+        scan_fmt ir f (succ i)
       | 's' ->
-        let i, stp = scan_fmt_stoppers (succ i) in
+        let i, stp = scan_indication (succ i) in
         let _x = scan_string stp width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | 'S' ->
         let _x = scan_String width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | '[' (* ']' *) ->
-        let i, char_set = read_char_set fmt (succ i) in
-        let i, stp = scan_fmt_stoppers (succ i) in
+        let i, char_set = scan_range fmt (succ i) in
+        let i, stp = scan_indication (succ i) in
         let _x = scan_chars_in_char_set stp char_set width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | ('c' | 'C') when width = 0 ->
@@ -1458,12 +1479,23 @@ let scan_format ib ef fmt rv f =
 
       | c -> bad_conversion fmt i c
 
-    and scan_fmt_stoppers i =
-      if i > lim then i - 1, [] else
-      match Sformat.get fmt i with
-      | '@' when i < lim -> let i = succ i in i, [Sformat.get fmt i]
-      | '@' when i = lim -> incomplete_format fmt
-      | _ -> i - 1, [] in
+    and scan_indication j =
+      if j > lim then j - 1, [] else
+      match Sformat.get fmt j with
+      | '@' ->
+        let k = j + 1 in
+        if k > lim then j - 1, [] else
+        begin match Sformat.get fmt k with
+        | '%' ->
+          let k = k + 1 in
+          if k > lim then j - 1, [] else
+          begin match Sformat.get fmt k with
+          | '%' | '@' as c  -> k, [ c ]
+          | _c -> j - 1, []
+          end
+        | c -> k, [ c ]
+        end
+      | _c -> j - 1, [] in
 
     scan_fmt in