Permalink
Browse files

PR#6418: fix format regression on "@{<..%d..%s..>" (Benoît Vaugon)

To be able to compile this patch, you should temporarily apply the
following patch to bootstrap the format type change:

> diff -Naur old/typing/typecore.ml new/typing/typecore.ml
> --- old/typing/typecore.ml	2014-06-06 03:37:03.240926150 +0200
> +++ new/typing/typecore.ml	2014-06-06 03:37:24.696926699 +0200
> @@ -2956,7 +2956,7 @@
>          | Theta rest ->
>            mk_constr "Theta" [ mk_fmt rest ]
>          | Formatting (fmting, rest) ->
> -          mk_constr "Formatting" [ mk_formatting fmting; mk_fmt rest ]
> +          mk_constr "Formatting_lit" [ mk_formatting fmting; mk_fmt rest ]
>          | Reader rest ->
>            mk_constr "Reader" [ mk_fmt rest ]
>          | Scan_char_set (width_opt, char_set, rest) ->

Bootstrap process:

  make core
  apply the patch above
  make core
  make promote-cross
  make partialclean
  revert the patch above, apply the commit
  make partialclean
  make core
  make coreboot

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14973 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent bb313fa commit 7cb9d0d84ea13ae0f984b45f6b9ddae5ca4a5198 @gasche gasche committed Jun 9, 2014
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
Oops, something went wrong.
@@ -18,13 +18,17 @@ val param_format_of_ignored_format :
('a, 'b, 'c, 'd, 'y, 'x) ignored -> ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
-type ('b, 'c) acc =
- | Acc_formatting of ('b, 'c) acc * formatting
- | Acc_string of ('b, 'c) acc * string
- | Acc_char of ('b, 'c) acc * char
- | Acc_delay of ('b, 'c) acc * ('b -> 'c)
- | Acc_flush of ('b, 'c) acc
- | Acc_invalid_arg of ('b, 'c) acc * string
+type ('b, 'c) acc_formatting_gen =
+ | Acc_open_tag of ('b, 'c) acc
+
+and ('b, 'c) acc =
+ | Acc_formatting_lit of ('b, 'c) acc * formatting_lit
+ | Acc_formatting_gen of ('b, 'c) acc * ('b, 'c) acc_formatting_gen
+ | Acc_string of ('b, 'c) acc * string
+ | Acc_char of ('b, 'c) acc * char
+ | Acc_delay of ('b, 'c) acc * ('b -> 'c)
+ | Acc_flush of ('b, 'c) acc
+ | Acc_invalid_arg of ('b, 'c) acc * string
| End_of_acc
type ('a, 'b) heter_list =
@@ -61,7 +65,9 @@ val format_of_string_format :
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
val char_of_iconv : CamlinternalFormatBasics.int_conv -> char
-val string_of_formatting : CamlinternalFormatBasics.formatting -> string
+val string_of_formatting_lit : CamlinternalFormatBasics.formatting_lit -> string
+val string_of_formatting_gen :
+ ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.formatting_gen -> string
val string_of_fmtty :
('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty -> string
@@ -1,33 +1,3 @@
-(* Type of a block used by the Format pretty-printer. *)
-type 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 *)
-
-(* Formatting element used by the Format pretty-printter. *)
-type formatting =
- | Open_box of string * block_type * int (* @[ *)
- | Close_box (* @] *)
- | Open_tag of string * string (* @{ *)
- | Close_tag (* @} *)
- | Break of string * int * int (* @, | @ | @; | @;<> *)
- | FFlush (* @? *)
- | Force_newline (* @\n *)
- | Flush_newline (* @. *)
- | Magic_size of string * int (* @<n> *)
- | Escaped_at (* @@ *)
- | Escaped_percent (* @%% *)
- | Scan_indic of char (* @X *)
-
-(***)
-
(* Padding position. *)
type padty =
| Left (* Text is left justified ('-' option). *)
@@ -226,9 +196,43 @@ does assume that the two input have exactly the same term structure
Format_subst_ty constructor).
*)
+(* Type of a block used by the Format pretty-printer. *)
+type 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 *)
+
+(* Formatting element used by the Format pretty-printter. *)
+type formatting_lit =
+ | Open_box of string * block_type * int (* @[ *)
+ | Close_box (* @] *)
+ | Close_tag (* @} *)
+ | Break of string * int * int (* @, | @ | @; | @;<> *)
+ | FFlush (* @? *)
+ | Force_newline (* @\n *)
+ | Flush_newline (* @. *)
+ | Magic_size of string * int (* @<n> *)
+ | Escaped_at (* @@ *)
+ | Escaped_percent (* @%% *)
+ | Scan_indic of char (* @X *)
+
+(* Formatting element used by the Format pretty-printter. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen =
+ | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> (* @{ *)
+ ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+
+(***)
+
(* List of format type elements. *)
(* In particular used to represent %(...%) and %{...%} contents. *)
-type ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+and ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
('a, 'b, 'c, 'd, 'e, 'f,
'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
@@ -388,9 +392,12 @@ and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
(('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
(* Format specific constructor: *)
- | Formatting : (* @_ *)
- formatting * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+ | Formatting_lit : (* @_ *)
+ formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
('a, 'b, 'c, 'd, 'e, 'f) fmt
+ | Formatting_gen : (* @_ *)
+ ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen *
+ ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt
(* Scanf specific constructors: *)
| Reader : (* %r *)
@@ -597,8 +604,10 @@ fun fmt1 fmt2 -> match fmt1 with
| Ignored_param (ign, rest) ->
Ignored_param (ign, concat_fmt rest fmt2)
- | Formatting (fmting, rest) ->
- Formatting (fmting, concat_fmt rest fmt2)
+ | Formatting_lit (fmting_lit, rest) ->
+ Formatting_lit (fmting_lit, concat_fmt rest fmt2)
+ | Formatting_gen (fmting_gen, rest) ->
+ Formatting_gen (fmting_gen, concat_fmt rest fmt2)
| End_of_format ->
fmt2
Oops, something went wrong.

0 comments on commit 7cb9d0d

Please sign in to comment.