+10 -8

Changes

reviewed

··· 192 192 - GPR#1638: add a Float module. 193 193 (Nicolás Ojeda Bär, review by Alain Frisch and Jeremy Yallop) 194 194 195 195 - - GPR#1697: Tune [List.init] tailrec threshold so that it does not stack overflow 196 196 - when compiled with the Js_of_ocaml backend. 195 195 + - GPR#1697: Tune [List.init] tailrec threshold so that it does not stack 196 196 + overflow when compiled with the Js_of_ocaml backend. 197 197 (Hugo Heuzard, reviewed by Gabriel Scherer) 198 198 199 199 ### Other libraries: ··· 273 273 - GPR#1618: add the -dno-unique-ids and -dunique-ids compiler flags 274 274 (Sébastien Hinderer, review by Leo White and Damien Doligez) 275 275 276 276 - - GPR#1649 change compilation order of toplevel definitions, so that some warnings 277 277 - emitted by the bytecode compiler appear more in-order than before. 276 276 + - GPR#1649 change compilation order of toplevel definitions, so that some 277 277 + warnings emitted by the bytecode compiler appear more in-order than before. 278 278 (Luc Maranget, advice and review by Damien Doligez) 279 279 280 280 - GPR#1806: add linscan to OCAMLPARAM options ··· 492 492 493 493 - GPR#1513: Allow compilation units to shadow sub-modules of Pervasives. 494 494 For instance users can now use a largeFile.ml file in their project. 495 495 - (Jérémie Dimino, review by Nicolas Ojeda Bar, Alain Frisch and Gabriel Radanne) 495 495 + (Jérémie Dimino, review by Nicolas Ojeda Bar, Alain Frisch and Gabriel 496 496 + Radanne) 496 497 497 498 - GPR#1516: Allow float array construction in recursive bindings 498 499 when configured with -no-flat-float-array ··· 852 853 pretty-printing items. New fields have been added to the 853 854 formatter_out_functions record, thus this change will break any code building 854 855 such record from scratch. 855 855 - When building Format.formatter_out_functions values redefining the out_spaces field, 856 856 - "{ fmt_out_funs with out_spaces = f; }" should be replaced by 857 857 - "{ fmt_out_funs with out_spaces = f; out_indent = f; }" to maintain the old behavior. 856 856 + When building Format.formatter_out_functions values redefining the out_spaces 857 857 + field, "{ fmt_out_funs with out_spaces = f; }" should be replaced by 858 858 + "{ fmt_out_funs with out_spaces = f; out_indent = f; }" to maintain the old 859 859 + behavior. 858 860 (Richard Bonichon and Pierre Weis, review by Alain Frisch, original request by 859 861 Spiros Eliopoulos in GPR#506) 860 862

+16 -8

README.adoc

reviewed

··· 1 1 |===== 2 2 | Branch `trunk` | Branch `4.06` | Branch `4.05` | Branch `4.04` 3 3 4 4 - | image:https://travis-ci.org/ocaml/ocaml.svg?branch=trunk["TravisCI Build Status (trunk branch)",link="https://travis-ci.org/ocaml/ocaml"] 5 5 - image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=trunk&svg=true["AppVeyor Build Status (trunk branch)",link="https://ci.appveyor.com/project/avsm/ocaml"] 6 6 - | image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.06["TravisCI Build Status (4.06 branch)",link="https://travis-ci.org/ocaml/ocaml"] 7 7 - image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.06&svg=true["AppVeyor Build Status (4.06 branch)",link="https://ci.appveyor.com/project/avsm/ocaml"] 8 8 - | image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.05["TravisCI Build Status (4.05 branch)",link="https://travis-ci.org/ocaml/ocaml"] 9 9 - image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.05&svg=true["AppVeyor Build Status (4.05 branch)",link="https://ci.appveyor.com/project/avsm/ocaml"] 10 10 - | image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.04["TravisCI Build Status (4.04 branch)",link="https://travis-ci.org/ocaml/ocaml"] 11 11 - image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.04&svg=true["AppVeyor Build Status (4.04 branch)",link="https://ci.appveyor.com/project/avsm/ocaml"] 4 4 + | image:https://travis-ci.org/ocaml/ocaml.svg?branch=trunk["TravisCI Build Status (trunk branch)", 5 5 + link="https://travis-ci.org/ocaml/ocaml"] 6 6 + image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=trunk&svg=true["AppVeyor Build Status (trunk branch)", 7 7 + link="https://ci.appveyor.com/project/avsm/ocaml"] 8 8 + | image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.06["TravisCI Build Status (4.06 branch)", 9 9 + link="https://travis-ci.org/ocaml/ocaml"] 10 10 + image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.06&svg=true["AppVeyor Build Status (4.06 branch)", 11 11 + link="https://ci.appveyor.com/project/avsm/ocaml"] 12 12 + | image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.05["TravisCI Build Status (4.05 branch)", 13 13 + link="https://travis-ci.org/ocaml/ocaml"] 14 14 + image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.05&svg=true["AppVeyor Build Status (4.05 branch)", 15 15 + link="https://ci.appveyor.com/project/avsm/ocaml"] 16 16 + | image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.04["TravisCI Build Status (4.04 branch)", 17 17 + link="https://travis-ci.org/ocaml/ocaml"] 18 18 + image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.04&svg=true["AppVeyor Build Status (4.04 branch)", 19 19 + link="https://ci.appveyor.com/project/avsm/ocaml"] 12 20 13 21 |===== 14 22

+1 -1

README.win32.adoc

reviewed

··· 96 96 97 97 |===== 98 98 | | `cl` Version | Express | SDK/Build Tools 99 99 - | Visual Studio 2005 | 14.00.x.x | 32-bit only <<vs1,(*)>> | 99 99 + | Visual Studio 2005 | 14.00.x.x | 32-bit only <<vs1,(*)>> | 100 100 | Visual Studio 2008 | 15.00.x.x | 32-bit only | Windows SDK 7.0 also provides 32/64-bit compilers 101 101 | Visual Studio 2010 | 16.00.x.x | 32-bit only | Windows SDK 7.1 also provides 32/64-bit compilers 102 102 | Visual Studio 2012 | 17.00.x.x | 32/64-bit |

+3 -3

asmcomp/arm/reload.ml

reviewed

··· 44 44 | Iabsf | Inegf when !fpu = Soft -> 45 45 (* Soft FP neg and abs also have a "two-address" constraint of sorts. 46 46 64-bit floats are represented by pairs of 32-bit integers, 47 47 - hence there are two arguments and two results. 48 48 - The code emitter assumes [arg.(0) = res.(0)] but supports 49 49 - [arg.(1)] and [res.(1)] being in different registers. *) 47 47 + hence there are two arguments and two results. 48 48 + The code emitter assumes [arg.(0) = res.(0)] but supports 49 49 + [arg.(1)] and [res.(1)] being in different registers. *) 50 50 res'.(0) <- arg'.(0); 51 51 argres' 52 52 | _ ->

+2 -1

asmcomp/asmlink.ml

reviewed

··· 353 353 (fun () -> make_startup_file ppf units_tolink); 354 354 Misc.try_finally 355 355 (fun () -> 356 356 - call_linker (List.map object_file_name objfiles) startup_obj output_name) 356 356 + call_linker (List.map object_file_name objfiles) 357 357 + startup_obj output_name) 357 358 (fun () -> remove_file startup_obj) 358 359 ) 359 360

+6 -6

asmcomp/build_export_info.ml

reviewed

··· 652 652 let closure_id_to_set_of_closures_id = 653 653 Set_of_closures_id.Map.fold 654 654 (fun set_of_closure_id 655 655 - (function_declarations : Simple_value_approx.function_declarations) acc -> 656 656 - Variable.Map.fold 657 657 - (fun fun_var _ acc -> 655 655 + (function_declarations : Simple_value_approx.function_declarations) 656 656 + acc -> 657 657 + Variable.Map.fold 658 658 + (fun fun_var _ acc -> 658 659 let closure_id = Closure_id.wrap fun_var in 659 660 Closure_id.Map.add closure_id set_of_closure_id acc) 660 660 - function_declarations.funs 661 661 - acc) 661 661 + function_declarations.funs 662 662 + acc) 662 663 function_declarations_map 663 664 Closure_id.Map.empty 664 665 in ··· 710 711 ~relevant_imported_closure_ids 711 712 ~relevant_local_vars_within_closure 712 713 ~relevant_imported_vars_within_closure 713 713 -

+8 -3

asmcomp/closure.ml

reviewed

··· 645 645 (fun id id' s -> Tbl.add id (Uvar id') s) 646 646 ids ids' sb 647 647 in 648 648 - Ucatch(nfail, ids', substitute loc fpc sb rn u1, substitute loc fpc sb' rn u2) 648 648 + Ucatch(nfail, ids', substitute loc fpc sb rn u1, 649 649 + substitute loc fpc sb' rn u2) 649 650 | Utrywith(u1, id, u2) -> 650 651 let id' = Ident.rename id in 651 652 Utrywith(substitute loc fpc sb rn u1, id', ··· 653 654 | Uifthenelse(u1, u2, u3) -> 654 655 begin match substitute loc fpc sb rn u1 with 655 656 Uconst (Uconst_ptr n) -> 656 656 - if n <> 0 then substitute loc fpc sb rn u2 else substitute loc fpc sb rn u3 657 657 + if n <> 0 then 658 658 + substitute loc fpc sb rn u2 659 659 + else 660 660 + substitute loc fpc sb rn u3 657 661 | Uprim(Pmakeblock _, _, _) -> 658 662 substitute loc fpc sb rn u2 659 663 | su1 -> 660 660 - Uifthenelse(su1, substitute loc fpc sb rn u2, substitute loc fpc sb rn u3) 664 664 + Uifthenelse(su1, substitute loc fpc sb rn u2, 665 665 + substitute loc fpc sb rn u3) 661 666 end 662 667 | Usequence(u1, u2) -> 663 668 Usequence(substitute loc fpc sb rn u1, substitute loc fpc sb rn u2)

+25 -16

asmcomp/cmmgen.ml

reviewed

··· 612 612 Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg) 613 613 614 614 let non_profinfo_mask = 615 615 - if Config.profinfo 615 615 + if Config.profinfo 616 616 then (1 lsl (64 - Config.profinfo_width)) - 1 617 617 else 0 (* [non_profinfo_mask] is unused in this case *) 618 618 ··· 1106 1106 Pbigarray_complex32 | Pbigarray_complex64 -> 1107 1107 let kind = bigarray_word_kind elt_kind in 1108 1108 let sz = bigarray_elt_size elt_kind / 2 in 1109 1109 - bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr -> 1110 1110 - bind "reval" 1111 1111 - (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval -> 1112 1112 - bind "imval" 1113 1113 - (Cop(Cload (kind, Mutable), 1114 1114 - [Cop(Cadda, [addr; Cconst_int sz], dbg)], dbg)) (fun imval -> 1115 1115 - box_complex dbg reval imval))) 1109 1109 + bind "addr" 1110 1110 + (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr -> 1111 1111 + bind "reval" 1112 1112 + (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval -> 1113 1113 + bind "imval" 1114 1114 + (Cop(Cload (kind, Mutable), 1115 1115 + [Cop(Cadda, [addr; Cconst_int sz], dbg)], dbg)) 1116 1116 + (fun imval -> box_complex dbg reval imval))) 1116 1117 | _ -> 1117 1118 Cop(Cload (bigarray_word_kind elt_kind, Mutable), 1118 1119 [bigarray_indexing unsafe elt_kind layout b args dbg], ··· 2081 2082 bind "header" hdr (fun hdr -> 2082 2083 Cifthenelse(is_addr_array_hdr hdr dbg, 2083 2084 Cop(Clsr, [hdr; Cconst_int wordsize_shift], dbg), 2084 2084 - Cop(Clsr, [hdr; Cconst_int numfloat_shift], dbg))) in 2085 2085 + Cop(Clsr, [hdr; Cconst_int numfloat_shift], dbg))) 2086 2086 + in 2085 2087 Cop(Cor, [len; Cconst_int 1], dbg) 2086 2088 | Paddrarray | Pintarray -> 2087 2089 Cop(Cor, [addr_array_length hdr dbg; Cconst_int 1], dbg) ··· 2213 2215 (* Float operations *) 2214 2216 | Paddfloat -> 2215 2217 box_float dbg (Cop(Caddf, 2216 2216 - [transl_unbox_float dbg env arg1; transl_unbox_float dbg env arg2], 2218 2218 + [transl_unbox_float dbg env arg1; 2219 2219 + transl_unbox_float dbg env arg2], 2217 2220 dbg)) 2218 2221 | Psubfloat -> 2219 2222 box_float dbg (Cop(Csubf, 2220 2220 - [transl_unbox_float dbg env arg1; transl_unbox_float dbg env arg2], 2223 2223 + [transl_unbox_float dbg env arg1; 2224 2224 + transl_unbox_float dbg env arg2], 2221 2225 dbg)) 2222 2226 | Pmulfloat -> 2223 2227 box_float dbg (Cop(Cmulf, 2224 2224 - [transl_unbox_float dbg env arg1; transl_unbox_float dbg env arg2], 2228 2228 + [transl_unbox_float dbg env arg1; 2229 2229 + transl_unbox_float dbg env arg2], 2225 2230 dbg)) 2226 2231 | Pdivfloat -> 2227 2232 box_float dbg (Cop(Cdivf, 2228 2228 - [transl_unbox_float dbg env arg1; transl_unbox_float dbg env arg2], 2233 2233 + [transl_unbox_float dbg env arg1; 2234 2234 + transl_unbox_float dbg env arg2], 2229 2235 dbg)) 2230 2236 | Pfloatcomp cmp -> 2231 2237 tag_int(Cop(Ccmpf(transl_float_comparison cmp), 2232 2232 - [transl_unbox_float dbg env arg1; transl_unbox_float dbg env arg2], 2238 2238 + [transl_unbox_float dbg env arg1; 2239 2239 + transl_unbox_float dbg env arg2], 2233 2240 dbg)) dbg 2234 2241 2235 2242 (* String operations *) ··· 2404 2411 untag_int(transl env arg2) dbg], dbg)) 2405 2412 | Plsrbint bi -> 2406 2413 box_int dbg bi (Cop(Clsr, 2407 2407 - [make_unsigned_int bi (transl_unbox_int dbg env bi arg1) dbg; 2414 2414 + [make_unsigned_int bi (transl_unbox_int dbg env bi arg1) 2415 2415 + dbg; 2408 2416 untag_int(transl env arg2) dbg], dbg)) 2409 2417 | Pasrbint bi -> 2410 2418 box_int dbg bi (Cop(Casr, ··· 3331 3339 let newclos = Ident.create "clos" in 3332 3340 Clet(newclos, 3333 3341 get_field env (Cvar clos) 4 dbg, 3334 3334 - curry_fun (get_field env (Cvar clos) 3 dbg :: args) newclos (n-1)) 3342 3342 + curry_fun (get_field env (Cvar clos) 3 dbg :: args) 3343 3343 + newclos (n-1)) 3335 3344 end in 3336 3345 Cfunction 3337 3346 {fun_name = "caml_curry" ^ string_of_int arity ^

+3 -1

asmcomp/export_info.ml

reviewed

··· 277 277 sets_of_closures = 278 278 Set_of_closures_id.Map.disjoint_union t1.sets_of_closures 279 279 t2.sets_of_closures; 280 280 - symbol_id = Symbol.Map.disjoint_union ~print:Export_id.print t1.symbol_id t2.symbol_id; 280 280 + symbol_id = 281 281 + Symbol.Map.disjoint_union ~print:Export_id.print t1.symbol_id 282 282 + t2.symbol_id; 281 283 offset_fun = Closure_id.Map.disjoint_union 282 284 ~eq:int_eq t1.offset_fun t2.offset_fun; 283 285 offset_fv = Var_within_closure.Map.disjoint_union

+4 -2

asmcomp/flambda_to_clambda.ml

reviewed

··· 24 24 } 25 25 26 26 type t = { 27 27 - current_unit : Set_of_closures_id.t for_one_or_more_units; 28 28 - imported_units : Simple_value_approx.function_declarations for_one_or_more_units; 27 27 + current_unit : 28 28 + Set_of_closures_id.t for_one_or_more_units; 29 29 + imported_units : 30 30 + Simple_value_approx.function_declarations for_one_or_more_units; 29 31 } 30 32 31 33 let get_fun_offset t closure_id =

+2 -1

asmcomp/linscan.ml

reviewed

··· 113 113 (* Remove all overlapping registers from the register mask *) 114 114 let remove_bound_overlapping = function 115 115 {reg = {loc = Reg r}} as j -> 116 116 - if (r - r0 < rn) && regmask.(r - r0) && Interval.overlap j i then 116 116 + if (r - r0 < rn) && regmask.(r - r0) 117 117 + && Interval.overlap j i then 117 118 regmask.(r - r0) <- false 118 119 | _ -> () in 119 120 List.iter remove_bound_overlapping ci.ci_inactive;

+2 -1

asmcomp/split.ml

reviewed

··· 171 171 let previous_exit_subst = !exit_subst in 172 172 exit_subst := new_subst @ !exit_subst; 173 173 let (new_body, sub_body) = rename body sub in 174 174 - let res = List.map2 (fun (_, handler) (_, new_subst) -> rename handler !new_subst) 174 174 + let res = 175 175 + List.map2 (fun (_, handler) (_, new_subst) -> rename handler !new_subst) 175 176 handlers new_subst in 176 177 exit_subst := previous_exit_subst; 177 178 let merged_subst =

+1 -1

asmrun/amd64nt.asm

reviewed

··· 498 498 lea rax, caml_array_bound_error 499 499 jmp caml_c_call 500 500 501 501 - PUBLIC caml_system__code_end 501 501 + PUBLIC caml_system__code_end 502 502 caml_system__code_end: 503 503 504 504 .DATA

+2 -1

bytecomp/bytegen.ml

reviewed

··· 554 554 (add_pop ndecl cont))) 555 555 end else begin 556 556 let decl_size = 557 557 - List.map (fun (id, exp) -> (id, exp, size_of_lambda Ident.empty exp)) decl in 557 557 + List.map (fun (id, exp) -> (id, exp, size_of_lambda Ident.empty exp)) 558 558 + decl in 558 559 let rec comp_init new_env sz = function 559 560 | [] -> comp_nonrec new_env sz ndecl decl_size 560 561 | (id, _exp, RHS_floatblock blocksize) :: rem ->

+2 -1

bytecomp/bytegen.mli

reviewed

··· 22 22 val compile_phrase: lambda -> instruction list * instruction list 23 23 val reset: unit -> unit 24 24 25 25 - val merge_events : Instruct.debug_event -> Instruct.debug_event -> Instruct.debug_event 25 25 + val merge_events: 26 26 + Instruct.debug_event -> Instruct.debug_event -> Instruct.debug_event

+2 -1

bytecomp/bytelink.ml

reviewed

··· 619 619 let basename = Filename.chop_extension output_name in 620 620 let temps = ref [] in 621 621 let c_file = 622 622 - if !Clflags.output_complete_object && not (Filename.check_suffix output_name ".c") 622 622 + if !Clflags.output_complete_object 623 623 + && not (Filename.check_suffix output_name ".c") 623 624 then Filename.temp_file "camlobj" ".c" 624 625 else begin 625 626 let f = basename ^ ".c" in

+6 -3

bytecomp/emitcode.ml

reviewed

··· 39 39 40 40 41 41 let report_error ppf (file, kind) = 42 42 - Format.fprintf ppf "Generated %s %S cannot be used on a 32-bit platform" kind file 42 42 + Format.fprintf ppf "Generated %s %S cannot be used on a 32-bit platform" 43 43 + kind file 43 44 let () = 44 45 Location.register_error_of_exn 45 46 (function 46 46 - | Error (Not_compatible_32 info) -> Some (Location.error_of_printer_file report_error info) 47 47 - | _ -> None 47 47 + | Error (Not_compatible_32 info) -> 48 48 + Some (Location.error_of_printer_file report_error info) 49 49 + | _ -> 50 50 + None 48 51 ) 49 52 50 53 (* Buffering of bytecode *)

+5 -3

bytecomp/emitcode.mli

reviewed

··· 27 27 required_globals: list of compilation units that must be 28 28 evaluated before this one 29 29 list of instructions to emit *) 30 30 - val to_memory: instruction list -> instruction list -> 31 31 - Misc.LongString.t * (reloc_info * int) list * debug_event list 30 30 + val to_memory: 31 31 + instruction list -> instruction list -> 32 32 + Misc.LongString.t * (reloc_info * int) list * debug_event list 32 33 (* Arguments: 33 34 initialization code (terminated by STOP) 34 35 function code ··· 46 47 47 48 val reset: unit -> unit 48 49 49 49 - val marshal_to_channel_with_possibly_32bit_compat : filename:string -> kind:string -> out_channel -> 'a -> unit 50 50 + val marshal_to_channel_with_possibly_32bit_compat : 51 51 + filename:string -> kind:string -> out_channel -> 'a -> unit

-1

bytecomp/meta.mli

reviewed

··· 29 29 = "caml_invoke_traced_function" 30 30 external get_section_table : unit -> (string * Obj.t) list 31 31 = "caml_get_section_table" 32 32 -

+2 -1

bytecomp/translcore.ml

reviewed

··· 416 416 | Texp_new (cl, {Location.loc=loc}, _) -> 417 417 Lapply{ap_should_be_tailcall=false; 418 418 ap_loc=loc; 419 419 - ap_func=Lprim(Pfield 0, [transl_class_path ~loc e.exp_env cl], loc); 419 419 + ap_func= 420 420 + Lprim(Pfield 0, [transl_class_path ~loc e.exp_env cl], loc); 420 421 ap_args=[lambda_unit]; 421 422 ap_inlined=Default_inline; 422 423 ap_specialised=Default_specialise}

+11 -3

bytecomp/translmod.ml

reviewed

··· 559 559 transl_structure loc (id :: fields) cc rootpath final_env rem 560 560 in 561 561 Llet(Strict, Pgenval, id, 562 562 - transl_extension_constructor item.str_env path ext.tyexn_constructor, body), 562 562 + transl_extension_constructor item.str_env 563 563 + path 564 564 + ext.tyexn_constructor, body), 563 565 size 564 566 | Tstr_module mb -> 565 567 let id = mb.mb_id in ··· 795 797 | Tstr_include{incl_type; incl_mod={mod_desc = 796 798 Tmod_constraint ({mod_desc = Tmod_structure str}, 797 799 _, _, _)}} -> 798 798 - bound_value_identifiers incl_type @ all_idents str.str_items @ all_idents rem 800 800 + bound_value_identifiers incl_type 801 801 + @ all_idents str.str_items 802 802 + @ all_idents rem 799 803 | Tstr_include incl -> 800 804 bound_value_identifiers incl.incl_type @ all_idents rem 801 805 ··· 873 877 | Tstr_exception ext -> 874 878 let id = ext.tyexn_constructor.ext_id in 875 879 let path = field_path rootpath id in 876 876 - let lam = transl_extension_constructor item.str_env path ext.tyexn_constructor in 880 880 + let lam = 881 881 + transl_extension_constructor item.str_env 882 882 + path 883 883 + ext.tyexn_constructor 884 884 + in 877 885 Lsequence(Llet(Strict, Pgenval, id, Lambda.subst subst lam, 878 886 store_ident ext.tyexn_constructor.ext_loc id), 879 887 transl_store rootpath (add_ident false id subst) rem)

+3 -2

byterun/backtrace_prim.c

reviewed

··· 109 109 return 0; 110 110 } 111 111 112 112 - static struct ev_info *process_debug_events(code_t code_start, value events_heap, 113 113 - mlsize_t *num_events) 112 112 + static struct ev_info *process_debug_events(code_t code_start, 113 113 + value events_heap, 114 114 + mlsize_t *num_events) 114 115 { 115 116 CAMLparam1(events_heap); 116 117 CAMLlocal3(l, ev, ev_start);

+1 -1

byterun/caml/gc.h

reviewed

··· 40 40 41 41 /* This depends on the layout of the header. See [mlvalues.h]. */ 42 42 #define Make_header(wosize, tag, color) \ 43 43 - (/*CAMLassert ((wosize) <= Max_wosize),*/ \ 43 43 + (/*CAMLassert ((wosize) <= Max_wosize),*/ \ 44 44 ((header_t) (((header_t) (wosize) << 10) \ 45 45 + (color) \ 46 46 + (tag_t) (tag))) \

+1 -1

byterun/caml/instrtrace.h

reviewed

··· 27 27 void caml_stop_here (void); 28 28 void caml_disasm_instr (code_t pc); 29 29 void caml_trace_value_file (value v, code_t prog, asize_t proglen, FILE * f); 30 30 - void caml_trace_accu_sp_file(value accu, value * sp, code_t prog, 30 30 + void caml_trace_accu_sp_file(value accu, value * sp, code_t prog, 31 31 asize_t proglen, FILE * f); 32 32 33 33 #endif /* CAML_INTERNALS */

+3 -2

byterun/caml/memory.h

reviewed

··· 102 102 */ 103 103 CAMLextern caml_stat_block caml_stat_alloc(asize_t); 104 104 105 105 - /* [caml_stat_alloc_noexc(size)] allocates a memory block of the requested [size] 106 106 - (in bytes) and returns a pointer to it, or NULL in case the request fails. 105 105 + /* [caml_stat_alloc_noexc(size)] allocates a memory block of the requested 106 106 + [size] (in bytes) and returns a pointer to it, or NULL in case the request 107 107 + fails. 107 108 */ 108 109 CAMLextern caml_stat_block caml_stat_alloc_noexc(asize_t); 109 110

+2 -1

byterun/caml/misc.h

reviewed

··· 357 357 extern void caml_ext_table_free(struct ext_table * tbl, int free_entries); 358 358 extern void caml_ext_table_clear(struct ext_table * tbl, int free_entries); 359 359 360 360 - CAMLextern int caml_read_directory(char_os * dirname, struct ext_table * contents); 360 360 + CAMLextern int caml_read_directory(char_os * dirname, 361 361 + struct ext_table * contents); 361 362 362 363 /* Deprecated aliases */ 363 364 #define caml_aligned_malloc caml_stat_alloc_aligned_noexc

+12 -4

byterun/caml/osdeps.h

reviewed

··· 52 52 53 53 /* Search the given file in the given list of directories. 54 54 If not found, return a copy of [name]. */ 55 55 - extern char_os * caml_search_in_path(struct ext_table * path, const char_os * name); 55 55 + extern char_os * caml_search_in_path(struct ext_table * path, 56 56 + const char_os * name); 56 57 57 58 /* Same, but search an executable name in the system path for executables. */ 58 59 CAMLextern char_os * caml_search_exe_in_path(const char_os * name); 59 60 60 61 /* Same, but search a shared library in the given path. */ 61 61 - extern char_os * caml_search_dll_in_path(struct ext_table * path, const char_os * name); 62 62 + extern char_os * caml_search_dll_in_path(struct ext_table * path, 63 63 + const char_os * name); 62 64 63 65 /* Open a shared library and return a handle on it. 64 66 If [for_execution] is true, perform full symbol resolution and ··· 115 117 116 118 /* Windows Unicode support */ 117 119 118 118 - extern int win_multi_byte_to_wide_char(const char* s, int slen, wchar_t *out, int outlen); 119 119 - extern int win_wide_char_to_multi_byte(const wchar_t* s, int slen, char *out, int outlen); 120 120 + extern int win_multi_byte_to_wide_char(const char* s, 121 121 + int slen, 122 122 + wchar_t *out, 123 123 + int outlen); 124 124 + extern int win_wide_char_to_multi_byte(const wchar_t* s, 125 125 + int slen, 126 126 + char *out, 127 127 + int outlen); 120 128 121 129 /* [caml_stat_strdup_to_utf16(s)] returns a NULL-terminated copy of [s], 122 130 re-encoded in UTF-16. The encoding of [s] is assumed to be UTF-8 if

+1 -1

byterun/compact.c

reviewed

··· 333 333 }else{ 334 334 CAMLassert (Ecolor (q) == 3); 335 335 /* This is guaranteed only if caml_compact_heap was called after a 336 336 - nonincremental major GC: CAMLassert (Tag_ehd (q) == String_tag); 336 336 + nonincremental major GC: CAMLassert (Tag_ehd (q) == String_tag); 337 337 */ 338 338 /* No pointers to the header and no infix header: 339 339 the object was free. */

+2 -1

byterun/extern.c

reviewed

··· 179 179 180 180 if (extern_flags & NO_SHARING) return; 181 181 if (extern_trail_cur == extern_trail_limit) { 182 182 - struct trail_block * new_block = caml_stat_alloc_noexc(sizeof(struct trail_block)); 182 182 + struct trail_block * new_block = 183 183 + caml_stat_alloc_noexc(sizeof(struct trail_block)); 183 184 if (new_block == NULL) extern_out_of_memory(); 184 185 new_block->previous = extern_trail_block; 185 186 extern_trail_block = new_block;

+3 -2

byterun/gc_ctrl.c

reviewed

··· 201 201 && Wosize_hp (prev_hp) > 0) 202 202 || cur_hp == caml_gc_sweep_hp); 203 203 CAMLassert (Next (cur_hp) == chunk_end 204 204 - || (Color_hp (Next (cur_hp)) != Caml_blue 204 204 + || (Color_hp (Next (cur_hp)) != Caml_blue 205 205 && Wosize_hp (Next (cur_hp)) > 0) 206 206 || (Whsize_hd (cur_hd) + Wosize_hp (Next (cur_hp)) 207 207 > Max_wosize) ··· 651 651 652 652 CAMLassert (unit == Val_unit); 653 653 return caml_alloc_sprintf 654 654 - ("a=%d,b=%d,H=%"F_Z"u,i=%"F_Z"u,l=%"F_Z"u,o=%"F_Z"u,O=%"F_Z"u,p=%d,s=%"F_S"u,t=%"F_Z"u,v=%"F_Z"u,w=%d,W=%"F_Z"u", 654 654 + ("a=%d,b=%d,H=%"F_Z"u,i=%"F_Z"u,l=%"F_Z"u,o=%"F_Z"u,O=%"F_Z"u,p=%d," 655 655 + "s=%"F_S"u,t=%"F_Z"u,v=%"F_Z"u,w=%d,W=%"F_Z"u", 655 656 /* a */ (int) caml_allocation_policy, 656 657 /* b */ caml_backtrace_active, 657 658 /* h */ /* missing */ /* FIXME add when changed to min_heap_size */

+2 -1

byterun/intern.c

reviewed

··· 612 612 } 613 613 obj_counter = 0; 614 614 if (num_objects > 0) { 615 615 - intern_obj_table = (value *) caml_stat_alloc_noexc(num_objects * sizeof(value)); 615 615 + intern_obj_table = 616 616 + (value *) caml_stat_alloc_noexc(num_objects * sizeof(value)); 616 617 if (intern_obj_table == NULL) { 617 618 intern_cleanup(); 618 619 caml_raise_out_of_memory();

+1 -1

byterun/major_gc.c

reviewed

··· 231 231 } 232 232 233 233 /* auxillary function of mark_slice */ 234 234 - static inline value* mark_slice_darken(value *gray_vals_ptr, 234 234 + static inline value* mark_slice_darken(value *gray_vals_ptr, 235 235 value v, mlsize_t i, 236 236 int in_ephemeron, int *slice_pointers) 237 237 {

+3 -1

byterun/meta.c

reviewed

··· 85 85 CAMLreturnT (char*, ret); 86 86 } 87 87 88 88 - CAMLprim value caml_reify_bytecode(value ls_prog, value debuginfo, value digest_opt) 88 88 + CAMLprim value caml_reify_bytecode(value ls_prog, 89 89 + value debuginfo, 90 90 + value digest_opt) 89 91 { 90 92 CAMLparam3(ls_prog, debuginfo, digest_opt); 91 93 CAMLlocal3(clos, bytecode, retval);

+6 -2

byterun/misc.c

reviewed

··· 266 266 for (p = CAML_INSTR_LOG; p != NULL; p = p->next){ 267 267 for (i = 0; i < p->index; i++){ 268 268 fprintf (f, "@@ %19ld %19ld %s\n", 269 269 - (long) Get_time (p, i), (long) Get_time(p, i+1), p->tag[i+1]); 269 269 + (long) Get_time (p, i), 270 270 + (long) Get_time(p, i+1), 271 271 + p->tag[i+1]); 270 272 } 271 273 if (p->tag[0][0] != '\000'){ 272 274 fprintf (f, "@@ %19ld %19ld %s\n", 273 273 - (long) Get_time (p, 0), (long) Get_time(p, p->index), p->tag[0]); 275 275 + (long) Get_time (p, 0), 276 276 + (long) Get_time(p, p->index), 277 277 + p->tag[0]); 274 278 } 275 279 } 276 280 fclose (f);

+5 -3

byterun/startup.c

reviewed

··· 87 87 fixup_endianness_trailer(&trail->num_sections); 88 88 memcpy(magicstr, trail->magic, EXEC_MAGIC_LENGTH); 89 89 magicstr[EXEC_MAGIC_LENGTH] = 0; 90 90 - 90 90 + 91 91 if (print_magic) { 92 92 printf("%s\n", magicstr); 93 93 exit(0); ··· 202 202 203 203 #ifdef _WIN32 204 204 205 205 - static char_os * read_section_to_os(int fd, struct exec_trailer *trail, char *name) 205 205 + static char_os * read_section_to_os(int fd, struct exec_trailer *trail, 206 206 + char *name) 206 207 { 207 208 int32_t len, wlen; 208 209 char * data; ··· 380 381 fd = caml_attempt_open(&exe_name, &trail, 1); 381 382 switch(fd) { 382 383 case FILE_NOT_FOUND: 383 383 - caml_fatal_error("cannot find file '%s'", caml_stat_strdup_of_os(argv[pos])); 384 384 + caml_fatal_error("cannot find file '%s'", 385 385 + caml_stat_strdup_of_os(argv[pos])); 384 386 break; 385 387 case BAD_BYTECODE: 386 388 caml_fatal_error(

+2 -1

byterun/startup_aux.c

reviewed

··· 89 89 while (*opt != _T('\0')){ 90 90 switch (*opt++){ 91 91 case _T('a'): scanmult (opt, &p); caml_set_allocation_policy (p); break; 92 92 - case _T('b'): scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); break; 92 92 + case _T('b'): scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); 93 93 + break; 93 94 case _T('c'): scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break; 94 95 case _T('h'): scanmult (opt, &caml_init_heap_wsz); break; 95 96 case _T('H'): scanmult (opt, &caml_use_huge_pages); break;

+5 -2

byterun/sys.c

reviewed

··· 381 381 CAMLparam0 (); /* unit is unused */ 382 382 CAMLlocal3 (exe_name, argv, res); 383 383 exe_name = caml_copy_string_of_os(caml_exe_name); 384 384 - argv = caml_alloc_array((void *)caml_copy_string_of_os, (char const **) caml_main_argv); 384 384 + argv = 385 385 + caml_alloc_array((void *)caml_copy_string_of_os, 386 386 + (char const **) caml_main_argv); 385 387 res = caml_alloc_small(2, 0); 386 388 Field(res, 0) = exe_name; 387 389 Field(res, 1) = argv; ··· 483 485 484 486 CAMLprim value caml_sys_time_include_children(value include_children) 485 487 { 486 486 - return caml_copy_double(caml_sys_time_include_children_unboxed(include_children)); 488 488 + return caml_copy_double( 489 489 + caml_sys_time_include_children_unboxed(include_children)); 487 490 } 488 491 489 492 double caml_sys_time_unboxed(value unit) {

+4 -4

byterun/unix.c

reviewed

··· 172 172 return ret == 0 && S_ISREG(st.st_mode); 173 173 } 174 174 175 175 - static caml_stat_string cygwin_search_exe_in_path(struct ext_table * path, const char * name) 175 175 + static caml_stat_string cygwin_search_exe_in_path(struct ext_table * path, 176 176 + const char * name) 176 177 { 177 178 const char * p; 178 179 char * dir, * fullname; ··· 219 220 return res; 220 221 } 221 222 222 222 - caml_stat_string caml_search_dll_in_path(struct ext_table * path, const char * name) 223 223 + caml_stat_string caml_search_dll_in_path(struct ext_table * path, 224 224 + const char * name) 223 225 { 224 226 caml_stat_string dllname; 225 227 caml_stat_string res; ··· 443 445 return -1; 444 446 #endif 445 447 } 446 446 - 447 447 -

+34 -16

byterun/win32.c

reviewed

··· 342 342 { 343 343 if (argc + 1 >= argvsize) { 344 344 argvsize *= 2; 345 345 - argv = (wchar_t **) caml_stat_resize_noexc(argv, argvsize * sizeof(wchar_t *)); 345 345 + argv = 346 346 + (wchar_t **) caml_stat_resize_noexc(argv, argvsize * sizeof(wchar_t *)); 346 347 if (argv == NULL) out_of_memory(); 347 348 } 348 349 argv[argc++] = arg; ··· 380 381 wchar_t c = prefix[i - 1]; 381 382 if (c == L'\\' || c == L'/' || c == L':') { prefix[i] = 0; break; } 382 383 } 383 383 - /* No separator was found, it's a filename pattern without a leading directory. */ 384 384 + /* No separator was found, it's a filename pattern without a leading 385 385 + directory. */ 384 386 if (i == 0) 385 387 prefix[0] = 0; 386 388 do { ··· 828 830 the argument string is encoded in the local codepage. */ 829 831 static uintnat windows_unicode_fallback = 1; 830 832 831 831 - CAMLexport int win_multi_byte_to_wide_char(const char *s, int slen, wchar_t *out, int outlen) 833 833 + CAMLexport int win_multi_byte_to_wide_char(const char *s, int slen, 834 834 + wchar_t *out, int outlen) 832 835 { 833 836 int retcode; 834 837 ··· 838 841 return 0; 839 842 840 843 if (windows_unicode_enabled != 0) { 841 841 - retcode = MultiByteToWideChar(CP_UTF8, windows_unicode_strict ? MB_ERR_INVALID_CHARS : 0, s, slen, out, outlen); 844 844 + retcode = 845 845 + MultiByteToWideChar(CP_UTF8, 846 846 + windows_unicode_strict ? MB_ERR_INVALID_CHARS : 0, 847 847 + s, slen, out, outlen); 842 848 if (retcode == 0 && windows_unicode_fallback != 0) 843 849 retcode = MultiByteToWideChar(CP_THREAD_ACP, 0, s, slen, out, outlen); 844 850 } else { ··· 851 857 return retcode; 852 858 } 853 859 854 854 - #ifndef WC_ERR_INVALID_CHARS /* For old versions of Windows we simply ignore the flag */ 860 860 + /* For old versions of Windows we simply ignore the flag */ 861 861 + #ifndef WC_ERR_INVALID_CHARS 855 862 #define WC_ERR_INVALID_CHARS 0 856 863 #endif 857 864 858 858 - CAMLexport int win_wide_char_to_multi_byte(const wchar_t *s, int slen, char *out, int outlen) 865 865 + CAMLexport int win_wide_char_to_multi_byte(const wchar_t *s, int slen, 866 866 + char *out, int outlen) 859 867 { 860 868 int retcode; 861 869 ··· 865 873 return 0; 866 874 867 875 if (windows_unicode_enabled != 0) 868 868 - retcode = WideCharToMultiByte(CP_UTF8, windows_unicode_strict ? WC_ERR_INVALID_CHARS : 0, s, slen, out, outlen, NULL, NULL); 876 876 + retcode = 877 877 + WideCharToMultiByte(CP_UTF8, 878 878 + windows_unicode_strict ? WC_ERR_INVALID_CHARS : 0, 879 879 + s, slen, out, outlen, NULL, NULL); 869 880 else 870 870 - retcode = WideCharToMultiByte(CP_THREAD_ACP, 0, s, slen, out, outlen, NULL, NULL); 881 881 + retcode = 882 882 + WideCharToMultiByte(CP_THREAD_ACP, 0, s, slen, out, outlen, NULL, NULL); 871 883 872 884 if (retcode == 0) 873 885 caml_win32_sys_error(GetLastError()); ··· 881 893 value v; 882 894 883 895 slen = wcslen(s); 884 884 - retcode = win_wide_char_to_multi_byte(s, slen, NULL, 0); /* Do not include final NULL */ 896 896 + /* Do not include final NULL */ 897 897 + retcode = win_wide_char_to_multi_byte(s, slen, NULL, 0); 885 898 v = caml_alloc_string(retcode); 886 899 win_wide_char_to_multi_byte(s, slen, String_val(v), retcode); 887 900 ··· 963 976 { 964 977 char buffer[1024]; 965 978 FILE_NAME_INFO * nameinfo = (FILE_NAME_INFO *) buffer; 966 966 - static tGetFileInformationByHandleEx pGetFileInformationByHandleEx = INVALID_HANDLE_VALUE; 979 979 + static tGetFileInformationByHandleEx pGetFileInformationByHandleEx = 980 980 + INVALID_HANDLE_VALUE; 967 981 968 982 if (pGetFileInformationByHandleEx == INVALID_HANDLE_VALUE) 969 983 pGetFileInformationByHandleEx = 970 970 - (tGetFileInformationByHandleEx)GetProcAddress(GetModuleHandle(L"KERNEL32.DLL"), 971 971 - "GetFileInformationByHandleEx"); 984 984 + (tGetFileInformationByHandleEx)GetProcAddress( 985 985 + GetModuleHandle(L"KERNEL32.DLL"), "GetFileInformationByHandleEx"); 972 986 973 987 if (pGetFileInformationByHandleEx == NULL) 974 988 return 0; 975 989 976 976 - /* Get pipe name. GetFileInformationByHandleEx does not NULL-terminate the string, so reduce 977 977 - the buffer size to allow for adding one. */ 978 978 - if (! pGetFileInformationByHandleEx(hFile, FileNameInfo, buffer, sizeof(buffer) - sizeof(WCHAR))) 990 990 + /* Get pipe name. GetFileInformationByHandleEx does not NULL-terminate the 991 991 + string, so reduce the buffer size to allow for adding one. */ 992 992 + if (! pGetFileInformationByHandleEx(hFile, 993 993 + FileNameInfo, 994 994 + buffer, 995 995 + sizeof(buffer) - sizeof(WCHAR))) 979 996 return 0; 980 997 981 998 nameinfo->FileName[nameinfo->FileNameLength / sizeof(WCHAR)] = L'\0'; ··· 983 1000 /* check if this could be a msys pty pipe ('msys-XXXX-ptyN-XX') 984 1001 or a cygwin pty pipe ('cygwin-XXXX-ptyN-XX') */ 985 1002 if ((wcsstr(nameinfo->FileName, L"msys-") || 986 986 - wcsstr(nameinfo->FileName, L"cygwin-")) && wcsstr(nameinfo->FileName, L"-pty")) 1003 1003 + wcsstr(nameinfo->FileName, L"cygwin-")) && 1004 1004 + wcsstr(nameinfo->FileName, L"-pty")) 987 1005 return 1; 988 1006 989 1007 return 0;

+2 -1

config/Makefile.mingw

reviewed

··· 115 115 CFLAGS=-O -mms-bitfields -Wall -Wno-unused -fno-tree-vrp 116 116 # -fno-tree-vrp is here to try to work around the Skylake/Kaby lake bug, 117 117 # and only works on GCC 4.2 and later. 118 118 - CPPFLAGS=-DCAML_NAME_SPACE -DUNICODE -D_UNICODE -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 118 118 + CPPFLAGS=-DCAML_NAME_SPACE -DUNICODE -D_UNICODE \ 119 119 + -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 119 120 OCAMLC_CFLAGS=-O -mms-bitfields 120 121 121 122 BYTECCDBGCOMPOPTS=-g

+2 -1

config/Makefile.mingw64

reviewed

··· 115 115 CFLAGS=-O -mms-bitfields -Wall -Wno-unused -fno-tree-vrp 116 116 # -fno-tree-vrp is here to try to work around the Skylake/Kaby lake bug, 117 117 # and only works on GCC 4.2 and later. 118 118 - CPPFLAGS=-DCAML_NAME_SPACE -DUNICODE -D_UNICODE -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 118 118 + CPPFLAGS=-DCAML_NAME_SPACE -DUNICODE -D_UNICODE \ 119 119 + -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 119 120 OCAMLC_CFLAGS=-O -mms-bitfields 120 121 121 122 BYTECCDBGCOMPOPTS=-g

+4 -3

config/Makefile.msvc

reviewed

··· 106 106 ### Which C compiler to use for the bytecode interpreter. 107 107 CC=cl 108 108 CFLAGS=-nologo -O2 -Gy- -MD 109 109 - CPPFLAGS=-D_CRT_SECURE_NO_DEPRECATE -DCAML_NAME_SPACE -DUNICODE -D_UNICODE -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 109 109 + CPPFLAGS=-D_CRT_SECURE_NO_DEPRECATE -DCAML_NAME_SPACE -DUNICODE -D_UNICODE \ 110 110 + -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 110 111 OCAMLC_CFLAGS=-nologo -O2 -Gy- -MD 111 112 OCAMLC_CPPFLAGS=-D_CRT_SECURE_NO_DEPRECATE 112 113 BYTECCDBGCOMPOPTS=-Zi ··· 145 146 MERGEMANIFESTEXE=test ! -f $(1).manifest \ 146 147 || mt -nologo -outputresource:$(1) -manifest $(1).manifest \ 147 148 && rm -f $(1).manifest 148 148 - MKEXE_BOOT=$(CC) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) /link /subsystem:console $(LDFLAGS) \ 149 149 - && ($(MERGEMANIFESTEXE)) 149 149 + MKEXE_BOOT=$(CC) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) /link /subsystem:console \ 150 150 + $(LDFLAGS) && ($(MERGEMANIFESTEXE)) 150 151 151 152 ### Native command to build an ANSI executable 152 153 MKEXE_ANSI=$(FLEXLINK) -exe

+4 -3

config/Makefile.msvc64

reviewed

··· 105 105 ### Which C compiler to use for the bytecode interpreter. 106 106 CC=cl 107 107 CFLAGS=-nologo -O2 -Gy- -MD 108 108 - CPPFLAGS=-D_CRT_SECURE_NO_DEPRECATE -DCAML_NAME_SPACE -DUNICODE -D_UNICODE -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 108 108 + CPPFLAGS=-D_CRT_SECURE_NO_DEPRECATE -DCAML_NAME_SPACE -DUNICODE -D_UNICODE \ 109 109 + -DWINDOWS_UNICODE=$(WINDOWS_UNICODE) 109 110 OCAMLC_CFLAGS=-nologo -O2 -Gy- -MD 110 111 OCAMLC_CPPFLAGS=-D_CRT_SECURE_NO_DEPRECATE 111 112 ··· 147 148 MERGEMANIFESTEXE=test ! -f $(1).manifest \ 148 149 || mt -nologo -outputresource:$(1) -manifest $(1).manifest \ 149 150 && rm -f $(1).manifest 150 150 - MKEXE_BOOT=$(CC) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) /link /subsystem:console $(LDFLAGS) \ 151 151 - && ($(MERGEMANIFESTEXE)) 151 151 + MKEXE_BOOT=$(CC) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) /link /subsystem:console \ 152 152 + $(LDFLAGS) && ($(MERGEMANIFESTEXE)) 152 153 153 154 ### Native command to build an ANSI executable 154 155 MKEXE_ANSI=$(FLEXLINK) -exe

+2 -1

configure

reviewed

··· 2182 2182 inf "Directories where OCaml will be installed:" 2183 2183 inf " binaries.................. $bindir" 2184 2184 inf " standard library.......... $libdir" 2185 2185 - inf " manual pages.............. $mandir (with extension .$programs_man_section)" 2185 2185 + inf " manual pages.............. $mandir (with extension" \ 2186 2186 + ".$programs_man_section)" 2186 2187 2187 2188 inf "Configuration for the bytecode compiler:" 2188 2189 inf " C compiler used........... $cc"

+2 -1

driver/compenv.ml

reviewed

··· 235 235 236 236 | "pp" -> preprocessor := Some v 237 237 | "runtime-variant" -> runtime_variant := v 238 238 - | "open" -> open_modules := List.rev_append (String.split_on_char ',' v) !open_modules 238 238 + | "open" -> 239 239 + open_modules := List.rev_append (String.split_on_char ',' v) !open_modules 239 240 | "cc" -> c_compiler := Some v 240 241 241 242 | "clambda-checks" -> set "clambda-checks" [ clambda_checks ] v

+2 -1

driver/compile.ml

reviewed

··· 38 38 if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast; 39 39 Profile.(record_call typing) (fun () -> 40 40 let tsg = Typemod.type_interface sourcefile initial_env ast in 41 41 - if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; 41 41 + if !Clflags.dump_typedtree then 42 42 + fprintf ppf "%a@." Printtyped.interface tsg; 42 43 let sg = tsg.sig_type in 43 44 if !Clflags.print_types then 44 45 Printtyp.wrap_printing_env ~error:false initial_env (fun () ->

+1 -1

driver/main.ml

reviewed

··· 109 109 let _nopervasives = set nopervasives 110 110 let _match_context_rows n = match_context_rows := n 111 111 let _dno_unique_ids = unset unique_ids 112 112 - let _dunique_ids = set unique_ids 112 112 + let _dunique_ids = set unique_ids 113 113 let _dsource = set dump_source 114 114 let _dparsetree = set dump_parsetree 115 115 let _dtypedtree = set dump_typedtree

+2 -1

driver/optcompile.ml

reviewed

··· 38 38 if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast; 39 39 Profile.(record_call typing) (fun () -> 40 40 let tsg = Typemod.type_interface sourcefile initial_env ast in 41 41 - if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; 41 41 + if !Clflags.dump_typedtree then 42 42 + fprintf ppf "%a@." Printtyped.interface tsg; 42 43 let sg = tsg.sig_type in 43 44 if !Clflags.print_types then 44 45 Printtyp.wrap_printing_env ~error:false initial_env (fun () ->

+2 -1

driver/optmain.ml

reviewed

··· 244 244 Clflags.add_arguments __LOC__ (Arch.command_line_options @ Options.list); 245 245 Clflags.add_arguments __LOC__ 246 246 ["-depend", Arg.Unit Makedepend.main_from_option, 247 247 - "<options> Compute dependencies (use 'ocamlopt -depend -help' for details)"]; 247 247 + "<options> Compute dependencies \ 248 248 + (use 'ocamlopt -depend -help' for details)"]; 248 249 Clflags.parse_arguments anonymous usage; 249 250 Compmisc.read_color_env ppf; 250 251 if !gprofile && not Config.profiling then

+12 -6

lex/outputbis.ml

reviewed

··· 31 31 let output_auto_defs ctx = 32 32 if ctx.has_refill then begin 33 33 pr ctx "\n"; 34 34 - pr ctx "let rec __ocaml_lex_refill_buf lexbuf _buf _len _curr _last _last_action state k =\n"; 34 34 + pr ctx "let rec __ocaml_lex_refill_buf lexbuf _buf _len _curr _last \ 35 35 + _last_action state k =\n"; 35 36 pr ctx " if lexbuf.Lexing.lex_eof_reached then\n"; 36 37 pr ctx " state lexbuf _last_action _buf _len _curr _last k 256\n"; 37 38 pr ctx " else begin\n"; ··· 44 45 pr ctx " let _len = lexbuf.Lexing.lex_buffer_len in\n"; 45 46 pr ctx " let _buf = lexbuf.Lexing.lex_buffer in\n"; 46 47 pr ctx " if _curr < _len then\n"; 47 47 - pr ctx " state lexbuf _last_action _buf _len (_curr + 1) _last k\n"; 48 48 + pr ctx " state lexbuf _last_action _buf _len (_curr + 1) \ 49 49 + _last k\n"; 48 50 pr ctx " (Char.code (Bytes.unsafe_get _buf _curr))\n"; 49 51 pr ctx " else\n"; 50 50 - pr ctx " __ocaml_lex_refill_buf lexbuf _buf _len _curr _last _last_action\n"; 52 52 + pr ctx " __ocaml_lex_refill_buf lexbuf _buf _len _curr _last \ 53 53 + _last_action\n"; 51 54 pr ctx " state k\n"; 52 55 pr ctx " )\n"; 53 56 pr ctx " lexbuf\n"; ··· 67 70 pr ctx " let _len = lexbuf.Lexing.lex_buffer_len in\n"; 68 71 pr ctx " let _buf = lexbuf.Lexing.lex_buffer in\n"; 69 72 pr ctx " if _curr < _len then\n"; 70 70 - pr ctx " Char.code (Bytes.unsafe_get _buf _curr), _buf, _len, (_curr + 1), _last\n"; 73 73 + pr ctx " Char.code (Bytes.unsafe_get _buf _curr), _buf, _len, \ 74 74 + (_curr + 1), _last\n"; 71 75 pr ctx " else\n"; 72 76 pr ctx " __ocaml_lex_refill_buf lexbuf _buf _len _curr _last\n"; 73 77 pr ctx " end\n"; ··· 220 224 output_moves ctx pref move; 221 225 pr ctx "%sin\n\ 222 226 %sif _curr >= _len then\n\ 223 223 - %s __ocaml_lex_refill_buf lexbuf _buf _len _curr _last _last_action state k\n\ 227 227 + %s __ocaml_lex_refill_buf lexbuf _buf _len _curr _last \ 228 228 + _last_action state k\n\ 224 229 %selse\n\ 225 230 %s state lexbuf _last_action _buf _len (_curr + 1) _last k\n\ 226 231 %s (Char.code (Bytes.unsafe_get _buf _curr))\n" ··· 279 284 pr ctx "%s lexbuf.Lexing.lex_start_p <- _curr_p;\n" pref; 280 285 pr ctx "%s lexbuf.Lexing.lex_curr_p <-\n" pref; 281 286 pr ctx "%s {_curr_p with Lexing.pos_cnum =\n" pref; 282 282 - pr ctx "%s lexbuf.Lexing.lex_abs_pos+lexbuf.Lexing.lex_curr_pos}\n" pref; 287 287 + pr ctx "%s lexbuf.Lexing.lex_abs_pos+lexbuf.Lexing.lex_curr_pos}\n" 288 288 + pref; 283 289 pr ctx "%s end\n" pref; 284 290 pr ctx "%send;\n" pref; 285 291 pr ctx "%smatch __ocaml_lex_result with\n" pref;

+4 -4

man/ocamldep.m

reviewed

··· 158 158 .BI \-plugin \ plugin 159 159 Dynamically load the code of the given 160 160 .I plugin 161 161 - (a .cmo, .cma or .cmxs file) in 161 161 + (a .cmo, .cma or .cmxs file) in 162 162 .BR ocamldep (1). 163 163 The plugin must exist in 164 164 the same kind of code as the tool ( 165 165 - .BR ocamldep.byte 165 165 + .BR ocamldep.byte 166 166 must load bytecode 167 167 - plugins, while 167 167 + plugins, while 168 168 .BR ocamldep.opt 169 169 must load native code plugins), and 170 170 extension adaptation is done automatically for .cma files (to .cmxs files 171 171 - if 171 171 + if 172 172 .BR ocamldep (1) 173 173 is compiled in native code). 174 174 .TP

+17 -10

middle_end/inlining_decision.ml

reviewed

··· 541 541 let try_inlining = 542 542 if self_call then 543 543 Don't_try_it S.Not_inlined.Self_call 544 544 - else if not (E.inlining_allowed env function_decl.closure_origin) then 545 545 - Don't_try_it S.Not_inlined.Unrolling_depth_exceeded 546 544 else 547 547 - Try_it 545 545 + if not (E.inlining_allowed env function_decl.closure_origin) then 546 546 + Don't_try_it S.Not_inlined.Unrolling_depth_exceeded 547 547 + else 548 548 + Try_it 548 549 in 549 550 match try_inlining with 550 551 | Don't_try_it decision -> Original decision ··· 553 554 let body, r = 554 555 Inlining_transforms.inline_by_copying_function_body ~env 555 556 ~r ~function_body ~lhs_of_application 556 556 - ~closure_id_being_applied ~specialise_requested ~inline_requested 557 557 - ~function_decl ~fun_vars ~args ~dbg ~simplify 557 557 + ~closure_id_being_applied ~specialise_requested 558 558 + ~inline_requested ~function_decl ~fun_vars ~args ~dbg ~simplify 558 559 in 559 560 let env = E.note_entering_inlined env in 560 561 let env = 561 562 (* We decrement the unrolling count even if the function is not 562 563 recursive to avoid having to check whether or not it is 563 564 recursive *) 564 564 - E.inside_unrolled_function env function_decls.set_of_closures_origin 565 565 + E.inside_unrolled_function env 566 566 + function_decls.set_of_closures_origin 567 567 + in 568 568 + let env = 569 569 + E.inside_inlined_function env function_decl.closure_origin 565 570 in 566 566 - let env = E.inside_inlined_function env function_decl.closure_origin in 567 571 Changed ((simplify env r body), S.Inlined.Classic_mode) 568 572 in 569 573 let res, decision = ··· 619 623 Inline_and_simplify_aux.initial_inlining_toplevel_threshold 620 624 ~round:(E.round env) 621 625 else 622 622 - Inline_and_simplify_aux.initial_inlining_threshold ~round:(E.round env) 626 626 + Inline_and_simplify_aux.initial_inlining_threshold 627 627 + ~round:(E.round env) 623 628 in 624 629 let unthrottled_inlining_threshold = 625 630 match raw_inlining_threshold with ··· 680 685 let size_from_approximation = 681 686 let fun_var = Closure_id.unwrap closure_id_being_applied in 682 687 match 683 683 - Variable.Map.find fun_var (Lazy.force value_set_of_closures.size) 688 688 + Variable.Map.find fun_var 689 689 + (Lazy.force value_set_of_closures.size) 684 690 with 685 691 | size -> size 686 692 | exception Not_found -> 687 693 Misc.fatal_errorf "Approximation does not give a size for the \ 688 688 - function having fun_var %a. value_set_of_closures: %a" 694 694 + function having fun_var %a. \ 695 695 + value_set_of_closures: %a" 689 696 Variable.print fun_var 690 697 A.print_value_set_of_closures value_set_of_closures 691 698 in

+2 -2

middle_end/inlining_transforms.ml

reviewed

··· 508 508 match expr with 509 509 | Apply ({ kind = Direct closure_id } as apply) -> begin 510 510 match 511 511 - rewrite_direct_call ~specialised_args ~funs ~direct_call_surrogates 512 512 - ~state:!state_ref ~closure_id ~apply 511 511 + rewrite_direct_call ~specialised_args ~funs 512 512 + ~direct_call_surrogates ~state:!state_ref ~closure_id ~apply 513 513 with 514 514 | None -> expr 515 515 | Some (state, expr) ->

+2 -2

middle_end/middle_end.ml

reviewed

··· 125 125 +-+ ("Lift_constants", Lift_constants.lift_constants ~backend) 126 126 +-+ ("Share_constants", Share_constants.share_constants) 127 127 +-+ ("Remove_unused_program_constructs", 128 128 - Remove_unused_program_constructs.remove_unused_program_constructs) 128 128 + Remove_unused_program_constructs.remove_unused_program_constructs) 129 129 +-+ ("Lift_let_to_initialize_symbol", 130 130 Lift_let_to_initialize_symbol.lift ~backend) 131 131 +-+ ("lift_lets 2", Lift_code.lift_lets) ··· 159 159 +-+ ("Lift_constants", Lift_constants.lift_constants ~backend) 160 160 +-+ ("Share_constants", Share_constants.share_constants) 161 161 +-+ ("Remove_unused_program_constructs", 162 162 - Remove_unused_program_constructs.remove_unused_program_constructs) 162 162 + Remove_unused_program_constructs.remove_unused_program_constructs) 163 163 in 164 164 let flam = 165 165 if !Clflags.classic_inlining then

+2 -1

middle_end/simple_value_approx.ml

reviewed

··· 115 115 116 116 let print_value_set_of_closures ppf 117 117 { function_decls = { funs }; invariant_params; freshening; size; _ } = 118 118 - Format.fprintf ppf "(set_of_closures:@ %a invariant_params=%a freshening=%a size=%a)" 118 118 + Format.fprintf ppf 119 119 + "(set_of_closures:@ %a invariant_params=%a freshening=%a size=%a)" 119 120 (fun ppf -> Variable.Map.iter (fun id _ -> Variable.print ppf id)) funs 120 121 (Variable.Map.print Variable.Set.print) (Lazy.force invariant_params) 121 122 Freshening.Project_var.print freshening

+2 -1

ocamldoc/Makefile.unprefix

reviewed

··· 93 93 cp $< $@ 94 94 95 95 #Extract the pervasives module from stdlib.mli 96 96 - $(STDLIB_UNPREFIXED)/pervasives.mli: $(SRC)/stdlib/stdlib.mli $(STDLIB_UNPREFIXED)/extract_pervasives.awk 96 96 + $(STDLIB_UNPREFIXED)/pervasives.mli: $(SRC)/stdlib/stdlib.mli \ 97 97 + $(STDLIB_UNPREFIXED)/extract_pervasives.awk 97 98 $(AWK) -f $(STDLIB_UNPREFIXED)/extract_pervasives.awk $< > $@ 98 99 99 100 # Build cmis file inside the STDLIB_UNPREFIXED directories

+1 -1

ocamltest/actions.ml

reviewed

··· 27 27 28 28 let make n c = { name = n; body = c; hook = None } 29 29 30 30 - let update action code = { action with body = code } 30 30 + let update action code = { action with body = code } 31 31 32 32 let compare a1 a2 = String.compare a1.name a2.name 33 33

+1 -1

ocamltest/builtin_actions.ml

reviewed

··· 55 55 let reason = "Could not chidir to \"" ^ cwd ^ "\"" in 56 56 let result = Result.fail_with_reason reason in 57 57 (result, env) 58 58 - end) 58 58 + end) 59 59 60 60 let dumpenv = make 61 61 "dumpenv"

+10 -9

ocamltest/ocaml_actions.ml

reviewed

··· 70 70 let binary_modules backend env = 71 71 let extension = Ocaml_backends.module_extension backend in 72 72 filelist env Ocaml_variables.binary_modules extension 73 73 - 73 73 + 74 74 let backend_default_flags env = 75 75 get_backend_value_from_env env 76 76 Ocaml_variables.ocamlc_default_flags ··· 384 384 Ocaml_compilers.ocamlc_byte 385 385 386 386 let setup_ocamlc_opt_build_env = 387 387 - native_action 387 387 + native_action 388 388 (mk_compiler_env_setup 389 389 "setup-ocamlc.opt-build-env" 390 390 Ocaml_compilers.ocamlc_opt) ··· 414 414 415 415 let compile (compiler : Ocaml_compilers.compiler) log env = 416 416 let ocamlsrcdir = Ocaml_directories.srcdir () in 417 417 - match Environments.lookup_nonempty Builtin_variables.commandline env with 417 417 + match Environments.lookup_nonempty Builtin_variables.commandline env with 418 418 | None -> 419 419 begin 420 420 match Environments.lookup_nonempty Ocaml_variables.module_ env with ··· 443 443 what (String.concat " " commandline) exit_status) in 444 444 (Result.fail_with_reason reason, env) 445 445 end 446 446 - 446 446 + 447 447 (* Compile actions *) 448 448 449 449 let ocamlc_byte = ··· 560 560 let what = Printf.sprintf "Running ocamlmklib to produce %s" program in 561 561 Printf.fprintf log "%s\n%!" what; 562 562 let ocamlc_command = 563 563 - String.concat " " 563 563 + String.concat " " 564 564 [ 565 565 Ocaml_commands.ocamlrun_ocamlc ocamlsrcdir; 566 566 Ocaml_flags.stdlib ocamlsrcdir; ··· 644 644 Printf.fprintf log "%s\n%!" what; 645 645 let test_build_directory = 646 646 Actions_helpers.test_build_directory env in 647 647 - let compiler_output = 647 647 + let compiler_output = 648 648 Filename.make_path [test_build_directory; "compiler-output"] 649 649 in 650 650 let env = ··· 671 671 let testfile_basename = Filename.chop_extension testfile in 672 672 let finalise = 673 673 if Ocamltest_config.ccomptype="msvc" 674 674 - then finalise_codegen_msvc 674 674 + then finalise_codegen_msvc 675 675 else finalise_codegen_cc 676 676 in 677 677 finalise ocamlsrcdir testfile_basename log env ··· 977 977 Environments.lookup_as_bool 978 978 Ocaml_variables.ocaml_script_as_argument env 979 979 with 980 980 - | None -> false 980 980 + | None -> false 981 981 | Some b -> b 982 982 in 983 983 let commandline = ··· 1051 1051 Ocaml_variables.c_preprocessor, Ocamltest_config.c_preprocessor; 1052 1052 Ocaml_variables.csc, Ocamltest_config.csc; 1053 1053 Ocaml_variables.csc_flags, Ocamltest_config.csc_flags; 1054 1054 - Ocaml_variables.shared_library_cflags, Ocamltest_config.shared_library_cflags; 1054 1054 + Ocaml_variables.shared_library_cflags, 1055 1055 + Ocamltest_config.shared_library_cflags; 1055 1056 Ocaml_variables.objext, Ocamltest_config.objext; 1056 1057 Ocaml_variables.sharedobjext, Ocamltest_config.sharedobjext; 1057 1058 Ocaml_variables.ocamlc_default_flags,

+1 -1

ocamltest/ocaml_filetypes.ml

reviewed

··· 42 42 | Lexer -> "lexer" 43 43 | Grammar -> "grammar" 44 44 | Binary_interface -> "binary interface" 45 45 - | Obj -> "object" 45 45 + | Obj -> "object" 46 46 | Backend_specific (backend, filetype) -> 47 47 ((Ocaml_backends.string_of_backend backend) ^ " " ^ 48 48 (string_of_backend_specific filetype))

+1 -1

ocamltest/ocaml_tests.ml

reviewed

··· 113 113 114 114 let msvc64 = 115 115 Ocamltest_config.ccomptype = "msvc" && Ocamltest_config.arch="amd64" 116 116 - 116 116 + 117 117 let asmgen_skip_on_msvc64 = 118 118 Actions_helpers.skip_with_reason "not ported to MSVC64 yet" 119 119

+3 -2

ocamltest/ocaml_variables.ml

reviewed

··· 28 28 29 29 let all_modules = make ("all_modules", 30 30 "All the modules to compile and link") 31 31 - 31 31 + 32 32 let binary_modules = make ("binary_modules", 33 33 "Additional binary modules to link") 34 34 ··· 217 217 "Extension of shared object files") 218 218 219 219 let use_runtime = 220 220 - Variables.make ( "use_runtime", "Whether the -use-runtime option should be used" ) 220 220 + Variables.make ("use_runtime", 221 221 + "Whether the -use-runtime option should be used" ) 221 222 222 223 let _ = List.iter register_variable 223 224 [

+5 -2

ocamltest/ocamltest_stdlib_stubs.c

reviewed

··· 60 60 61 61 if (!GetTokenInformation(hProcess, TokenPrivileges, NULL, 0, &length)) { 62 62 if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) { 63 63 - TOKEN_PRIVILEGES* privileges = (TOKEN_PRIVILEGES*)caml_stat_alloc(length); 63 63 + TOKEN_PRIVILEGES* privileges = 64 64 + (TOKEN_PRIVILEGES*)caml_stat_alloc(length); 64 65 if (GetTokenInformation(hProcess, 65 66 TokenPrivileges, 66 67 privileges, ··· 70 71 71 72 if (count) { 72 73 LUID_AND_ATTRIBUTES* privs = privileges->Privileges; 73 73 - while (count-- && !(result = luid_eq(privs->Luid, seCreateSymbolicLinkPrivilege))) 74 74 + while (count-- && 75 75 + !(result = luid_eq(privs->Luid, 76 76 + seCreateSymbolicLinkPrivilege))) 74 77 privs++; 75 78 } 76 79 }

+1 -1

otherlibs/graph/graphics.mli

reviewed

··· 48 48 (** Return the size of the graphics window. Coordinates of the screen 49 49 pixels range over [0 .. size_x()-1] and [0 .. size_y()-1]. 50 50 Drawings outside of this rectangle are clipped, without causing 51 51 - an error. The origin (0,0) is at the lower left corner. 51 51 + an error. The origin (0,0) is at the lower left corner. 52 52 Some implementation (e.g. X Windows) represent coordinates by 53 53 16-bit integers, hence wrong clipping may occur with coordinates 54 54 below [-32768] or above [32676]. *)

+2 -2

otherlibs/graph/open.c

reviewed

··· 374 374 if (graphic_failure_exn == NULL) { 375 375 graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); 376 376 if (graphic_failure_exn == NULL) 377 377 - caml_invalid_argument("Exception Graphics.Graphic_failure not initialized," 378 378 - " must link graphics.cma"); 377 377 + caml_invalid_argument("Exception Graphics.Graphic_failure not " 378 378 + "initialized, must link graphics.cma"); 379 379 } 380 380 sprintf(buffer, fmt, arg); 381 381 caml_raise_with_string(*graphic_failure_exn, buffer);

+4 -2

otherlibs/systhreads/Makefile

reviewed

··· 75 75 76 76 $(LIBNAME).cma: $(THREADS_BCOBJS) 77 77 ifeq "$(UNIX_OR_WIN32)" "unix" 78 78 - $(MKLIB) -o $(LIBNAME) -ocamlc '$(CAMLC)' -cclib -lunix -linkall $(PTHREAD_CAML_LINK) $^ 78 78 + $(MKLIB) -o $(LIBNAME) -ocamlc '$(CAMLC)' -cclib -lunix -linkall \ 79 79 + $(PTHREAD_CAML_LINK) $^ 79 80 # TODO: Figure out why -cclib -lunix is used here. 80 81 # It may be because of the threadsUnix module which is deprecated. 81 82 # It may hence be good to figure out whether this module shouldn't be 82 83 # removed, and then -cclib -lunix arguments. 83 84 else # Windows 84 84 - $(MKLIB) -o $(LIBNAME) -ocamlc "$(CAMLC)" -linkall $(PTHREAD_CAML_LINK) $^ 85 85 + $(MKLIB) -o $(LIBNAME) -ocamlc "$(CAMLC)" -linkall \ 86 86 + $(PTHREAD_CAML_LINK) $^ 85 87 endif 86 88 87 89 # See remark above: force static linking of libthreadsnat.a

+2 -1

otherlibs/systhreads/st_posix.h

reviewed

··· 266 266 rc = pthread_mutex_init(&e->lock, NULL); 267 267 if (rc != 0) { caml_stat_free(e); return rc; } 268 268 rc = pthread_cond_init(&e->triggered, NULL); 269 269 - if (rc != 0) { pthread_mutex_destroy(&e->lock); caml_stat_free(e); return rc; } 269 269 + if (rc != 0) 270 270 + { pthread_mutex_destroy(&e->lock); caml_stat_free(e); return rc; } 270 271 e->status = 0; 271 272 *res = e; 272 273 return 0;

+10 -8

otherlibs/systhreads/st_stubs.c

reviewed

··· 87 87 value* spacetime_finaliser_trie_root; 88 88 #endif 89 89 #else 90 90 - value * stack_low; /* The execution stack for this thread */ 90 90 + value * stack_low; /* The execution stack for this thread */ 91 91 value * stack_high; 92 92 value * stack_threshold; 93 93 - value * sp; /* Saved value of caml_extern_sp for this thread */ 94 94 - value * trapsp; /* Saved value of caml_trapsp for this thread */ 93 93 + value * sp; /* Saved value of caml_extern_sp for this thread */ 94 94 + value * trapsp; /* Saved value of caml_trapsp for this thread */ 95 95 struct caml__roots_block * local_roots; /* Saved value of caml_local_roots */ 96 96 struct longjmp_buffer * external_raise; /* Saved caml_external_raise */ 97 97 #endif 98 98 - int backtrace_pos; /* Saved caml_backtrace_pos */ 99 99 - backtrace_slot * backtrace_buffer; /* Saved caml_backtrace_buffer */ 100 100 - value backtrace_last_exn; /* Saved caml_backtrace_last_exn (root) */ 98 98 + int backtrace_pos; /* Saved caml_backtrace_pos */ 99 99 + backtrace_slot * backtrace_buffer; /* Saved caml_backtrace_buffer */ 100 100 + value backtrace_last_exn; /* Saved caml_backtrace_last_exn (root) */ 101 101 }; 102 102 103 103 typedef struct caml_thread_struct * caml_thread_t; ··· 676 676 677 677 CAMLprim value caml_thread_self(value unit) /* ML */ 678 678 { 679 679 - if (curr_thread == NULL) caml_invalid_argument("Thread.self: not initialized"); 679 679 + if (curr_thread == NULL) 680 680 + caml_invalid_argument("Thread.self: not initialized"); 680 681 return curr_thread->descr; 681 682 } 682 683 ··· 706 707 { 707 708 struct longjmp_buffer * exit_buf = NULL; 708 709 709 709 - if (curr_thread == NULL) caml_invalid_argument("Thread.exit: not initialized"); 710 710 + if (curr_thread == NULL) 711 711 + caml_invalid_argument("Thread.exit: not initialized"); 710 712 711 713 /* In native code, we cannot call pthread_exit here because on some 712 714 systems this raises a C++ exception, and ocamlopt-generated stack

+2 -1

otherlibs/systhreads/st_win32.h

reviewed

··· 381 381 sizeof(err)/sizeof(wchar_t), 382 382 NULL); 383 383 if (! ret) { 384 384 - ret = swprintf(err, sizeof(err)/sizeof(wchar_t), L"error code %lx", retcode); 384 384 + ret = 385 385 + swprintf(err, sizeof(err)/sizeof(wchar_t), L"error code %lx", retcode); 385 386 } 386 387 msglen = strlen(msg); 387 388 errlen = win_wide_char_to_multi_byte(err, ret, NULL, 0);

+17 -15

otherlibs/threads/Makefile

reviewed

··· 38 38 # Object file prefix 39 39 P=stdlib__ 40 40 41 41 - LIB_OBJS=$(LIB)/camlinternalFormatBasics.cmo stdlib.cmo \ 42 42 - $(LIB)/$(P)seq.cmo $(LIB)/$(P)array.cmo $(LIB)/$(P)list.cmo $(LIB)/$(P)char.cmo $(LIB)/$(P)bytes.cmo \ 43 43 - $(LIB)/$(P)string.cmo $(LIB)/$(P)sys.cmo $(LIB)/$(P)sort.cmo marshal.cmo \ 44 44 - $(LIB)/$(P)obj.cmo $(LIB)/$(P)int32.cmo $(LIB)/$(P)int64.cmo \ 45 45 - $(LIB)/$(P)nativeint.cmo $(LIB)/$(P)lexing.cmo $(LIB)/$(P)parsing.cmo \ 46 46 - $(LIB)/$(P)set.cmo $(LIB)/$(P)map.cmo $(LIB)/$(P)stack.cmo $(LIB)/$(P)queue.cmo \ 47 47 - $(LIB)/camlinternalLazy.cmo $(LIB)/$(P)lazy.cmo $(LIB)/$(P)stream.cmo \ 48 48 - $(LIB)/$(P)buffer.cmo $(LIB)/camlinternalFormat.cmo $(LIB)/$(P)printf.cmo \ 49 49 - $(LIB)/$(P)arg.cmo $(LIB)/$(P)printexc.cmo $(LIB)/$(P)gc.cmo $(LIB)/$(P)digest.cmo \ 50 50 - $(LIB)/$(P)random.cmo $(LIB)/$(P)hashtbl.cmo $(LIB)/$(P)format.cmo \ 51 51 - $(LIB)/$(P)scanf.cmo $(LIB)/$(P)callback.cmo $(LIB)/camlinternalOO.cmo \ 52 52 - $(LIB)/$(P)oo.cmo $(LIB)/camlinternalMod.cmo $(LIB)/$(P)genlex.cmo \ 53 53 - $(LIB)/$(P)weak.cmo $(LIB)/$(P)ephemeron.cmo $(LIB)/$(P)filename.cmo \ 54 54 - $(LIB)/$(P)complex.cmo $(LIB)/$(P)arrayLabels.cmo $(LIB)/$(P)listLabels.cmo \ 55 55 - $(LIB)/$(P)bytesLabels.cmo $(LIB)/$(P)stringLabels.cmo \ 41 41 + LIB_OBJS=$(LIB)/camlinternalFormatBasics.cmo stdlib.cmo \ 42 42 + $(LIB)/$(P)seq.cmo $(LIB)/$(P)array.cmo $(LIB)/$(P)list.cmo \ 43 43 + $(LIB)/$(P)char.cmo $(LIB)/$(P)bytes.cmo $(LIB)/$(P)string.cmo \ 44 44 + $(LIB)/$(P)sys.cmo $(LIB)/$(P)sort.cmo marshal.cmo \ 45 45 + $(LIB)/$(P)obj.cmo $(LIB)/$(P)int32.cmo $(LIB)/$(P)int64.cmo \ 46 46 + $(LIB)/$(P)nativeint.cmo $(LIB)/$(P)lexing.cmo $(LIB)/$(P)parsing.cmo \ 47 47 + $(LIB)/$(P)set.cmo $(LIB)/$(P)map.cmo $(LIB)/$(P)stack.cmo \ 48 48 + $(LIB)/$(P)queue.cmo $(LIB)/camlinternalLazy.cmo $(LIB)/$(P)lazy.cmo \ 49 49 + $(LIB)/$(P)stream.cmo $(LIB)/$(P)buffer.cmo $(LIB)/camlinternalFormat.cmo \ 50 50 + $(LIB)/$(P)printf.cmo $(LIB)/$(P)arg.cmo $(LIB)/$(P)printexc.cmo \ 51 51 + $(LIB)/$(P)gc.cmo $(LIB)/$(P)digest.cmo \ 52 52 + $(LIB)/$(P)random.cmo $(LIB)/$(P)hashtbl.cmo $(LIB)/$(P)format.cmo \ 53 53 + $(LIB)/$(P)scanf.cmo $(LIB)/$(P)callback.cmo $(LIB)/camlinternalOO.cmo \ 54 54 + $(LIB)/$(P)oo.cmo $(LIB)/camlinternalMod.cmo $(LIB)/$(P)genlex.cmo \ 55 55 + $(LIB)/$(P)weak.cmo $(LIB)/$(P)ephemeron.cmo $(LIB)/$(P)filename.cmo \ 56 56 + $(LIB)/$(P)complex.cmo $(LIB)/$(P)arrayLabels.cmo $(LIB)/$(P)listLabels.cmo \ 57 57 + $(LIB)/$(P)bytesLabels.cmo $(LIB)/$(P)stringLabels.cmo \ 56 58 $(LIB)/$(P)moreLabels.cmo $(LIB)/$(P)stdLabels.cmo 57 59 58 60 UNIXLIB=../unix

+1 -1

otherlibs/threads/stdlib.ml

reviewed

··· 629 629 (* MPR#7253, MPR#7796: make sure "f" is executed only once *) 630 630 let f_already_ran = ref false in 631 631 exit_function := 632 632 - (fun () -> 632 632 + (fun () -> 633 633 if not !f_already_ran then begin f_already_ran := true; f() end; 634 634 g()) 635 635

+2 -1

otherlibs/threads/unix.ml

reviewed

··· 1061 1061 let (out_read, out_write) = pipe ~cloexec:true () in 1062 1062 let outchan = out_channel_of_descr out_write in 1063 1063 try 1064 1064 - open_proc prog args None (Process(inchan, outchan)) out_read in_write stderr; 1064 1064 + open_proc prog args None 1065 1065 + (Process(inchan, outchan)) out_read in_write stderr; 1065 1066 close out_read; 1066 1067 close in_write; 1067 1068 (inchan, outchan)

+1 -1

otherlibs/unix/access.c

reviewed

··· 37 37 38 38 static int access_permission_table[] = { 39 39 R_OK, 40 40 - W_OK, 40 40 + W_OK, 41 41 #ifdef _WIN32 42 42 /* Since there is no concept of execute permission on Windows, 43 43 we fall b+ack to the read permission */

+2 -1

otherlibs/unix/cstringv.c

reviewed

··· 31 31 if (! caml_string_is_c_safe(Field(arg, i))) 32 32 unix_error(EINVAL, cmdname, Field(arg, i)); 33 33 res = (char_os **) caml_stat_alloc((size + 1) * sizeof(char_os *)); 34 34 - for (i = 0; i < size; i++) res[i] = caml_stat_strdup_to_os(String_val(Field(arg, i))); 34 34 + for (i = 0; i < size; i++) 35 35 + res[i] = caml_stat_strdup_to_os(String_val(Field(arg, i))); 35 36 res[size] = NULL; 36 37 return res; 37 38 }

-1

otherlibs/unix/execvp.c

reviewed

··· 65 65 } 66 66 67 67 #endif 68 68 -

+2 -1

otherlibs/unix/gethost.c

reviewed

··· 70 70 aliases = Atom(0); 71 71 entry_h_length = entry->h_length; 72 72 #ifdef h_addr 73 73 - addr_list = caml_alloc_array(alloc_one_addr, (const char**)entry->h_addr_list); 73 73 + addr_list = 74 74 + caml_alloc_array(alloc_one_addr, (const char**)entry->h_addr_list); 74 75 #else 75 76 adr = alloc_one_addr(entry->h_addr); 76 77 addr_list = caml_alloc_small(1, 0);

+2 -1

otherlibs/unix/getnameinfo.c

reviewed

··· 50 50 getnameinfo((const struct sockaddr *) &addr.s_gen, addr_len, 51 51 host, sizeof(host), serv, sizeof(serv), opts); 52 52 caml_leave_blocking_section(); 53 53 - if (retcode != 0) caml_raise_not_found(); /* TODO: detailed error reporting? */ 53 53 + /* TODO: detailed error reporting? */ 54 54 + if (retcode != 0) caml_raise_not_found(); 54 55 vhost = caml_copy_string(host); 55 56 vserv = caml_copy_string(serv); 56 57 vres = caml_alloc_small(2, 0);

+2 -1

otherlibs/unix/socketaddr.c

reviewed

··· 115 115 mlsize_t path_length = 116 116 strnlen(adr->s_unix.sun_path, 117 117 adr_len - offsetof(struct sockaddr_un, sun_path)); 118 118 - n = caml_alloc_initialized_string(path_length, (char *)adr->s_unix.sun_path); 118 118 + n = caml_alloc_initialized_string(path_length, 119 119 + (char *)adr->s_unix.sun_path); 119 120 Begin_root (n); 120 121 res = caml_alloc_small(1, 0); 121 122 Field(res,0) = n;

+2 -1

otherlibs/unix/unix.ml

reviewed

··· 1057 1057 let outchan = out_channel_of_descr out_write in 1058 1058 begin 1059 1059 try 1060 1060 - open_proc prog args None (Process(inchan, outchan)) out_read in_write stderr 1060 1060 + open_proc prog args None 1061 1061 + (Process(inchan, outchan)) out_read in_write stderr 1061 1062 with e -> 1062 1063 close out_read; close out_write; 1063 1064 close in_read; close in_write;

+2 -1

otherlibs/unix/unix.mli

reviewed

··· 821 821 @since 4.08.0 *) 822 822 823 823 val open_process_args_full : 824 824 - string -> string array -> string array -> in_channel * out_channel * in_channel 824 824 + string -> string array -> string array -> 825 825 + in_channel * out_channel * in_channel 825 826 (** Similar to {!Unix.open_process_args}, but the third argument specifies the 826 827 environment passed to the command. The result is a triple of channels 827 828 connected respectively to the standard output, standard input, and standard

+2 -1

otherlibs/unix/unixLabels.mli

reviewed

··· 693 693 @since 4.08.0 *) 694 694 695 695 val open_process_args_full : 696 696 - string -> string array -> string array -> in_channel * out_channel * in_channel 696 696 + string -> string array -> string array -> 697 697 + in_channel * out_channel * in_channel 697 698 (** Similar to {!Unix.open_process_args}, but the third argument specifies the 698 699 environment passed to the command. The result is a triple of channels 699 700 connected respectively to the standard output, standard input, and standard

+2 -2

otherlibs/win32graph/open.c

reviewed

··· 359 359 if (graphic_failure_exn == NULL) { 360 360 graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); 361 361 if (graphic_failure_exn == NULL) 362 362 - caml_invalid_argument("Exception Graphics.Graphic_failure not initialized, " 363 363 - "must link graphics.cma"); 362 362 + caml_invalid_argument("Exception Graphics.Graphic_failure not " 363 363 + "initialized, must link graphics.cma"); 364 364 } 365 365 sprintf(buffer, fmt, arg); 366 366 caml_raise_with_string(*graphic_failure_exn, buffer);

+11 -6

otherlibs/win32unix/createprocess.c

reviewed

··· 24 24 25 25 static int win_has_console(void); 26 26 27 27 - static DWORD do_create_process_native(wchar_t * exefile, wchar_t * cmdline, wchar_t * env, 28 28 - HANDLE fd1, HANDLE fd2, HANDLE fd3, HANDLE * hProcess) 27 27 + static DWORD do_create_process_native(wchar_t * exefile, wchar_t * cmdline, 28 28 + wchar_t * env, HANDLE fd1, HANDLE fd2, 29 29 + HANDLE fd3, HANDLE * hProcess) 29 30 { 30 31 PROCESS_INFORMATION pi; 31 32 STARTUPINFO si; ··· 100 101 101 102 if (env != Val_int(0)) { 102 103 env = Field(env, 0); 103 103 - size = win_multi_byte_to_wide_char(String_val(env), caml_string_length(env), NULL, 0); 104 104 + size = 105 105 + win_multi_byte_to_wide_char(String_val(env), 106 106 + caml_string_length(env), NULL, 0); 104 107 wenv = caml_stat_alloc((size + 1)*sizeof(wchar_t)); 105 105 - win_multi_byte_to_wide_char(String_val(env), caml_string_length(env), wenv, size); 108 108 + win_multi_byte_to_wide_char(String_val(env), 109 109 + caml_string_length(env), wenv, size); 106 110 wenv[size] = 0; 107 111 } else { 108 112 wenv = NULL; 109 113 } 110 114 111 111 - err = do_create_process_native(exefile, wcmdline, wenv, 112 112 - Handle_val(fd1), Handle_val(fd2), Handle_val(fd3), &hProcess); 115 115 + err = 116 116 + do_create_process_native(exefile, wcmdline, wenv, Handle_val(fd1), 117 117 + Handle_val(fd2), Handle_val(fd3), &hProcess); 113 118 114 119 if (wenv != NULL) caml_stat_free(wenv); 115 120 caml_stat_free(wcmdline);

+2 -1

otherlibs/win32unix/errmsg.c

reviewed

··· 41 41 sizeof(buffer)/sizeof(wchar_t), 42 42 NULL)) 43 43 return caml_copy_string_of_utf16(buffer); 44 44 - swprintf(buffer, sizeof(buffer)/sizeof(wchar_t), L"unknown error #%d", errnum); 44 44 + swprintf(buffer, sizeof(buffer)/sizeof(wchar_t), 45 45 + L"unknown error #%d", errnum); 45 46 return caml_copy_string_of_utf16(buffer); 46 47 }

+2 -1

otherlibs/win32unix/mmap.c

reviewed

··· 180 180 buffer, 181 181 sizeof(buffer)/sizeof(wchar_t), 182 182 NULL)) 183 183 - swprintf(buffer, sizeof(buffer)/sizeof(wchar_t), L"Unknown error %ld\n", errnum); 183 183 + swprintf(buffer, sizeof(buffer)/sizeof(wchar_t), 184 184 + L"Unknown error %ld\n", errnum); 184 185 caml_raise_sys_error(caml_copy_string_of_utf16(buffer)); 185 186 } 186 187

+6 -2

otherlibs/win32unix/readlink.c

reviewed

··· 75 75 if (point->ReparseTag == IO_REPARSE_TAG_SYMLINK) { 76 76 int cbLen = point->SymbolicLinkReparseBuffer.SubstituteNameLength / sizeof(WCHAR); 77 77 int len; 78 78 - len = win_wide_char_to_multi_byte(point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR), cbLen, NULL, 0); 78 78 + len = 79 79 + win_wide_char_to_multi_byte( 80 80 + point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR), 81 81 + cbLen, NULL, 0); 79 82 result = caml_alloc_string(len); 80 80 - win_wide_char_to_multi_byte(point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR), 83 83 + win_wide_char_to_multi_byte( 84 84 + point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR), 81 85 cbLen, 82 86 String_val(result), 83 87 len);

+16 -8

otherlibs/win32unix/unix.ml

reviewed

··· 401 401 Windows call GetFullPathName to do this because we need relative paths to 402 402 stay relative. *) 403 403 let normalize_slashes path = 404 404 - if String.length path >= 4 && path.[0] = '\\' && path.[1] = '\\' && path.[2] = '?' && path.[3] = '\\' then 404 404 + if String.length path >= 4 && path.[0] = '\\' && path.[1] = '\\' 405 405 + && path.[2] = '?' && path.[3] = '\\' then 405 406 path 406 407 else 407 407 - String.init (String.length path) (fun i -> match path.[i] with '/' -> '\\' | c -> c) 408 408 + String.init (String.length path) 409 409 + (fun i -> match path.[i] with '/' -> '\\' | c -> c) 408 410 409 411 let symlink ?to_dir source dest = 410 412 let to_dir = ··· 579 581 external socket : 580 582 ?cloexec: bool -> socket_domain -> socket_type -> int -> file_descr 581 583 = "unix_socket" 582 582 - let socketpair ?cloexec:_ _dom _ty _proto = invalid_arg "Unix.socketpair not implemented" 584 584 + let socketpair ?cloexec:_ _dom _ty _proto = 585 585 + invalid_arg "Unix.socketpair not implemented" 583 586 external accept : 584 587 ?cloexec: bool -> file_descr -> file_descr * sockaddr = "unix_accept" 585 588 external bind : file_descr -> sockaddr -> unit = "unix_bind" ··· 932 935 let outchan = out_channel_of_descr out_write in 933 936 begin 934 937 try 935 935 - open_proc prog cmdline None (Process(inchan, outchan)) out_read in_write stderr 938 938 + open_proc prog cmdline None 939 939 + (Process(inchan, outchan)) out_read in_write stderr 936 940 with e -> 937 941 close out_read; close out_write; 938 942 close in_read; close in_write; ··· 970 974 close err_write; 971 975 (inchan, outchan, errchan) 972 976 973 973 - let open_process_args_in prog args = open_process_cmdline_in prog (make_cmdline args) 974 974 - let open_process_args_out prog args = open_process_cmdline_out prog (make_cmdline args) 975 975 - let open_process_args prog args = open_process_cmdline prog (make_cmdline args) 976 976 - let open_process_args_full prog args = open_process_cmdline_full prog (make_cmdline args) 977 977 + let open_process_args_in prog args = 978 978 + open_process_cmdline_in prog (make_cmdline args) 979 979 + let open_process_args_out prog args = 980 980 + open_process_cmdline_out prog (make_cmdline args) 981 981 + let open_process_args prog args = 982 982 + open_process_cmdline prog (make_cmdline args) 983 983 + let open_process_args_full prog args = 984 984 + open_process_cmdline_full prog (make_cmdline args) 977 985 978 986 let open_process_shell fn cmd = 979 987 let shell =

+4 -2

otherlibs/win32unix/unixsupport.c

reviewed

··· 50 50 51 51 value win_alloc_handle(HANDLE h) 52 52 { 53 53 - value res = caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1); 53 53 + value res = 54 54 + caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1); 54 55 Handle_val(res) = h; 55 56 Descr_kind_val(res) = KIND_HANDLE; 56 57 CRT_fd_val(res) = NO_CRT_FD; ··· 60 61 61 62 value win_alloc_socket(SOCKET s) 62 63 { 63 63 - value res = caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1); 64 64 + value res = 65 65 + caml_alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1); 64 66 Socket_val(res) = s; 65 67 Descr_kind_val(res) = KIND_SOCKET; 66 68 CRT_fd_val(res) = NO_CRT_FD;

+7 -2

otherlibs/win32unix/utimes.c

reviewed

··· 30 30 /* There are 11644473600 seconds between 1 January 1601 (the NT Epoch) and 1 31 31 * January 1970 (the Unix Epoch). FILETIME is measured in 100ns ticks. 32 32 */ 33 33 - u.QuadPart = (ULONGLONG)(unixTime * 10000000.0) + INT64_LITERAL(116444736000000000U); 33 33 + u.QuadPart = 34 34 + (ULONGLONG)(unixTime * 10000000.0) + INT64_LITERAL(116444736000000000U); 34 35 ft->dwLowDateTime = u.LowPart; 35 36 ft->dwHighDateTime = u.HighPart; 36 37 } ··· 52 53 caml_enter_blocking_section(); 53 54 hFile = CreateFile(wpath, 54 55 FILE_WRITE_ATTRIBUTES, 55 55 - FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING, 0, NULL); 56 56 + FILE_SHARE_READ | FILE_SHARE_WRITE, 57 57 + NULL, 58 58 + OPEN_EXISTING, 59 59 + 0, 60 60 + NULL); 56 61 caml_leave_blocking_section(); 57 62 caml_stat_free(wpath); 58 63 if (hFile == INVALID_HANDLE_VALUE) {

-1

parsing/HACKING.adoc

reviewed

··· 6 6 link:location.mli[Location]:: This module contains utilities 7 7 related to locations and error handling. In particular, it contains 8 8 handlers that are used for all the error reporting in the compiler. 9 9 -

+2 -1

parsing/ast_mapper.ml

reviewed

··· 829 829 let extension_of_exn exn = 830 830 match error_of_exn exn with 831 831 | Some (`Ok error) -> extension_of_error error 832 832 - | Some `Already_displayed -> { loc = Location.none; txt = "ocaml.error" }, PStr [] 832 832 + | Some `Already_displayed -> 833 833 + { loc = Location.none; txt = "ocaml.error" }, PStr [] 833 834 | None -> raise exn 834 835 835 836

+2 -1

parsing/lexer.mll

reviewed

··· 226 226 (* Warn about Latin-1 characters used in idents *) 227 227 228 228 let warn_latin1 lexbuf = 229 229 - Location.deprecated (Location.curr lexbuf)"ISO-Latin1 characters in identifiers" 229 229 + Location.deprecated (Location.curr lexbuf) 230 230 + "ISO-Latin1 characters in identifiers" 230 231 231 232 let handle_docstrings = ref true 232 233 let comment_list = ref []

+2 -1

parsing/location.ml

reviewed

··· 19 19 (* This reference should be in Clflags, but it would create an additional 20 20 dependency and make bootstrapping Camlp4 more difficult. *) 21 21 22 22 - type t = Warnings.loc = { loc_start: position; loc_end: position; loc_ghost: bool };; 22 22 + type t = Warnings.loc = 23 23 + { loc_start: position; loc_end: position; loc_ghost: bool };; 23 24 24 25 let in_file name = 25 26 let loc = {

+6 -3

parsing/parser.mly

reviewed

··· 1194 1194 post_item_attributes 1195 1195 { 1196 1196 let (p, v) = $3 in 1197 1197 - mkctf (Pctf_method (mkrhs $4 4, p, v, $6)) ~attrs:($2@$7) ~docs:(symbol_docs ()) 1197 1197 + mkctf (Pctf_method (mkrhs $4 4, p, v, $6)) 1198 1198 + ~attrs:($2@$7) ~docs:(symbol_docs ()) 1198 1199 } 1199 1200 | CONSTRAINT attributes constrain_field post_item_attributes 1200 1201 { mkctf (Pctf_constraint $3) ~attrs:($2@$4) ~docs:(symbol_docs ()) } ··· 2343 2344 | core_type_list STAR simple_core_type { $3 :: $1 } 2344 2345 ; 2345 2346 meth_list: 2346 2346 - field_semi meth_list { let (f, c) = $2 in ($1 :: f, c) } 2347 2347 - | inherit_field_semi meth_list { let (f, c) = $2 in ($1 :: f, c) } 2347 2347 + field_semi meth_list 2348 2348 + { let (f, c) = $2 in ($1 :: f, c) } 2349 2349 + | inherit_field_semi meth_list 2350 2350 + { let (f, c) = $2 in ($1 :: f, c) } 2348 2351 | field_semi { [$1], Closed } 2349 2352 | field { [$1], Closed } 2350 2353 | inherit_field_semi { [$1], Closed }

+2 -1

parsing/pprintast.ml

reviewed

··· 779 779 pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e 780 780 781 781 and exception_declaration ctxt f x = 782 782 - pp f "@[<hov2>exception@ %a@]%a" (extension_constructor ctxt) x.ptyexn_constructor 782 782 + pp f "@[<hov2>exception@ %a@]%a" 783 783 + (extension_constructor ctxt) x.ptyexn_constructor 783 784 (item_attributes ctxt) x.ptyexn_attributes 784 785 785 786 and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =

+2 -1

stdlib/Compflags

reviewed

··· 31 31 echo ' -w Ae';; 32 32 stdlib__scanf.cmx|stdlib__scanf.p.cmx) echo ' -inline 9';; 33 33 *Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -no-alias-deps';; 34 34 - pervasives.cm[iox]|pervasives.p.cmx) echo ' -nopervasives -no-alias-deps -w -49';; 34 34 + pervasives.cm[iox]|pervasives.p.cmx) 35 35 + echo ' -nopervasives -no-alias-deps -w -49';; 35 36 *) echo ' ';; 36 37 esac

+13 -7

stdlib/arg.ml

reviewed

··· 38 38 function with each remaining argument *) 39 39 | Expand of (string -> string array) (* If the remaining arguments to process 40 40 are of the form 41 41 - [["-foo"; "arg"] @ rest] where "foo" is 42 42 - registered as [Expand f], then the 41 41 + [["-foo"; "arg"] @ rest] where "foo" 42 42 + is registered as [Expand f], then the 43 43 arguments [f "arg" @ rest] are 44 44 processed. Only allowed in 45 45 [parse_and_expand_argv_dynamic]. *) ··· 129 129 try Some (float_of_string x) 130 130 with Failure _ -> None 131 131 132 132 - let parse_and_expand_argv_dynamic_aux allow_expand current argv speclist anonfun errmsg = 132 132 + let parse_and_expand_argv_dynamic_aux allow_expand current argv speclist anonfun 133 133 + errmsg = 133 134 let initpos = !current in 134 135 let convert_error error = 135 136 (* convert an internal error to a Bad/Help exception ··· 137 138 to an user-raised Bad exception. 138 139 *) 139 140 let b = Buffer.create 200 in 140 140 - let progname = if initpos < (Array.length !argv) then !argv.(initpos) else "(?)" in 141 141 + let progname = 142 142 + if initpos < (Array.length !argv) then !argv.(initpos) else "(?)" in 141 143 begin match error with 142 144 | Unknown "-help" -> () 143 145 | Unknown "--help" -> () ··· 249 251 done; 250 252 | Expand f -> 251 253 if not allow_expand then 252 252 - raise (Invalid_argument "Arg.Expand is is only allowed with Arg.parse_and_expand_argv_dynamic"); 254 254 + raise (Invalid_argument "Arg.Expand is is only allowed with \ 255 255 + Arg.parse_and_expand_argv_dynamic"); 253 256 let arg = get_arg () in 254 257 let newarg = f arg in 255 258 consume_arg (); 256 259 let before = Array.sub !argv 0 (!current + 1) 257 257 - and after = Array.sub !argv (!current + 1) ((Array.length !argv) - !current - 1) in 260 260 + and after = 261 261 + Array.sub !argv (!current + 1) 262 262 + ((Array.length !argv) - !current - 1) in 258 263 argv:= Array.concat [before;newarg;after]; 259 264 in 260 265 treat_action action end ··· 269 274 parse_and_expand_argv_dynamic_aux true current argv speclist anonfun errmsg 270 275 271 276 let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg = 272 272 - parse_and_expand_argv_dynamic_aux false current (ref argv) speclist anonfun errmsg 277 277 + parse_and_expand_argv_dynamic_aux false current (ref argv) speclist anonfun 278 278 + errmsg 273 279 274 280 275 281 let parse_argv ?(current=current) argv speclist anonfun errmsg =

+4 -4

stdlib/arg.mli

reviewed

··· 61 61 function with each remaining argument *) 62 62 | Expand of (string -> string array) (** If the remaining arguments to process 63 63 are of the form 64 64 - [["-foo"; "arg"] @ rest] where "foo" is 65 65 - registered as [Expand f], then the 64 64 + [["-foo"; "arg"] @ rest] where "foo" 65 65 + is registered as [Expand f], then the 66 66 arguments [f "arg" @ rest] are 67 67 processed. Only allowed in 68 68 [parse_and_expand_argv_dynamic]. *) ··· 189 189 @since 4.05.0 *) 190 190 191 191 val read_arg0: string -> string array 192 192 - (** Identical to {!Arg.read_arg} but assumes null character terminated command line 193 193 - arguments. 192 192 + (** Identical to {!Arg.read_arg} but assumes null character terminated command 193 193 + line arguments. 194 194 @since 4.05.0 *) 195 195 196 196

-1

stdlib/buffer.ml

reviewed

··· 299 299 let b = create 32 in 300 300 add_seq b i; 301 301 b 302 302 -

-1

stdlib/buffer.mli

reviewed

··· 177 177 val of_seq : char Seq.t -> t 178 178 (** Create a buffer from the generator 179 179 @since 4.07 *) 180 180 -

+4 -3

stdlib/bytes.ml

reviewed

··· 261 261 (* duplicated in string.ml *) 262 262 let index_from_opt s i c = 263 263 let l = length s in 264 264 - if i < 0 || i > l then invalid_arg "String.index_from_opt / Bytes.index_from_opt" else 265 265 - index_rec_opt s l i c 264 264 + if i < 0 || i > l then 265 265 + invalid_arg "String.index_from_opt / Bytes.index_from_opt" 266 266 + else 267 267 + index_rec_opt s l i c 266 268 267 269 (* duplicated in string.ml *) 268 270 let rec rindex_rec s i c = ··· 366 368 incr n) 367 369 i; 368 370 sub !buf 0 !n 369 369 -

+2 -1

stdlib/bytes.mli

reviewed

··· 219 219 220 220 val index_from_opt: bytes -> int -> char -> int option 221 221 (** [index_from _opts i c] returns the index of the first occurrence of 222 222 - byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. 222 222 + byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] 223 223 + after position [i]. 223 224 [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. 224 225 225 226 Raise [Invalid_argument] if [i] is not a valid position in [s].

+2 -1

stdlib/bytesLabels.mli

reviewed

··· 193 193 194 194 val index_from_opt: bytes -> int -> char -> int option 195 195 (** [index_from _opts i c] returns the index of the first occurrence of 196 196 - byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. 196 196 + byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] 197 197 + after position [i]. 197 198 [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. 198 199 199 200 Raise [Invalid_argument] if [i] is not a valid position in [s].

+17 -10

stdlib/camlinternalFormat.ml

reviewed

··· 281 281 282 282 (* Convert an integer conversion to char. *) 283 283 let char_of_iconv iconv = match iconv with 284 284 - | Int_d | Int_pd | Int_sd | Int_Cd -> 'd' | Int_i | Int_pi | Int_si | Int_Ci -> 'i' 285 285 - | Int_x | Int_Cx -> 'x' | Int_X | Int_CX -> 'X' | Int_o | Int_Co -> 'o' 286 286 - | Int_u | Int_Cu -> 'u' 284 284 + | Int_d | Int_pd | Int_sd | Int_Cd -> 'd' | Int_i | Int_pi | Int_si 285 285 + | Int_Ci -> 'i' | Int_x | Int_Cx -> 'x' | Int_X | Int_CX -> 'X' | Int_o 286 286 + | Int_Co -> 'o' | Int_u | Int_Cu -> 'u' 287 287 288 288 (* Convert a float conversion to char. *) 289 289 let char_of_fconv fconv = match fconv with ··· 407 407 let bprint_iconv_flag buf iconv = match iconv with 408 408 | Int_pd | Int_pi -> buffer_add_char buf '+' 409 409 | Int_sd | Int_si -> buffer_add_char buf ' ' 410 410 - | Int_Cx | Int_CX | Int_Co | Int_Cd | Int_Ci | Int_Cu -> buffer_add_char buf '#' 410 410 + | Int_Cx | Int_CX | Int_Co | Int_Cd | Int_Ci | Int_Cu -> 411 411 + buffer_add_char buf '#' 411 412 | Int_d | Int_i | Int_x | Int_X | Int_o | Int_u -> () 412 413 413 414 (* Print an complete int format in a buffer (ex: "%3.*d"). *) ··· 885 886 886 887 | Char rest -> Char_ty (fmtty_of_fmt rest) 887 888 | Caml_char rest -> Char_ty (fmtty_of_fmt rest) 888 888 - | Bool (pad, rest) -> fmtty_of_padding_fmtty pad (Bool_ty (fmtty_of_fmt rest)) 889 889 + | Bool (pad, rest) -> 890 890 + fmtty_of_padding_fmtty pad (Bool_ty (fmtty_of_fmt rest)) 889 891 | Alpha rest -> Alpha_ty (fmtty_of_fmt rest) 890 892 | Theta rest -> Theta_ty (fmtty_of_fmt rest) 891 893 | Custom (arity, _, rest) -> fmtty_of_custom arity (fmtty_of_fmt rest) ··· 1435 1437 let left = ref ((digits - 1) mod 3 + 1) in 1436 1438 for i = 0 to String.length s - 1 do 1437 1439 match String.unsafe_get s i with 1438 1438 - | '0'..'9' as c -> if !left = 0 then (put '_'; left := 3); decr left; put c 1440 1440 + | '0'..'9' as c -> 1441 1441 + if !left = 0 then (put '_'; left := 3); decr left; put c 1439 1442 | c -> put c 1440 1443 done; 1441 1444 Bytes.unsafe_to_string buf 1442 1445 | _ -> s 1443 1446 1444 1447 (* Convert an integer to a string according to a conversion. *) 1445 1445 - let convert_int iconv n = transform_int_alt iconv (format_int (format_of_iconv iconv) n) 1446 1446 - let convert_int32 iconv n = transform_int_alt iconv (format_int32 (format_of_iconvl iconv) n) 1447 1447 - let convert_nativeint iconv n = transform_int_alt iconv (format_nativeint (format_of_iconvn iconv) n) 1448 1448 - let convert_int64 iconv n = transform_int_alt iconv (format_int64 (format_of_iconvL iconv) n) 1448 1448 + let convert_int iconv n = 1449 1449 + transform_int_alt iconv (format_int (format_of_iconv iconv) n) 1450 1450 + let convert_int32 iconv n = 1451 1451 + transform_int_alt iconv (format_int32 (format_of_iconvl iconv) n) 1452 1452 + let convert_nativeint iconv n = 1453 1453 + transform_int_alt iconv (format_nativeint (format_of_iconvn iconv) n) 1454 1454 + let convert_int64 iconv n = 1455 1455 + transform_int_alt iconv (format_int64 (format_of_iconvL iconv) n) 1449 1456 1450 1457 (* Convert a float to string. *) 1451 1458 (* Fix special case of "OCaml float format". *)

+2 -1

stdlib/float.ml

reviewed

··· 87 87 type t = float 88 88 external compare : float -> float -> int = "%compare" 89 89 let equal x y = compare x y = 0 90 90 - external seeded_hash_param : int -> int -> int -> float -> int = "caml_hash" [@@noalloc] 90 90 + external seeded_hash_param : int -> int -> int -> float -> int 91 91 + = "caml_hash" [@@noalloc] 91 92 let hash x = seeded_hash_param 10 100 0 x 92 93 93 94 module Array = struct

+9 -4

stdlib/headernt.c

reviewed

··· 98 98 DWORD consoleMode, numwritten, len; 99 99 static char str[MAX_PATH]; 100 100 101 101 - if (GetConsoleMode(hOut, &consoleMode) != 0) { /* The output stream is a Console */ 101 101 + if (GetConsoleMode(hOut, &consoleMode) != 0) { 102 102 + /* The output stream is a Console */ 102 103 WriteConsole(hOut, wstr, wcslen(wstr), &numwritten, NULL); 103 104 } else { /* The output stream is redirected */ 104 104 - len = WideCharToMultiByte(CP, 0, wstr, wcslen(wstr), str, sizeof(str), NULL, NULL); 105 105 + len = 106 106 + WideCharToMultiByte(CP, 0, wstr, wcslen(wstr), str, sizeof(str), 107 107 + NULL, NULL); 105 108 WriteFile(hOut, str, len, &numwritten, NULL); 106 109 } 107 110 } ··· 113 116 STARTUPINFO stinfo; 114 117 PROCESS_INFORMATION procinfo; 115 118 DWORD retcode; 116 116 - if (SearchPath(NULL, runtime, L".exe", sizeof(path)/sizeof(wchar_t), path, &runtime) == 0) { 119 119 + if (SearchPath(NULL, runtime, L".exe", sizeof(path)/sizeof(wchar_t), 120 120 + path, &runtime) == 0) { 117 121 HANDLE errh; 118 122 errh = GetStdHandle(STD_ERROR_HANDLE); 119 123 write_console(errh, L"Cannot exec "); ··· 180 184 #endif 181 185 } 182 186 CloseHandle(h); 183 183 - MultiByteToWideChar(CP, 0, runtime_path, -1, wruntime_path, sizeof(wruntime_path)/sizeof(wchar_t)); 187 187 + MultiByteToWideChar(CP, 0, runtime_path, -1, wruntime_path, 188 188 + sizeof(wruntime_path)/sizeof(wchar_t)); 184 189 run_runtime(wruntime_path , cmdline); 185 190 #if _MSC_VER >= 1200 186 191 __assume(0); /* Not reached */

+1 -1

stdlib/int32.mli

reviewed

··· 128 128 129 129 external of_string : string -> int32 = "caml_int32_of_string" 130 130 (** Convert the given string to a 32-bit integer. 131 131 - The string is read in decimal (by default, or if the string 131 131 + The string is read in decimal (by default, or if the string 132 132 begins with [0u]) or in hexadecimal, octal or binary if the 133 133 string begins with [0x], [0o] or [0b] respectively. 134 134

+1 -1

stdlib/int64.mli

reviewed

··· 150 150 151 151 external of_string : string -> int64 = "caml_int64_of_string" 152 152 (** Convert the given string to a 64-bit integer. 153 153 - The string is read in decimal (by default, or if the string 153 153 + The string is read in decimal (by default, or if the string 154 154 begins with [0u]) or in hexadecimal, octal or binary if the 155 155 string begins with [0x], [0o] or [0b] respectively. 156 156

+4 -2

stdlib/map.ml

reviewed

··· 351 351 match (l, r) with 352 352 (Empty, _) -> add_min_binding v d r 353 353 | (_, Empty) -> add_max_binding v d l 354 354 - | (Node{l=ll; v=lv; d=ld; r=lr; h=lh}, Node{l=rl; v=rv; d=rd; r=rr; h=rh}) -> 354 354 + | (Node{l=ll; v=lv; d=ld; r=lr; h=lh}, 355 355 + Node{l=rl; v=rv; d=rd; r=rr; h=rh}) -> 355 356 if lh > rh + 2 then bal ll lv ld (join lr v d r) else 356 357 if rh > lh + 2 then bal (join l v d rl) rv rd rr else 357 358 create l v d r ··· 399 400 let rec union f s1 s2 = 400 401 match (s1, s2) with 401 402 | (Empty, s) | (s, Empty) -> s 402 402 - | (Node {l=l1; v=v1; d=d1; r=r1; h=h1}, Node {l=l2; v=v2; d=d2; r=r2; h=h2}) -> 403 403 + | (Node {l=l1; v=v1; d=d1; r=r1; h=h1}, 404 404 + Node {l=l2; v=v2; d=d2; r=r2; h=h2}) -> 403 405 if h1 >= h2 then 404 406 let (l2, d2, r2) = split v1 s2 in 405 407 let l = union f l1 l2 and r = union f r1 r2 in

+1 -1

stdlib/nativeint.mli

reviewed

··· 158 158 159 159 external of_string : string -> nativeint = "caml_nativeint_of_string" 160 160 (** Convert the given string to a native integer. 161 161 - The string is read in decimal (by default, or if the string 161 161 + The string is read in decimal (by default, or if the string 162 162 begins with [0u]) or in hexadecimal, octal or binary if the 163 163 string begins with [0x], [0o] or [0b] respectively. 164 164

-1

stdlib/queue.ml

reviewed

··· 146 146 let q = create() in 147 147 add_seq q g; 148 148 q 149 149 -

-1

stdlib/queue.mli

reviewed

··· 96 96 val of_seq : 'a Seq.t -> 'a t 97 97 (** Create an array from the generator 98 98 @since 4.07 *) 99 99 -

+10 -5

stdlib/seq.mli

reviewed

··· 53 53 val filter : ('a -> bool) -> 'a t -> 'a t 54 54 (** Remove from the sequence the elements that do not satisfy the 55 55 given predicate. 56 56 - This transformation is lazy, it only applies when the result is traversed. *) 56 56 + This transformation is lazy, it only applies when the result is 57 57 + traversed. *) 57 58 58 59 val filter_map : ('a -> 'b option) -> 'a t -> 'b t 59 60 (** Apply the function to every element; if [f x = None] then [x] is dropped; 60 61 if [f x = Some y] then [y] is returned. 61 61 - This transformation is lazy, it only applies when the result is traversed. *) 62 62 + This transformation is lazy, it only applies when the result is 63 63 + traversed. *) 62 64 63 65 val flat_map : ('a -> 'b t) -> 'a t -> 'b t 64 66 (** Map each element to a subsequence, then return each element of this 65 67 sub-sequence in turn. 66 66 - This transformation is lazy, it only applies when the result is traversed. *) 68 68 + This transformation is lazy, it only applies when the result is 69 69 + traversed. *) 67 70 68 71 val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a 69 72 (** Traverse the sequence from left to right, combining each element with the 70 73 accumulator using the given function. 71 71 - The traversal happens immediately and will not terminate on infinite sequences. 74 74 + The traversal happens immediately and will not terminate on infinite 75 75 + sequences. 72 76 73 77 Also see {!List.fold_left} *) 74 78 75 79 val iter : ('a -> unit) -> 'a t -> unit 76 80 (** Iterate on the sequence, calling the (imperative) function on every element. 77 77 - The traversal happens immediately and will not terminate on infinite sequences. *) 81 81 + The traversal happens immediately and will not terminate on infinite 82 82 + sequences. *)

-1

stdlib/stack.ml

reviewed

··· 53 53 let s = create() in 54 54 add_seq s g; 55 55 s 56 56 -

-1

stdlib/stack.mli

reviewed

··· 76 76 val of_seq : 'a Seq.t -> 'a t 77 77 (** Create a stack from the iterator 78 78 @since 4.07 *) 79 79 -

+1 -1

stdlib/stdlib.ml

reviewed

··· 541 541 (* MPR#7253, MPR#7796: make sure "f" is executed only once *) 542 542 let f_already_ran = ref false in 543 543 exit_function := 544 544 - (fun () -> 544 544 + (fun () -> 545 545 if not !f_already_ran then begin f_already_ran := true; f() end; 546 546 g()) 547 547

+6 -4

stdlib/string.ml

reviewed

··· 104 104 let rec escape_if_needed s n i = 105 105 if i >= n then s else 106 106 match unsafe_get s i with 107 107 - | '\"' | '\\' | '\000'..'\031' | '\127'.. '\255' -> bts (B.escaped (bos s)) 107 107 + | '\"' | '\\' | '\000'..'\031' | '\127'.. '\255' -> 108 108 + bts (B.escaped (bos s)) 108 109 | _ -> escape_if_needed s n (i+1) 109 110 in 110 111 escape_if_needed s (length s) 0 ··· 134 135 (* duplicated in bytes.ml *) 135 136 let index_from_opt s i c = 136 137 let l = length s in 137 137 - if i < 0 || i > l then invalid_arg "String.index_from_opt / Bytes.index_from_opt" else 138 138 - index_rec_opt s l i c 138 138 + if i < 0 || i > l then 139 139 + invalid_arg "String.index_from_opt / Bytes.index_from_opt" 140 140 + else 141 141 + index_rec_opt s l i c 139 142 140 143 (* duplicated in bytes.ml *) 141 144 let rec rindex_rec s i c = ··· 228 231 let to_seqi s = bos s |> B.to_seqi 229 232 230 233 let of_seq g = B.of_seq g |> bts 231 231 -

+23 -4

testsuite/HACKING.adoc

reviewed

··· 4 4 5 5 == Useful Makefile targets 6 6 7 7 - `make parallel`:: runs the tests in parallel using the link:https://www.gnu.org/software/parallel/[GNU parallel] tool: tests run twice as fast with no difference in output order. 7 7 + `make parallel`:: 8 8 + runs the tests in parallel using the 9 9 + link:https://www.gnu.org/software/parallel/[GNU parallel] tool: tests run 10 10 + twice as fast with no difference in output order. 8 11 9 9 - `make all-foo`, `make parallel-foo`:: runs only the tests in the directories whose name starts with `foo`: `parallel-typing`, `all-lib`, etc. 12 12 + `make all-foo`, `make parallel-foo`:: 13 13 + runs only the tests in the directories whose name starts with `foo`: 14 14 + `parallel-typing`, `all-lib`, etc. 10 15 11 11 - `make one DIR=tests/foo`:: runs only the tests in the directory `tests/foo`. This is often equivalent to `cd tests/foo && make`, but sometimes the latter breaks the test makefile if it contains fragile relative filesystem paths. Such errors should be fixed if you find them, but `make one DIR=...` is the more reliable option as it runs exactly as `make all` which is heavily tested. 16 16 + `make one DIR=tests/foo`:: 17 17 + runs only the tests in the directory `tests/foo`. This is often equivalent to 18 18 + `cd tests/foo && make`, but sometimes the latter breaks the test makefile if 19 19 + it contains fragile relative filesystem paths. Such errors should be fixed if 20 20 + you find them, but `make one DIR=...` is the more reliable option as it runs 21 21 + exactly as `make all` which is heavily tested. 12 22 13 13 - `make promote DIR=tests/foo`:: most test run a program and compare the result of the program, store in a file `foo.result`, with a reference output stored in `foo.reference` -- the test fails if the two output differ. Sometimes a change in result is innocuous, it comes from an intended change in output instead of a regression. `make promote` copies the new result file into the reference file, making the test pass again. Whenever you use this rule please check carefully, using `git diff`, that the change really corresponds to an intended output difference, and not to a regression. You then need to commit the change to reference file, and your commit message should explain why the output changed. 23 23 + `make promote DIR=tests/foo`:: 24 24 + most test run a program and compare the result of the program, store in a file 25 25 + `foo.result`, with a reference output stored in `foo.reference` -- the test 26 26 + fails if the two output differ. Sometimes a change in result is innocuous, it 27 27 + comes from an intended change in output instead of a regression. 28 28 + `make promote` copies the new result file into the reference file, making the 29 29 + test pass again. Whenever you use this rule please check carefully, using 30 30 + `git diff`, that the change really corresponds to an intended output 31 31 + difference, and not to a regression. You then need to commit the change to 32 32 + reference file, and your commit message should explain why the output changed.

+1 -1

testsuite/tests/afl-instrumentation/afltest.ml

reviewed

··· 8 8 module = "test.ml" 9 9 flags = "-afl-instrument" 10 10 ***** ocamlopt.byte 11 11 - module = "" 11 11 + module = "" 12 12 program = "${test_build_directory}/test" 13 13 flags = "-afl-inst-ratio 0" 14 14 all_modules = "test.cmx harness.ml"

+1 -1

testsuite/tests/afl-instrumentation/afltest.run

reviewed

··· 29 29 done 30 30 31 31 if [ -z "$failures" ]; then 32 32 - echo "all tests passed"; 32 32 + echo "all tests passed"; 33 33 exit ${TEST_PASS} 34 34 else 35 35 exit ${TEST_FAIL};

+7 -2

testsuite/tests/afl-instrumentation/harness.ml

reviewed

··· 13 13 reset_instrumentation true; 14 14 begin 15 15 match Sys.argv with 16 16 - | [| _; "len" |] -> print_int (Array.length Test.tests); print_newline (); flush stdout 16 16 + | [| _; "len" |] -> 17 17 + print_int (Array.length Test.tests); print_newline (); flush stdout 17 18 | [| _; "name"; n |] -> print_string (name n); flush stdout 18 19 | [| _; "1"; n |] -> run n 19 19 - | [| _; "2"; n |] -> run n; (* Random.set_state orig_random; *)reset_instrumentation false; run n 20 20 + | [| _; "2"; n |] -> 21 21 + run n; 22 22 + (* Random.set_state orig_random; *) 23 23 + reset_instrumentation false; 24 24 + run n 20 25 | _ -> failwith "error" 21 26 end; 22 27 sys_exit 0

-1

testsuite/tests/afl-instrumentation/test.ml

reviewed

··· 78 78 (* ("random", random); *) 79 79 ("laziness", laziness); 80 80 |] 81 81 -

+2 -1

testsuite/tests/asmcomp/staticalloc.ml

reviewed

··· 19 19 let g () = (a, fst b) in 20 20 assert (g () == ((1,2), (1,2))); 21 21 assert (fst (pair a a) == (1, 2)); 22 22 - assert (snd b != ["x"; "y"] || Config.safe_string); (* mutable "constant", cannot be shared *) 22 22 + assert (snd b != ["x"; "y"] || Config.safe_string); (* mutable "constant", 23 23 + cannot be shared *) 23 24 let x2 = Gc.allocated_bytes () in 24 25 assert(x1 -. x0 = x2 -. x1) 25 26 (* check that we did not allocated anything between x1 and x2 *)

+1 -1

testsuite/tests/asmgen/even-odd.cmm

reviewed

··· 11 11 (exit even (- v 1))) 12 12 and (even v) 13 13 (if (== v 0) 1 14 14 - (exit odd (- v 1))))) 14 14 + (exit odd (- v 1)))))

+1 -1

testsuite/tests/asmgen/pgcd.cmm

reviewed

··· 12 12 (if (== n 0) 13 13 m 14 14 (let (r (mod m n)) 15 15 - (exit pgcd r n)))))) 15 15 + (exit pgcd r n))))))

-1

testsuite/tests/basic-modules/recursive_module_evaluation_errors.ml

reviewed

··· 21 21 [%%expect {| 22 22 Exception: Undefined_recursive_module ("", 1, 43). 23 23 |}] 24 24 -

+91 -84

testsuite/tests/basic-more/structural_constants.ml

reviewed

··· 127 127 962; 963; 964; 965; 966; 967; 968; 969; 970; 971; 972; 973; 974; 128 128 975; 976; 977; 978; 979; 980; 981; 982; 983; 984; 985; 986; 987; 129 129 988; 989; 990; 991; 992; 993; 994; 995; 996; 997; 998; 999; 1000; 130 130 - 1001; 1002; 1003; 1004; 1005; 1006; 1007; 1008; 1009; 1010; 1011; 1012; 1013; 131 131 - 1014; 1015; 1016; 1017; 1018; 1019; 1020; 1021; 1022; 1023; 1024; 1025; 1026; 132 132 - 1027; 1028; 1029; 1030; 1031; 1032; 1033; 1034; 1035; 1036; 1037; 1038; 1039; 133 133 - 1040; 1041; 1042; 1043; 1044; 1045; 1046; 1047; 1048; 1049; 1050; 1051; 1052; 134 134 - 1053; 1054; 1055; 1056; 1057; 1058; 1059; 1060; 1061; 1062; 1063; 1064; 1065; 135 135 - 1066; 1067; 1068; 1069; 1070; 1071; 1072; 1073; 1074; 1075; 1076; 1077; 1078; 136 136 - 1079; 1080; 1081; 1082; 1083; 1084; 1085; 1086; 1087; 1088; 1089; 1090; 1091; 137 137 - 1092; 1093; 1094; 1095; 1096; 1097; 1098; 1099; 1100; 1101; 1102; 1103; 1104; 138 138 - 1105; 1106; 1107; 1108; 1109; 1110; 1111; 1112; 1113; 1114; 1115; 1116; 1117; 139 139 - 1118; 1119; 1120; 1121; 1122; 1123; 1124; 1125; 1126; 1127; 1128; 1129; 1130; 140 140 - 1131; 1132; 1133; 1134; 1135; 1136; 1137; 1138; 1139; 1140; 1141; 1142; 1143; 141 141 - 1144; 1145; 1146; 1147; 1148; 1149; 1150; 1151; 1152; 1153; 1154; 1155; 1156; 142 142 - 1157; 1158; 1159; 1160; 1161; 1162; 1163; 1164; 1165; 1166; 1167; 1168; 1169; 143 143 - 1170; 1171; 1172; 1173; 1174; 1175; 1176; 1177; 1178; 1179; 1180; 1181; 1182; 144 144 - 1183; 1184; 1185; 1186; 1187; 1188; 1189; 1190; 1191; 1192; 1193; 1194; 1195; 145 145 - 1196; 1197; 1198; 1199; 1200; 1201; 1202; 1203; 1204; 1205; 1206; 1207; 1208; 146 146 - 1209; 1210; 1211; 1212; 1213; 1214; 1215; 1216; 1217; 1218; 1219; 1220; 1221; 147 147 - 1222; 1223; 1224; 1225; 1226; 1227; 1228; 1229; 1230; 1231; 1232; 1233; 1234; 148 148 - 1235; 1236; 1237; 1238; 1239; 1240; 1241; 1242; 1243; 1244; 1245; 1246; 1247; 149 149 - 1248; 1249; 1250; 1251; 1252; 1253; 1254; 1255; 1256; 1257; 1258; 1259; 1260; 150 150 - 1261; 1262; 1263; 1264; 1265; 1266; 1267; 1268; 1269; 1270; 1271; 1272; 1273; 151 151 - 1274; 1275; 1276; 1277; 1278; 1279; 1280; 1281; 1282; 1283; 1284; 1285; 1286; 152 152 - 1287; 1288; 1289; 1290; 1291; 1292; 1293; 1294; 1295; 1296; 1297; 1298; 1299; 153 153 - 1300; 1301; 1302; 1303; 1304; 1305; 1306; 1307; 1308; 1309; 1310; 1311; 1312; 154 154 - 1313; 1314; 1315; 1316; 1317; 1318; 1319; 1320; 1321; 1322; 1323; 1324; 1325; 155 155 - 1326; 1327; 1328; 1329; 1330; 1331; 1332; 1333; 1334; 1335; 1336; 1337; 1338; 156 156 - 1339; 1340; 1341; 1342; 1343; 1344; 1345; 1346; 1347; 1348; 1349; 1350; 1351; 157 157 - 1352; 1353; 1354; 1355; 1356; 1357; 1358; 1359; 1360; 1361; 1362; 1363; 1364; 158 158 - 1365; 1366; 1367; 1368; 1369; 1370; 1371; 1372; 1373; 1374; 1375; 1376; 1377; 159 159 - 1378; 1379; 1380; 1381; 1382; 1383; 1384; 1385; 1386; 1387; 1388; 1389; 1390; 160 160 - 1391; 1392; 1393; 1394; 1395; 1396; 1397; 1398; 1399; 1400; 1401; 1402; 1403; 161 161 - 1404; 1405; 1406; 1407; 1408; 1409; 1410; 1411; 1412; 1413; 1414; 1415; 1416; 162 162 - 1417; 1418; 1419; 1420; 1421; 1422; 1423; 1424; 1425; 1426; 1427; 1428; 1429; 163 163 - 1430; 1431; 1432; 1433; 1434; 1435; 1436; 1437; 1438; 1439; 1440; 1441; 1442; 164 164 - 1443; 1444; 1445; 1446; 1447; 1448; 1449; 1450; 1451; 1452; 1453; 1454; 1455; 165 165 - 1456; 1457; 1458; 1459; 1460; 1461; 1462; 1463; 1464; 1465; 1466; 1467; 1468; 166 166 - 1469; 1470; 1471; 1472; 1473; 1474; 1475; 1476; 1477; 1478; 1479; 1480; 1481; 167 167 - 1482; 1483; 1484; 1485; 1486; 1487; 1488; 1489; 1490; 1491; 1492; 1493; 1494; 168 168 - 1495; 1496; 1497; 1498; 1499; 1500; 1501; 1502; 1503; 1504; 1505; 1506; 1507; 169 169 - 1508; 1509; 1510; 1511; 1512; 1513; 1514; 1515; 1516; 1517; 1518; 1519; 1520; 170 170 - 1521; 1522; 1523; 1524; 1525; 1526; 1527; 1528; 1529; 1530; 1531; 1532; 1533; 171 171 - 1534; 1535; 1536; 1537; 1538; 1539; 1540; 1541; 1542; 1543; 1544; 1545; 1546; 172 172 - 1547; 1548; 1549; 1550; 1551; 1552; 1553; 1554; 1555; 1556; 1557; 1558; 1559; 173 173 - 1560; 1561; 1562; 1563; 1564; 1565; 1566; 1567; 1568; 1569; 1570; 1571; 1572; 174 174 - 1573; 1574; 1575; 1576; 1577; 1578; 1579; 1580; 1581; 1582; 1583; 1584; 1585; 175 175 - 1586; 1587; 1588; 1589; 1590; 1591; 1592; 1593; 1594; 1595; 1596; 1597; 1598; 176 176 - 1599; 1600; 1601; 1602; 1603; 1604; 1605; 1606; 1607; 1608; 1609; 1610; 1611; 177 177 - 1612; 1613; 1614; 1615; 1616; 1617; 1618; 1619; 1620; 1621; 1622; 1623; 1624; 178 178 - 1625; 1626; 1627; 1628; 1629; 1630; 1631; 1632; 1633; 1634; 1635; 1636; 1637; 179 179 - 1638; 1639; 1640; 1641; 1642; 1643; 1644; 1645; 1646; 1647; 1648; 1649; 1650; 180 180 - 1651; 1652; 1653; 1654; 1655; 1656; 1657; 1658; 1659; 1660; 1661; 1662; 1663; 181 181 - 1664; 1665; 1666; 1667; 1668; 1669; 1670; 1671; 1672; 1673; 1674; 1675; 1676; 182 182 - 1677; 1678; 1679; 1680; 1681; 1682; 1683; 1684; 1685; 1686; 1687; 1688; 1689; 183 183 - 1690; 1691; 1692; 1693; 1694; 1695; 1696; 1697; 1698; 1699; 1700; 1701; 1702; 184 184 - 1703; 1704; 1705; 1706; 1707; 1708; 1709; 1710; 1711; 1712; 1713; 1714; 1715; 185 185 - 1716; 1717; 1718; 1719; 1720; 1721; 1722; 1723; 1724; 1725; 1726; 1727; 1728; 186 186 - 1729; 1730; 1731; 1732; 1733; 1734; 1735; 1736; 1737; 1738; 1739; 1740; 1741; 187 187 - 1742; 1743; 1744; 1745; 1746; 1747; 1748; 1749; 1750; 1751; 1752; 1753; 1754; 188 188 - 1755; 1756; 1757; 1758; 1759; 1760; 1761; 1762; 1763; 1764; 1765; 1766; 1767; 189 189 - 1768; 1769; 1770; 1771; 1772; 1773; 1774; 1775; 1776; 1777; 1778; 1779; 1780; 190 190 - 1781; 1782; 1783; 1784; 1785; 1786; 1787; 1788; 1789; 1790; 1791; 1792; 1793; 191 191 - 1794; 1795; 1796; 1797; 1798; 1799; 1800; 1801; 1802; 1803; 1804; 1805; 1806; 192 192 - 1807; 1808; 1809; 1810; 1811; 1812; 1813; 1814; 1815; 1816; 1817; 1818; 1819; 193 193 - 1820; 1821; 1822; 1823; 1824; 1825; 1826; 1827; 1828; 1829; 1830; 1831; 1832; 194 194 - 1833; 1834; 1835; 1836; 1837; 1838; 1839; 1840; 1841; 1842; 1843; 1844; 1845; 195 195 - 1846; 1847; 1848; 1849; 1850; 1851; 1852; 1853; 1854; 1855; 1856; 1857; 1858; 196 196 - 1859; 1860; 1861; 1862; 1863; 1864; 1865; 1866; 1867; 1868; 1869; 1870; 1871; 197 197 - 1872; 1873; 1874; 1875; 1876; 1877; 1878; 1879; 1880; 1881; 1882; 1883; 1884; 198 198 - 1885; 1886; 1887; 1888; 1889; 1890; 1891; 1892; 1893; 1894; 1895; 1896; 1897; 199 199 - 1898; 1899; 1900; 1901; 1902; 1903; 1904; 1905; 1906; 1907; 1908; 1909; 1910; 200 200 - 1911; 1912; 1913; 1914; 1915; 1916; 1917; 1918; 1919; 1920; 1921; 1922; 1923; 201 201 - 1924; 1925; 1926; 1927; 1928; 1929; 1930; 1931; 1932; 1933; 1934; 1935; 1936; 202 202 - 1937; 1938; 1939; 1940; 1941; 1942; 1943; 1944; 1945; 1946; 1947; 1948; 1949; 203 203 - 1950; 1951; 1952; 1953; 1954; 1955; 1956; 1957; 1958; 1959; 1960; 1961; 1962; 204 204 - 1963; 1964; 1965; 1966; 1967; 1968; 1969; 1970; 1971; 1972; 1973; 1974; 1975; 205 205 - 1976; 1977; 1978; 1979; 1980; 1981; 1982; 1983; 1984; 1985; 1986; 1987; 1988; 206 206 - 1989; 1990; 1991; 1992; 1993; 1994; 1995; 1996; 1997; 1998; 1999; 2000; 2001; 207 207 - 2002; 2003; 2004; 2005; 2006; 2007; 2008; 2009; 2010; 2011; 2012; 2013; 2014; 208 208 - 2015; 2016; 2017; 2018; 2019; 2020; 2021; 2022; 2023; 2024; 2025; 2026; 2027; 209 209 - 2028; 2029; 2030; 2031; 2032; 2033; 2034; 2035; 2036; 2037; 2038; 2039; 2040; 210 210 - 2041; 2042; 2043; 2044; 2045; 2046; 2047; 2048; 2049; 2050; 2051; 2052; 2053; 211 211 - 2054; 2055; 2056; 2057; 2058; 2059; 2060; 2061; 2062; 2063; 2064; 2065; 2066; 212 212 - 2067; 2068; 2069; 2070; 2071; 2072; 2073; 2074; 2075; 2076; 2077; 2078; 2079; 213 213 - 2080; 2081; 2082; 2083; 2084; 2085; 2086; 2087; 2088; 2089; 2090; 2091; 2092; 130 130 + 1001; 1002; 1003; 1004; 1005; 1006; 1007; 1008; 1009; 1010; 1011; 1012; 131 131 + 1013; 1014; 1015; 1016; 1017; 1018; 1019; 1020; 1021; 1022; 1023; 1024; 132 132 + 1025; 1026; 1027; 1028; 1029; 1030; 1031; 1032; 1033; 1034; 1035; 1036; 133 133 + 1037; 1038; 1039; 1040; 1041; 1042; 1043; 1044; 1045; 1046; 1047; 1048; 134 134 + 1049; 1050; 1051; 1052; 1053; 1054; 1055; 1056; 1057; 1058; 1059; 1060; 135 135 + 1061; 1062; 1063; 1064; 1065; 1066; 1067; 1068; 1069; 1070; 1071; 1072; 136 136 + 1073; 1074; 1075; 1076; 1077; 1078; 1079; 1080; 1081; 1082; 1083; 1084; 137 137 + 1085; 1086; 1087; 1088; 1089; 1090; 1091; 1092; 1093; 1094; 1095; 1096; 138 138 + 1097; 1098; 1099; 1100; 1101; 1102; 1103; 1104; 1105; 1106; 1107; 1108; 139 139 + 1109; 1110; 1111; 1112; 1113; 1114; 1115; 1116; 1117; 1118; 1119; 1120; 140 140 + 1121; 1122; 1123; 1124; 1125; 1126; 1127; 1128; 1129; 1130; 1131; 1132; 141 141 + 1133; 1134; 1135; 1136; 1137; 1138; 1139; 1140; 1141; 1142; 1143; 1144; 142 142 + 1145; 1146; 1147; 1148; 1149; 1150; 1151; 1152; 1153; 1154; 1155; 1156; 143 143 + 1157; 1158; 1159; 1160; 1161; 1162; 1163; 1164; 1165; 1166; 1167; 1168; 144 144 + 1169; 1170; 1171; 1172; 1173; 1174; 1175; 1176; 1177; 1178; 1179; 1180; 145 145 + 1181; 1182; 1183; 1184; 1185; 1186; 1187; 1188; 1189; 1190; 1191; 1192; 146 146 + 1193; 1194; 1195; 1196; 1197; 1198; 1199; 1200; 1201; 1202; 1203; 1204; 147 147 + 1205; 1206; 1207; 1208; 1209; 1210; 1211; 1212; 1213; 1214; 1215; 1216; 148 148 + 1217; 1218; 1219; 1220; 1221; 1222; 1223; 1224; 1225; 1226; 1227; 1228; 149 149 + 1229; 1230; 1231; 1232; 1233; 1234; 1235; 1236; 1237; 1238; 1239; 1240; 150 150 + 1241; 1242; 1243; 1244; 1245; 1246; 1247; 1248; 1249; 1250; 1251; 1252; 151 151 + 1253; 1254; 1255; 1256; 1257; 1258; 1259; 1260; 1261; 1262; 1263; 1264; 152 152 + 1265; 1266; 1267; 1268; 1269; 1270; 1271; 1272; 1273; 1274; 1275; 1276; 153 153 + 1277; 1278; 1279; 1280; 1281; 1282; 1283; 1284; 1285; 1286; 1287; 1288; 154 154 + 1289; 1290; 1291; 1292; 1293; 1294; 1295; 1296; 1297; 1298; 1299; 1300; 155 155 + 1301; 1302; 1303; 1304; 1305; 1306; 1307; 1308; 1309; 1310; 1311; 1312; 156 156 + 1313; 1314; 1315; 1316; 1317; 1318; 1319; 1320; 1321; 1322; 1323; 1324; 157 157 + 1325; 1326; 1327; 1328; 1329; 1330; 1331; 1332; 1333; 1334; 1335; 1336; 158 158 + 1337; 1338; 1339; 1340; 1341; 1342; 1343; 1344; 1345; 1346; 1347; 1348; 159 159 + 1349; 1350; 1351; 1352; 1353; 1354; 1355; 1356; 1357; 1358; 1359; 1360; 160 160 + 1361; 1362; 1363; 1364; 1365; 1366; 1367; 1368; 1369; 1370; 1371; 1372; 161 161 + 1373; 1374; 1375; 1376; 1377; 1378; 1379; 1380; 1381; 1382; 1383; 1384; 162 162 + 1385; 1386; 1387; 1388; 1389; 1390; 1391; 1392; 1393; 1394; 1395; 1396; 163 163 + 1397; 1398; 1399; 1400; 1401; 1402; 1403; 1404; 1405; 1406; 1407; 1408; 164 164 + 1409; 1410; 1411; 1412; 1413; 1414; 1415; 1416; 1417; 1418; 1419; 1420; 165 165 + 1421; 1422; 1423; 1424; 1425; 1426; 1427; 1428; 1429; 1430; 1431; 1432; 166 166 + 1433; 1434; 1435; 1436; 1437; 1438; 1439; 1440; 1441; 1442; 1443; 1444; 167 167 + 1445; 1446; 1447; 1448; 1449; 1450; 1451; 1452; 1453; 1454; 1455; 1456; 168 168 + 1457; 1458; 1459; 1460; 1461; 1462; 1463; 1464; 1465; 1466; 1467; 1468; 169 169 + 1469; 1470; 1471; 1472; 1473; 1474; 1475; 1476; 1477; 1478; 1479; 1480; 170 170 + 1481; 1482; 1483; 1484; 1485; 1486; 1487; 1488; 1489; 1490; 1491; 1492; 171 171 + 1493; 1494; 1495; 1496; 1497; 1498; 1499; 1500; 1501; 1502; 1503; 1504; 172 172 + 1505; 1506; 1507; 1508; 1509; 1510; 1511; 1512; 1513; 1514; 1515; 1516; 173 173 + 1517; 1518; 1519; 1520; 1521; 1522; 1523; 1524; 1525; 1526; 1527; 1528; 174 174 + 1529; 1530; 1531; 1532; 1533; 1534; 1535; 1536; 1537; 1538; 1539; 1540; 175 175 + 1541; 1542; 1543; 1544; 1545; 1546; 1547; 1548; 1549; 1550; 1551; 1552; 176 176 + 1553; 1554; 1555; 1556; 1557; 1558; 1559; 1560; 1561; 1562; 1563; 1564; 177 177 + 1565; 1566; 1567; 1568; 1569; 1570; 1571; 1572; 1573; 1574; 1575; 1576; 178 178 + 1577; 1578; 1579; 1580; 1581; 1582; 1583; 1584; 1585; 1586; 1587; 1588; 179 179 + 1589; 1590; 1591; 1592; 1593; 1594; 1595; 1596; 1597; 1598; 1599; 1600; 180 180 + 1601; 1602; 1603; 1604; 1605; 1606; 1607; 1608; 1609; 1610; 1611; 1612; 181 181 + 1613; 1614; 1615; 1616; 1617; 1618; 1619; 1620; 1621; 1622; 1623; 1624; 182 182 + 1625; 1626; 1627; 1628; 1629; 1630; 1631; 1632; 1633; 1634; 1635; 1636; 183 183 + 1637; 1638; 1639; 1640; 1641; 1642; 1643; 1644; 1645; 1646; 1647; 1648; 184 184 + 1649; 1650; 1651; 1652; 1653; 1654; 1655; 1656; 1657; 1658; 1659; 1660; 185 185 + 1661; 1662; 1663; 1664; 1665; 1666; 1667; 1668; 1669; 1670; 1671; 1672; 186 186 + 1673; 1674; 1675; 1676; 1677; 1678; 1679; 1680; 1681; 1682; 1683; 1684; 187 187 + 1685; 1686; 1687; 1688; 1689; 1690; 1691; 1692; 1693; 1694; 1695; 1696; 188 188 + 1697; 1698; 1699; 1700; 1701; 1702; 1703; 1704; 1705; 1706; 1707; 1708; 189 189 + 1709; 1710; 1711; 1712; 1713; 1714; 1715; 1716; 1717; 1718; 1719; 1720; 190 190 + 1721; 1722; 1723; 1724; 1725; 1726; 1727; 1728; 1729; 1730; 1731; 1732; 191 191 + 1733; 1734; 1735; 1736; 1737; 1738; 1739; 1740; 1741; 1742; 1743; 1744; 192 192 + 1745; 1746; 1747; 1748; 1749; 1750; 1751; 1752; 1753; 1754; 1755; 1756; 193 193 + 1757; 1758; 1759; 1760; 1761; 1762; 1763; 1764; 1765; 1766; 1767; 1768; 194 194 + 1769; 1770; 1771; 1772; 1773; 1774; 1775; 1776; 1777; 1778; 1779; 1780; 195 195 + 1781; 1782; 1783; 1784; 1785; 1786; 1787; 1788; 1789; 1790; 1791; 1792; 196 196 + 1793; 1794; 1795; 1796; 1797; 1798; 1799; 1800; 1801; 1802; 1803; 1804; 197 197 + 1805; 1806; 1807; 1808; 1809; 1810; 1811; 1812; 1813; 1814; 1815; 1816; 198 198 + 1817; 1818; 1819; 1820; 1821; 1822; 1823; 1824; 1825; 1826; 1827; 1828; 199 199 + 1829; 1830; 1831; 1832; 1833; 1834; 1835; 1836; 1837; 1838; 1839; 1840; 200 200 + 1841; 1842; 1843; 1844; 1845; 1846; 1847; 1848; 1849; 1850; 1851; 1852; 201 201 + 1853; 1854; 1855; 1856; 1857; 1858; 1859; 1860; 1861; 1862; 1863; 1864; 202 202 + 1865; 1866; 1867; 1868; 1869; 1870; 1871; 1872; 1873; 1874; 1875; 1876; 203 203 + 1877; 1878; 1879; 1880; 1881; 1882; 1883; 1884; 1885; 1886; 1887; 1888; 204 204 + 1889; 1890; 1891; 1892; 1893; 1894; 1895; 1896; 1897; 1898; 1899; 1900; 205 205 + 1901; 1902; 1903; 1904; 1905; 1906; 1907; 1908; 1909; 1910; 1911; 1912; 206 206 + 1913; 1914; 1915; 1916; 1917; 1918; 1919; 1920; 1921; 1922; 1923; 1924; 207 207 + 1925; 1926; 1927; 1928; 1929; 1930; 1931; 1932; 1933; 1934; 1935; 1936; 208 208 + 1937; 1938; 1939; 1940; 1941; 1942; 1943; 1944; 1945; 1946; 1947; 1948; 209 209 + 1949; 1950; 1951; 1952; 1953; 1954; 1955; 1956; 1957; 1958; 1959; 1960; 210 210 + 1961; 1962; 1963; 1964; 1965; 1966; 1967; 1968; 1969; 1970; 1971; 1972; 211 211 + 1973; 1974; 1975; 1976; 1977; 1978; 1979; 1980; 1981; 1982; 1983; 1984; 212 212 + 1985; 1986; 1987; 1988; 1989; 1990; 1991; 1992; 1993; 1994; 1995; 1996; 213 213 + 1997; 1998; 1999; 2000; 2001; 2002; 2003; 2004; 2005; 2006; 2007; 2008; 214 214 + 2009; 2010; 2011; 2012; 2013; 2014; 2015; 2016; 2017; 2018; 2019; 2020; 215 215 + 2021; 2022; 2023; 2024; 2025; 2026; 2027; 2028; 2029; 2030; 2031; 2032; 216 216 + 2033; 2034; 2035; 2036; 2037; 2038; 2039; 2040; 2041; 2042; 2043; 2044; 217 217 + 2045; 2046; 2047; 2048; 2049; 2050; 2051; 2052; 2053; 2054; 2055; 2056; 218 218 + 2057; 2058; 2059; 2060; 2061; 2062; 2063; 2064; 2065; 2066; 2067; 2068; 219 219 + 2069; 2070; 2071; 2072; 2073; 2074; 2075; 2076; 2077; 2078; 2079; 2080; 220 220 + 2081; 2082; 2083; 2084; 2085; 2086; 2087; 2088; 2089; 2090; 2091; 2092; 214 221 2093; 2094; |] 215 222 216 223 let () =

+3 -3

testsuite/tests/basic/eval_order_4.ml

reviewed

··· 7 7 in fun q -> fun i -> "") (print_endline "x") 8 8 9 9 let _ = 10 10 - let k = 11 11 - (let _i = print_int 1 12 12 - in fun q -> fun i -> "") () 10 10 + let k = 11 11 + (let _i = print_int 1 12 12 + in fun q -> fun i -> "") () 13 13 in k (print_int 0) 14 14 15 15 let () =

-1

testsuite/tests/basic/eval_order_6.ml

reviewed

··· 16 16 r.x <- 20;; 17 17 18 18 print_endline (string_of_int (h ()));; 19 19 -

+7 -5

testsuite/tests/basic/maps.ml

reviewed

··· 54 54 List.iter (function (k, f) -> 55 55 let m1 = update i f m in 56 56 let m2 = IntMap.update i f m in 57 57 - if not (IntMap.equal ( = ) m1 m2 && ((m1 == m) = (m2 == m))) then begin 57 57 + if not (IntMap.equal ( = ) m1 m2 && ((m1 == m) = (m2 == m))) then 58 58 + begin 58 59 Printf.printf "ERROR: %s: %d -> %d\n" k i j; 59 60 print_endline "expected result:"; 60 61 show m1; ··· 63 64 end 64 65 ) 65 66 [ 66 66 - "replace", (function None -> None | Some _ -> Some j); 67 67 - "delete if exists, bind otherwise", (function None -> Some j | Some _ -> None); 68 68 - "delete", (function None -> None | Some _ -> None); 69 69 - "insert", (function None -> Some j | Some _ -> Some j); 67 67 + "replace", (function None -> None | Some _ -> Some j); 68 68 + "delete if exists, bind otherwise", 69 69 + (function None -> Some j | Some _ -> None); 70 70 + "delete", (function None -> None | Some _ -> None); 71 71 + "insert", (function None -> Some j | Some _ -> Some j); 70 72 ] 71 73 done; 72 74 done;

-1

testsuite/tests/basic/pr7253.ml

reviewed

··· 13 13 at_exit (fun () -> print_endline "Last"); 14 14 at_exit (fun () -> print_endline "Raise"; raise My_exception); 15 15 at_exit (fun () -> print_endline "First") 16 16 -

+2 -2

testsuite/tests/basic/switch_opts.ml

reviewed

··· 20 20 Test (3, 3., function 1 -> 1. | 2 -> 2. | 3 -> 3. | _ -> 0.); 21 21 Test (3, Sys.opaque_identity "c" ^ Sys.opaque_identity "c", 22 22 function 1 -> "a" | 2 -> "b" | 3 -> "cc" | _ -> ""); 23 23 - Test (3, List.rev [3;2;1], function 1 -> [] | 2 -> [42] | 3 -> [1;2;3] | _ -> [415]); 23 23 + Test (3, List.rev [3;2;1], 24 24 + function 1 -> [] | 2 -> [42] | 3 -> [1;2;3] | _ -> [415]); 24 25 25 26 Test (C, 3, function A -> 1 | B -> 2 | C -> 3); 26 27 Test (C, -3, function A -> 1 | B -> 2 | C -> -3); ··· 62 63 let () = 63 64 List.iter run_test testcases; 64 65 Printf.printf "%d tests passed\n" !passes 65 65 -

+8 -3

testsuite/tests/flambda/specialise.ml

reviewed

··· 44 44 let a12 = a11 + 1 in 45 45 let a13 = a12 + 1 in 46 46 match x_in_g with 47 47 - | Some _ -> f_inner x_in_g (y_in_g - baz) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 48 48 - | None -> f_inner x_in_g (y_in_g - baz) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 47 47 + | Some _ -> 48 48 + f_inner x_in_g (y_in_g - baz) 49 49 + a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 50 50 + | None -> 51 51 + f_inner x_in_g (y_in_g - baz) 52 52 + a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 49 53 in 50 54 f_inner 51 55 in 52 56 let s = Some init in 53 57 let f_through_hide = hide_until_round_2 init f_outer in 54 54 - (f_through_hide [@specialised]) s 10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 58 58 + (f_through_hide [@specialised]) 59 59 + s 10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13

+4 -4

testsuite/tests/float-unboxing/float_subst_boxed_number.ml

reviewed

··· 10 10 for n = 1 to 1000 do 11 11 let open Complex in 12 12 let c = { re = float n; im = 0. } in 13 13 - (* The following line triggers warning 55 twice when compiled without flambda *) 14 14 - (* It would be better to disable this warning just here but since *) 15 15 - (* this is a backend-warning, this is not currently possible *) 16 16 - (* Hence the use of the -w-55 command-line flag for this test *) 13 13 + (* The following line triggers warning 55 twice when compiled without 14 14 + flambda. It would be better to disable this warning just here but since 15 15 + this is a backend-warning, this is not currently possible. Hence the use 16 16 + of the -w-55 command-line flag for this test *) 17 17 r := !r +. (norm [@inlined]) ((add [@inlined]) c i); 18 18 done; 19 19 ignore (Sys.opaque_identity !r)

+1 -2

testsuite/tests/letrec-disallowed/disallowed.ml

reviewed

··· 110 110 let rec x = 111 111 match let _ = y in raise Not_found with 112 112 _ -> "x" 113 113 - | exception Not_found -> "z" 113 113 + | exception Not_found -> "z" 114 114 and y = match x with 115 115 z -> ("y", z);; 116 116 -

+1 -1

testsuite/tests/letrec-disallowed/disallowed.ocaml.reference

reviewed

··· 120 120 Characters 15-98: 121 121 ..match let _ = y in raise Not_found with 122 122 _ -> "x" 123 123 - | exception Not_found -> "z". 123 123 + | exception Not_found -> "z" 124 124 Error: This kind of expression is not allowed as right-hand side of `let rec' 125 125

+1 -1

testsuite/tests/letrec-disallowed/labels.ml

reviewed

··· 1 1 - (* TEST 1 1 + (* TEST 2 2 * toplevel 3 3 *) 4 4

+1 -1

testsuite/tests/letrec-disallowed/lazy_.ml

reviewed

··· 1 1 - (* TEST 1 1 + (* TEST 2 2 * toplevel 3 3 *) 4 4

+1 -1

testsuite/tests/letrec-disallowed/lazy_.ocaml.reference

reviewed

··· 1 1 - Characters 39-45: 1 1 + Characters 38-44: 2 2 let rec a = lazy b and b = 3;; 3 3 ^^^^^^ 4 4 Error: This kind of expression is not allowed as right-hand side of `let rec'

+1 -1

testsuite/tests/letrec-disallowed/pr7231.ml

reviewed

··· 2 2 * toplevel 3 3 *) 4 4 5 5 - let rec r = let rec x () = r and y () = x () in y () in r "oops";; 5 5 + let rec r = let rec x () = r and y () = x () in y () in r "oops";;

+2 -2

testsuite/tests/letrec-disallowed/pr7231.ocaml.reference

reviewed

··· 1 1 Characters 84-90: 2 2 - let rec r = let rec x () = r and y () = x () in y () in r "oops";; 2 2 + let rec r = let rec x () = r and y () = x () in y () in r "oops";; 3 3 ^^^^^^ 4 4 Warning 20: this argument will not be used by the function. 5 5 Characters 38-78: 6 6 - let rec r = let rec x () = r and y () = x () in y () in r "oops";; 6 6 + let rec r = let rec x () = r and y () = x () in y () in r "oops";; 7 7 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 8 8 Error: This kind of expression is not allowed as right-hand side of `let rec' 9 9

+1 -1

testsuite/tests/letrec-disallowed/unboxed.ml

reviewed

··· 7 7 8 8 type r = A of r [@@unboxed];; 9 9 let rec y = A y;; 10 10 - 10 10 + 11 11 type a = {a: b }[@@unboxed] 12 12 and b = X of a | Y 13 13

+1 -1

testsuite/tests/letrec-disallowed/unboxed.ocaml.reference

reviewed

··· 8 8 let rec y = A y;; 9 9 ^^^ 10 10 Error: This kind of expression is not allowed as right-hand side of `let rec' 11 11 - Characters 77-150: 11 11 + Characters 63-136: 12 12 ..{a= 13 13 (if Sys.opaque_identity true then 14 14 X a

+2 -1

testsuite/tests/letrec/ref.ml

reviewed

··· 1 1 (* TEST *) 2 2 3 3 - (* Test construction of cyclic values where the cycles pass through references *) 3 3 + (* Test construction of cyclic values where the cycles pass through 4 4 + references *) 4 5 5 6 type t = { mutable next : t; mutable inst : n ref } 6 7 and n = T of t

+2 -1

testsuite/tests/lib-arg/testarg.ml

reviewed

··· 195 195 let spec = 196 196 [ 197 197 "-foo", Arg.String ignore, "FOO Do foo with FOO"; 198 198 - "-bar", Arg.Tuple [Arg.String ignore; Arg.String ignore], "FOO BAR\tDo bar with FOO and BAR"; 198 198 + "-bar", Arg.Tuple [Arg.String ignore; Arg.String ignore], 199 199 + "FOO BAR\tDo bar with FOO and BAR"; 199 200 "-cha", Arg.Unit ignore, " Another option"; 200 201 "-sym", Arg.Symbol (["a"; "b"], ignore), "\ty\tfoo"; 201 202 "-sym2", Arg.Symbol (["a"; "b"], ignore), "x bar";

+2 -1

testsuite/tests/lib-arg/testerror.ml

reviewed

··· 24 24 ; [], ignore, ["-help" ] 25 25 26 26 (** wrong argument type *) 27 27 - ; ["-int", Arg.Int ignore, "wrong argument type" ], ignore, ["-int"; "not_an_int" ] 27 27 + ; ["-int", Arg.Int ignore, "wrong argument type" ], ignore, 28 28 + ["-int"; "not_an_int" ] 28 29 29 30 (** unknown option *) 30 31 ; [], ignore, [ "-an-unknown-option" ]

+2 -1

testsuite/tests/lib-bigarray/change_layout.ml

reviewed

··· 64 64 Genarray.set gen pos (-1.); 65 65 let different = Genarray.get gen pos <> initial in 66 66 let gen' = Genarray.change_layout gen fortran in 67 67 - Genarray.set gen' ( Array.init rank @@ fun n -> 1 + pos.( rank - 1 - n ) ) initial; 67 67 + Genarray.set gen' ( Array.init rank @@ fun n -> 1 + pos.( rank - 1 - n ) ) 68 68 + initial; 68 69 if not (different && initial = Genarray.get gen pos) then Some pos 69 70 else None 70 71

+2 -2

testsuite/tests/lib-bytes/test_bytes.ml

reviewed

··· 4 4 5 5 let test_raises_invalid_argument f x = 6 6 ignore 7 7 - (Testing.test_raises_exc_p (function Invalid_argument _ -> true | _ -> false) 8 8 - f x) 7 7 + (Testing.test_raises_exc_p 8 8 + (function Invalid_argument _ -> true | _ -> false) f x) 9 9 10 10 let check b offset s = 11 11 let rec loop i =

+8 -4

testsuite/tests/lib-digest/md5.ml

reviewed

··· 134 134 data 135 135 136 136 let int32_to_string n s i = 137 137 - Bytes.set s (i+3) (Char.chr (Int32.to_int (Int32.shift_right n 24) land 0xFF)); 138 138 - Bytes.set s (i+2) (Char.chr (Int32.to_int (Int32.shift_right n 16) land 0xFF)); 139 139 - Bytes.set s (i+1) (Char.chr (Int32.to_int (Int32.shift_right n 8) land 0xFF)); 140 140 - Bytes.set s i (Char.chr (Int32.to_int n land 0xFF)) 137 137 + Bytes.set s (i+3) 138 138 + (Char.chr (Int32.to_int (Int32.shift_right n 24) land 0xFF)); 139 139 + Bytes.set s (i+2) 140 140 + (Char.chr (Int32.to_int (Int32.shift_right n 16) land 0xFF)); 141 141 + Bytes.set s (i+1) 142 142 + (Char.chr (Int32.to_int (Int32.shift_right n 8) land 0xFF)); 143 143 + Bytes.set s i 144 144 + (Char.chr (Int32.to_int n land 0xFF)) 141 145 142 146 let init () = 143 147 { buf = Bytes.create 64;

+1 -1

testsuite/tests/lib-dynlink-native/main.ml

reviewed

··· 8 8 include systhreads 9 9 include dynlink 10 10 11 11 - set subdir = "${test_source_directory}/sub" 11 11 + set subdir = "${test_source_directory}/sub" 12 12 13 13 * native-dynlink 14 14 libraries = "" (* We will add them manually where appropriated *)

+2 -1

testsuite/tests/lib-hashtbl/htbl.ml

reviewed

··· 45 45 let check_to_seq_of_seq h = 46 46 let h' = H.create (H.length h) in 47 47 H.add_seq h' (H.to_seq h); 48 48 - (*printf "h.len=%d, h'.len=%d\n" (List.length @@ to_list_ h) (List.length @@ to_list_ h');*) 48 48 + (*printf "h.len=%d, h'.len=%d\n" (List.length @@ to_list_ h) 49 49 + (List.length @@ to_list_ h');*) 49 50 assert (to_list_ h = to_list_ h') 50 51 51 52 let test data =

+2 -1

testsuite/tests/lib-list/test.ml

reviewed

··· 59 59 let _ = List.init n (fun x -> result := (x = n - 1)) in 60 60 assert !result 61 61 in 62 62 - let threshold = 10_000 in (* Threshold must equal the value in stdlib/list.ml *) 62 62 + (* Threshold must equal the value in stdlib/list.ml *) 63 63 + let threshold = 10_000 in 63 64 test threshold; (* Non tail-recursive case *) 64 65 test (threshold + 1) (* Tail-recursive case *) 65 66 ;;

+1 -3

testsuite/tests/lib-seq/test.ml

reviewed

··· 11 11 |> Seq.filter (fun x -> x mod 2 = 0) 12 12 |> List.of_seq)); 13 13 () 14 14 - ;; 14 14 + ;; 15 15 16 16 let () = print_endline "OK";; 17 17 - 18 18 -

+2 -1

testsuite/tests/lib-threads/torture.ml

reviewed

··· 32 32 (* print_string "reader "; print_int n; print_newline(); *) 33 33 for i = 0 to n-1 do 34 34 if Bytes.get buff i = 'b' then Thread.exit() 35 35 - else if Bytes.get buff i <> 'a' then print_string "error in reader_thread\n" 35 35 + else if Bytes.get buff i <> 'a' then 36 36 + print_string "error in reader_thread\n" 36 37 done 37 38 done 38 39

+2 -2

testsuite/tests/lib-unix/common/cloexec.ml

reviewed

··· 7 7 Presumably this is because the OCaml runtime opens files, so that handles 8 8 that have actually been closed at execution look open and make the 9 9 test fail. 10 10 - 10 10 + 11 11 One possible fix for this would be to make it possible for ocamltest to 12 12 compile C-only programs, which will be a bit of work to handle the 13 13 output of msvc and will also duplicate what the ocaml compiler itslef ··· 97 97 p0;p0';p1;p1';p2;p2'; 98 98 s0;s1;s2; 99 99 x0;x0';x1;x1';x2;x2' |] in 100 100 - let untested = 100 100 + let untested = 101 101 [untested1; untested2; untested3; untested4; untested5] 102 102 in 103 103 let pid =

+1 -3

testsuite/tests/lib-unix/common/dup2.ml

reviewed

··· 18 18 let fd = 19 19 Unix.(openfile "./tmp.txt" 20 20 [O_WRONLY;O_TRUNC;O_CREAT;O_SHARE_DELETE] 21 21 - 0o600) in 21 21 + 0o600) in 22 22 out fd "---\n"; 23 23 Unix.dup2 ~cloexec:true fd Unix.stderr; 24 24 Unix.close fd; 25 25 out Unix.stderr "Some output\n"; 26 26 cat "./tmp.txt"; 27 27 Sys.remove "./tmp.txt" 28 28 - 29 29 -

+4 -3

testsuite/tests/lib-unix/common/redirections.ml

reviewed

··· 55 55 let pid = 56 56 Unix.create_process_env 57 57 refl 58 58 - [| refl; "-i2o"; "-i2e"; "-o"; "123"; "-e"; "456"; "-i2o"; "-v"; "XVAR" |] 58 58 + [| refl; "-i2o"; "-i2e"; "-o"; "123"; "-e"; "456"; "-i2o"; "-v"; "XVAR" 59 59 + |] 59 60 (Array.append [| "XVAR=xvar" |] systemenv) 60 61 p_exit f_out f_err in 61 62 out p_entrance "aaaa\n"; ··· 115 116 (refl ^ " -o 123 -i2o -e 456 -i2e -v XVAR") 116 117 (Array.append [|"XVAR=xvar"|] systemenv) in 117 118 output_string i "aa\nbbbb\n"; close_out i; 118 118 - for _i = 1 to 3 do 119 119 + for _i = 1 to 3 do 119 120 out Unix.stdout (input_line o ^ "\n") 120 121 done; 121 122 for _i = 1 to 2 do ··· 128 129 let _ = 129 130 let env = Unix.environment() in 130 131 (* The following 'close' makes things more difficult. 131 131 - Under Unix it works fine, but under Win32 create_process 132 132 + Under Unix it works fine, but under Win32 create_process 132 133 gives an error if one of the standard handles is closed. *) 133 134 (* Unix.close Unix.stdin; *) 134 135 out Unix.stdout "** create_process\n";

+4 -5

testsuite/tests/lib-unix/common/reflector.ml

reviewed

··· 1 1 - let copyline input output = 1 1 + let copyline input output = 2 2 let rec copy() = match input_char input with 3 3 | exception End_of_file -> 4 4 output_string output "<end of file>\n" 5 5 | char -> 6 6 output_char output char; 7 7 - if char='\n' then () else copy() 7 7 + if char='\n' then () else copy() 8 8 in 9 9 copy(); 10 10 flush output ··· 16 16 17 17 let output_env_var output env_var = 18 18 let value = match Sys.getenv_opt env_var with 19 19 - | None -> "<no such variable>" 19 19 + | None -> "<no such variable>" 20 20 | Some v -> v 21 21 in 22 22 output_endline stdout value ··· 44 44 output_endline stderr "<bad argument>" 45 45 46 46 let () = 47 47 - set_binary_mode_in stdin true; 47 47 + set_binary_mode_in stdin true; 48 48 set_binary_mode_out stdout true; 49 49 set_binary_mode_out stderr true; 50 50 Arg.parse options report_bad_argument "" 51 51 -

+3 -1

testsuite/tests/lib-unix/common/test_unix_cmdline.ml

reviewed

··· 38 38 let out, inp = pipe () in 39 39 let in_chan = in_channel_of_descr out in 40 40 set_binary_mode_in in_chan false; 41 41 - let pid = create_process ("./" ^ prog_name) (Array.of_list (prog_name :: args)) Unix.stdin inp Unix.stderr in 41 41 + let pid = 42 42 + create_process ("./" ^ prog_name) (Array.of_list (prog_name :: args)) 43 43 + Unix.stdin inp Unix.stderr in 42 44 List.iter (fun arg -> 43 45 let s = input_line in_chan in 44 46 Printf.printf "%S -> %S [%s]\n" arg s (if s = arg then "OK" else "FAIL")

-1

testsuite/tests/lib-unix/unix-execvpe/script3

reviewed

··· 2 2 echo "--- ./script3" 3 3 echo "FOO is $FOO, BAR is $BAR, BUZ is $BUZ" 4 4 echo "$# arguments: $*" 5 5 -

-1

testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec

reviewed

··· 1 1 echo "This script lacks the x bit and should not run!" 2 2 -

+2 -1

testsuite/tests/lib-unix/win-env/test_env.ml

reviewed

··· 7 7 ** native 8 8 *) 9 9 10 10 - external set_environment_variable: string -> string -> unit = "stub_SetEnvironmentVariable" 10 10 + external set_environment_variable: string -> string -> unit 11 11 + = "stub_SetEnvironmentVariable" 11 12 12 13 let find_env s = 13 14 let env = Unix.environment () in

+6 -2

testsuite/tests/locale/test.ml

reviewed

··· 4 4 5 5 external setlocale : string -> unit = "ml_setlocale" 6 6 7 7 - let show f = try string_of_float @@ f () with exn -> Printf.sprintf "exn %s" (Printexc.to_string exn) 7 7 + let show f = 8 8 + try 9 9 + string_of_float @@ f () 10 10 + with exn -> Printf.sprintf "exn %s" (Printexc.to_string exn) 8 11 let pr fmt = Printf.ksprintf print_endline fmt 9 12 10 13 let () = ··· 13 16 let test () = 14 17 pr " print 1.23 : %s" (show @@ fun () -> f); 15 18 pr " parse %S : %s" s (show @@ fun () -> float_of_string s); 16 16 - pr " roundtrip 1.23 : %s" (show @@ fun () -> float_of_string @@ string_of_float f); 19 19 + pr " roundtrip 1.23 : %s" 20 20 + (show @@ fun () -> float_of_string @@ string_of_float f); 17 21 in 18 22 pr "locale from environment"; 19 23 setlocale "";

+2 -2

testsuite/tests/no-alias-deps/aliases.compilers.reference

reviewed

··· 1 1 - File "aliases.ml", line 16, characters 12-13: 2 2 - Warning 49: no cmi file was found in path for module A 3 1 File "aliases.ml", line 17, characters 12-13: 2 2 + Warning 49: no cmi file was found in path for module A 3 3 + File "aliases.ml", line 18, characters 12-13: 4 4 Warning 49: no valid cmi file was found in path for module B. b.cmi 5 5 is not a compiled interface

+2 -1

testsuite/tests/no-alias-deps/aliases.ml

reviewed

··· 4 4 files = "c.mli d.mli" 5 5 * setup-ocamlc.byte-build-env 6 6 ** script 7 7 - script = "cp ${test_source_directory}/b.cmi.invalid ${test_build_directory}/b.cmi" 7 7 + script = 8 8 + "cp ${test_source_directory}/b.cmi.invalid ${test_build_directory}/b.cmi" 8 9 *** ocamlc.byte 9 10 all_modules = "c.mli d.mli aliases.ml" 10 11 **** check-ocamlc.byte-output

-1

testsuite/tests/ppx-contexts/myppx.ml

reviewed

··· 7 7 Printf.eprintf "use_threads=%b\n" !Clflags.use_threads; 8 8 Printf.eprintf "use_vmthreads=%b\n" !Clflags.use_vmthreads; 9 9 default_mapper); 10 10 -

+4 -4

testsuite/tests/regression/gpr1623/gpr1623.ml

reviewed

··· 1 1 (* TEST 2 2 - arguments = "???" 2 2 + arguments = "???" 3 3 *) 4 4 5 5 (* On Windows the runtime expand windows wildcards (asterisks and 6 6 * question marks). 7 7 * 8 8 - * This file is a non-regression test for github's PR#1623. 8 8 + * This file is a non-regression test for github's PR#1623. 9 9 * 10 10 - * On Windows 64bits, a segfault was triggered when one argument consists 11 11 - * only of wildcards. 10 10 + * On Windows 64bits, a segfault was triggered when one argument consists 11 11 + * only of wildcards. 12 12 * 13 13 * The source code of this test is empty: we just check the arguments 14 14 * expansion.

+1 -1

testsuite/tests/regression/missing_set_of_closures/missing_set_of_closures.ml

reviewed

··· 1 1 (* TEST 2 2 files = "a.ml b.ml b2.ml" 3 3 * setup-ocamlopt.byte-build-env 4 4 - ** script 4 4 + ** script 5 5 script = "mkdir -p dir" 6 6 *** script 7 7 script = "cp ${test_source_directory}/dir/c.ml dir/"

+1 -1

testsuite/tests/runtime-errors/has-stackoverflow-detection.sh

reviewed

··· 2 2 if grep -q HAS_STACK_OVERFLOW_DETECTION ${ocamlsrcdir}/byterun/caml/s.h; then 3 3 test_result=${TEST_PASS}; 4 4 else 5 5 - test_result=${TEST_SKIP}; 5 5 + test_result=${TEST_SKIP}; 6 6 fi 7 7 8 8 exit ${test_result}

-1

testsuite/tests/tool-command-line/test.ml

reviewed

··· 29 29 *) 30 30 31 31 (* this file is just a test driver, the test does not contain real OCamlcode *) 32 32 -

+1 -1

testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference

reviewed

··· 41 41 </ul></li> 42 42 </ul> 43 43 </div> 44 44 - </body></html> 44 44 + </body></html>

+2 -2

testsuite/tests/tool-ocamldoc/Documentation_tags.mli

reviewed

··· 5 5 (** Test the html rendering of ocamldoc documentation tags *) 6 6 7 7 val heterological: unit 8 8 - (** 8 8 + (** 9 9 @author yes 10 10 @param no No description 11 11 - @param neither see no description 11 11 + @param neither see no description 12 12 @deprecated since the start of time 13 13 @return () 14 14 @see "Documentation_tags.mli" Self reference

+1 -1

testsuite/tests/tool-ocamldoc/Inline_records.html.reference

reviewed

··· 349 349 </div> 350 350 </div> 351 351 352 352 - </body></html> 352 352 + </body></html>

+1 -1

testsuite/tests/tool-ocamldoc/Item_ids.html.reference

reviewed

··· 50 50 <pre><span id="TYPEc"><span class="keyword">class</span> <a href="Item_ids.c-c.html">c</a></span> : <code class="type"></code><code class="code"><span class="keyword">object</span></code> <a href="Item_ids.c-c.html">..</a> <code class="code"><span class="keyword">end</span></code></pre> 51 51 <pre><span id="TYPEct"><span class="keyword">class type</span> <a href="Item_ids.ct-c.html">ct</a></span> = <code class="code"><span class="keyword">object</span></code> <a href="Item_ids.ct-c.html">..</a> <code class="code"><span class="keyword">end</span></code></pre> 52 52 <pre><span id="MODULEM"><span class="keyword">module</span> <a href="Item_ids.M.html">M</a></span>: <code class="code"><span class="keyword">sig</span></code> <a href="Item_ids.M.html">..</a> <code class="code"><span class="keyword">end</span></code></pre> 53 53 - <pre><span id="MODULETYPEs"><span class="keyword">module type</span> <a href="Item_ids.s-c.html">s</a></span> = <code class="code"><span class="keyword">sig</span></code> <a href="Item_ids.s-c.html">..</a> <code class="code"><span class="keyword">end</span></code></pre></body></html> 53 53 + <pre><span id="MODULETYPEs"><span class="keyword">module type</span> <a href="Item_ids.s-c.html">s</a></span> = <code class="code"><span class="keyword">sig</span></code> <a href="Item_ids.s-c.html">..</a> <code class="code"><span class="keyword">end</span></code></pre></body></html>

+4 -4

testsuite/tests/tool-ocamldoc/Level_0.latex.reference

reviewed

··· 7 7 \usepackage{ocamldoc} 8 8 \begin{document} 9 9 \tableofcontents 10 10 - \section{Module {\tt{Level\_0}} : Test for level 0 headings } 10 10 + \section{Module {\tt{Level\_0}} : Test for level 0 headings} 11 11 \label{Level-underscore0}\index{Level-underscore0@\verb`Level_0`} 12 12 13 13 14 14 15 15 \subsection*{Level 1} 16 16 - 16 16 + 17 17 18 18 19 19 Standard heading levels start at 1. ··· 25 25 the main heading of the module. 26 26 27 27 28 28 - This setup allows users to start their standard heading at level 1 rather 29 29 - than 2, without losing the ability to add global level heading, 28 28 + This setup allows users to start their standard heading at level 1 rather 29 29 + than 2, without losing the ability to add global level heading, 30 30 when, if ever, such heading is warranted 31 31 32 32

+6 -6

testsuite/tests/tool-ocamldoc/Level_0.mli

reviewed

··· 2 2 * ocamldoc with latex 3 3 *) 4 4 5 5 - (** Test for level 0 headings 6 6 - 7 7 - {1 Level 1} 8 8 - 5 5 + (** Test for level 0 headings 6 6 + 7 7 + {1 Level 1} 8 8 + 9 9 Standard heading levels start at 1. 10 10 11 11 {0 Level 0} 12 12 A level 0 heading is guaranted to be at the same level that 13 13 the main heading of the module. 14 14 15 15 - This setup allows users to start their standard heading at level 1 rather 16 16 - than 2, without losing the ability to add global level heading, 15 15 + This setup allows users to start their standard heading at level 1 rather 16 16 + than 2, without losing the ability to add global level heading, 17 17 when, if ever, such heading is warranted 18 18 19 19 *)

+1 -1

testsuite/tests/tool-ocamldoc/Linebreaks.html.reference

reviewed

··· 132 132 133 133 <p>See <a href="http://caml.inria.fr/mantis/view.php?id=7272">MPR#7272</a> for more 134 134 information.</p> 135 135 - </body></html> 135 135 + </body></html>

+1 -1

testsuite/tests/tool-ocamldoc/Loop.html.reference

reviewed

··· 17 17 <pre><span id="MODULELoop"><span class="keyword">module</span> Loop</span>: <code class="code"><span class="keyword">sig</span></code> <a href="Loop.html">..</a> <code class="code"><span class="keyword">end</span></code></pre><hr width="100%"> 18 18 19 19 <pre><span id="MODULEA"><span class="keyword">module</span> <a href="Loop.A.html">A</a></span>: <code class="type"><a href="Loop.B.html">B</a></code></pre> 20 20 - <pre><span id="MODULEB"><span class="keyword">module</span> <a href="Loop.B.html">B</a></span>: <code class="type"><a href="Loop.A.html">A</a></code></pre></body></html> 20 20 + <pre><span id="MODULEB"><span class="keyword">module</span> <a href="Loop.B.html">B</a></span>: <code class="type"><a href="Loop.A.html">A</a></code></pre></body></html>

+1 -1

testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference

reviewed

··· 21 21 22 22 23 23 <pre><span id="VALcompare"><span class="keyword">val</span> compare</span> : <code class="type">'a -> 'a -> int</code></pre></div> 24 24 - <pre><code class="code"><span class="keyword">end</span></code><code class="code">)</code></pre></body></html> 24 24 + <pre><code class="code"><span class="keyword">end</span></code><code class="code">)</code></pre></body></html>

+1 -1

testsuite/tests/tool-ocamldoc/No_preamble.html.reference

reviewed

··· 22 22 <p>This is a documentation comment for <code class="code">x</code>, not a module preamble.</p> 23 23 </div> 24 24 </div> 25 25 - </body></html> 25 25 + </body></html>

+1 -1

testsuite/tests/tool-ocamldoc/Paragraph.html.reference

reviewed

··· 72 72 </div> 73 73 </div> 74 74 75 75 - </body></html> 75 75 + </body></html>

+1 -1

testsuite/tests/tool-ocamldoc/Variants.html.reference

reviewed

··· 279 279 </div> 280 280 </div> 281 281 282 282 - </body></html> 282 282 + </body></html>

+1 -1

testsuite/tests/tool-ocamldoc/type_Linebreaks.reference

reviewed

··· 24 24 &nbsp;&nbsp;<span class="keyword">module</span>&nbsp;<span class="keyword">type</span>&nbsp;s&nbsp;=&nbsp;<span class="keyword">sig</span>&nbsp;&nbsp;<span class="keyword">end</span><br> 25 25 &nbsp;&nbsp;<span class="keyword">class</span>&nbsp;<span class="keyword">type</span>&nbsp;d&nbsp;=&nbsp;<span class="keyword">object</span>&nbsp;&nbsp;<span class="keyword">end</span><br> 26 26 &nbsp;&nbsp;<span class="keyword">exception</span>&nbsp;<span class="constructor">E</span>&nbsp;<span class="keyword">of</span>&nbsp;{&nbsp;inline&nbsp;:&nbsp;int;&nbsp;}<br> 27 27 - <span class="keyword">end</span></code></body></html> 27 27 + <span class="keyword">end</span></code></body></html>

+4 -2

testsuite/tests/tool-toplevel-invocation/test.ml

reviewed

··· 13 13 14 14 ** ocaml 15 15 flags = "-args ${test_source_directory}/indirect_first_arg_fail.txt" 16 16 - compiler_reference = "${test_source_directory}/indirect_first_arg_fail.txt.reference" 16 16 + compiler_reference = 17 17 + "${test_source_directory}/indirect_first_arg_fail.txt.reference" 17 18 compiler_output = "${test_build_directory}/indirect_first_arg_fail.output" 18 19 ocaml_exit_status = "2" 19 20 *** check-ocaml-output 20 21 21 22 ** ocaml 22 23 flags = "-args ${test_source_directory}/indirect_last_arg_fail.txt" 23 23 - compiler_reference = "${test_source_directory}/indirect_last_arg_fail.txt.reference" 24 24 + compiler_reference = 25 25 + "${test_source_directory}/indirect_last_arg_fail.txt.reference" 24 26 compiler_output = "${test_build_directory}/indirect_last_arg_fail.output" 25 27 ocaml_exit_status = "2" 26 28 *** check-ocaml-output

-2

testsuite/tests/tool-toplevel/exotic_lists.ml

reviewed

··· 15 15 L.[[1];[2];[3];[4];[5]];; 16 16 open L;; 17 17 [1;2;3;4;5];; 18 18 - 19 19 -

+2 -1

testsuite/tests/tool-toplevel/strings.ml

reviewed

··· 7 7 8 8 {|"\'|};; 9 9 10 10 - " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmnopqrstuvwxyz{|}~";; 10 10 + " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`\ 11 11 + abcdefghijklmnopqrstuvwxyz{|}~";; 11 12 12 13 "\x00\x01\x02\x03\x04\x05\x06\x07\x0B\x0C\x0E\x0F\ 13 14 \x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F\

+4 -2

testsuite/tests/translprim/array_spec.ml

reviewed

··· 4 4 flags = "-dlambda -dno-unique-ids" 5 5 *** flat-float-array 6 6 **** check-ocamlc.byte-output 7 7 - compiler_reference = "${test_source_directory}/array_spec.compilers.reference.flat" 7 7 + compiler_reference = 8 8 + "${test_source_directory}/array_spec.compilers.reference.flat" 8 9 *** no-flat-float-array 9 10 **** check-ocamlc.byte-output 10 10 - compiler_reference = "${test_source_directory}/array_spec.compilers.reference.no-flat" 11 11 + compiler_reference = 12 12 + "${test_source_directory}/array_spec.compilers.reference.no-flat" 11 13 *) 12 14 13 15 external len : 'a array -> int = "%array_length"

+7 -7

testsuite/tests/translprim/module_coercion.compilers.reference.flat

reviewed

··· 1 1 (setglobal Module_coercion! 2 2 - (let (M = (module-defn(M) module_coercion.ml(13):417-1116 (makeblock 0))) 2 2 + (let (M = (module-defn(M) module_coercion.ml(15):436-1135 (makeblock 0))) 3 3 (makeblock 0 M 4 4 - (module-defn(M_int) module_coercion.ml(44):1533-1572 4 4 + (module-defn(M_int) module_coercion.ml(46):1552-1591 5 5 (makeblock 0 (function prim stub (array.length[int] prim)) 6 6 (function prim prim stub (array.get[int] prim prim)) 7 7 (function prim prim stub (array.unsafe_get[int] prim prim)) ··· 15 15 (function prim prim stub (> prim prim)) 16 16 (function prim prim stub (<= prim prim)) 17 17 (function prim prim stub (>= prim prim)))) 18 18 - (module-defn(M_float) module_coercion.ml(45):1575-1618 18 18 + (module-defn(M_float) module_coercion.ml(47):1594-1637 19 19 (makeblock 0 (function prim stub (array.length[float] prim)) 20 20 (function prim prim stub (array.get[float] prim prim)) 21 21 (function prim prim stub (array.unsafe_get[float] prim prim)) ··· 29 29 (function prim prim stub (>. prim prim)) 30 30 (function prim prim stub (<=. prim prim)) 31 31 (function prim prim stub (>=. prim prim)))) 32 32 - (module-defn(M_string) module_coercion.ml(46):1621-1666 32 32 + (module-defn(M_string) module_coercion.ml(48):1640-1685 33 33 (makeblock 0 (function prim stub (array.length[addr] prim)) 34 34 (function prim prim stub (array.get[addr] prim prim)) 35 35 (function prim prim stub (array.unsafe_get[addr] prim prim)) ··· 43 43 (function prim prim stub (caml_string_greaterthan prim prim)) 44 44 (function prim prim stub (caml_string_lessequal prim prim)) 45 45 (function prim prim stub (caml_string_greaterequal prim prim)))) 46 46 - (module-defn(M_int32) module_coercion.ml(47):1669-1712 46 46 + (module-defn(M_int32) module_coercion.ml(49):1688-1731 47 47 (makeblock 0 (function prim stub (array.length[addr] prim)) 48 48 (function prim prim stub (array.get[addr] prim prim)) 49 49 (function prim prim stub (array.unsafe_get[addr] prim prim)) ··· 57 57 (function prim prim stub (Int32.> prim prim)) 58 58 (function prim prim stub (Int32.<= prim prim)) 59 59 (function prim prim stub (Int32.>= prim prim)))) 60 60 - (module-defn(M_int64) module_coercion.ml(48):1715-1758 60 60 + (module-defn(M_int64) module_coercion.ml(50):1734-1777 61 61 (makeblock 0 (function prim stub (array.length[addr] prim)) 62 62 (function prim prim stub (array.get[addr] prim prim)) 63 63 (function prim prim stub (array.unsafe_get[addr] prim prim)) ··· 71 71 (function prim prim stub (Int64.> prim prim)) 72 72 (function prim prim stub (Int64.<= prim prim)) 73 73 (function prim prim stub (Int64.>= prim prim)))) 74 74 - (module-defn(M_nativeint) module_coercion.ml(49):1761-1812 74 74 + (module-defn(M_nativeint) module_coercion.ml(51):1780-1831 75 75 (makeblock 0 (function prim stub (array.length[addr] prim)) 76 76 (function prim prim stub (array.get[addr] prim prim)) 77 77 (function prim prim stub (array.unsafe_get[addr] prim prim))

+7 -7

testsuite/tests/translprim/module_coercion.compilers.reference.no-flat

reviewed

··· 1 1 (setglobal Module_coercion! 2 2 - (let (M = (module-defn(M) module_coercion.ml(13):417-1116 (makeblock 0))) 2 2 + (let (M = (module-defn(M) module_coercion.ml(15):436-1135 (makeblock 0))) 3 3 (makeblock 0 M 4 4 - (module-defn(M_int) module_coercion.ml(44):1533-1572 4 4 + (module-defn(M_int) module_coercion.ml(46):1552-1591 5 5 (makeblock 0 (function prim stub (array.length[int] prim)) 6 6 (function prim prim stub (array.get[int] prim prim)) 7 7 (function prim prim stub (array.unsafe_get[int] prim prim)) ··· 15 15 (function prim prim stub (> prim prim)) 16 16 (function prim prim stub (<= prim prim)) 17 17 (function prim prim stub (>= prim prim)))) 18 18 - (module-defn(M_float) module_coercion.ml(45):1575-1618 18 18 + (module-defn(M_float) module_coercion.ml(47):1594-1637 19 19 (makeblock 0 (function prim stub (array.length[addr] prim)) 20 20 (function prim prim stub (array.get[addr] prim prim)) 21 21 (function prim prim stub (array.unsafe_get[addr] prim prim)) ··· 29 29 (function prim prim stub (>. prim prim)) 30 30 (function prim prim stub (<=. prim prim)) 31 31 (function prim prim stub (>=. prim prim)))) 32 32 - (module-defn(M_string) module_coercion.ml(46):1621-1666 32 32 + (module-defn(M_string) module_coercion.ml(48):1640-1685 33 33 (makeblock 0 (function prim stub (array.length[addr] prim)) 34 34 (function prim prim stub (array.get[addr] prim prim)) 35 35 (function prim prim stub (array.unsafe_get[addr] prim prim)) ··· 43 43 (function prim prim stub (caml_string_greaterthan prim prim)) 44 44 (function prim prim stub (caml_string_lessequal prim prim)) 45 45 (function prim prim stub (caml_string_greaterequal prim prim)))) 46 46 - (module-defn(M_int32) module_coercion.ml(47):1669-1712 46 46 + (module-defn(M_int32) module_coercion.ml(49):1688-1731 47 47 (makeblock 0 (function prim stub (array.length[addr] prim)) 48 48 (function prim prim stub (array.get[addr] prim prim)) 49 49 (function prim prim stub (array.unsafe_get[addr] prim prim)) ··· 57 57 (function prim prim stub (Int32.> prim prim)) 58 58 (function prim prim stub (Int32.<= prim prim)) 59 59 (function prim prim stub (Int32.>= prim prim)))) 60 60 - (module-defn(M_int64) module_coercion.ml(48):1715-1758 60 60 + (module-defn(M_int64) module_coercion.ml(50):1734-1777 61 61 (makeblock 0 (function prim stub (array.length[addr] prim)) 62 62 (function prim prim stub (array.get[addr] prim prim)) 63 63 (function prim prim stub (array.unsafe_get[addr] prim prim)) ··· 71 71 (function prim prim stub (Int64.> prim prim)) 72 72 (function prim prim stub (Int64.<= prim prim)) 73 73 (function prim prim stub (Int64.>= prim prim)))) 74 74 - (module-defn(M_nativeint) module_coercion.ml(49):1761-1812 74 74 + (module-defn(M_nativeint) module_coercion.ml(51):1780-1831 75 75 (makeblock 0 (function prim stub (array.length[addr] prim)) 76 76 (function prim prim stub (array.get[addr] prim prim)) 77 77 (function prim prim stub (array.unsafe_get[addr] prim prim))

+4 -2

testsuite/tests/translprim/module_coercion.ml

reviewed

··· 4 4 flags = "-dlambda -dno-unique-ids" 5 5 *** flat-float-array 6 6 **** check-ocamlc.byte-output 7 7 - compiler_reference = "${test_source_directory}/module_coercion.compilers.reference.flat" 7 7 + compiler_reference = 8 8 + "${test_source_directory}/module_coercion.compilers.reference.flat" 8 9 *** no-flat-float-array 9 10 **** check-ocamlc.byte-output 10 10 - compiler_reference = "${test_source_directory}/module_coercion.compilers.reference.no-flat" 11 11 + compiler_reference = 12 12 + "${test_source_directory}/module_coercion.compilers.reference.no-flat" 11 13 *) 12 14 13 15 module M = struct

+16 -9

testsuite/tests/typing-deprecated/deprecated.ml

reviewed

··· 225 225 module rec M : sig val x : X.t end 226 226 |}] 227 227 228 228 - module rec M : sig val x: X.t end = struct let x = X.x end [@@ocaml.warning "-3"] 228 228 + module rec M : sig val x: X.t end = 229 229 + struct 230 230 + let x = X.x 231 231 + end [@@ocaml.warning "-3"] 229 232 [%%expect{| 230 233 module rec M : sig val x : X.t end 231 234 |}] ··· 575 578 module X : sig end 576 579 |}] 577 580 578 578 - let x = ((() [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@ocaml.ppwarning "Pp warning 2!"] 581 581 + let x = 582 582 + ((() [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) 583 583 + [@ocaml.ppwarning "Pp warning 2!"] 579 584 ;; 580 585 [%%expect{| 581 581 - Line _, characters 93-108: 582 582 - let x = ((() [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@ocaml.ppwarning "Pp warning 2!"] 583 583 - ^^^^^^^^^^^^^^^ 586 586 + Line _, characters 23-38: 587 587 + [@ocaml.ppwarning "Pp warning 2!"] 588 588 + ^^^^^^^^^^^^^^^ 584 589 Warning 22: Pp warning 2! 585 590 val x : unit = () 586 591 |}] 587 592 588 588 - type t = ((unit [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@ocaml.ppwarning "Pp warning 2!"] 593 593 + type t = 594 594 + ((unit [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) 595 595 + [@ocaml.ppwarning "Pp warning 2!"] 589 596 [@@ocaml.ppwarning "Pp warning 3!"] 590 597 ;; 591 598 [%%expect{| ··· 593 600 [@@ocaml.ppwarning "Pp warning 3!"] 594 601 ^^^^^^^^^^^^^^^ 595 602 Warning 22: Pp warning 3! 596 596 - Line _, characters 96-111: 597 597 - type t = ((unit [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@ocaml.ppwarning "Pp warning 2!"] 598 598 - ^^^^^^^^^^^^^^^ 603 603 + Line _, characters 21-36: 604 604 + [@ocaml.ppwarning "Pp warning 2!"] 605 605 + ^^^^^^^^^^^^^^^ 599 606 Warning 22: Pp warning 2! 600 607 type t = unit 601 608 |}]

-1

testsuite/tests/typing-gadts/pr6934.ml

reviewed

··· 9 9 ^^^^^ 10 10 Error: GADT case syntax cannot be used in a 'nonrec' block. 11 11 |}] 12 12 -

+1 -1

testsuite/tests/typing-misc/empty_variant.ml

reviewed

··· 25 25 val g : m -> 'a = <fun> 26 26 |}] 27 27 28 28 - let f : t option -> int = function None -> 3 28 28 + let f : t option -> int = function None -> 3 29 29 [%%expect{| 30 30 val f : t option -> int = <fun> 31 31 |}]

-1

testsuite/tests/typing-modules-bugs/pr6485_ok.ml

reviewed

··· 51 51 let module Baz = String_id2.Make(struct let module_name="Baz" end) in 52 52 let baz = Baz.of_string "baz" in 53 53 Printf.printf "baz = %s\n" (baz :> string) 54 54 -

+3 -2

testsuite/tests/typing-modules-bugs/pr7601_ok.ml

reviewed

··· 19 19 [< `Location of t 20 20 | `Value of t 21 21 | `None ] as 'a 22 22 - val of_var : ?f:string -> string -> [ `Location of _ | `Value of _ | `None ] maybe_region 22 22 + val of_var : 23 23 + ?f:string -> string -> 24 24 + [ `Location of _ | `Value of _ | `None ] maybe_region 23 25 end 24 26 25 27 module Make (Analysis : Analysis) = struct 26 28 include Analysis 27 29 let of_var = of_var ~f:"" 28 30 end 29 29 -

-1

testsuite/tests/typing-modules-bugs/pr7601a_ok.ml

reviewed

··· 25 25 include M 26 26 let f = f ~a:"" 27 27 end 28 28 -

+1 -1

testsuite/tests/typing-modules/pr7348.ml

reviewed

··· 33 33 let x : < foo: int; ..> = X.x 34 34 end 35 35 36 36 - module N = F(M) 36 36 + module N = F(M) 37 37 let _ = (N.x = M.x) 38 38 end;; 39 39 [%%expect{|

+1 -1

testsuite/tests/typing-multifile/pr7325.ml

reviewed

··· 10 10 ***** ocamlc.byte 11 11 module = "c.ml" 12 12 ****** check-ocamlc.byte-output 13 13 - *) 13 13 + *)

+1 -1

testsuite/tests/typing-ocamlc-i/pr7620_bad.ml

reviewed

··· 6 6 *** check-ocamlc.byte-output 7 7 *) 8 8 9 9 - let t = 9 9 + let t = 10 10 (function `A | `B -> () : 'a) (`A : [`A]); 11 11 (failwith "dummy" : 'a) (* to know how 'a is unified *)

-1

testsuite/tests/typing-private/private.ml

reviewed

··· 120 120 (* PR#7437 *) 121 121 type t = [` Closed ];; 122 122 type nonrec t = private [> t];; 123 123 -

+1 -1

testsuite/tests/typing-safe-linking/b_bad.compilers.reference

reviewed

··· 2 2 Error (warning 8): this pattern-matching is not exhaustive. 3 3 Here is an example of a case that is not matched: 4 4 Y 5 5 - File "b_bad.ml", line 17, characters 11-14: 5 5 + File "b_bad.ml", line 18, characters 11-14: 6 6 Error: Unbound value A.y

+2 -1

testsuite/tests/typing-safe-linking/b_bad.ml

reviewed

··· 13 13 let f : string A.t -> unit = function 14 14 A.X s -> print_endline s 15 15 16 16 - (* It is important that the line below is the last line of the file (see Makefile) *) 16 16 + (* It is important that the line below is the last line of the file 17 17 + (see Makefile) *) 17 18 let () = f A.y

+1 -1

testsuite/tests/typing-short-paths/gpr1223.ml

reviewed

··· 1 1 (* TEST 2 2 - flags = " -short-paths " 2 2 + flags = " -short-paths " 3 3 modules = "gpr1223_foo.mli gpr1223_bar.mli" 4 4 * toplevel 5 5 *)

-1

testsuite/tests/typing-sigsubst/test_loc_modtype_type_eq.ml

reviewed

··· 1 1 module type S = Test_functor.S with type elt = unit 2 2 3 3 module M : S = Test_functor.Apply (String) 4 4 -

-1

testsuite/tests/typing-sigsubst/test_loc_modtype_type_subst.ml

reviewed

··· 1 1 module type S = Test_functor.S with type elt := unit 2 2 3 3 module M : S = Test_functor.Apply (String) 4 4 -

-1

testsuite/tests/typing-sigsubst/test_loc_type_eq.ml

reviewed

··· 1 1 module M : Test_functor.S with type elt = unit = Test_functor.Apply (String) 2 2 -

-1

testsuite/tests/typing-sigsubst/test_loc_type_subst.ml

reviewed

··· 1 1 module M : Test_functor.S with type elt := unit = Test_functor.Apply (String) 2 2 -

-1

testsuite/tests/typing-sigsubst/test_locations.ml

reviewed

··· 19 19 ocamlc_byte_exit_status = "2" 20 20 ** check-ocamlc.byte-output 21 21 *) 22 22 -

-1

testsuite/tests/typing-warnings/pr7553.ml

reviewed

··· 22 22 end 23 23 end 24 24 end = D;; 25 25 -

+2 -1

testsuite/tests/typing-warnings/unused_types.ml

reviewed

··· 77 77 module Pr7438 : sig 78 78 end = struct 79 79 module type S = sig type t = private [> `Foo] end 80 80 - module type X = sig type t = private [> `Foo | `Bar] include S with type t := t end 80 80 + module type X = 81 81 + sig type t = private [> `Foo | `Bar] include S with type t := t end 81 82 end;;

+2 -1

testsuite/tests/utils/test_strongly_connected_components.ml

reviewed

··· 1 1 (* TEST 2 2 include config 3 3 include testing 4 4 - binary_modules = "config misc identifiable numbers strongly_connected_components" 4 4 + binary_modules = 5 5 + "config misc identifiable numbers strongly_connected_components" 5 6 * bytecode 6 7 *) 7 8

+1 -1

testsuite/tests/warnings/w04.ml

reviewed

··· 13 13 14 14 type expr = E of int [@@unboxed] 15 15 16 16 - 16 16 + 17 17 let f x = match x with (E e) -> e 18 18 19 19 type t = A | B

+20 -12

testsuite/tests/win-unicode/mltest.ml

reviewed

··· 21 21 22 22 let to_create_and_delete_files = 23 23 [ 24 24 - "\xD0\xB2\xD0\xB5\xD1\x80\xD0\xB1\xD0\xBB\xD1\x8E\xD0\xB4\xD1\x8B"; (* "верблюды" *) 24 24 + (* "верблюды" *) 25 25 + "\xD0\xB2\xD0\xB5\xD1\x80\xD0\xB1\xD0\xBB\xD1\x8E\xD0\xB4\xD1\x8B"; 25 26 "\xE9\xAA\x86\xE9\xA9\xBC"; (* "骆驼" *) 26 27 "\215\167\215\162\215\158\215\156"; (* "קעמל" *) 27 28 "\216\167\217\136\217\134\217\185"; (* "اونٹ" *) ··· 44 45 take (List.length foreign_names) to_create_and_delete_files 45 46 ;; 46 47 47 47 - (* let env0 = *) 48 48 - (* List.sort compare (List.mapi (fun i v -> Printf.sprintf "OCAML_UTF8_VAR%d=%s" i v) foreign_names2) *) 48 48 + (* let env0 = 49 49 + List.sort compare 50 50 + (List.mapi (fun i v -> Printf.sprintf "OCAML_UTF8_VAR%d=%s" i v) 51 51 + foreign_names2) *) 49 52 50 53 (* let read_all ic = *) 51 54 (* set_binary_mode_in ic false; *) ··· 111 114 (* in *) 112 115 (* wrap "Unix.open_process_in" f ell cmdline (list quote) *) 113 116 114 114 - (* let open_process_full filter cmdline env = *) 115 115 - (* let f cmdline env = *) 116 116 - (* let (ic, _, _) as proc = Unix.open_process_full cmdline (Array.of_list env) in *) 117 117 - (* let l = read_all ic in *) 118 118 - (* ignore (Unix.close_process_full proc); *) 119 119 - (* List.sort compare (List.filter filter l) *) 120 120 - (* in *) 121 121 - (* wrap2 "Unix.open_process_full" f ell (list quote) cmdline env (list quote) *) 117 117 + (* let open_process_full filter cmdline env = 118 118 + let f cmdline env = 119 119 + let (ic, _, _) as proc = 120 120 + Unix.open_process_full cmdline (Array.of_list env) 121 121 + in 122 122 + let l = read_all ic in 123 123 + ignore (Unix.close_process_full proc); 124 124 + List.sort compare (List.filter filter l) 125 125 + in 126 126 + wrap2 "Unix.open_process_full" f ell (list quote) cmdline env (list quote) 127 127 + *) 122 128 123 129 let test_readdir readdir = 124 130 let filter s = List.mem s test_files && Filename.check_suffix s ".txt" in ··· 229 235 230 236 let test_symlink () = 231 237 let foodir = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD" (* "UNIQU你好" *) in 232 232 - let foofile = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD/\xE4\xBD\xA0\xE5\xA5\xBD.txt" (* "UNIQU你好/你好.txt" *) in 238 238 + let foofile = "UNIQU\xE4\xBD\xA0\xE5\xA5\xBD/\xE4\xBD\xA0\xE5\xA5\xBD.txt" 239 239 + (* "UNIQU你好/你好.txt" *) 240 240 + in 233 241 let fileln = "\xE4\xBD\xA0\xE5\xA5\xBD-file-ln-s" (* "你好-file-ln-s" *) in 234 242 let dirln = "\xE4\xBD\xA0\xE5\xA5\xBD-dir-ln-s" (* "你好-dir-ln-s" *) in 235 243 Unix.mkdir foodir 0o777;

+1 -2

testsuite/tools/Makefile

reviewed

··· 38 38 39 39 codegen_ADD_COMPFLAGS=$(codegen_INCLUDES) -w -40 -g 40 40 41 41 - targets := $(expect_PROG) 41 41 + targets := $(expect_PROG) 42 42 43 43 ifneq "$(ARCH)" "none" 44 44 targets += codegen ··· 79 79 asmgen_i386.obj: asmgen_i386nt.asm 80 80 @set -o pipefail ; \ 81 81 $(ASM) $@ $^ | tail -n +2 82 82 -

-1

testsuite/tools/lexcmm.mll

reviewed

··· 257 257 | _ 258 258 { store_string_char(Lexing.lexeme_char lexbuf 0); 259 259 string lexbuf } 260 260 -

+2 -2

tools/Makefile

reviewed

··· 183 183 184 184 # Converter olabl/ocaml 2.99 to ocaml 3 185 185 186 186 - OCAML299TO3= lexer299.cmo ocaml299to3.cmo 187 187 - LIBRARY3= config.cmo misc.cmo warnings.cmo build_path_prefix_map.cmo location.cmo 186 186 + OCAML299TO3=lexer299.cmo ocaml299to3.cmo 187 187 + LIBRARY3=config.cmo misc.cmo warnings.cmo build_path_prefix_map.cmo location.cmo 188 188 189 189 ocaml299to3: $(OCAML299TO3) 190 190 $(CAMLC) $(LINKFLAGS) -o ocaml299to3 $(LIBRARY3) $(OCAML299TO3)

+11 -4

tools/ci/appveyor/appveyor_build.sh

reviewed

··· 65 65 for f in flexdll.h flexlink.exe flexdll*_msvc.obj default*.manifest ; do 66 66 cp $f "$OCAMLROOT/bin/flexdll/" 67 67 done 68 68 - echo 'eval $($APPVEYOR_BUILD_FOLDER/tools/msvs-promote-path)' >> ~/.bash_profile 68 68 + echo 'eval $($APPVEYOR_BUILD_FOLDER/tools/msvs-promote-path)' \ 69 69 + >> ~/.bash_profile 69 70 ;; 70 71 msvc32-only) 71 72 cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32 ··· 107 108 cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc64 108 109 109 110 export TERM=ansi 110 110 - script --quiet --return --command "make -C ../$BUILD_PREFIX-mingw32 flexdll world.opt" ../$BUILD_PREFIX-mingw32/build.log >/dev/null 2>/dev/null & 111 111 + script --quiet --return --command \ 112 112 + "make -C ../$BUILD_PREFIX-mingw32 flexdll world.opt" \ 113 113 + ../$BUILD_PREFIX-mingw32/build.log >/dev/null 2>/dev/null & 111 114 BUILD_PID=$! 112 115 113 116 run "make world" make world ··· 117 120 118 121 set +e 119 122 120 120 - # For an explanation of the sed command, see https://github.com/appveyor/ci/issues/1824 121 121 - tail --pid=$BUILD_PID -n +1 -f ../$BUILD_PREFIX-mingw32/build.log | sed -e 's/\d027\[K//g' -e 's/\d027\[m/\d027[0m/g' -e 's/\d027\[01\([m;]\)/\d027[1\1/g' & 123 123 + # For an explanation of the sed command, see 124 124 + # https://github.com/appveyor/ci/issues/1824 125 125 + tail --pid=$BUILD_PID -n +1 -f ../$BUILD_PREFIX-mingw32/build.log | \ 126 126 + sed -e 's/\d027\[K//g' \ 127 127 + -e 's/\d027\[m/\d027[0m/g' \ 128 128 + -e 's/\d027\[01\([m;]\)/\d027[1\1/g' & 122 129 TAIL_PID=$! 123 130 wait $BUILD_PID 124 131 STATUS=$?

+7 -8

tools/ci/inria/extra-checks

reviewed

··· 16 16 17 17 # This script is run on our continuous-integration servers to recompile 18 18 # from scratch, adding more run-time checks ("sanitizers") to the C code, 19 19 - # and run the test suite. 19 19 + # and run the test suite. 20 20 21 21 # In this context, it is necessary to skip a few tests whose behaviour 22 22 # is modified by the instrumentation: ··· 126 126 $make -s distclean || : 127 127 128 128 # Use clang 6.0 129 129 - # We cannot give the sanitizer options as part of -cc because 130 130 - # then various autoconfiguration tests fail. 129 129 + # We cannot give the sanitizer options as part of -cc because 130 130 + # then various autoconfiguration tests fail. 131 131 # Instead, we'll fix CFLAGS a posteriori. 132 132 ./configure -cc clang-6.0 133 133 134 134 # These are the undefined behaviors we want to check 135 135 - # Others occur on purpose e.g. signed arithmetic overflow 135 135 + # Others occur on purpose e.g. signed arithmetic overflow 136 136 ubsan="\ 137 137 bool,\ 138 138 builtin,\ ··· 195 195 196 196 ######################################################################### 197 197 198 198 - # This is a failed attempt at using the memory sanitizer 198 198 + # This is a failed attempt at using the memory sanitizer 199 199 # (to detect reads from uninitialized memory). 200 200 # Some alarms are reported that look like false positive 201 201 # and are impossible to debug. ··· 205 205 # $make -s distclean || : 206 206 207 207 # # Use clang 6.0 208 208 - # # We cannot give the sanitizer options as part of -cc because 209 209 - # # then various autoconfiguration tests fail. 208 208 + # # We cannot give the sanitizer options as part of -cc because 209 209 + # # then various autoconfiguration tests fail. 210 210 # # Instead, we'll fix CFLAGS a posteriori. 211 211 # # Memory sanitizer doesn't like the static data generated by ocamlopt, 212 212 # # hence build bytecode only ··· 226 226 # # Build the system (bytecode only) and test 227 227 # make $jobs world 228 228 # $run_testsuite 229 229 -

+2 -1

tools/lintapidiff.ml

reviewed

··· 248 248 let first_seen = Version.of_string_exn rev in 249 249 let empty = {last_not_seen=None;first_seen;deprecated=false} in 250 250 let f = Ast.parse_file ~orig:path ~init:empty ~f:(fun _ _ attrs -> 251 251 - { last_not_seen=None;first_seen; deprecated=Doc.is_deprecated attrs }) in 251 251 + { last_not_seen=None;first_seen; deprecated=Doc.is_deprecated attrs }) 252 252 + in 252 253 let map = match Git.with_show ~f rev path with 253 254 | Ok r -> r 254 255 | Error `Not_found -> IdMap.empty

+4 -2

tools/objinfo.ml

reviewed

··· 327 327 end 328 328 329 329 let arg_list = [ 330 330 - "-no-approx", Arg.Set no_approx, " Do not print module approximation information"; 331 331 - "-no-code", Arg.Set no_code, " Do not print code from exported flambda functions"; 330 330 + "-no-approx", Arg.Set no_approx, 331 331 + " Do not print module approximation information"; 332 332 + "-no-code", Arg.Set no_code, 333 333 + " Do not print code from exported flambda functions"; 332 334 "-null-crc", Arg.Set no_crc, " Print a null CRC for imported interfaces"; 333 335 "-args", Arg.Expand Arg.read_arg, 334 336 "<file> Read additional newline separated command line arguments \n\

+4 -4

tools/ocamlprof.ml

reviewed

··· 507 507 "-vnum", Arg.Unit print_version_num, 508 508 " Print version number and exit"; 509 509 "-args", Arg.Expand Arg.read_arg, 510 510 - "<file> Read additional newline separated command line arguments \n\ 511 511 - \ from <file>"; 510 510 + "<file> Read additional newline separated command line arguments \n\ 511 511 + \ from <file>"; 512 512 "-args0", Arg.Expand Arg.read_arg0, 513 513 - "<file> Read additional NUL separated command line arguments from \n\ 514 514 - \ <file>" 513 513 + "<file> Read additional NUL separated command line arguments from \n\ 514 514 + \ <file>" 515 515 ] process_anon_file usage; 516 516 exit 0 517 517 with

+4 -2

toplevel/genprintval.ml

reviewed

··· 152 152 ] : (Path.t * printer) list) 153 153 154 154 let exn_printer ppf path exn = 155 155 - fprintf ppf "<printer %a raised an exception: %s>" Printtyp.path path (Printexc.to_string exn) 155 155 + fprintf ppf "<printer %a raised an exception: %s>" Printtyp.path path 156 156 + (Printexc.to_string exn) 156 157 157 158 let out_exn path exn = 158 159 Oval_printer (fun ppf -> exn_printer ppf path exn) ··· 583 584 584 585 and apply_generic_printer path printer args = 585 586 match (printer, args) with 586 586 - | (Zero fn, []) -> (fun (obj : O.t)-> try fn obj with exn -> out_exn path exn) 587 587 + | (Zero fn, []) -> 588 588 + (fun (obj : O.t)-> try fn obj with exn -> out_exn path exn) 587 589 | (Succ fn, arg :: args) -> 588 590 let printer = fn (fun depth obj -> tree_of_val depth obj arg) in 589 591 apply_generic_printer path printer args

+6 -4

toplevel/opttopmain.ml

reviewed

··· 32 32 33 33 let expand_position pos len = 34 34 if pos < !first_nonexpanded_pos then 35 35 - first_nonexpanded_pos := !first_nonexpanded_pos + len (* Shift the position *) 35 35 + (* Shift the position *) 36 36 + first_nonexpanded_pos := !first_nonexpanded_pos + len 36 37 else 37 37 - first_nonexpanded_pos := pos + len + 2 (* New last position *) 38 38 + (* New last position *) 39 39 + first_nonexpanded_pos := pos + len + 2 38 40 39 41 40 42 let prepare ppf = ··· 63 65 than the original argv. 64 66 *) 65 67 Printf.eprintf "For implementation reasons, the toplevel does not support\ 66 66 - \ having script files (here %S) inside expanded arguments passed through the\ 67 67 - \ -args{,0} command-line option.\n" name; 68 68 + \ having script files (here %S) inside expanded arguments passed through\ 69 69 + \ the -args{,0} command-line option.\n" name; 68 70 exit 2 69 71 end else begin 70 72 let newargs = Array.sub !argv !Arg.current

+4 -2

toplevel/topmain.ml

reviewed

··· 33 33 34 34 let expand_position pos len = 35 35 if pos < !first_nonexpanded_pos then 36 36 - first_nonexpanded_pos := !first_nonexpanded_pos + len (* Shift the position *) 36 36 + (* Shift the position *) 37 37 + first_nonexpanded_pos := !first_nonexpanded_pos + len 37 38 else 38 38 - first_nonexpanded_pos := pos + len + 2 (* New last position *) 39 39 + (* New last position *) 40 40 + first_nonexpanded_pos := pos + len + 2 39 41 40 42 let prepare ppf = 41 43 Toploop.set_paths ();

+1 -1

typing/btype.ml

reviewed

··· 210 210 211 211 (**** Utilities for fixed row private types ****) 212 212 213 213 - let row_of_type t = 213 213 + let row_of_type t = 214 214 match (repr t).desc with 215 215 Tobject(t,_) -> 216 216 let rec get_row t =

+2 -1

typing/ctype.mli

reviewed

··· 170 170 171 171 val unify: Env.t -> type_expr -> type_expr -> unit 172 172 (* Unify the two types given. Raise [Unify] if not possible. *) 173 173 - val unify_gadt: equations_level:int -> Env.t ref -> type_expr -> type_expr -> unit 173 173 + val unify_gadt: 174 174 + equations_level:int -> Env.t ref -> type_expr -> type_expr -> unit 174 175 (* Unify the two types given and update the environment with the 175 176 local constraints. Raise [Unify] if not possible. *) 176 177 val unify_var: Env.t -> type_expr -> type_expr -> unit

+16 -8

typing/env.ml

reviewed

··· 78 78 val create : 'a -> ('a,'b) t 79 79 val get_arg : ('a,'b) t -> 'a option 80 80 81 81 - (* [force_logged log f t] is equivalent to [force f t] but if [f] returns [None] then 82 82 - [t] is recorded in [log]. [backtrack log] will then reset all the recorded [t]s back 83 83 - to their original state. *) 81 81 + (* [force_logged log f t] is equivalent to [force f t] but if [f] returns 82 82 + [None] then [t] is recorded in [log]. [backtrack log] will then reset all 83 83 + the recorded [t]s back to their original state. *) 84 84 val log : unit -> log 85 85 val force_logged : log -> ('a -> 'b option) -> ('a,'b option) t -> 'b option 86 86 val backtrack : log -> unit ··· 386 386 387 387 388 388 let rec find_all name tbl = 389 389 - List.map (fun (id, desc) -> Pident id, desc) (Ident.find_all name tbl.current) @ 389 389 + List.map (fun (id, desc) -> Pident id, desc) 390 390 + (Ident.find_all name tbl.current) @ 390 391 match tbl.opened with 391 392 | None -> [] 392 393 | Some {root; using = _; next; components} -> ··· 397 398 find_all name next 398 399 399 400 let rec fold_name f tbl acc = 400 400 - let acc = Ident.fold_name (fun id d -> f (Ident.name id) (Pident id, d)) tbl.current acc in 401 401 + let acc = 402 402 + Ident.fold_name (fun id d -> f (Ident.name id) (Pident id, d)) 403 403 + tbl.current acc 404 404 + in 401 405 match tbl.opened with 402 406 | Some {root; using = _; next; components} -> 403 407 acc ··· 420 424 match tbl.opened with 421 425 | Some {root; using = _; next; components} -> 422 426 Tbl.iter 423 423 - (fun s (x, pos) -> f (Ident.hide (Ident.create s) (* ??? *)) (Pdot (root, s, pos), x)) 427 427 + (fun s (x, pos) -> 428 428 + f (Ident.hide (Ident.create s) (* ??? *)) 429 429 + (Pdot (root, s, pos), x)) 424 430 components; 425 431 iter f next 426 432 | None -> () ··· 1285 1291 } 1286 1292 1287 1293 let make_copy_of_types l env : copy_of_types = 1288 1288 - let f desc = { desc with val_type = Subst.type_expr Subst.identity desc.val_type} in 1289 1289 - let values = List.fold_left (fun env s -> IdTbl.update s f env) env.values l in 1294 1294 + let f desc = 1295 1295 + {desc with val_type = Subst.type_expr Subst.identity desc.val_type} in 1296 1296 + let values = 1297 1297 + List.fold_left (fun env s -> IdTbl.update s f env) env.values l in 1290 1298 {to_copy = l; initial_values = env.values; new_values = values} 1291 1299 1292 1300 let do_copy_types { to_copy = l; initial_values; new_values = values } env =

+2 -1

typing/env.mli

reviewed

··· 214 214 val read_signature: string -> string -> signature 215 215 (* Arguments: module name, file name. Results: signature. *) 216 216 val save_signature: 217 217 - deprecated:string option -> signature -> string -> string -> Cmi_format.cmi_infos 217 217 + deprecated:string option -> signature -> string -> string -> 218 218 + Cmi_format.cmi_infos 218 219 (* Arguments: signature, module name, file name. *) 219 220 val save_signature_with_imports: 220 221 deprecated:string option ->

+3 -1

typing/includecore.ml

reviewed

··· 232 232 | ld1::rem1, ld2::rem2 -> 233 233 if Ident.name ld1.ld_id <> Ident.name ld2.ld_id 234 234 then [Field_names (n, ld1.ld_id, ld2.ld_id)] 235 235 - else if ld1.ld_mutable <> ld2.ld_mutable then [Field_mutable ld1.ld_id] else begin 235 235 + else if ld1.ld_mutable <> ld2.ld_mutable then 236 236 + [Field_mutable ld1.ld_id] 237 237 + else begin 236 238 Builtin_attributes.check_deprecated_mutable_inclusion 237 239 ~def:ld1.ld_loc 238 240 ~use:ld2.ld_loc

+2 -1

typing/includemod.mli

reviewed

··· 36 36 module_type -> module_type -> module_coercion 37 37 38 38 val check_modtype_inclusion : 39 39 - loc:Location.t -> Env.t -> Types.module_type -> Path.t -> Types.module_type -> unit 39 39 + loc:Location.t -> Env.t -> Types.module_type -> Path.t -> Types.module_type -> 40 40 + unit 40 41 (** [check_modtype_inclusion ~loc env mty1 path1 mty2] checks that the 41 42 functor application F(M) is well typed, where mty2 is the type of 42 43 the argument of F and path1/mty1 is the path/unstrenghened type of M. *)

+5 -2

typing/oprint.ml

reviewed

··· 79 79 if isneg then pp_print_char ppf ')' 80 80 81 81 let escape_string s = 82 82 - (* Escape only C0 control characters (bytes <= 0x1F), DEL(0x7F), '\\' and '"' *) 82 82 + (* Escape only C0 control characters (bytes <= 0x1F), DEL(0x7F), '\\' 83 83 + and '"' *) 83 84 let n = ref 0 in 84 85 for i = 0 to String.length s - 1 do 85 86 n := !n + ··· 151 152 | Oval_int32 i -> parenthesize_if_neg ppf "%lil" i (i < 0l) 152 153 | Oval_int64 i -> parenthesize_if_neg ppf "%LiL" i (i < 0L) 153 154 | Oval_nativeint i -> parenthesize_if_neg ppf "%nin" i (i < 0n) 154 154 - | Oval_float f -> parenthesize_if_neg ppf "%s" (float_repres f) (f < 0.0 || 1. /. f = neg_infinity) 155 155 + | Oval_float f -> 156 156 + parenthesize_if_neg ppf "%s" (float_repres f) 157 157 + (f < 0.0 || 1. /. f = neg_infinity) 155 158 | Oval_string (_,_, Ostr_bytes) as tree -> 156 159 pp_print_char ppf '('; 157 160 print_simple_tree ppf tree;

+7 -5

typing/parmatch.ml

reviewed

··· 820 820 | ({pat_desc = Tpat_array(_)},_) :: _ -> false 821 821 | ({pat_desc = Tpat_lazy(_)},_) :: _ -> true 822 822 823 823 - (* Written as a non-fragile matching, PR#7451 originated from a fragile matching below. *) 823 823 + (* Written as a non-fragile matching, PR#7451 originated from a fragile matching 824 824 + below. *) 824 825 let should_extend ext env = match ext with 825 826 | None -> false 826 827 | Some ext -> begin match env with ··· 1361 1362 exhaust 1362 1363 ext pss (List.length (simple_match_args p omega) + n - 1) 1363 1364 with 1364 1364 - | Witnesses r -> Witnesses (List.map (fun row -> (set_args p row)) r) 1365 1365 + | Witnesses r -> 1366 1366 + Witnesses (List.map (fun row -> (set_args p row)) r) 1365 1367 | r -> r in 1366 1368 let before = try_many try_non_omega constrs in 1367 1369 if ··· 1973 1975 Buffer.add_string buf 1974 1976 "\nMatching over values of extensible variant types \ 1975 1977 (the *extension* above)\n\ 1976 1976 - must include a wild card pattern in order to be exhaustive." 1978 1978 + must include a wild card pattern in order to be exhaustive." 1977 1979 ; 1978 1980 Buffer.contents buf 1979 1981 with _ -> ··· 2082 2084 - the clause under consideration is not a refutation clause 2083 2085 and either: 2084 2086 + there are no other lines 2085 2085 - + we do not care whether the types prevent this clause to be 2086 2086 - reached. 2087 2087 + + we do not care whether the types prevent this clause to 2088 2088 + be reached. 2087 2089 If the clause under consideration *is* a refutation clause 2088 2090 then we do need to check more carefully whether it can be 2089 2091 refuted or not. *)

+4 -3

typing/parmatch.mli

reviewed

··· 106 106 (* Irrefutability tests *) 107 107 val irrefutable : pattern -> bool 108 108 109 109 - (** An inactive pattern is a pattern, matching against which can be duplicated, erased or 110 110 - delayed without change in observable behavior of the program. Patterns containing 111 111 - (lazy _) subpatterns or reads of mutable fields are active. *) 109 109 + (** An inactive pattern is a pattern, matching against which can be duplicated, 110 110 + erased or delayed without change in observable behavior of the program. 111 111 + Patterns containing (lazy _) subpatterns or reads of mutable fields are 112 112 + active. *) 112 113 val inactive : partial:partial -> pattern -> bool 113 114 114 115 (* Ambiguous bindings *)

+4 -2

typing/printtyp.ml

reviewed

··· 1526 1526 when is_unit env ty1 && unifiable env t3 ty2 -> 1527 1527 Some (fun ppf -> 1528 1528 fprintf ppf 1529 1529 - "@,@[Hint: Did you forget to wrap the expression using `fun () ->'?@]") 1529 1529 + "@,@[Hint: Did you forget to wrap the expression using \ 1530 1530 + `fun () ->'?@]") 1530 1531 | Ttuple [], Tvar _ | Tvar _, Ttuple [] -> 1531 1532 Some (fun ppf -> 1532 1533 fprintf ppf "@,Self type cannot escape its class") ··· 1584 1585 Some (fun ppf -> 1585 1586 let row1 = row_repr row1 and row2 = row_repr row2 in 1586 1587 begin match 1587 1587 - row1.row_fields, row1.row_closed, row2.row_fields, row2.row_closed with 1588 1588 + row1.row_fields, row1.row_closed, 1589 1589 + row2.row_fields, row2.row_closed with 1588 1590 | [], true, [], true -> 1589 1591 fprintf ppf "@,These two variant types have no intersection" 1590 1592 | [], true, (_::_ as fields), _ ->

+2 -3

typing/printtyp.mli

reviewed

··· 92 92 val print_items: (Env.t -> signature_item -> 'a option) -> 93 93 Env.t -> signature_item list -> (out_sig_item * 'a option) list 94 94 95 95 - (* Simple heuristic to rewrite Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias for 96 96 - Foo__bar. This pattern is used by the stdlib. *) 95 95 + (* Simple heuristic to rewrite Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias 96 96 + for Foo__bar. This pattern is used by the stdlib. *) 97 97 val rewrite_double_underscore_paths: Env.t -> Path.t -> Path.t 98 98 -

+6 -3

typing/rec_check.ml

reviewed

··· 66 66 (** The address of a subexpression is not used, but may be bound *) 67 67 68 68 val inspect : t -> t 69 69 - (** The value of a subexpression is inspected with match, application, etc. *) 69 69 + (** The value of a subexpression is inspected with match, application, 70 70 + etc. *) 70 71 71 72 val delay : t -> t 72 73 (** An expression appears under 'fun p ->' or 'lazy' *) ··· 636 637 Use.(join ty 637 638 (join (expression env c_rhs) 638 639 (inspect (option expression env c_guard)))) 639 639 - and value_bindings : rec_flag -> Env.env -> Typedtree.value_binding list -> Env.env * Use.t = 640 640 + and value_bindings : 641 641 + rec_flag -> Env.env -> Typedtree.value_binding list -> Env.env * Use.t = 640 642 fun rec_flag env bindings -> 641 643 match rec_flag with 642 644 | Recursive -> ··· 692 694 | Tpat_variant _ -> true 693 695 | Tpat_record (_, _) -> true 694 696 | Tpat_array _ -> true 695 695 - | Tpat_or (l,r,_) -> is_destructuring_pattern l || is_destructuring_pattern r 697 697 + | Tpat_or (l,r,_) -> 698 698 + is_destructuring_pattern l || is_destructuring_pattern r 696 699 | Tpat_lazy _ -> true 697 700 698 701 let is_valid_recursive_expression idlist expr =

+4 -2

typing/typeclass.ml

reviewed

··· 1228 1228 } 1229 1229 | Pcl_open (ovf, lid, e) -> 1230 1230 let used_slot = ref false in 1231 1231 - let (path, new_val_env) = !Typecore.type_open ~used_slot ovf val_env scl.pcl_loc lid in 1232 1232 - let (_path, new_met_env) = !Typecore.type_open ~used_slot ovf met_env scl.pcl_loc lid in 1231 1231 + let (path, new_val_env) = 1232 1232 + !Typecore.type_open ~used_slot ovf val_env scl.pcl_loc lid in 1233 1233 + let (_path, new_met_env) = 1234 1234 + !Typecore.type_open ~used_slot ovf met_env scl.pcl_loc lid in 1233 1235 let cl = class_expr cl_num new_val_env new_met_env e in 1234 1236 rc {cl_desc = Tcl_open (ovf, path, lid, new_val_env, cl); 1235 1237 cl_loc = scl.pcl_loc;

+37 -22

typing/typecore.ml

reviewed

··· 55 55 | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list 56 56 | Multiply_bound_variable of string 57 57 | Orpat_vars of Ident.t * Ident.t list 58 58 - | Expr_type_clash of (type_expr * type_expr) list * type_forcing_context option 58 58 + | Expr_type_clash of 59 59 + (type_expr * type_expr) list * type_forcing_context option 59 60 | Apply_non_function of type_expr 60 61 | Apply_wrong_label of arg_label * type_expr 61 62 | Label_multiply_defined of string 62 63 | Label_missing of Ident.t list 63 64 | Label_not_mutable of Longident.t 64 64 - | Wrong_name of string * type_expected * string * Path.t * string * string list 65 65 + | Wrong_name of 66 66 + string * type_expected * string * Path.t * string * string list 65 67 | Name_type_mismatch of 66 68 string * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list 67 69 | Invalid_format of string ··· 486 488 } env 487 489 ) pv env 488 490 489 489 - let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty attrs = 491 491 + let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty 492 492 + attrs = 490 493 if List.exists (fun {pv_id; _} -> Ident.name pv_id = name.txt) 491 494 !pattern_variables 492 495 then raise(Error(loc, Env.empty, Multiply_bound_variable name.txt)); ··· 537 540 (x2,x1)::unify_vars rem1 rem2 538 541 end 539 542 | [],[] -> [] 540 540 - | {pv_id; _}::_, [] | [],{pv_id; _}::_ -> raise (Error (loc, env, Orpat_vars (pv_id, []))) 543 543 + | {pv_id; _}::_, [] | [],{pv_id; _}::_ -> 544 544 + raise (Error (loc, env, Orpat_vars (pv_id, []))) 541 545 | {pv_id = x; _}::_, {pv_id = y; _}::_ -> 542 546 let err = 543 547 if Ident.name x < Ident.name y ··· 1097 1101 pat_env = !env } 1098 1102 | Ppat_unpack name -> 1099 1103 assert (constrs = None); 1100 1100 - let id = enter_variable loc name expected_ty ~is_module:true sp.ppat_attributes in 1104 1104 + let id = 1105 1105 + enter_variable loc name expected_ty ~is_module:true sp.ppat_attributes 1106 1106 + in 1101 1107 rp k { 1102 1108 pat_desc = Tpat_var (id, name); 1103 1109 pat_loc = sp.ppat_loc; ··· 1105 1111 pat_type = expected_ty; 1106 1112 pat_attributes = []; 1107 1113 pat_env = !env } 1108 1108 - | Ppat_constraint({ppat_desc=Ppat_var name; ppat_loc=lloc; ppat_attributes = attrs}, 1109 1109 - ({ptyp_desc=Ptyp_poly _} as sty)) -> 1114 1114 + | Ppat_constraint( 1115 1115 + {ppat_desc=Ppat_var name; ppat_loc=lloc; ppat_attributes = attrs}, 1116 1116 + ({ptyp_desc=Ptyp_poly _} as sty)) -> 1110 1117 (* explicitly polymorphic type *) 1111 1118 assert (constrs = None); 1112 1119 let cty, force = Typetexp.transl_simple_type_delayed !env sty in ··· 1137 1144 let ty_var = build_as_type !env q in 1138 1145 end_def (); 1139 1146 generalize ty_var; 1140 1140 - let id = enter_variable ~is_as_variable:true loc name ty_var sp.ppat_attributes in 1147 1147 + let id = 1148 1148 + enter_variable ~is_as_variable:true loc name ty_var sp.ppat_attributes 1149 1149 + in 1141 1150 rp k { 1142 1151 pat_desc = Tpat_alias(q, id, name); 1143 1152 pat_loc = loc; pat_extra=[]; ··· 1583 1592 pattern_variables := []; 1584 1593 let (val_env, met_env, par_env) = 1585 1594 List.fold_right 1586 1586 - (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} (val_env, met_env, par_env) -> 1595 1595 + (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} 1596 1596 + (val_env, met_env, par_env) -> 1587 1597 (Env.add_value pv_id {val_type = pv_type; 1588 1598 val_kind = 1589 1599 Val_unbound Val_unbound_instance_variable; ··· 1591 1601 Types.val_loc = pv_loc; 1592 1602 } val_env, 1593 1603 Env.add_value pv_id {val_type = pv_type; 1594 1594 - val_kind = Val_self (meths, vars, cl_num, privty); 1604 1604 + val_kind = 1605 1605 + Val_self (meths, vars, cl_num, privty); 1595 1606 val_attributes = pv_attributes; 1596 1607 Types.val_loc = pv_loc; 1597 1608 } ··· 1696 1707 is_nonexpansive_mod mexp && is_nonexpansive e 1697 1708 | Texp_pack mexp -> 1698 1709 is_nonexpansive_mod mexp 1699 1699 - (* Computations which raise exceptions are nonexpansive, since (raise e) is equivalent 1700 1700 - to (raise e; diverge), and a nonexpansive "diverge" can be produced using lazy values 1701 1701 - or the relaxed value restriction. See GPR#1142 *) 1710 1710 + (* Computations which raise exceptions are nonexpansive, since (raise e) is 1711 1711 + equivalent to (raise e; diverge), and a nonexpansive "diverge" can be 1712 1712 + produced using lazy values or the relaxed value restriction. 1713 1713 + See GPR#1142 *) 1702 1714 | Texp_assert exp -> 1703 1715 is_nonexpansive exp 1704 1716 | Texp_apply ( ··· 1729 1741 id_mod_list 1730 1742 | Tstr_exception {tyexn_constructor = {ext_kind = Text_decl _}} -> 1731 1743 false (* true would be unsound *) 1732 1732 - | Tstr_exception {tyexn_constructor = {ext_kind = Text_rebind _}} -> true 1744 1744 + | Tstr_exception {tyexn_constructor = {ext_kind = Text_rebind _}} -> 1745 1745 + true 1733 1746 | Tstr_typext te -> 1734 1747 List.for_all 1735 1748 (function {ext_kind = Text_decl _} -> false ··· 2252 2265 Exp.let_ ~loc Nonrecursive ~attrs:[mknoloc "#default",PStr []] 2253 2266 [Vb.mk spat smatch] sbody 2254 2267 in 2255 2255 - type_function ?in_function loc sexp.pexp_attributes env ty_expected_explained 2256 2256 - l [Exp.case pat body] 2268 2268 + type_function ?in_function loc sexp.pexp_attributes env 2269 2269 + ty_expected_explained l [Exp.case pat body] 2257 2270 | Pexp_fun (l, None, spat, sbody) -> 2258 2258 - type_function ?in_function loc sexp.pexp_attributes env ty_expected_explained 2259 2259 - l [Ast_helper.Exp.case spat sbody] 2271 2271 + type_function ?in_function loc sexp.pexp_attributes env 2272 2272 + ty_expected_explained l [Ast_helper.Exp.case spat sbody] 2260 2273 | Pexp_function caselist -> 2261 2274 type_function ?in_function 2262 2275 loc sexp.pexp_attributes env ty_expected_explained Nolabel caselist ··· 2670 2683 let tv = newvar () in 2671 2684 let gen = generalizable tv.level arg.exp_type in 2672 2685 (try unify_var env tv arg.exp_type with Unify trace -> 2673 2673 - raise(Error(arg.exp_loc, env, Expr_type_clash (trace, None)))); 2686 2686 + raise(Error(arg.exp_loc, env, 2687 2687 + Expr_type_clash (trace, None)))); 2674 2688 gen 2675 2689 end else true 2676 2690 in ··· 4275 4289 List.exists 4276 4290 (fun attrs -> 4277 4291 Builtin_attributes.warning_scope ~ppwarning:false attrs (fun () -> 4278 4278 - Warnings.is_active (check "") || Warnings.is_active (check_strict "") || 4279 4279 - (is_recursive && (Warnings.is_active Warnings.Unused_rec_flag)))) 4292 4292 + Warnings.is_active (check "") || Warnings.is_active (check_strict "") 4293 4293 + || (is_recursive && (Warnings.is_active Warnings.Unused_rec_flag)))) 4280 4294 attrs_list 4281 4295 in 4282 4296 let pat_slot_list = ··· 4307 4321 List.iter 4308 4322 (fun id -> 4309 4323 let vd = Env.find_value (Path.Pident id) new_env in 4310 4310 - (* note: Env.find_value does not trigger the value_used event *) 4324 4324 + (* note: Env.find_value does not trigger the value_used 4325 4325 + event *) 4311 4326 let name = Ident.name id in 4312 4327 let used = ref false in 4313 4328 if not (name = "" || name.[0] = '_' || name.[0] = '#') then

+4 -2

typing/typecore.mli

reviewed

··· 120 120 | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list 121 121 | Multiply_bound_variable of string 122 122 | Orpat_vars of Ident.t * Ident.t list 123 123 - | Expr_type_clash of (type_expr * type_expr) list * type_forcing_context option 123 123 + | Expr_type_clash of 124 124 + (type_expr * type_expr) list * type_forcing_context option 124 125 | Apply_non_function of type_expr 125 126 | Apply_wrong_label of arg_label * type_expr 126 127 | Label_multiply_defined of string 127 128 | Label_missing of Ident.t list 128 129 | Label_not_mutable of Longident.t 129 129 - | Wrong_name of string * type_expected * string * Path.t * string * string list 130 130 + | Wrong_name of 131 131 + string * type_expected * string * Path.t * string * string list 130 132 | Name_type_mismatch of 131 133 string * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list 132 134 | Invalid_format of string

+2 -1

typing/typedtreeMap.ml

reviewed

··· 219 219 let tyexn_constructor = 220 220 map_extension_constructor tyexn.tyexn_constructor 221 221 in 222 222 - Map.leave_type_exception { tyexn with tyexn_constructor = tyexn_constructor } 222 222 + Map.leave_type_exception 223 223 + { tyexn with tyexn_constructor = tyexn_constructor } 223 224 224 225 and map_extension_constructor ext = 225 226 let ext = Map.enter_extension_constructor ext in

+13 -5

typing/typemod.ml

reviewed

··· 470 470 in 471 471 let params = tdecl.typ_type.type_params in 472 472 if params_are_constrained params 473 473 - then raise(Error(loc, initial_env, With_cannot_remove_constrained_type)); 473 473 + then raise(Error(loc, initial_env, 474 474 + With_cannot_remove_constrained_type)); 474 475 fun s path -> Subst.add_type_function path ~params ~body s 475 476 in 476 477 let sub = Subst.change_locs Subst.identity loc in ··· 844 845 let (ext, newenv) = Typedecl.transl_type_exception env sext in 845 846 let (trem, rem, final_env) = transl_sig newenv srem in 846 847 mksig (Tsig_exception ext) env loc :: trem, 847 847 - Sig_typext(ext.tyexn_constructor.ext_id, ext.tyexn_constructor.ext_type, Text_exception) :: rem, 848 848 + Sig_typext(ext.tyexn_constructor.ext_id, 849 849 + ext.tyexn_constructor.ext_type, 850 850 + Text_exception) :: rem, 848 851 final_env 849 852 | Psig_module pmd -> 850 853 check_name check_module names pmd.pmd_name; ··· 968 971 (fun () -> 969 972 let (trem, rem, final_env) = transl_sig (Env.in_signature true env) sg in 970 973 let rem = simplify_signature rem in 971 971 - let sg = { sig_items = trem; sig_type = rem; sig_final_env = final_env } in 974 974 + let sg = 975 975 + { sig_items = trem; sig_type = rem; sig_final_env = final_env } 976 976 + in 972 977 Cmt_format.set_saved_types 973 978 ((Cmt_format.Partial_signature sg) :: previous_saved_types); 974 979 sg ··· 1526 1531 check_name check_typext names sext.ptyexn_constructor.pext_name; 1527 1532 let (ext, newenv) = Typedecl.transl_type_exception env sext in 1528 1533 Tstr_exception ext, 1529 1529 - [Sig_typext(ext.tyexn_constructor.ext_id, ext.tyexn_constructor.ext_type, Text_exception)], 1534 1534 + [Sig_typext(ext.tyexn_constructor.ext_id, 1535 1535 + ext.tyexn_constructor.ext_type, 1536 1536 + Text_exception)], 1530 1537 newenv 1531 1538 | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs; 1532 1539 pmb_loc; ··· 1982 1989 (prefix ^ ".cmi") imports 1983 1990 in 1984 1991 Cmt_format.save_cmt (prefix ^ ".cmt") modulename 1985 1985 - (Cmt_format.Packed (cmi.Cmi_format.cmi_sign, objfiles)) None initial_env (Some cmi) 1992 1992 + (Cmt_format.Packed (cmi.Cmi_format.cmi_sign, objfiles)) None initial_env 1993 1993 + (Some cmi) 1986 1994 end; 1987 1995 Tcoerce_none 1988 1996 end

+2 -2

typing/types.ml

reviewed

··· 328 328 | Cstr_extension of Path.t * bool (* Extension constructor 329 329 true if a constant false if a block*) 330 330 331 331 - let equal_tag t1 t2 = 331 331 + let equal_tag t1 t2 = 332 332 match (t1, t2) with 333 333 | Cstr_constant i1, Cstr_constant i2 -> i2 = i1 334 334 | Cstr_block i1, Cstr_block i2 -> i2 = i1 335 335 | Cstr_unboxed, Cstr_unboxed -> true 336 336 - | Cstr_extension (path1, b1), Cstr_extension (path2, b2) -> 336 336 + | Cstr_extension (path1, b1), Cstr_extension (path2, b2) -> 337 337 Path.same path1 path2 && b1 = b2 338 338 | (Cstr_constant _|Cstr_block _|Cstr_unboxed|Cstr_extension _), _ -> false 339 339

+2 -1

typing/typetexp.ml

reviewed

··· 175 175 r 176 176 177 177 let lookup_module ?(load=false) env loc lid = 178 178 - find_component (fun ?loc ?mark lid env -> (Env.lookup_module ~load ?loc ?mark lid env)) 178 178 + find_component 179 179 + (fun ?loc ?mark lid env -> (Env.lookup_module ~load ?loc ?mark lid env)) 179 180 (fun lid -> Unbound_module lid) env loc lid 180 181 181 182 let find_module env loc lid =

+2 -1

utils/config.mli

reviewed

··· 29 29 val c_compiler: string 30 30 (* The compiler to use for compiling C files *) 31 31 val c_output_obj: string 32 32 - (* Name of the option of the C compiler for specifying the output file *) 32 32 + (* Name of the option of the C compiler for specifying the output 33 33 + file *) 33 34 val ocamlc_cflags : string 34 35 (* The flags ocamlc should pass to the C compiler *) 35 36 val ocamlc_cppflags : string

+3 -1

utils/identifiable.ml

reviewed

··· 46 46 val filter_map : 'a t -> f:(key -> 'a -> 'b option) -> 'b t 47 47 val of_list : (key * 'a) list -> 'a t 48 48 49 49 - val disjoint_union : ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 'a t -> 'a t 49 49 + val disjoint_union : 50 50 + ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 51 51 + 'a t -> 'a t 50 52 51 53 val union_right : 'a t -> 'a t -> 'a t 52 54

+3 -1

utils/identifiable.mli

reviewed

··· 53 53 (** [disjoint_union m1 m2] contains all bindings from [m1] and 54 54 [m2]. If some binding is present in both and the associated 55 55 value is not equal, a Fatal_error is raised *) 56 56 - val disjoint_union : ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 'a t -> 'a t 56 56 + val disjoint_union : 57 57 + ?eq:('a -> 'a -> bool) -> ?print:(Format.formatter -> 'a -> unit) -> 'a t -> 58 58 + 'a t -> 'a t 57 59 58 60 (** [union_right m1 m2] contains all bindings from [m1] and [m2]. If 59 61 some binding is present in both, the one from [m2] is taken *)

+2 -1

utils/profile.ml

reviewed

··· 310 310 | None -> Measure.zero 311 311 in 312 312 let total = Measure_diff.of_diff Measure.zero (Measure.create ()) in 313 313 - display_rows ppf (rows_of_hierarchy !hierarchy total initial_measure columns) 313 313 + display_rows ppf 314 314 + (rows_of_hierarchy !hierarchy total initial_measure columns) 314 315 315 316 let column_mapping = [ 316 317 "time", `Time;

+1 -1

utils/terminfo.ml

reviewed

··· 23 23 | Bad_term 24 24 | Good_term 25 25 26 26 - let setup oc = 26 26 + let setup oc = 27 27 let term = try Sys.getenv "TERM" with Not_found -> "" in 28 28 (* Same heuristics as in Misc.Color.should_enable_color *) 29 29 if term <> "" && term <> "dumb" && isatty oc