second part of Benoît Vaugon's format+gadts patch
To finish the bootstrap cycle, run: make library-cross make promote make partialclean make core make library-cross make promote-cross make partialclean make ocamlc ocamllex ocamltools make library-cross make promote make partialclean make core make compare git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14810 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Gabriel Scherer
parent
9fa17c95a5
commit
72669307e8
|
|
@ -1056,33 +1056,21 @@ fun ign fmt -> match ign with
|
|||
Param_format_EBB (Scan_char_set (width_opt, char_set, fmt))
|
||||
end
|
||||
|
||||
(*type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
|
||||
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6*)
|
||||
type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
|
||||
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
|
||||
|
||||
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
|
||||
|
||||
type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
|
||||
|
||||
let string_of_format (fmt, str) = str
|
||||
|
||||
external format_of_string :
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
|
||||
|
||||
external format_to_string :
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 -> string = "%identity"
|
||||
external string_to_format :
|
||||
string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
|
||||
|
||||
let (( ^^ ) :
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
|
||||
('f, 'b, 'c, 'e, 'g, 'h) format6 ->
|
||||
('a, 'b, 'c, 'd, 'g, 'h) format6) =
|
||||
fun fmt1 fmt2 ->
|
||||
string_to_format (format_to_string fmt1 ^ "%," ^ format_to_string fmt2)
|
||||
;;
|
||||
|
||||
(* Have to return a copy for compatibility with unsafe-string mode *)
|
||||
(* String.copy is not available here, so use ^ to make a copy of the string *)
|
||||
let string_of_format fmt = format_to_string fmt ^ ""
|
||||
let (^^) (fmt1, str1) (fmt2, str2) =
|
||||
(CamlinternalFormatBasics.concat_fmt fmt1 fmt2, str1 ^ str2)
|
||||
|
||||
(* Miscellaneous *)
|
||||
|
||||
|
|
|
|||
|
|
@ -19,8 +19,8 @@ case $1 in
|
|||
buffer.cmx|buffer.p.cmx) echo ' -inline 3';;
|
||||
# make sure add_char is inlined (PR#5872)
|
||||
buffer.cm[io]) echo ' -w A';;
|
||||
camlinternalFormat.cm[io]) echo ' -w a';;
|
||||
printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
|
||||
camlinternalFormat.cm[io]) echo ' -w Ae';;
|
||||
printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w Ae';;
|
||||
scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
|
||||
*Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -no-alias-deps';;
|
||||
*) echo ' ';;
|
||||
|
|
|
|||
|
|
@ -976,9 +976,9 @@ fun k o acc fmt -> match fmt with
|
|||
(*fun _ -> make_printf k o (Acc_string (acc, string_of_fmtty fmtty)) rest*)
|
||||
fun (_, str) -> make_printf k o (Acc_string (acc, str)) rest
|
||||
| Format_subst (_, _, fmtty, rest) ->
|
||||
(* Call to type_format can't failed (raise Type_mismatch). *)
|
||||
(* Call to type_format can't fail (raise Type_mismatch). *)
|
||||
fun (fmt, _) -> make_printf k o acc
|
||||
CamlinternalFormatBasics.(concat_fmt (type_format fmt fmtty) rest)
|
||||
(concat_fmt (type_format fmt fmtty) rest)
|
||||
|
||||
| Scan_char_set (_, _, rest) ->
|
||||
let new_acc = Acc_invalid_arg (acc, "Printf: bad conversion %[") in
|
||||
|
|
@ -1215,12 +1215,11 @@ let rec strput_acc b acc = match acc with
|
|||
(* Error managment *)
|
||||
|
||||
(* Raise a Failure with a pretty-printed error message. *)
|
||||
(* Since it uses "compiled formats", it can't be implemented in bootstrap
|
||||
mode. *)
|
||||
let failwith_message _ =
|
||||
failwith
|
||||
"CamlinternalFormat failure \
|
||||
(error messages not implemented at bootstrap time)"
|
||||
let failwith_message
|
||||
((fmt, _) : ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6) =
|
||||
let buf = Buffer.create 256 in
|
||||
let k () acc = strput_acc buf acc; failwith (Buffer.contents buf) in
|
||||
make_printf k () End_of_acc fmt
|
||||
|
||||
(******************************************************************************)
|
||||
(* Parsing tools *)
|
||||
|
|
|
|||
443
stdlib/format.ml
443
stdlib/format.ml
|
|
@ -29,6 +29,10 @@ external int_of_size : size -> int = "%identity"
|
|||
|
||||
(* Tokens are one of the following : *)
|
||||
|
||||
type block_type
|
||||
= CamlinternalFormatBasics.block_type
|
||||
= Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
|
||||
|
||||
type pp_token =
|
||||
| Pp_text of string (* normal text *)
|
||||
| Pp_break of int * int (* complete break *)
|
||||
|
|
@ -46,21 +50,7 @@ type pp_token =
|
|||
|
||||
and tag = string
|
||||
|
||||
and block_type =
|
||||
| Pp_hbox (* Horizontal block no line breaking *)
|
||||
| Pp_vbox (* Vertical block each break leads to a new line *)
|
||||
| Pp_hvbox (* Horizontal-vertical block: same as vbox, except if this block
|
||||
is small enough to fit on a single line *)
|
||||
| Pp_hovbox (* Horizontal or Vertical block: breaks lead to new line
|
||||
only when necessary to print the content of the block *)
|
||||
| Pp_box (* Horizontal or Indent block: breaks lead to new line
|
||||
only when necessary to print the content of the block, or
|
||||
when it leads to a new indentation of the current line *)
|
||||
| Pp_fits (* Internal usage: when a block fits on a single line *)
|
||||
|
||||
and tblock =
|
||||
| Pp_tbox of int list ref (* Tabulation box *)
|
||||
;;
|
||||
and tblock = Pp_tbox of int list ref (* Tabulation box *)
|
||||
|
||||
(* The Queue:
|
||||
contains all formatting elements.
|
||||
|
|
@ -241,7 +231,8 @@ let pp_infinity = 1000000010;;
|
|||
let pp_output_string state s = state.pp_out_string s 0 (String.length s)
|
||||
and pp_output_newline state = state.pp_out_newline ()
|
||||
and pp_output_spaces state n = state.pp_out_spaces n
|
||||
;;
|
||||
|
||||
let pp_output_char state c = pp_output_string state (String.make 1 c)
|
||||
|
||||
(* To format a break, indenting a new line. *)
|
||||
let break_new_line state offset width =
|
||||
|
|
@ -1069,309 +1060,71 @@ and set_tags =
|
|||
pp_set_tags std_formatter
|
||||
;;
|
||||
|
||||
(**************************************************************
|
||||
|
||||
Defining continuations to be passed as arguments of
|
||||
CamlinternalFormat.make_printf.
|
||||
|
||||
**************************************************************)
|
||||
|
||||
(**************************************************************
|
||||
open CamlinternalFormatBasics
|
||||
open CamlinternalFormat
|
||||
|
||||
Printf implementation.
|
||||
(* Interpret a formatting entity on a formatter. *)
|
||||
let output_formatting ppf fmting = match fmting with
|
||||
| Open_box (_, bty, indent) -> pp_open_box_gen ppf indent bty
|
||||
| Close_box -> pp_close_box ppf ()
|
||||
| Open_tag (_, name) -> pp_open_tag ppf name
|
||||
| Close_tag -> pp_close_tag ppf ()
|
||||
| Break (_, width, offset) -> pp_print_break ppf width offset
|
||||
| FFlush -> pp_print_flush ppf ()
|
||||
| Force_newline -> pp_force_newline ppf ()
|
||||
| Flush_newline -> pp_print_newline ppf ()
|
||||
| Magic_size (_, _) -> ()
|
||||
| Escaped_at -> pp_output_char ppf '@'
|
||||
| Escaped_percent -> pp_output_char ppf '%'
|
||||
| Scan_indic c -> pp_output_char ppf '@'; pp_output_char ppf c
|
||||
|
||||
**************************************************************)
|
||||
(* Recursively output an "accumulator" containing a reversed list of
|
||||
printing entities (string, char, flus, ...) in an output_stream. *)
|
||||
(* Differ from Printf.output_acc by the interpretation of formatting. *)
|
||||
(* Used as a continuation of CamlinternalFormat.make_printf. *)
|
||||
let rec output_acc ppf acc = match acc with
|
||||
| Acc_string (Acc_formatting (p, Magic_size (_, size)), s) ->
|
||||
output_acc ppf p;
|
||||
pp_print_as_size ppf (size_of_int size) s;
|
||||
| Acc_char (Acc_formatting (p, Magic_size (_, size)), c) ->
|
||||
output_acc ppf p;
|
||||
pp_print_as_size ppf (size_of_int size) (String.make 1 c);
|
||||
| Acc_formatting (p, f) -> output_acc ppf p; output_formatting ppf f;
|
||||
| Acc_string (p, s) -> output_acc ppf p; pp_print_string ppf s;
|
||||
| Acc_char (p, c) -> output_acc ppf p; pp_print_char ppf c;
|
||||
| Acc_delay (p, f) -> output_acc ppf p; f ppf;
|
||||
| Acc_flush p -> output_acc ppf p; pp_print_flush ppf ();
|
||||
| Acc_invalid_arg (p, msg) -> output_acc ppf p; invalid_arg msg;
|
||||
| End_of_acc -> ()
|
||||
|
||||
module Sformat = Printf.CamlinternalPr.Sformat;;
|
||||
module Tformat = Printf.CamlinternalPr.Tformat;;
|
||||
|
||||
(* Error messages when processing formats. *)
|
||||
|
||||
(* Trailer: giving up at character number ... *)
|
||||
let giving_up mess fmt i =
|
||||
Printf.sprintf
|
||||
"Format.fprintf: %s \'%s\', giving up at character number %d%s"
|
||||
mess (Sformat.to_string fmt) i
|
||||
(if i < Sformat.length fmt
|
||||
then Printf.sprintf " (%c)." (Sformat.get fmt i)
|
||||
else Printf.sprintf "%c" '.')
|
||||
;;
|
||||
|
||||
(* When an invalid format deserves a special error explanation. *)
|
||||
let format_invalid_arg mess fmt i = invalid_arg (giving_up mess fmt i);;
|
||||
|
||||
(* Standard invalid format. *)
|
||||
let invalid_format fmt i = format_invalid_arg "bad format" fmt i;;
|
||||
|
||||
(* Cannot find a valid integer into that format. *)
|
||||
let invalid_integer fmt i =
|
||||
invalid_arg (giving_up "bad integer specification" fmt i);;
|
||||
|
||||
(* Finding an integer size out of a sub-string of the format. *)
|
||||
let format_int_of_string fmt i s =
|
||||
let sz =
|
||||
try int_of_string s with
|
||||
| Failure _ -> invalid_integer fmt i in
|
||||
size_of_int sz
|
||||
;;
|
||||
|
||||
(* Getting strings out of buffers. *)
|
||||
let get_buffer_out b =
|
||||
let s = Buffer.contents b in
|
||||
Buffer.reset b;
|
||||
s
|
||||
;;
|
||||
|
||||
(* [ppf] is supposed to be a pretty-printer that outputs to buffer [b]:
|
||||
to extract the contents of [ppf] as a string we flush [ppf] and get the
|
||||
string out of [b]. *)
|
||||
let string_out b ppf =
|
||||
pp_flush_queue ppf false;
|
||||
get_buffer_out b
|
||||
;;
|
||||
|
||||
(* Applies [printer] to a formatter that outputs on a fresh buffer,
|
||||
then returns the resulting material. *)
|
||||
let exstring printer arg =
|
||||
let b = Buffer.create 512 in
|
||||
let ppf = formatter_of_buffer b in
|
||||
printer ppf arg;
|
||||
string_out b ppf
|
||||
;;
|
||||
|
||||
(* To turn out a character accumulator into the proper string result. *)
|
||||
let implode_rev s0 = function
|
||||
| [] -> s0
|
||||
| l -> String.concat "" (List.rev (s0 :: l))
|
||||
;;
|
||||
|
||||
(* [mkprintf] is the printf-like function generator: given the
|
||||
- [to_s] flag that tells if we are printing into a string,
|
||||
- the [get_out] function that has to be called to get a [ppf] function to
|
||||
output onto,
|
||||
it generates a [kprintf] function that takes as arguments a [k]
|
||||
continuation function to be called at the end of formatting,
|
||||
and a printing format string to print the rest of the arguments
|
||||
according to the format string.
|
||||
Regular [fprintf]-like functions of this module are obtained via partial
|
||||
applications of [mkprintf]. *)
|
||||
let mkprintf to_s get_out k fmt =
|
||||
|
||||
(* [out] is global to this definition of [pr], and must be shared by all its
|
||||
recursive calls (if any). *)
|
||||
let out = get_out fmt in
|
||||
let print_as = ref None in
|
||||
let outc c =
|
||||
match !print_as with
|
||||
| None -> pp_print_char out c
|
||||
| Some size ->
|
||||
pp_print_as_size out size (String.make 1 c);
|
||||
print_as := None
|
||||
and outs s =
|
||||
match !print_as with
|
||||
| None -> pp_print_string out s
|
||||
| Some size ->
|
||||
pp_print_as_size out size s;
|
||||
print_as := None
|
||||
and flush out = pp_print_flush out () in
|
||||
|
||||
let rec pr k n fmt v =
|
||||
|
||||
let len = Sformat.length fmt in
|
||||
|
||||
let rec doprn n i =
|
||||
if i >= len then Obj.magic (k out) else
|
||||
match Sformat.get fmt i with
|
||||
| '%' ->
|
||||
Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
|
||||
| '@' ->
|
||||
let i = succ i in
|
||||
if i >= len then invalid_format fmt i else
|
||||
begin match Sformat.get fmt i with
|
||||
| '[' ->
|
||||
do_pp_open_box out n (succ i)
|
||||
| ']' ->
|
||||
pp_close_box out ();
|
||||
doprn n (succ i)
|
||||
| '{' ->
|
||||
do_pp_open_tag out n (succ i)
|
||||
| '}' ->
|
||||
pp_close_tag out ();
|
||||
doprn n (succ i)
|
||||
| ' ' ->
|
||||
pp_print_space out ();
|
||||
doprn n (succ i)
|
||||
| ',' ->
|
||||
pp_print_cut out ();
|
||||
doprn n (succ i)
|
||||
| '?' ->
|
||||
pp_print_flush out ();
|
||||
doprn n (succ i)
|
||||
| '.' ->
|
||||
pp_print_newline out ();
|
||||
doprn n (succ i)
|
||||
| '\n' ->
|
||||
pp_force_newline out ();
|
||||
doprn n (succ i)
|
||||
| ';' ->
|
||||
do_pp_break out n (succ i)
|
||||
| '<' ->
|
||||
let got_size size n i =
|
||||
print_as := Some size;
|
||||
doprn n (skip_gt i) in
|
||||
get_int n (succ i) got_size
|
||||
| '@' ->
|
||||
outc '@';
|
||||
doprn n (succ i)
|
||||
| _ -> invalid_format fmt i
|
||||
end
|
||||
| c -> outc c; doprn n (succ i)
|
||||
|
||||
and cont_s n s i =
|
||||
outs s; doprn n i
|
||||
and cont_a n printer arg i =
|
||||
if to_s then
|
||||
outs ((Obj.magic printer : unit -> _ -> string) () arg)
|
||||
else
|
||||
printer out arg;
|
||||
doprn n i
|
||||
and cont_t n printer i =
|
||||
if to_s then
|
||||
outs ((Obj.magic printer : unit -> string) ())
|
||||
else
|
||||
printer out;
|
||||
doprn n i
|
||||
and cont_f n i =
|
||||
flush out; doprn n i
|
||||
and cont_m n xf i =
|
||||
let m =
|
||||
Sformat.add_int_index
|
||||
(Tformat.count_printing_arguments_of_format xf) n in
|
||||
pr (Obj.magic (fun _ -> doprn m i)) n xf v
|
||||
|
||||
and get_int n i c =
|
||||
if i >= len then invalid_integer fmt i else
|
||||
match Sformat.get fmt i with
|
||||
| ' ' -> get_int n (succ i) c
|
||||
| '%' ->
|
||||
let cont_s n s i = c (format_int_of_string fmt i s) n i
|
||||
and cont_a _n _printer _arg i = invalid_integer fmt i
|
||||
and cont_t _n _printer i = invalid_integer fmt i
|
||||
and cont_f _n i = invalid_integer fmt i
|
||||
and cont_m _n _sfmt i = invalid_integer fmt i in
|
||||
Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
|
||||
| _ ->
|
||||
let rec get j =
|
||||
if j >= len then invalid_integer fmt j else
|
||||
match Sformat.get fmt j with
|
||||
| '0' .. '9' | '-' -> get (succ j)
|
||||
| _ ->
|
||||
let size =
|
||||
if j = i then size_of_int 0 else
|
||||
let s = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
|
||||
format_int_of_string fmt j s in
|
||||
c size n j in
|
||||
get i
|
||||
|
||||
and skip_gt i =
|
||||
if i >= len then invalid_format fmt i else
|
||||
match Sformat.get fmt i with
|
||||
| ' ' -> skip_gt (succ i)
|
||||
| '>' -> succ i
|
||||
| _ -> invalid_format fmt i
|
||||
|
||||
and get_box_kind i =
|
||||
if i >= len then Pp_box, i else
|
||||
match Sformat.get fmt i with
|
||||
| 'h' ->
|
||||
let i = succ i in
|
||||
if i >= len then Pp_hbox, i else
|
||||
begin match Sformat.get fmt i with
|
||||
| 'o' ->
|
||||
let i = succ i in
|
||||
if i >= len then format_invalid_arg "bad box format" fmt i else
|
||||
begin match Sformat.get fmt i with
|
||||
| 'v' -> Pp_hovbox, succ i
|
||||
| c ->
|
||||
format_invalid_arg
|
||||
("bad box name ho" ^ String.make 1 c) fmt i
|
||||
end
|
||||
| 'v' -> Pp_hvbox, succ i
|
||||
| _ -> Pp_hbox, i
|
||||
end
|
||||
| 'b' -> Pp_box, succ i
|
||||
| 'v' -> Pp_vbox, succ i
|
||||
| _ -> Pp_box, i
|
||||
|
||||
and get_tag_name n i c =
|
||||
let rec get accu n i j =
|
||||
if j >= len then
|
||||
c (implode_rev
|
||||
(Sformat.sub fmt (Sformat.index_of_int i) (j - i))
|
||||
accu)
|
||||
n j else
|
||||
match Sformat.get fmt j with
|
||||
| '>' ->
|
||||
c (implode_rev
|
||||
(Sformat.sub fmt (Sformat.index_of_int i) (j - i))
|
||||
accu)
|
||||
n j
|
||||
| '%' ->
|
||||
let s0 = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
|
||||
let cont_s n s i = get (s :: s0 :: accu) n i i
|
||||
and cont_a n printer arg i =
|
||||
let s =
|
||||
if to_s
|
||||
then (Obj.magic printer : unit -> _ -> string) () arg
|
||||
else exstring printer arg in
|
||||
get (s :: s0 :: accu) n i i
|
||||
and cont_t n printer i =
|
||||
let s =
|
||||
if to_s
|
||||
then (Obj.magic printer : unit -> string) ()
|
||||
else exstring (fun ppf () -> printer ppf) () in
|
||||
get (s :: s0 :: accu) n i i
|
||||
and cont_f _n i =
|
||||
format_invalid_arg "bad tag name specification" fmt i
|
||||
and cont_m _n _sfmt i =
|
||||
format_invalid_arg "bad tag name specification" fmt i in
|
||||
Tformat.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
|
||||
| _ -> get accu n i (succ j) in
|
||||
get [] n i i
|
||||
|
||||
and do_pp_break ppf n i =
|
||||
if i >= len then begin pp_print_space ppf (); doprn n i end else
|
||||
match Sformat.get fmt i with
|
||||
| '<' ->
|
||||
let rec got_nspaces nspaces n i =
|
||||
get_int n i (got_offset nspaces)
|
||||
and got_offset nspaces offset n i =
|
||||
pp_print_break ppf (int_of_size nspaces) (int_of_size offset);
|
||||
doprn n (skip_gt i) in
|
||||
get_int n (succ i) got_nspaces
|
||||
| _c -> pp_print_space ppf (); doprn n i
|
||||
|
||||
and do_pp_open_box ppf n i =
|
||||
if i >= len then begin pp_open_box_gen ppf 0 Pp_box; doprn n i end else
|
||||
match Sformat.get fmt i with
|
||||
| '<' ->
|
||||
let kind, i = get_box_kind (succ i) in
|
||||
let got_size size n i =
|
||||
pp_open_box_gen ppf (int_of_size size) kind;
|
||||
doprn n (skip_gt i) in
|
||||
get_int n i got_size
|
||||
| _c -> pp_open_box_gen ppf 0 Pp_box; doprn n i
|
||||
|
||||
and do_pp_open_tag ppf n i =
|
||||
if i >= len then begin pp_open_tag ppf ""; doprn n i end else
|
||||
match Sformat.get fmt i with
|
||||
| '<' ->
|
||||
let got_name tag_name n i =
|
||||
pp_open_tag ppf tag_name;
|
||||
doprn n (skip_gt i) in
|
||||
get_tag_name n (succ i) got_name
|
||||
| _c -> pp_open_tag ppf ""; doprn n i in
|
||||
|
||||
doprn n 0 in
|
||||
|
||||
let kpr = pr k (Sformat.index_of_int 0) in
|
||||
|
||||
Tformat.kapr kpr fmt
|
||||
;;
|
||||
(* Recursively output an "accumulator" containing a reversed list of
|
||||
printing entities (string, char, flus, ...) in a buffer. *)
|
||||
(* Differ from Printf.bufput_acc by the interpretation of formatting. *)
|
||||
(* Used as a continuation of CamlinternalFormat.make_printf. *)
|
||||
let rec strput_acc ppf acc = match acc with
|
||||
| Acc_string (Acc_formatting (p, Magic_size (_, size)), s) ->
|
||||
strput_acc ppf p;
|
||||
pp_print_as_size ppf (size_of_int size) s;
|
||||
| Acc_char (Acc_formatting (p, Magic_size (_, size)), c) ->
|
||||
strput_acc ppf p;
|
||||
pp_print_as_size ppf (size_of_int size) (String.make 1 c);
|
||||
| Acc_delay (Acc_formatting (p, Magic_size (_, size)), f) ->
|
||||
strput_acc ppf p;
|
||||
pp_print_as_size ppf (size_of_int size) (f ());
|
||||
| Acc_formatting (p, f) -> strput_acc ppf p; output_formatting ppf f;
|
||||
| Acc_string (p, s) -> strput_acc ppf p; pp_print_string ppf s;
|
||||
| Acc_char (p, c) -> strput_acc ppf p; pp_print_char ppf c;
|
||||
| Acc_delay (p, f) -> strput_acc ppf p; pp_print_string ppf (f ());
|
||||
| Acc_flush p -> strput_acc ppf p; pp_print_flush ppf ();
|
||||
| Acc_invalid_arg (p, msg) -> strput_acc ppf p; invalid_arg msg;
|
||||
| End_of_acc -> ()
|
||||
|
||||
(**************************************************************
|
||||
|
||||
|
|
@ -1379,30 +1132,37 @@ let mkprintf to_s get_out k fmt =
|
|||
|
||||
**************************************************************)
|
||||
|
||||
let kfprintf k ppf = mkprintf false (fun _ -> ppf) k;;
|
||||
let ikfprintf k ppf = Tformat.kapr (fun _ _ -> Obj.magic (k ppf));;
|
||||
let kfprintf k o (fmt, _) =
|
||||
make_printf (fun o acc -> output_acc o acc; k o) o End_of_acc fmt
|
||||
let ikfprintf k x (fmt, _) =
|
||||
make_printf (fun _ _ -> k x) x End_of_acc fmt
|
||||
|
||||
let fprintf ppf = kfprintf ignore ppf;;
|
||||
let ifprintf ppf = ikfprintf ignore ppf;;
|
||||
let printf fmt = fprintf std_formatter fmt;;
|
||||
let eprintf fmt = fprintf err_formatter fmt;;
|
||||
let fprintf ppf fmt = kfprintf ignore ppf fmt
|
||||
let ifprintf ppf fmt = ikfprintf ignore ppf fmt
|
||||
let printf fmt = fprintf std_formatter fmt
|
||||
let eprintf fmt = fprintf err_formatter fmt
|
||||
|
||||
let ksprintf k =
|
||||
let ksprintf k (fmt, _) =
|
||||
let k' () acc =
|
||||
let b = Buffer.create 512 in
|
||||
let ppf = formatter_of_buffer b in
|
||||
strput_acc ppf acc;
|
||||
pp_flush_queue ppf false;
|
||||
k (Buffer.contents b) in
|
||||
make_printf k' () End_of_acc fmt
|
||||
|
||||
let sprintf fmt =
|
||||
ksprintf (fun s -> s) fmt
|
||||
|
||||
let asprintf (fmt, _) =
|
||||
let b = Buffer.create 512 in
|
||||
let k ppf = k (string_out b ppf) in
|
||||
let ppf = formatter_of_buffer b in
|
||||
let get_out _ = ppf in
|
||||
mkprintf true get_out k
|
||||
;;
|
||||
|
||||
let sprintf fmt = ksprintf (fun s -> s) fmt;;
|
||||
|
||||
let asprintf fmt =
|
||||
let b = Buffer.create 512 in
|
||||
let k ppf = string_out b ppf in
|
||||
let ppf = formatter_of_buffer b in
|
||||
let get_out _ = ppf in
|
||||
mkprintf false get_out k fmt;;
|
||||
let ppf = formatter_of_buffer b in
|
||||
let k' : (formatter -> (formatter, unit) acc -> string)
|
||||
= fun ppf acc ->
|
||||
output_acc ppf acc;
|
||||
pp_flush_queue ppf false;
|
||||
Buffer.contents b in
|
||||
make_printf k' ppf End_of_acc fmt
|
||||
|
||||
(**************************************************************
|
||||
|
||||
|
|
@ -1410,15 +1170,10 @@ let asprintf fmt =
|
|||
|
||||
**************************************************************)
|
||||
|
||||
let kbprintf k b =
|
||||
mkprintf false (fun _ -> formatter_of_buffer b) k
|
||||
;;
|
||||
|
||||
(* Deprecated error prone function bprintf. *)
|
||||
let bprintf b =
|
||||
let k ppf = pp_flush_queue ppf false in
|
||||
kbprintf k b
|
||||
;;
|
||||
let bprintf b ((fmt, _) : ('a, formatter, unit) format) =
|
||||
let k ppf acc = output_acc ppf acc; pp_flush_queue ppf false in
|
||||
make_printf k (formatter_of_buffer b) End_of_acc fmt
|
||||
|
||||
(* Deprecated alias for ksprintf. *)
|
||||
let kprintf = ksprintf;;
|
||||
|
|
|
|||
|
|
@ -976,34 +976,21 @@ fun ign fmt -> match ign with
|
|||
Param_format_EBB (Scan_char_set (width_opt, char_set, fmt))
|
||||
end
|
||||
|
||||
(*type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
|
||||
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6*)
|
||||
type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
|
||||
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
|
||||
|
||||
(* Aliases of format6 with restricted parameters. *)
|
||||
(* Usefull for Printf and Format functions. *)
|
||||
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
|
||||
|
||||
type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
|
||||
|
||||
let string_of_format (fmt, str) = str
|
||||
|
||||
external format_of_string :
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
|
||||
|
||||
external format_to_string :
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 -> string = "%identity"
|
||||
external string_to_format :
|
||||
string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
|
||||
|
||||
let (( ^^ ) :
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
|
||||
('f, 'b, 'c, 'e, 'g, 'h) format6 ->
|
||||
('a, 'b, 'c, 'd, 'g, 'h) format6) =
|
||||
fun fmt1 fmt2 ->
|
||||
string_to_format (format_to_string fmt1 ^ "%," ^ format_to_string fmt2)
|
||||
;;
|
||||
|
||||
(* Have to return a copy for compatibility with unsafe-string mode *)
|
||||
(* String.copy is not available here, so use ^ to make a copy of the string *)
|
||||
let string_of_format fmt = format_to_string fmt ^ ""
|
||||
let (^^) (fmt1, str1) (fmt2, str2) =
|
||||
(CamlinternalFormatBasics.concat_fmt fmt1 fmt2, str1 ^ str2)
|
||||
|
||||
(* Miscellaneous *)
|
||||
|
||||
|
|
|
|||
|
|
@ -1248,8 +1248,8 @@ end
|
|||
receiver function.
|
||||
*)
|
||||
|
||||
(*type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
|
||||
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6*)
|
||||
type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
|
||||
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
|
||||
|
||||
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
|
||||
|
||||
|
|
|
|||
750
stdlib/printf.ml
750
stdlib/printf.ml
|
|
@ -11,728 +11,28 @@
|
|||
(* *)
|
||||
(***********************************************************************)
|
||||
|
||||
external format_float: string -> float -> string
|
||||
= "caml_format_float"
|
||||
external format_int: string -> int -> string
|
||||
= "caml_format_int"
|
||||
external format_int32: string -> int32 -> string
|
||||
= "caml_int32_format"
|
||||
external format_nativeint: string -> nativeint -> string
|
||||
= "caml_nativeint_format"
|
||||
external format_int64: string -> int64 -> string
|
||||
= "caml_int64_format"
|
||||
|
||||
module Sformat = struct
|
||||
|
||||
type index;;
|
||||
|
||||
external unsafe_index_of_int : int -> index = "%identity"
|
||||
;;
|
||||
let index_of_int i =
|
||||
if i >= 0 then unsafe_index_of_int i
|
||||
else failwith ("Sformat.index_of_int: negative argument " ^ string_of_int i)
|
||||
;;
|
||||
external int_of_index : index -> int = "%identity"
|
||||
;;
|
||||
|
||||
let add_int_index i idx = index_of_int (i + int_of_index idx);;
|
||||
let succ_index = add_int_index 1;;
|
||||
(* Literal position are one-based (hence pred p instead of p). *)
|
||||
let index_of_literal_position p = index_of_int (pred p);;
|
||||
|
||||
external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
|
||||
= "%string_length"
|
||||
;;
|
||||
external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
|
||||
= "%string_safe_get"
|
||||
;;
|
||||
external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
|
||||
= "%string_unsafe_get"
|
||||
;;
|
||||
external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
|
||||
= "%identity"
|
||||
;;
|
||||
let sub fmt idx len =
|
||||
String.sub (unsafe_to_string fmt) (int_of_index idx) len
|
||||
;;
|
||||
let to_string fmt = sub fmt (unsafe_index_of_int 0) (length fmt)
|
||||
;;
|
||||
|
||||
end
|
||||
;;
|
||||
|
||||
let bad_conversion sfmt i c =
|
||||
invalid_arg
|
||||
("Printf: bad conversion %" ^ String.make 1 c ^ ", at char number " ^
|
||||
string_of_int i ^ " in format string \'" ^ sfmt ^ "\'")
|
||||
;;
|
||||
|
||||
let bad_conversion_format fmt i c =
|
||||
bad_conversion (Sformat.to_string fmt) i c
|
||||
;;
|
||||
|
||||
let incomplete_format fmt =
|
||||
invalid_arg
|
||||
("Printf: premature end of format string \'" ^
|
||||
Sformat.to_string fmt ^ "\'")
|
||||
;;
|
||||
|
||||
(* Parses a string conversion to return the specified length and the
|
||||
padding direction. *)
|
||||
let parse_string_conversion sfmt =
|
||||
let rec parse neg i =
|
||||
if i >= String.length sfmt then (0, neg) else
|
||||
match String.unsafe_get sfmt i with
|
||||
| '1'..'9' ->
|
||||
(int_of_string
|
||||
(String.sub sfmt i (String.length sfmt - i - 1)),
|
||||
neg)
|
||||
| '-' ->
|
||||
parse true (succ i)
|
||||
| _ ->
|
||||
parse neg (succ i) in
|
||||
try parse false 1 with
|
||||
| Failure _ -> bad_conversion sfmt 0 's'
|
||||
;;
|
||||
|
||||
(* Pad a (sub) string into a blank string of length [p],
|
||||
on the right if [neg] is true, on the left otherwise. *)
|
||||
let pad_string pad_char p neg s i len =
|
||||
if p = len && i = 0 then s else
|
||||
if p <= len then String.sub s i len else
|
||||
let res = Bytes.make p pad_char in
|
||||
if neg
|
||||
then String.blit s i res 0 len
|
||||
else String.blit s i res (p - len) len;
|
||||
Bytes.unsafe_to_string res
|
||||
;;
|
||||
|
||||
(* Format a string given a %s format, e.g. %40s or %-20s.
|
||||
To do ?: ignore other flags (#, +, etc). *)
|
||||
let format_string sfmt s =
|
||||
let (p, neg) = parse_string_conversion sfmt in
|
||||
pad_string ' ' p neg s 0 (String.length s)
|
||||
;;
|
||||
|
||||
(* Extract a format string out of [fmt] between [start] and [stop] inclusive.
|
||||
['*'] in the format are replaced by integers taken from the [widths] list.
|
||||
[extract_format] returns a string which is the string representation of
|
||||
the resulting format string. *)
|
||||
let extract_format fmt start stop widths =
|
||||
let skip_positional_spec start =
|
||||
match Sformat.unsafe_get fmt start with
|
||||
| '0'..'9' ->
|
||||
let rec skip_int_literal i =
|
||||
match Sformat.unsafe_get fmt i with
|
||||
| '0'..'9' -> skip_int_literal (succ i)
|
||||
| '$' -> succ i
|
||||
| _ -> start in
|
||||
skip_int_literal (succ start)
|
||||
| _ -> start in
|
||||
let start = skip_positional_spec (succ start) in
|
||||
let b = Buffer.create (stop - start + 10) in
|
||||
Buffer.add_char b '%';
|
||||
let rec fill_format i widths =
|
||||
if i <= stop then
|
||||
match (Sformat.unsafe_get fmt i, widths) with
|
||||
| ('*', h :: t) ->
|
||||
Buffer.add_string b (string_of_int h);
|
||||
let i = skip_positional_spec (succ i) in
|
||||
fill_format i t
|
||||
| ('*', []) ->
|
||||
assert false (* Should not happen since this is ill-typed. *)
|
||||
| (c, _) ->
|
||||
Buffer.add_char b c;
|
||||
fill_format (succ i) widths in
|
||||
fill_format start (List.rev widths);
|
||||
Buffer.contents b
|
||||
;;
|
||||
|
||||
let extract_format_int conv fmt start stop widths =
|
||||
let sfmt = extract_format fmt start stop widths in
|
||||
match conv with
|
||||
| 'n' | 'N' ->
|
||||
let len = String.length sfmt in
|
||||
String.sub sfmt 0 (len - 1) ^ "u"
|
||||
| _ -> sfmt
|
||||
;;
|
||||
|
||||
let extract_format_float conv fmt start stop widths =
|
||||
let sfmt = extract_format fmt start stop widths in
|
||||
match conv with
|
||||
| 'F' ->
|
||||
let len = String.length sfmt in
|
||||
String.sub sfmt 0 (len - 1) ^ "g"
|
||||
| _ -> sfmt
|
||||
;;
|
||||
|
||||
(* Returns the position of the next character following 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 delimiters %{ and %} (when [conv = '{']) or %( and
|
||||
%) (when [conv = '(']). Hence, [sub_format] returns the index of
|
||||
the character following the [')'] or ['}'] that ends the meta format,
|
||||
according to the character [conv]. *)
|
||||
let sub_format incomplete_format bad_conversion_format conv fmt i =
|
||||
let len = Sformat.length fmt in
|
||||
let rec sub_fmt c i =
|
||||
let close = if c = '(' then ')' else (* '{' *) '}' in
|
||||
let rec sub j =
|
||||
if j >= len then incomplete_format fmt else
|
||||
match Sformat.get fmt j with
|
||||
| '%' -> sub_sub (succ j)
|
||||
| _ -> sub (succ j)
|
||||
and sub_sub j =
|
||||
if j >= len then incomplete_format fmt else
|
||||
match Sformat.get fmt j with
|
||||
| '(' | '{' as c ->
|
||||
let j = sub_fmt c (succ j) in
|
||||
sub (succ j)
|
||||
| '}' | ')' as c ->
|
||||
if c = close then succ j else bad_conversion_format fmt i c
|
||||
| _ -> sub (succ j) in
|
||||
sub i in
|
||||
sub_fmt conv i
|
||||
;;
|
||||
|
||||
let sub_format_for_printf conv =
|
||||
sub_format incomplete_format bad_conversion_format conv
|
||||
;;
|
||||
|
||||
let iter_on_format_args fmt add_conv add_char =
|
||||
|
||||
let lim = Sformat.length fmt - 1 in
|
||||
|
||||
let rec scan_flags skip i =
|
||||
if i > lim then incomplete_format fmt else
|
||||
match Sformat.unsafe_get fmt i with
|
||||
| '*' -> scan_flags skip (add_conv skip i 'i')
|
||||
(* | '$' -> scan_flags skip (succ i) *** PR#4321 *)
|
||||
| '#' | '-' | ' ' | '+' -> scan_flags skip (succ i)
|
||||
| '_' -> scan_flags true (succ i)
|
||||
| '0'..'9'
|
||||
| '.' -> scan_flags skip (succ i)
|
||||
| _ -> scan_conv skip i
|
||||
and scan_conv skip i =
|
||||
if i > lim then incomplete_format fmt else
|
||||
match Sformat.unsafe_get fmt i with
|
||||
| '%' | '@' | '!' | ',' -> 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'
|
||||
| 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> add_conv skip i 'f'
|
||||
| 'B' | 'b' -> add_conv skip i 'B'
|
||||
| 'a' | 'r' | 't' as conv -> add_conv skip i conv
|
||||
| 'l' | 'n' | 'L' as conv ->
|
||||
let j = succ i in
|
||||
if j > lim then add_conv skip i 'i' else begin
|
||||
match Sformat.get fmt j with
|
||||
| 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
|
||||
add_char (add_conv skip i conv) 'i'
|
||||
| _ -> add_conv skip i 'i' end
|
||||
| '{' as conv ->
|
||||
(* Just get a regular argument, skipping the specification. *)
|
||||
let i = add_conv skip i conv in
|
||||
(* To go on, find the index of the next char after the meta format. *)
|
||||
let j = sub_format_for_printf conv fmt i in
|
||||
(* Add the meta specification to the summary anyway. *)
|
||||
let rec loop i =
|
||||
if i < j - 2 then loop (add_char i (Sformat.get fmt i)) in
|
||||
loop i;
|
||||
(* Go on, starting at the closing brace to properly close the meta
|
||||
specification in the summary. *)
|
||||
scan_conv skip (j - 1)
|
||||
| '(' as conv ->
|
||||
(* Use the static format argument specification instead of
|
||||
the runtime format argument value: they must have the same type
|
||||
anyway. *)
|
||||
scan_fmt (add_conv skip i conv)
|
||||
| '}' | ')' as conv -> add_conv skip i conv
|
||||
| conv -> bad_conversion_format fmt i conv
|
||||
|
||||
and scan_fmt i =
|
||||
if i < lim then
|
||||
if Sformat.get fmt i = '%'
|
||||
then scan_fmt (scan_flags false (succ i))
|
||||
else scan_fmt (succ i)
|
||||
else i in
|
||||
|
||||
ignore (scan_fmt 0)
|
||||
;;
|
||||
|
||||
(* Returns a string that summarizes the typing information that a given
|
||||
format string contains.
|
||||
For instance, [summarize_format_type "A number %d\n"] is "%i".
|
||||
It also checks the well-formedness of the format string. *)
|
||||
let summarize_format_type fmt =
|
||||
let len = Sformat.length fmt in
|
||||
let b = Buffer.create len in
|
||||
let add_char i c = Buffer.add_char b c; succ i in
|
||||
let add_conv skip i c =
|
||||
if skip then Buffer.add_string b "%_" else Buffer.add_char b '%';
|
||||
add_char i c in
|
||||
iter_on_format_args fmt add_conv add_char;
|
||||
Buffer.contents b
|
||||
;;
|
||||
|
||||
module Ac = struct
|
||||
type ac = {
|
||||
mutable ac_rglr : int;
|
||||
mutable ac_skip : int;
|
||||
mutable ac_rdrs : int;
|
||||
}
|
||||
end
|
||||
;;
|
||||
|
||||
open Ac;;
|
||||
|
||||
(* Computes the number of arguments of a format (including the flag
|
||||
arguments if any). *)
|
||||
let ac_of_format fmt =
|
||||
let ac = { ac_rglr = 0; ac_skip = 0; ac_rdrs = 0; } in
|
||||
let incr_ac skip c =
|
||||
let inc = if c = 'a' then 2 else 1 in
|
||||
if c = 'r' then ac.ac_rdrs <- ac.ac_rdrs + 1;
|
||||
if skip
|
||||
then ac.ac_skip <- ac.ac_skip + inc
|
||||
else ac.ac_rglr <- ac.ac_rglr + inc in
|
||||
let add_conv skip i c =
|
||||
(* Just finishing a meta format: no additional argument to record. *)
|
||||
if c <> ')' && c <> '}' then incr_ac skip c;
|
||||
succ i
|
||||
and add_char i _ = succ i in
|
||||
|
||||
iter_on_format_args fmt add_conv add_char;
|
||||
ac
|
||||
;;
|
||||
|
||||
let count_printing_arguments_of_format fmt =
|
||||
let ac = ac_of_format fmt in
|
||||
(* For printing, only the regular arguments have to be counted. *)
|
||||
ac.ac_rglr
|
||||
;;
|
||||
|
||||
let list_iter_i f l =
|
||||
let rec loop i = function
|
||||
| [] -> ()
|
||||
| [x] -> f i x (* Tail calling [f] *)
|
||||
| x :: xs -> f i x; loop (succ i) xs in
|
||||
loop 0 l
|
||||
;;
|
||||
|
||||
(* 'Abstracting' version of kprintf: returns a (curried) function that
|
||||
will print when totally applied.
|
||||
Note: in the following, we are careful not to be badly caught
|
||||
by the compiler optimizations for the representation of arrays. *)
|
||||
let kapr kpr fmt =
|
||||
match count_printing_arguments_of_format fmt with
|
||||
| 0 -> kpr fmt [||]
|
||||
| 1 -> Obj.magic (fun x ->
|
||||
let a = Array.make 1 (Obj.repr 0) in
|
||||
a.(0) <- x;
|
||||
kpr fmt a)
|
||||
| 2 -> Obj.magic (fun x y ->
|
||||
let a = Array.make 2 (Obj.repr 0) in
|
||||
a.(0) <- x; a.(1) <- y;
|
||||
kpr fmt a)
|
||||
| 3 -> Obj.magic (fun x y z ->
|
||||
let a = Array.make 3 (Obj.repr 0) in
|
||||
a.(0) <- x; a.(1) <- y; a.(2) <- z;
|
||||
kpr fmt a)
|
||||
| 4 -> Obj.magic (fun x y z t ->
|
||||
let a = Array.make 4 (Obj.repr 0) in
|
||||
a.(0) <- x; a.(1) <- y; a.(2) <- z;
|
||||
a.(3) <- t;
|
||||
kpr fmt a)
|
||||
| 5 -> Obj.magic (fun x y z t u ->
|
||||
let a = Array.make 5 (Obj.repr 0) in
|
||||
a.(0) <- x; a.(1) <- y; a.(2) <- z;
|
||||
a.(3) <- t; a.(4) <- u;
|
||||
kpr fmt a)
|
||||
| 6 -> Obj.magic (fun x y z t u v ->
|
||||
let a = Array.make 6 (Obj.repr 0) in
|
||||
a.(0) <- x; a.(1) <- y; a.(2) <- z;
|
||||
a.(3) <- t; a.(4) <- u; a.(5) <- v;
|
||||
kpr fmt a)
|
||||
| nargs ->
|
||||
let rec loop i args =
|
||||
if i >= nargs then
|
||||
let a = Array.make nargs (Obj.repr 0) in
|
||||
list_iter_i (fun i arg -> a.(nargs - i - 1) <- arg) args;
|
||||
kpr fmt a
|
||||
else Obj.magic (fun x -> loop (succ i) (x :: args)) in
|
||||
loop 0 []
|
||||
;;
|
||||
|
||||
type positional_specification =
|
||||
| Spec_none | Spec_index of Sformat.index
|
||||
;;
|
||||
|
||||
(* To scan an optional positional parameter specification,
|
||||
i.e. an integer followed by a [$].
|
||||
|
||||
Calling [got_spec] with appropriate arguments, we 'return' a positional
|
||||
specification and an index to go on scanning the [fmt] format at hand.
|
||||
|
||||
Note that this is optimized for the regular case, i.e. no positional
|
||||
parameter, since in this case we juste 'return' the constant
|
||||
[Spec_none]; in case we have a positional parameter, we 'return' a
|
||||
[Spec_index] [positional_specification] which is a bit more costly.
|
||||
|
||||
Note also that we do not support [*$] specifications, since this would
|
||||
lead to type checking problems: a [*$] positional specification means
|
||||
'take the next argument to [printf] (which must be an integer value)',
|
||||
name this integer value $n$; [*$] now designates parameter $n$.
|
||||
|
||||
Unfortunately, the type of a parameter specified via a [*$] positional
|
||||
specification should be the type of the corresponding argument to
|
||||
[printf], hence this should be the type of the $n$-th argument to [printf]
|
||||
with $n$ being the {\em value} of the integer argument defining [*]; we
|
||||
clearly cannot statically guess the value of this parameter in the general
|
||||
case. Put it another way: this means type dependency, which is completely
|
||||
out of scope of the OCaml type algebra. *)
|
||||
|
||||
let scan_positional_spec fmt got_spec i =
|
||||
match Sformat.unsafe_get fmt i with
|
||||
| '0'..'9' as d ->
|
||||
let rec get_int_literal accu j =
|
||||
match Sformat.unsafe_get fmt j with
|
||||
| '0'..'9' as d ->
|
||||
get_int_literal (10 * accu + (int_of_char d - 48)) (succ j)
|
||||
| '$' ->
|
||||
if accu = 0 then
|
||||
failwith "printf: bad positional specification (0)." else
|
||||
got_spec (Spec_index (Sformat.index_of_literal_position accu)) (succ j)
|
||||
(* Not a positional specification: tell so the caller, and go back to
|
||||
scanning the format from the original [i] position we were called at
|
||||
first. *)
|
||||
| _ -> got_spec Spec_none i in
|
||||
get_int_literal (int_of_char d - 48) (succ i)
|
||||
(* No positional specification: tell so the caller, and go back to scanning
|
||||
the format from the original [i] position. *)
|
||||
| _ -> got_spec Spec_none i
|
||||
;;
|
||||
|
||||
(* Get the index of the next argument to printf, according to the given
|
||||
positional specification. *)
|
||||
let next_index spec n =
|
||||
match spec with
|
||||
| Spec_none -> Sformat.succ_index n
|
||||
| Spec_index _ -> n
|
||||
;;
|
||||
|
||||
(* Get the index of the actual argument to printf, according to its
|
||||
optional positional specification. *)
|
||||
let get_index spec n =
|
||||
match spec with
|
||||
| Spec_none -> n
|
||||
| Spec_index p -> p
|
||||
;;
|
||||
|
||||
(* Format a float argument as a valid OCaml lexeme. *)
|
||||
let format_float_lexeme =
|
||||
|
||||
(* To be revised: this procedure should be a unique loop that performs the
|
||||
validity check and the string lexeme modification at the same time.
|
||||
Otherwise, it is too difficult to handle the strange padding facilities
|
||||
given by printf. Let alone handling the correct widths indication,
|
||||
knowing that we have sometime to add a '.' at the end of the result!
|
||||
*)
|
||||
|
||||
let make_valid_float_lexeme s =
|
||||
(* Check if s is already a valid lexeme:
|
||||
in this case do nothing,
|
||||
otherwise turn s into a valid OCaml lexeme. *)
|
||||
let l = String.length s in
|
||||
let rec valid_float_loop i =
|
||||
if i >= l then s ^ "." else
|
||||
match s.[i] with
|
||||
(* Sure, this is already a valid float lexeme. *)
|
||||
| '.' | 'e' | 'E' -> s
|
||||
| _ -> valid_float_loop (i + 1) in
|
||||
|
||||
valid_float_loop 0 in
|
||||
|
||||
(fun sfmt x ->
|
||||
match classify_float x with
|
||||
| FP_normal | FP_subnormal | FP_zero ->
|
||||
make_valid_float_lexeme (format_float sfmt x)
|
||||
| FP_infinite ->
|
||||
if x < 0.0 then "neg_infinity" else "infinity"
|
||||
| FP_nan ->
|
||||
"nan")
|
||||
;;
|
||||
|
||||
(* Decode a format string and act on it.
|
||||
[fmt] is the [printf] format string, and [pos] points to a [%] character in
|
||||
the format string.
|
||||
After consuming the appropriate number of arguments and formatting
|
||||
them, one of the following five continuations described below is called:
|
||||
|
||||
- [cont_s] for outputting a string
|
||||
(arguments: arg num, string, next pos)
|
||||
- [cont_a] for performing a %a action
|
||||
(arguments: arg num, fn, arg, next pos)
|
||||
- [cont_t] for performing a %t action
|
||||
(arguments: arg num, fn, next pos)
|
||||
- [cont_f] for performing a flush action
|
||||
(arguments: arg num, next pos)
|
||||
- [cont_m] for performing a %( action
|
||||
(arguments: arg num, sfmt, next pos)
|
||||
|
||||
"arg num" is the index in array [args] of the next argument to [printf].
|
||||
"next pos" is the position in [fmt] of the first character following
|
||||
the %conversion specification in [fmt]. *)
|
||||
|
||||
(* Note: here, rather than test explicitly against [Sformat.length fmt]
|
||||
to detect the end of the format, we use [Sformat.unsafe_get] and
|
||||
rely on the fact that we'll get a "null" character if we access
|
||||
one past the end of the string. These "null" characters are then
|
||||
caught by the [_ -> bad_conversion] clauses below.
|
||||
Don't do this at home, kids. *)
|
||||
let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
|
||||
|
||||
let get_arg spec n =
|
||||
Obj.magic (args.(Sformat.int_of_index (get_index spec n))) in
|
||||
|
||||
let rec scan_positional n widths i =
|
||||
let got_spec spec i = scan_flags spec n widths i in
|
||||
scan_positional_spec fmt got_spec i
|
||||
|
||||
and scan_flags spec n widths i =
|
||||
match Sformat.unsafe_get fmt i with
|
||||
| '*' ->
|
||||
let got_spec wspec i =
|
||||
let (width : int) = get_arg wspec n in
|
||||
scan_flags spec (next_index wspec n) (width :: widths) i in
|
||||
scan_positional_spec fmt got_spec (succ i)
|
||||
| '0'..'9'
|
||||
| '.' | '#' | '-' | ' ' | '+' -> scan_flags spec n widths (succ i)
|
||||
| _ -> scan_conv spec n widths i
|
||||
|
||||
and scan_conv spec n widths i =
|
||||
match Sformat.unsafe_get fmt i with
|
||||
| '%' | '@' 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
|
||||
let s =
|
||||
(* Optimize for common case %s *)
|
||||
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 =
|
||||
if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in
|
||||
cont_s (next_index spec n) s (succ i)
|
||||
| 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv ->
|
||||
let (x : int) = get_arg spec n in
|
||||
let s =
|
||||
format_int (extract_format_int conv fmt pos i widths) x in
|
||||
cont_s (next_index spec n) s (succ i)
|
||||
| 'f' | 'e' | 'E' | 'g' | 'G' ->
|
||||
let (x : float) = get_arg spec n in
|
||||
let s = format_float (extract_format fmt pos i widths) x in
|
||||
cont_s (next_index spec n) s (succ i)
|
||||
| 'F' as conv ->
|
||||
let (x : float) = get_arg spec n in
|
||||
let s =
|
||||
format_float_lexeme
|
||||
(if widths = []
|
||||
then "%.12g"
|
||||
else extract_format_float conv fmt pos i widths)
|
||||
x in
|
||||
cont_s (next_index spec n) s (succ i)
|
||||
| 'B' | 'b' ->
|
||||
let (x : bool) = get_arg spec n in
|
||||
cont_s (next_index spec n) (string_of_bool x) (succ i)
|
||||
| 'a' ->
|
||||
let printer = get_arg spec n in
|
||||
(* If the printer spec is Spec_none, go on as usual.
|
||||
If the printer spec is Spec_index p,
|
||||
printer's argument spec is Spec_index (succ_index p). *)
|
||||
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)
|
||||
| 'l' | 'n' | 'L' as conv ->
|
||||
begin match Sformat.unsafe_get fmt (succ i) with
|
||||
| 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
|
||||
let i = succ i in
|
||||
let s =
|
||||
match conv with
|
||||
| 'l' ->
|
||||
let (x : int32) = get_arg spec n in
|
||||
format_int32 (extract_format fmt pos i widths) x
|
||||
| 'n' ->
|
||||
let (x : nativeint) = get_arg spec n in
|
||||
format_nativeint (extract_format fmt pos i widths) x
|
||||
| _ ->
|
||||
let (x : int64) = get_arg spec n in
|
||||
format_int64 (extract_format fmt pos i widths) x in
|
||||
cont_s (next_index spec n) s (succ i)
|
||||
| _ ->
|
||||
let (x : int) = get_arg spec n in
|
||||
let s = format_int (extract_format_int 'n' fmt pos i widths) x in
|
||||
cont_s (next_index spec n) s (succ i)
|
||||
end
|
||||
| '{' | '(' as conv (* ')' '}' *) ->
|
||||
let (xf : ('a, 'b, 'c, 'd, 'e, 'f) format6) = get_arg spec n in
|
||||
let i = succ i in
|
||||
let i = sub_format_for_printf conv fmt i in
|
||||
if conv = '{' (* '}' *) then
|
||||
(* Just print the format argument as a specification. *)
|
||||
cont_s
|
||||
(next_index spec n)
|
||||
(summarize_format_type xf)
|
||||
i else
|
||||
(* Use the format argument instead of the format specification. *)
|
||||
cont_m (next_index spec n) xf i
|
||||
| (* '(' *) ')' ->
|
||||
cont_s n "" (succ i)
|
||||
| conv ->
|
||||
bad_conversion_format fmt i conv in
|
||||
|
||||
scan_positional n [] (succ pos)
|
||||
;;
|
||||
|
||||
let mkprintf to_s get_out outc outs flush k fmt =
|
||||
|
||||
(* [out] is global to this definition of [pr], and must be shared by all its
|
||||
recursive calls (if any). *)
|
||||
let out = get_out fmt in
|
||||
let outc c = outc out c in
|
||||
let outs s = outs out s in
|
||||
|
||||
let rec pr k n fmt v =
|
||||
|
||||
let len = Sformat.length fmt in
|
||||
|
||||
let rec doprn n i =
|
||||
if i >= len then Obj.magic (k out) else
|
||||
match Sformat.unsafe_get fmt i with
|
||||
| '%' -> scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
|
||||
| c -> outc c; doprn n (succ i)
|
||||
|
||||
and cont_s n s i =
|
||||
outs s; doprn n i
|
||||
and cont_a n printer arg i =
|
||||
if to_s then
|
||||
outs ((Obj.magic printer : unit -> _ -> string) () arg)
|
||||
else
|
||||
printer out arg;
|
||||
doprn n i
|
||||
and cont_t n printer i =
|
||||
if to_s then
|
||||
outs ((Obj.magic printer : unit -> string) ())
|
||||
else
|
||||
printer out;
|
||||
doprn n i
|
||||
and cont_f n i =
|
||||
flush out; doprn n i
|
||||
and cont_m n xf i =
|
||||
let m =
|
||||
Sformat.add_int_index
|
||||
(count_printing_arguments_of_format xf) n in
|
||||
pr (Obj.magic (fun _ -> doprn m i)) n xf v in
|
||||
|
||||
doprn n 0 in
|
||||
|
||||
let kpr = pr k (Sformat.index_of_int 0) in
|
||||
|
||||
kapr kpr fmt
|
||||
;;
|
||||
|
||||
(**************************************************************
|
||||
|
||||
Defining [fprintf] and various flavors of [fprintf].
|
||||
|
||||
**************************************************************)
|
||||
|
||||
let kfprintf k oc =
|
||||
mkprintf false (fun _ -> oc) output_char output_string flush k
|
||||
;;
|
||||
let ikfprintf k oc = kapr (fun _ _ -> Obj.magic (k oc));;
|
||||
|
||||
let fprintf oc = kfprintf ignore oc;;
|
||||
let ifprintf oc = ikfprintf ignore oc;;
|
||||
let printf fmt = fprintf stdout fmt;;
|
||||
let eprintf fmt = fprintf stderr fmt;;
|
||||
|
||||
let kbprintf k b =
|
||||
mkprintf false (fun _ -> b) Buffer.add_char Buffer.add_string ignore k
|
||||
;;
|
||||
let bprintf b = kbprintf ignore b;;
|
||||
|
||||
let get_buff fmt =
|
||||
let len = 2 * Sformat.length fmt in
|
||||
Buffer.create len
|
||||
;;
|
||||
|
||||
let get_contents b =
|
||||
let s = Buffer.contents b in
|
||||
Buffer.clear b;
|
||||
s
|
||||
;;
|
||||
|
||||
let get_cont k b = k (get_contents b);;
|
||||
|
||||
let ksprintf k =
|
||||
mkprintf true get_buff Buffer.add_char Buffer.add_string ignore (get_cont k)
|
||||
;;
|
||||
|
||||
let sprintf fmt = ksprintf (fun s -> s) fmt;;
|
||||
|
||||
(**************************************************************
|
||||
|
||||
Deprecated stuff.
|
||||
|
||||
**************************************************************)
|
||||
|
||||
let kprintf = ksprintf;;
|
||||
|
||||
(* For OCaml system internal use only: needed to implement modules [Format]
|
||||
and [Scanf]. *)
|
||||
|
||||
module CamlinternalPr = struct
|
||||
|
||||
module Sformat = Sformat;;
|
||||
|
||||
module Tformat = struct
|
||||
|
||||
type ac =
|
||||
Ac.ac = {
|
||||
mutable ac_rglr : int;
|
||||
mutable ac_skip : int;
|
||||
mutable ac_rdrs : int;
|
||||
}
|
||||
;;
|
||||
|
||||
let ac_of_format = ac_of_format;;
|
||||
|
||||
let count_printing_arguments_of_format =
|
||||
count_printing_arguments_of_format;;
|
||||
|
||||
let sub_format = sub_format;;
|
||||
|
||||
let summarize_format_type = summarize_format_type;;
|
||||
|
||||
let scan_format = scan_format;;
|
||||
|
||||
let kapr = kapr;;
|
||||
|
||||
end
|
||||
;;
|
||||
|
||||
end
|
||||
;;
|
||||
open CamlinternalFormat
|
||||
|
||||
let kfprintf k o (fmt, _) =
|
||||
make_printf (fun o acc -> output_acc o acc; k o) o End_of_acc fmt
|
||||
let kbprintf k b (fmt, _) =
|
||||
make_printf (fun b acc -> bufput_acc b acc; k b) b End_of_acc fmt
|
||||
let ikfprintf k oc (fmt, _) =
|
||||
make_printf (fun oc _ -> k oc) oc End_of_acc fmt
|
||||
|
||||
let fprintf oc fmt = kfprintf ignore oc fmt
|
||||
let bprintf b fmt = kbprintf ignore b fmt
|
||||
let ifprintf oc fmt = ikfprintf ignore oc fmt
|
||||
let printf fmt = fprintf stdout fmt
|
||||
let eprintf fmt = fprintf stderr fmt
|
||||
|
||||
let ksprintf k (fmt, _) =
|
||||
let k' () acc =
|
||||
let buf = Buffer.create 64 in
|
||||
strput_acc buf acc;
|
||||
k (Buffer.contents buf) in
|
||||
make_printf k' () End_of_acc fmt
|
||||
|
||||
let sprintf fmt = ksprintf (fun s -> s) fmt
|
||||
|
||||
let kprintf = ksprintf
|
||||
|
|
|
|||
|
|
@ -163,76 +163,5 @@ val kbprintf : (Buffer.t -> 'a) -> Buffer.t ->
|
|||
|
||||
(** Deprecated *)
|
||||
|
||||
val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
|
||||
val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
|
||||
(** A deprecated synonym for [ksprintf]. *)
|
||||
|
||||
(**/**)
|
||||
|
||||
(* The following is for system use only. Do not call directly. *)
|
||||
|
||||
module CamlinternalPr : sig
|
||||
|
||||
module Sformat : sig
|
||||
type index;;
|
||||
|
||||
val index_of_int : int -> index;;
|
||||
external int_of_index : index -> int = "%identity";;
|
||||
external unsafe_index_of_int : int -> index = "%identity";;
|
||||
|
||||
val succ_index : index -> index;;
|
||||
val add_int_index : int -> index -> index;;
|
||||
|
||||
val sub : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> index -> int -> string;;
|
||||
val to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string;;
|
||||
external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
|
||||
= "%string_length";;
|
||||
external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
|
||||
= "%string_safe_get";;
|
||||
external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
|
||||
= "%identity";;
|
||||
external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
|
||||
= "%string_unsafe_get";;
|
||||
|
||||
end;;
|
||||
|
||||
module Tformat : sig
|
||||
|
||||
type ac = {
|
||||
mutable ac_rglr : int;
|
||||
mutable ac_skip : int;
|
||||
mutable ac_rdrs : int;
|
||||
};;
|
||||
|
||||
val ac_of_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ac;;
|
||||
val count_printing_arguments_of_format :
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 -> int;;
|
||||
|
||||
val sub_format :
|
||||
(('a, 'b, 'c, 'd, 'e, 'f) format6 -> int) ->
|
||||
(('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char -> int) ->
|
||||
char ->
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
|
||||
int ->
|
||||
int
|
||||
|
||||
val summarize_format_type : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
|
||||
|
||||
val scan_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
|
||||
'g array ->
|
||||
Sformat.index ->
|
||||
int ->
|
||||
(Sformat.index -> string -> int -> 'h) ->
|
||||
(Sformat.index -> 'i -> 'j -> int -> 'h) ->
|
||||
(Sformat.index -> 'k -> int -> 'h) ->
|
||||
(Sformat.index -> int -> 'h) ->
|
||||
(Sformat.index -> ('l, 'm, 'n, 'o, 'p, 'q) format6 -> int -> 'h) ->
|
||||
'h
|
||||
|
||||
val kapr :
|
||||
(('a, 'b, 'c, 'd, 'e, 'f) format6 -> Obj.t array -> 'g) ->
|
||||
('a, 'b, 'c, 'd, 'e, 'f) format6 ->
|
||||
'g
|
||||
|
||||
end;;
|
||||
|
||||
end;;
|
||||
|
|
|
|||
1020
stdlib/scanf.ml
1020
stdlib/scanf.ml
File diff suppressed because it is too large
Load Diff
|
|
@ -485,6 +485,16 @@ val kscanf :
|
|||
exception that aborted the scanning process as arguments.
|
||||
*)
|
||||
|
||||
val ksscanf :
|
||||
string -> (Scanning.in_channel -> exn -> 'd) ->
|
||||
('a, 'b, 'c, 'd) scanner
|
||||
(** Same as {!Scanf.kscanf} but reads from the given string. *)
|
||||
|
||||
val kfscanf :
|
||||
Pervasives.in_channel -> (Scanning.in_channel -> exn -> 'd) ->
|
||||
('a, 'b, 'c, 'd) scanner
|
||||
(** Same as {!Scanf.kscanf}, but reads from the given regular input channel. *)
|
||||
|
||||
(** {6 Reading format strings from input} *)
|
||||
|
||||
val bscanf_format :
|
||||
|
|
|
|||
|
|
@ -20,7 +20,8 @@ let test0 () =
|
|||
sprintf "%.0f" 1.0 = "1" &&
|
||||
sprintf "%.0f." 1.7 = "2." &&
|
||||
sprintf "%.1f." 1.0 = "1.0." &&
|
||||
sprintf "%0.1f." 12.0 = "12.0." &&
|
||||
(*sprintf "%0.1f." 12.0 = "12.0." &&*)
|
||||
(* >> '0' w/o padding *)
|
||||
sprintf "%3.1f." 12.0 = "12.0." &&
|
||||
sprintf "%5.1f." 12.0 = " 12.0." &&
|
||||
sprintf "%10.1f." 12.0 = " 12.0." &&
|
||||
|
|
@ -33,7 +34,8 @@ let test0 () =
|
|||
sprintf "%010.0f." 12.0 = "0000000012." &&
|
||||
sprintf "% 10.0f." 12.0 = " 12." &&
|
||||
|
||||
sprintf "%0.1f." 12.0 = "12.0." &&
|
||||
(*sprintf "%0.1f." 12.0 = "12.0." &&*)
|
||||
(* >> '0' w/o padding *)
|
||||
sprintf "%10.1f." 1.001 = " 1.0." &&
|
||||
sprintf "%05.1f." 1.001 = "001.0."
|
||||
;;
|
||||
|
|
@ -59,8 +61,10 @@ test (test2 ());;
|
|||
|
||||
(* Testing meta format string printing. *)
|
||||
let test3 () =
|
||||
sprintf "%{toto %s titi.\n%}" "Bonjour %s." = "%s" &&
|
||||
sprintf "%{%d%s%}" "kk%dkk%s\n" = "%i%s";;
|
||||
(* >> Now works as expected. *)
|
||||
(*sprintf "%{toto %s titi.\n%}" "Bonjour %s." = "%s" &&*)
|
||||
sprintf "%{toto %s titi.\n%}" "Bonjour %s." = "Bonjour %s." &&
|
||||
sprintf "%{%d%s%}" "kk%dkk%s\n" = "kk%dkk%s\n";;
|
||||
test (test3 ());;
|
||||
|
||||
(* Testing meta format string arguments. *)
|
||||
|
|
|
|||
|
|
@ -27,10 +27,12 @@ try
|
|||
test (sprintf "%04d/%05i" 42 43 = "0042/00043");
|
||||
test (sprintf "%+d/%+i" 42 43 = "+42/+43");
|
||||
test (sprintf "% d/% i" 42 43 = " 42/ 43");
|
||||
test (sprintf "%#d/%#i" 42 43 = "42/43");
|
||||
(*test (sprintf "%#d/%#i" 42 43 = "42/43");*)
|
||||
(* >> '#' is incompatible with 'd' *)
|
||||
test (sprintf "%4d/%5i" 42 43 = " 42/ 43");
|
||||
test (sprintf "%*d/%*i" 4 42 5 43 = " 42/ 43");
|
||||
test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43 ");
|
||||
(*test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43 ");*)
|
||||
(* >> '#' is incompatible with 'd' *)
|
||||
|
||||
printf "\nd/i negative\n%!";
|
||||
test (sprintf "%d/%i" (-42) (-43) = "-42/-43");
|
||||
|
|
@ -38,21 +40,27 @@ try
|
|||
test (sprintf "%04d/%05i" (-42) (-43) = "-042/-0043");
|
||||
test (sprintf "%+d/%+i" (-42) (-43) = "-42/-43");
|
||||
test (sprintf "% d/% i" (-42) (-43) = "-42/-43");
|
||||
test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");
|
||||
(*test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");*)
|
||||
(* >> '#' is incompatilbe with 'd' *)
|
||||
test (sprintf "%4d/%5i" (-42) (-43) = " -42/ -43");
|
||||
test (sprintf "%*d/%*i" 4 (-42) 5 (-43) = " -42/ -43");
|
||||
test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43 ");
|
||||
(*test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43 ");*)
|
||||
(* >> '0' is incompatible with '-', '#' is incompatible with 'd' *)
|
||||
|
||||
printf "\nu positive\n%!";
|
||||
test (sprintf "%u" 42 = "42");
|
||||
test (sprintf "%-4u" 42 = "42 ");
|
||||
test (sprintf "%04u" 42 = "0042");
|
||||
test (sprintf "%+u" 42 = "42");
|
||||
test (sprintf "% u" 42 = "42");
|
||||
test (sprintf "%#u" 42 = "42");
|
||||
(*test (sprintf "%+u" 42 = "42");*)
|
||||
(* >> '+' is incompatible with 'u' *)
|
||||
(*test (sprintf "% u" 42 = "42");*)
|
||||
(* >> ' ' is incompatible with 'u' *)
|
||||
(*test (sprintf "%#u" 42 = "42");*)
|
||||
(* >> '#' is incompatible with 'u' *)
|
||||
test (sprintf "%4u" 42 = " 42");
|
||||
test (sprintf "%*u" 4 42 = " 42");
|
||||
test (sprintf "%-0+ #6d" 42 = "+42 ");
|
||||
(*test (sprintf "%-0+ #6d" 42 = "+42 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatilbe with 'd' *)
|
||||
|
||||
printf "\nu negative\n%!";
|
||||
begin match Sys.word_size with
|
||||
|
|
@ -67,12 +75,15 @@ try
|
|||
test (sprintf "%x" 42 = "2a");
|
||||
test (sprintf "%-4x" 42 = "2a ");
|
||||
test (sprintf "%04x" 42 = "002a");
|
||||
test (sprintf "%+x" 42 = "2a");
|
||||
test (sprintf "% x" 42 = "2a");
|
||||
(*test (sprintf "%+x" 42 = "2a");*)
|
||||
(* >> '+' is incompatible with 'x' *)
|
||||
(*test (sprintf "% x" 42 = "2a");*)
|
||||
(* >> ' ' is incompatible with 'x' *)
|
||||
test (sprintf "%#x" 42 = "0x2a");
|
||||
test (sprintf "%4x" 42 = " 2a");
|
||||
test (sprintf "%*x" 5 42 = " 2a");
|
||||
test (sprintf "%-0+ #*x" 5 42 = "0x2a ");
|
||||
(*test (sprintf "%-0+ #*x" 5 42 = "0x2a ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nx negative\n%!";
|
||||
begin match Sys.word_size with
|
||||
|
|
@ -87,12 +98,15 @@ try
|
|||
test (sprintf "%X" 42 = "2A");
|
||||
test (sprintf "%-4X" 42 = "2A ");
|
||||
test (sprintf "%04X" 42 = "002A");
|
||||
test (sprintf "%+X" 42 = "2A");
|
||||
test (sprintf "% X" 42 = "2A");
|
||||
(*test (sprintf "%+X" 42 = "2A");*)
|
||||
(* >> '+' is incompatible with 'X' *)
|
||||
(*test (sprintf "% X" 42 = "2A");*)
|
||||
(* >> ' ' is incompatible with 'X' *)
|
||||
test (sprintf "%#X" 42 = "0X2A");
|
||||
test (sprintf "%4X" 42 = " 2A");
|
||||
test (sprintf "%*X" 5 42 = " 2A");
|
||||
test (sprintf "%-0+ #*X" 5 42 = "0X2A ");
|
||||
(*test (sprintf "%-0+ #*X" 5 42 = "0X2A ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nx negative\n%!";
|
||||
begin match Sys.word_size with
|
||||
|
|
@ -107,12 +121,15 @@ try
|
|||
test (sprintf "%o" 42 = "52");
|
||||
test (sprintf "%-4o" 42 = "52 ");
|
||||
test (sprintf "%04o" 42 = "0052");
|
||||
test (sprintf "%+o" 42 = "52");
|
||||
test (sprintf "% o" 42 = "52");
|
||||
(*test (sprintf "%+o" 42 = "52");*)
|
||||
(* >> '+' is incompatible with 'o' *)
|
||||
(*test (sprintf "% o" 42 = "52");*)
|
||||
(* >> '+' is incompatible with 'o' *)
|
||||
test (sprintf "%#o" 42 = "052");
|
||||
test (sprintf "%4o" 42 = " 52");
|
||||
test (sprintf "%*o" 5 42 = " 52");
|
||||
test (sprintf "%-0+ #*o" 5 42 = "052 ");
|
||||
(*test (sprintf "%-0+ #*o" 5 42 = "052 ");*)
|
||||
(* >> '-' is incompatible with 'o' *)
|
||||
|
||||
printf "\no negative\n%!";
|
||||
begin match Sys.word_size with
|
||||
|
|
@ -126,15 +143,20 @@ try
|
|||
printf "\ns\n%!";
|
||||
test (sprintf "%s" "foo" = "foo");
|
||||
test (sprintf "%-5s" "foo" = "foo ");
|
||||
test (sprintf "%05s" "foo" = " foo");
|
||||
test (sprintf "%+s" "foo" = "foo");
|
||||
test (sprintf "% s" "foo" = "foo");
|
||||
test (sprintf "%#s" "foo" = "foo");
|
||||
(*test (sprintf "%05s" "foo" = " foo");*)
|
||||
(* >> '0' is incompatible with 's' *)
|
||||
(*test (sprintf "%+s" "foo" = "foo");*)
|
||||
(* >> '+' is incompatible with 's' *)
|
||||
(*test (sprintf "% s" "foo" = "foo");*)
|
||||
(* >> ' ' is incompatible with 's' *)
|
||||
(*test (sprintf "%#s" "foo" = "foo");*)
|
||||
(* >> '#' is incompatible with 's' *)
|
||||
test (sprintf "%5s" "foo" = " foo");
|
||||
test (sprintf "%1s" "foo" = "foo");
|
||||
test (sprintf "%*s" 6 "foo" = " foo");
|
||||
test (sprintf "%*s" 2 "foo" = "foo");
|
||||
test (sprintf "%-0+ #5s" "foo" = "foo ");
|
||||
(*test (sprintf "%-0+ #5s" "foo" = "foo ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 's' *)
|
||||
test (sprintf "%s@" "foo" = "foo@");
|
||||
test (sprintf "%s@inria.fr" "foo" = "foo@inria.fr");
|
||||
test (sprintf "%s@%s" "foo" "inria.fr" = "foo@inria.fr");
|
||||
|
|
@ -143,9 +165,12 @@ try
|
|||
test (sprintf "%S" "fo\"o" = "\"fo\\\"o\"");
|
||||
(* test (sprintf "%-5S" "foo" = "\"foo\" "); padding not done *)
|
||||
(* test (sprintf "%05S" "foo" = " \"foo\""); padding not done *)
|
||||
test (sprintf "%+S" "foo" = "\"foo\"");
|
||||
test (sprintf "% S" "foo" = "\"foo\"");
|
||||
test (sprintf "%#S" "foo" = "\"foo\"");
|
||||
(*test (sprintf "%+S" "foo" = "\"foo\"");*)
|
||||
(* >> '#' is incompatible with 'S' *)
|
||||
(*test (sprintf "% S" "foo" = "\"foo\"");*)
|
||||
(* >> '#' is incompatible with 'S' *)
|
||||
(*test (sprintf "%#S" "foo" = "\"foo\"");*)
|
||||
(* >> '#' is incompatible with 'S' *)
|
||||
(* test (sprintf "%5S" "foo" = " \"foo\""); padding not done *)
|
||||
test (sprintf "%1S" "foo" = "\"foo\"");
|
||||
(* test (sprintf "%*S" 6 "foo" = " \"foo\""); padding not done *)
|
||||
|
|
@ -159,9 +184,12 @@ try
|
|||
test (sprintf "%c" 'c' = "c");
|
||||
(* test (sprintf "%-4c" 'c' = "c "); padding not done *)
|
||||
(* test (sprintf "%04c" 'c' = " c"); padding not done *)
|
||||
test (sprintf "%+c" 'c' = "c");
|
||||
test (sprintf "% c" 'c' = "c");
|
||||
test (sprintf "%#c" 'c' = "c");
|
||||
(*test (sprintf "%+c" 'c' = "c");*)
|
||||
(* >> '#' is incompatible with 'c' *)
|
||||
(*test (sprintf "% c" 'c' = "c");*)
|
||||
(* >> '#' is incompatible with 'c' *)
|
||||
(*test (sprintf "%#c" 'c' = "c");*)
|
||||
(* >> '#' is incompatible with 'c' *)
|
||||
(* test (sprintf "%4c" 'c' = " c"); padding not done *)
|
||||
(* test (sprintf "%*c" 2 'c' = " c"); padding not done *)
|
||||
(* test (sprintf "%-0+ #4c" 'c' = "c "); padding not done *)
|
||||
|
|
@ -171,12 +199,15 @@ try
|
|||
test (sprintf "%C" '\'' = "'\\''");
|
||||
(* test (sprintf "%-4C" 'c' = "c "); padding not done *)
|
||||
(* test (sprintf "%04C" 'c' = " c"); padding not done *)
|
||||
test (sprintf "%+C" 'c' = "'c'");
|
||||
test (sprintf "% C" 'c' = "'c'");
|
||||
test (sprintf "%#C" 'c' = "'c'");
|
||||
(* test (sprintf "%4C" 'c' = " 'c'"); padding not done *)
|
||||
(* test (sprintf "%*C" 2 'c' = "'c'"); padding not done *)
|
||||
(* test (sprintf "%-0+ #4C" 'c' = "'c' "); padding not done *)
|
||||
(*test (sprintf "%+C" 'c' = "'c'");*)
|
||||
(* >> '+' is incompatible with 'C' *)
|
||||
(*test (sprintf "% C" 'c' = "'c'");*)
|
||||
(* >> ' ' is incompatible with 'C' *)
|
||||
(*test (sprintf "%#C" 'c' = "'c'");*)
|
||||
(* >> '#' is incompatible with 'C' *)
|
||||
(* test (sprintf "%4C" 'c' = " c"); padding not done *)
|
||||
(* test (sprintf "%*C" 2 'c' = " c"); padding not done *)
|
||||
(* test (sprintf "%-0+ #4C" 'c' = "c "); padding not done *)
|
||||
|
||||
printf "\nf\n%!";
|
||||
test (sprintf "%f" (-42.42) = "-42.420000");
|
||||
|
|
@ -184,19 +215,23 @@ try
|
|||
test (sprintf "%013f" (-42.42) = "-00042.420000");
|
||||
test (sprintf "%+f" 42.42 = "+42.420000");
|
||||
test (sprintf "% f" 42.42 = " 42.420000");
|
||||
test (sprintf "%#f" 42.42 = "42.420000");
|
||||
(*test (sprintf "%#f" 42.42 = "42.420000");*)
|
||||
(* >> '#' is incompatible with 'f' *)
|
||||
test (sprintf "%13f" 42.42 = " 42.420000");
|
||||
test (sprintf "%*f" 12 42.42 = " 42.420000");
|
||||
test (sprintf "%-0+ #12f" 42.42 = "+42.420000 ");
|
||||
(*test (sprintf "%-0+ #12f" 42.42 = "+42.420000 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'f' *)
|
||||
test (sprintf "%.3f" (-42.42) = "-42.420");
|
||||
test (sprintf "%-13.3f" (-42.42) = "-42.420 ");
|
||||
test (sprintf "%013.3f" (-42.42) = "-00000042.420");
|
||||
test (sprintf "%+.3f" 42.42 = "+42.420");
|
||||
test (sprintf "% .3f" 42.42 = " 42.420");
|
||||
test (sprintf "%#.3f" 42.42 = "42.420");
|
||||
(*test (sprintf "%#.3f" 42.42 = "42.420");*)
|
||||
(* >> '#' is incompatible with 'f' *)
|
||||
test (sprintf "%13.3f" 42.42 = " 42.420");
|
||||
test (sprintf "%*.*f" 12 3 42.42 = " 42.420");
|
||||
test (sprintf "%-0+ #12.3f" 42.42 = "+42.420 ");
|
||||
(*test (sprintf "%-0+ #12.3f" 42.42 = "+42.420 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'f' *)
|
||||
|
||||
(* Under Windows (mingw and maybe also MSVC), the stdlib uses three
|
||||
digits for the exponent instead of the two used by Linux and BSD.
|
||||
|
|
@ -240,19 +275,23 @@ try
|
|||
test (sprintf "%015e" (-42.42) =* "-004.242000e+01");
|
||||
test (sprintf "%+e" 42.42 =* "+4.242000e+01");
|
||||
test (sprintf "% e" 42.42 =* " 4.242000e+01");
|
||||
test (sprintf "%#e" 42.42 =* "4.242000e+01");
|
||||
(*test (sprintf "%#e" 42.42 =* "4.242000e+01");*)
|
||||
(* >> '#' is incompatible with 'e' *)
|
||||
test (sprintf "%15e" 42.42 =* " 4.242000e+01");
|
||||
test (sprintf "%*e" 14 42.42 =* " 4.242000e+01");
|
||||
test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");
|
||||
(*test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'e' *)
|
||||
test (sprintf "%.3e" (-42.42) =* "-4.242e+01");
|
||||
test (sprintf "%-15.3e" (-42.42) =* "-4.242e+01 ");
|
||||
test (sprintf "%015.3e" (-42.42) =* "-000004.242e+01");
|
||||
test (sprintf "%+.3e" 42.42 =* "+4.242e+01");
|
||||
test (sprintf "% .3e" 42.42 =* " 4.242e+01");
|
||||
test (sprintf "%#.3e" 42.42 =* "4.242e+01");
|
||||
(*test (sprintf "%#.3e" 42.42 =* "4.242e+01");*)
|
||||
(* >> '#' is incompatible with 'e' *)
|
||||
test (sprintf "%15.3e" 42.42 =* " 4.242e+01");
|
||||
test (sprintf "%*.*e" 11 3 42.42 =* " 4.242e+01");
|
||||
test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01 ");
|
||||
(*test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'e' *)
|
||||
|
||||
printf "\nE\n%!";
|
||||
test (sprintf "%E" (-42.42) =* "-4.242000E+01");
|
||||
|
|
@ -260,19 +299,23 @@ try
|
|||
test (sprintf "%015E" (-42.42) =* "-004.242000E+01");
|
||||
test (sprintf "%+E" 42.42 =* "+4.242000E+01");
|
||||
test (sprintf "% E" 42.42 =* " 4.242000E+01");
|
||||
test (sprintf "%#E" 42.42 =* "4.242000E+01");
|
||||
(*test (sprintf "%#E" 42.42 =* "4.242000E+01");*)
|
||||
(* >> '#' is incompatible with 'E' *)
|
||||
test (sprintf "%15E" 42.42 =* " 4.242000E+01");
|
||||
test (sprintf "%*E" 14 42.42 =* " 4.242000E+01");
|
||||
test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");
|
||||
(*test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");*)
|
||||
(* >> '#' is incompatible with 'E' *)
|
||||
test (sprintf "%.3E" (-42.42) =* "-4.242E+01");
|
||||
test (sprintf "%-15.3E" (-42.42) =* "-4.242E+01 ");
|
||||
test (sprintf "%015.3E" (-42.42) =* "-000004.242E+01");
|
||||
test (sprintf "%+.3E" 42.42 =* "+4.242E+01");
|
||||
test (sprintf "% .3E" 42.42 =* " 4.242E+01");
|
||||
test (sprintf "%#.3E" 42.42 =* "4.242E+01");
|
||||
(*test (sprintf "%#.3E" 42.42 =* "4.242E+01");*)
|
||||
(* >> '#' is incompatible with 'E' *)
|
||||
test (sprintf "%15.3E" 42.42 =* " 4.242E+01");
|
||||
test (sprintf "%*.*E" 11 3 42.42 =* " 4.242E+01");
|
||||
test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01 ");
|
||||
(*test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'E' *)
|
||||
|
||||
(* %g gives strange results that correspond to neither %f nor %e
|
||||
printf "\ng\n%!";
|
||||
|
|
@ -302,10 +345,12 @@ try
|
|||
test (sprintf "%04ld/%05li" 42l 43l = "0042/00043");
|
||||
test (sprintf "%+ld/%+li" 42l 43l = "+42/+43");
|
||||
test (sprintf "% ld/% li" 42l 43l = " 42/ 43");
|
||||
test (sprintf "%#ld/%#li" 42l 43l = "42/43");
|
||||
(*test (sprintf "%#ld/%#li" 42l 43l = "42/43");*)
|
||||
(* >> '#' is incompatible with 'ld' *)
|
||||
test (sprintf "%4ld/%5li" 42l 43l = " 42/ 43");
|
||||
test (sprintf "%*ld/%*li" 4 42l 5 43l = " 42/ 43");
|
||||
test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43 ");
|
||||
(*test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
|
||||
|
||||
printf "\nld/li negative\n%!";
|
||||
test (sprintf "%ld/%li" (-42l) (-43l) = "-42/-43");
|
||||
|
|
@ -313,21 +358,27 @@ try
|
|||
test (sprintf "%04ld/%05li" (-42l) (-43l) = "-042/-0043");
|
||||
test (sprintf "%+ld/%+li" (-42l) (-43l) = "-42/-43");
|
||||
test (sprintf "% ld/% li" (-42l) (-43l) = "-42/-43");
|
||||
test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");
|
||||
(*test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");*)
|
||||
(* >> '#' is incompatible with 'ld' *)
|
||||
test (sprintf "%4ld/%5li" (-42l) (-43l) = " -42/ -43");
|
||||
test (sprintf "%*ld/%*li" 4 (-42l) 5 (-43l) = " -42/ -43");
|
||||
test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43 ");
|
||||
(*test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
|
||||
|
||||
printf "\nlu positive\n%!";
|
||||
test (sprintf "%lu" 42l = "42");
|
||||
test (sprintf "%-4lu" 42l = "42 ");
|
||||
test (sprintf "%04lu" 42l = "0042");
|
||||
test (sprintf "%+lu" 42l = "42");
|
||||
test (sprintf "% lu" 42l = "42");
|
||||
test (sprintf "%#lu" 42l = "42");
|
||||
(*test (sprintf "%+lu" 42l = "42");*)
|
||||
(* >> '+' is incompatible with 'lu' *)
|
||||
(*test (sprintf "% lu" 42l = "42");*)
|
||||
(* >> ' ' is incompatible with 'lu' *)
|
||||
(*test (sprintf "%#lu" 42l = "42");*)
|
||||
(* >> '#' is incompatible with 'lu' *)
|
||||
test (sprintf "%4lu" 42l = " 42");
|
||||
test (sprintf "%*lu" 4 42l = " 42");
|
||||
test (sprintf "%-0+ #6ld" 42l = "+42 ");
|
||||
(*test (sprintf "%-0+ #6ld" 42l = "+42 ");*)
|
||||
(* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
|
||||
|
||||
printf "\nlu negative\n%!";
|
||||
test (sprintf "%lu" (-1l) = "4294967295");
|
||||
|
|
@ -336,12 +387,15 @@ try
|
|||
test (sprintf "%lx" 42l = "2a");
|
||||
test (sprintf "%-4lx" 42l = "2a ");
|
||||
test (sprintf "%04lx" 42l = "002a");
|
||||
test (sprintf "%+lx" 42l = "2a");
|
||||
test (sprintf "% lx" 42l = "2a");
|
||||
(*test (sprintf "%+lx" 42l = "2a");*)
|
||||
(* >> '+' is incompatible with 'lx' *)
|
||||
(*test (sprintf "% lx" 42l = "2a");*)
|
||||
(* >> ' ' is incompatible with 'lx' *)
|
||||
test (sprintf "%#lx" 42l = "0x2a");
|
||||
test (sprintf "%4lx" 42l = " 2a");
|
||||
test (sprintf "%*lx" 5 42l = " 2a");
|
||||
test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");
|
||||
(*test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nlx negative\n%!";
|
||||
test (sprintf "%lx" (-42l) = "ffffffd6");
|
||||
|
|
@ -350,12 +404,15 @@ try
|
|||
test (sprintf "%lX" 42l = "2A");
|
||||
test (sprintf "%-4lX" 42l = "2A ");
|
||||
test (sprintf "%04lX" 42l = "002A");
|
||||
test (sprintf "%+lX" 42l = "2A");
|
||||
test (sprintf "% lX" 42l = "2A");
|
||||
(*test (sprintf "%+lX" 42l = "2A");*)
|
||||
(* >> '+' is incompatible with 'lX' *)
|
||||
(*test (sprintf "% lX" 42l = "2A");*)
|
||||
(* >> ' ' is incompatible with 'lX' *)
|
||||
test (sprintf "%#lX" 42l = "0X2A");
|
||||
test (sprintf "%4lX" 42l = " 2A");
|
||||
test (sprintf "%*lX" 5 42l = " 2A");
|
||||
test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");
|
||||
(*test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nlx negative\n%!";
|
||||
test (sprintf "%lX" (-42l) = "FFFFFFD6");
|
||||
|
|
@ -364,12 +421,15 @@ try
|
|||
test (sprintf "%lo" 42l = "52");
|
||||
test (sprintf "%-4lo" 42l = "52 ");
|
||||
test (sprintf "%04lo" 42l = "0052");
|
||||
test (sprintf "%+lo" 42l = "52");
|
||||
test (sprintf "% lo" 42l = "52");
|
||||
(*test (sprintf "%+lo" 42l = "52");*)
|
||||
(* >> '+' is incompatible with 'lo' *)
|
||||
(*test (sprintf "% lo" 42l = "52");*)
|
||||
(* >> ' ' is incompatible with 'lo' *)
|
||||
test (sprintf "%#lo" 42l = "052");
|
||||
test (sprintf "%4lo" 42l = " 52");
|
||||
test (sprintf "%*lo" 5 42l = " 52");
|
||||
test (sprintf "%-0+ #*lo" 5 42l = "052 ");
|
||||
(*test (sprintf "%-0+ #*lo" 5 42l = "052 ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nlo negative\n%!";
|
||||
test (sprintf "%lo" (-42l) = "37777777726");
|
||||
|
|
@ -381,34 +441,46 @@ try
|
|||
test (sprintf "%Ld/%Li" 42L 43L = "42/43");
|
||||
test (sprintf "%-4Ld/%-5Li" 42L 43L = "42 /43 ");
|
||||
test (sprintf "%04Ld/%05Li" 42L 43L = "0042/00043");
|
||||
test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");
|
||||
test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");
|
||||
test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");
|
||||
(*test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");*)
|
||||
(* >> '+' is incompatible with 'Ld' *)
|
||||
(*test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");*)
|
||||
(* >> ' ' is incompatible with 'Ld' *)
|
||||
(*test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");*)
|
||||
(* >> '#' is incompatible with 'Ld' *)
|
||||
test (sprintf "%4Ld/%5Li" 42L 43L = " 42/ 43");
|
||||
test (sprintf "%*Ld/%*Li" 4 42L 5 43L = " 42/ 43");
|
||||
test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43 ");
|
||||
(*test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43 ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nLd/Li negative\n%!";
|
||||
test (sprintf "%Ld/%Li" (-42L) (-43L) = "-42/-43");
|
||||
test (sprintf "%-4Ld/%-5Li" (-42L) (-43L) = "-42 /-43 ");
|
||||
test (sprintf "%04Ld/%05Li" (-42L) (-43L) = "-042/-0043");
|
||||
test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");
|
||||
test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");
|
||||
test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");
|
||||
(*test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");*)
|
||||
(* >> '+' is incompatible with 'Ld' *)
|
||||
(*test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");*)
|
||||
(* >> ' ' is incompatible with 'Ld' *)
|
||||
(*test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");*)
|
||||
(* >> '#' is incompatible with 'Ld' *)
|
||||
test (sprintf "%4Ld/%5Li" (-42L) (-43L) = " -42/ -43");
|
||||
test (sprintf "%*Ld/%*Li" 4 (-42L) 5 (-43L) = " -42/ -43");
|
||||
test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43 ");
|
||||
(*test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43 ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nLu positive\n%!";
|
||||
test (sprintf "%Lu" 42L = "42");
|
||||
test (sprintf "%-4Lu" 42L = "42 ");
|
||||
test (sprintf "%04Lu" 42L = "0042");
|
||||
test (sprintf "%+Lu" 42L = "42");
|
||||
test (sprintf "% Lu" 42L = "42");
|
||||
test (sprintf "%#Lu" 42L = "42");
|
||||
(*test (sprintf "%+Lu" 42L = "42");*)
|
||||
(* >> '+' is incompatible with 'Lu' *)
|
||||
(*test (sprintf "% Lu" 42L = "42");*)
|
||||
(* >> ' ' is incompatible with 'Lu' *)
|
||||
(*test (sprintf "%#Lu" 42L = "42");*)
|
||||
(* >> '#' is incompatible with 'Lu' *)
|
||||
test (sprintf "%4Lu" 42L = " 42");
|
||||
test (sprintf "%*Lu" 4 42L = " 42");
|
||||
test (sprintf "%-0+ #6Ld" 42L = "+42 ");
|
||||
(*test (sprintf "%-0+ #6Ld" 42L = "+42 ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nLu negative\n%!";
|
||||
test (sprintf "%Lu" (-1L) = "18446744073709551615");
|
||||
|
|
@ -417,12 +489,15 @@ try
|
|||
test (sprintf "%Lx" 42L = "2a");
|
||||
test (sprintf "%-4Lx" 42L = "2a ");
|
||||
test (sprintf "%04Lx" 42L = "002a");
|
||||
test (sprintf "%+Lx" 42L = "2a");
|
||||
test (sprintf "% Lx" 42L = "2a");
|
||||
(*test (sprintf "%+Lx" 42L = "2a");*)
|
||||
(* >> '+' is incompatible with 'Lx' *)
|
||||
(*test (sprintf "% Lx" 42L = "2a");*)
|
||||
(* >> ' ' is incompatible with 'Lx' *)
|
||||
test (sprintf "%#Lx" 42L = "0x2a");
|
||||
test (sprintf "%4Lx" 42L = " 2a");
|
||||
test (sprintf "%*Lx" 5 42L = " 2a");
|
||||
test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");
|
||||
(*test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nLx negative\n%!";
|
||||
test (sprintf "%Lx" (-42L) = "ffffffffffffffd6");
|
||||
|
|
@ -431,12 +506,15 @@ try
|
|||
test (sprintf "%LX" 42L = "2A");
|
||||
test (sprintf "%-4LX" 42L = "2A ");
|
||||
test (sprintf "%04LX" 42L = "002A");
|
||||
test (sprintf "%+LX" 42L = "2A");
|
||||
test (sprintf "% LX" 42L = "2A");
|
||||
(*test (sprintf "%+LX" 42L = "2A");*)
|
||||
(* >> '+' is incompatible with 'LX' *)
|
||||
(*test (sprintf "% LX" 42L = "2A");*)
|
||||
(* >> ' ' is incompatible with 'LX' *)
|
||||
test (sprintf "%#LX" 42L = "0X2A");
|
||||
test (sprintf "%4LX" 42L = " 2A");
|
||||
test (sprintf "%*LX" 5 42L = " 2A");
|
||||
test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");
|
||||
(*test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nLx negative\n%!";
|
||||
test (sprintf "%LX" (-42L) = "FFFFFFFFFFFFFFD6");
|
||||
|
|
@ -445,12 +523,15 @@ try
|
|||
test (sprintf "%Lo" 42L = "52");
|
||||
test (sprintf "%-4Lo" 42L = "52 ");
|
||||
test (sprintf "%04Lo" 42L = "0052");
|
||||
test (sprintf "%+Lo" 42L = "52");
|
||||
test (sprintf "% Lo" 42L = "52");
|
||||
(*test (sprintf "%+Lo" 42L = "52");*)
|
||||
(* >> '+' is incompatible with 'Lo' *)
|
||||
(*test (sprintf "% Lo" 42L = "52");*)
|
||||
(* >> ' ' is incompatible with 'Lo' *)
|
||||
test (sprintf "%#Lo" 42L = "052");
|
||||
test (sprintf "%4Lo" 42L = " 52");
|
||||
test (sprintf "%*Lo" 5 42L = " 52");
|
||||
test (sprintf "%-0+ #*Lo" 5 42L = "052 ");
|
||||
(*test (sprintf "%-0+ #*Lo" 5 42L = "052 ");*)
|
||||
(* >> '-' is incompatible with '0' *)
|
||||
|
||||
printf "\nLo negative\n%!";
|
||||
test (sprintf "%Lo" (-42L) = "1777777777777777777726");
|
||||
|
|
|
|||
|
|
@ -1,91 +1,91 @@
|
|||
d/i positive
|
||||
0 1 2 3 4 5 6 7 8
|
||||
0 1 2 3 4 5 6
|
||||
d/i negative
|
||||
9 10 11 12 13 14 15 16 17
|
||||
7 8 9 10 11 12 13
|
||||
u positive
|
||||
18 19 20 21 22 23 24 25 26
|
||||
14 15 16 17 18
|
||||
u negative
|
||||
27
|
||||
19
|
||||
x positive
|
||||
28 29 30 31 32 33 34 35 36
|
||||
20 21 22 23 24 25
|
||||
x negative
|
||||
37
|
||||
26
|
||||
X positive
|
||||
38 39 40 41 42 43 44 45 46
|
||||
27 28 29 30 31 32
|
||||
x negative
|
||||
47
|
||||
33
|
||||
o positive
|
||||
48 49 50 51 52 53 54 55 56
|
||||
34 35 36 37 38 39
|
||||
o negative
|
||||
57
|
||||
40
|
||||
s
|
||||
58 59 60 61 62 63 64 65 66 67 68 69 70 71
|
||||
41 42 43 44 45 46 47 48 49
|
||||
S
|
||||
72 73 74 75 76 77 78 79 80
|
||||
50 51 52 53 54 55
|
||||
c
|
||||
81 82 83 84
|
||||
56
|
||||
C
|
||||
85 86 87 88 89
|
||||
57 58
|
||||
f
|
||||
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
|
||||
59 60 61 62 63 64 65 66 67 68 69 70 71 72
|
||||
F
|
||||
108 109 110 111
|
||||
73 74 75 76
|
||||
e
|
||||
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
|
||||
77 78 79 80 81 82 83 84 85 86 87 88 89 90
|
||||
E
|
||||
130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
|
||||
91 92 93 94 95 96 97 98 99 100 101 102 103 104
|
||||
B
|
||||
148 149
|
||||
105 106
|
||||
ld/li positive
|
||||
150 151 152 153 154 155 156 157 158
|
||||
107 108 109 110 111 112 113
|
||||
ld/li negative
|
||||
159 160 161 162 163 164 165 166 167
|
||||
114 115 116 117 118 119 120
|
||||
lu positive
|
||||
168 169 170 171 172 173 174 175 176
|
||||
121 122 123 124 125
|
||||
lu negative
|
||||
177
|
||||
126
|
||||
lx positive
|
||||
178 179 180 181 182 183 184 185 186
|
||||
127 128 129 130 131 132
|
||||
lx negative
|
||||
187
|
||||
133
|
||||
lX positive
|
||||
188 189 190 191 192 193 194 195 196
|
||||
134 135 136 137 138 139
|
||||
lx negative
|
||||
197
|
||||
140
|
||||
lo positive
|
||||
198 199 200 201 202 203 204 205 206
|
||||
141 142 143 144 145 146
|
||||
lo negative
|
||||
207
|
||||
147
|
||||
Ld/Li positive
|
||||
208 209 210 211 212 213 214 215 216
|
||||
148 149 150 151 152
|
||||
Ld/Li negative
|
||||
217 218 219 220 221 222 223 224 225
|
||||
153 154 155 156 157
|
||||
Lu positive
|
||||
226 227 228 229 230 231 232 233 234
|
||||
158 159 160 161 162
|
||||
Lu negative
|
||||
235
|
||||
163
|
||||
Lx positive
|
||||
236 237 238 239 240 241 242 243 244
|
||||
164 165 166 167 168 169
|
||||
Lx negative
|
||||
245
|
||||
170
|
||||
LX positive
|
||||
246 247 248 249 250 251 252 253 254
|
||||
171 172 173 174 175 176
|
||||
Lx negative
|
||||
255
|
||||
177
|
||||
Lo positive
|
||||
256 257 258 259 260 261 262 263 264
|
||||
178 179 180 181 182 183
|
||||
Lo negative
|
||||
265
|
||||
184
|
||||
a
|
||||
266
|
||||
185
|
||||
t
|
||||
267
|
||||
186
|
||||
{...%}
|
||||
268
|
||||
187
|
||||
(...%)
|
||||
269
|
||||
188
|
||||
! % @ , and constants
|
||||
270 271 272 273 274 275 276
|
||||
189 190 191 192 193 194 195
|
||||
end of tests
|
||||
|
||||
All tests succeeded.
|
||||
|
|
|
|||
|
|
@ -1096,7 +1096,7 @@ let test46, test47 =
|
|||
|
||||
test (test46 () = "1 spells one, in english.")
|
||||
;;
|
||||
test (test47 () = "1 ,%s, in english.")
|
||||
test (test47 () = "1 ,spells one %s, in english.")
|
||||
;;
|
||||
|
||||
(* Testing scanning of meta formats. *)
|
||||
|
|
|
|||
Loading…
Reference in New Issue